|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_HOR_TEB_GARDEN_FIELD(HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE) 00003 ! ################################################################################# 00004 ! 00005 !!**** *PREP_HOR_TEB_GARDEN_FIELD* - reads, interpolates and prepares an ISBA field 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! REFERENCE 00014 !! --------- 00015 !! 00016 !! 00017 !! AUTHOR 00018 !! ------ 00019 !! V. Masson 00020 !! 00021 !! MODIFICATIONS 00022 !! ------------- 00023 !! Original 01/2004 00024 !! P. Le Moigne 10/2005, Phasage Arome 00025 !! P. Le Moigne 03/2007, Ajout initialisation par ascllv 00026 !! B. Decharme 01/2009, Optional Arpege deep soil temperature initialization 00027 !!------------------------------------------------------------------ 00028 ! 00029 ! 00030 ! 00031 USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, & 00032 XLAT_OUT, XLON_OUT, XX_OUT, XY_OUT, & 00033 LINTERP, CMASK 00034 00035 USE MODD_PREP_TEB_GARDEN, ONLY : XGRID_SOIL, NGRID_LEVEL, & 00036 XWSNOW, XRSNOW, XTSNOW, XASNOW, LSNOW_IDEAL 00037 USE MODD_TEB_n, ONLY : TTIME 00038 USE MODD_TEB_VEG_n, ONLY : CISBA 00039 USE MODD_TEB_GARDEN_n, ONLY : XWG, XWGI, XTG, XWR, XLAI, & 00040 NGROUND_LAYER, & 00041 XVEGTYPE, XDG, XWWILT, XWFC, & 00042 XROOTFRAC, XWSAT, TSNOW 00043 USE MODD_TEB_GRID_n, ONLY : XLAT, XLON 00044 USE MODD_ISBA_PAR, ONLY : XWGMIN 00045 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00046 USE MODD_SURF_PAR, ONLY : XUNDEF 00047 ! 00048 USE MODI_READ_PREP_TEB_GARDEN_CONF 00049 USE MODI_READ_PREP_GARDEN_SNOW 00050 USE MODI_PREP_TEB_GARDEN_ASCLLV 00051 USE MODI_PREP_TEB_GARDEN_GRIB 00052 USE MODI_PREP_TEB_GARDEN_UNIF 00053 USE MODI_PREP_TEB_GARDEN_BUFFER 00054 USE MODI_HOR_INTERPOL 00055 USE MODI_VEGTYPE_GRID_TO_PATCH_GRID 00056 USE MODI_PREP_HOR_SNOW_FIELDS 00057 USE MODI_GET_LUOUT 00058 USE MODI_PREP_TEB_GARDEN_EXTERN 00059 ! 00060 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00061 USE PARKIND1 ,ONLY : JPRB 00062 ! 00063 USE MODI_ABOR1_SFX 00064 IMPLICIT NONE 00065 ! 00066 !* 0.1 declarations of arguments 00067 ! 00068 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00069 CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field 00070 CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file 00071 CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! type of the Atmospheric file 00072 CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! name of the Atmospheric file 00073 CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! type of the Atmospheric file 00074 ! 00075 !* 0.2 declarations of local variables 00076 ! 00077 CHARACTER(LEN=6) :: YFILETYPE ! type of input file 00078 CHARACTER(LEN=28) :: YFILE ! name of file 00079 CHARACTER(LEN=6) :: YFILEPGDTYPE ! type of input file 00080 CHARACTER(LEN=28) :: YFILEPGD ! name of file 00081 REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally 00082 REAL, POINTER, DIMENSION(:,:) :: ZFIELD ! field to interpolate horizontally 00083 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUT ! field interpolated horizontally 00084 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZVEGTYPE_PATCH ! vegtype for each patch 00085 REAL, ALLOCATABLE, DIMENSION(:,:) :: ZW ! work array (x, fine soil grid) 00086 REAL, ALLOCATABLE, DIMENSION(:) :: ZSUM 00087 REAL, ALLOCATABLE, DIMENSION(:,:) :: ZF ! work array (x, output soil grid) 00088 REAL, ALLOCATABLE, DIMENSION(:,:) :: ZDG ! out T grid (x, output soil grid) 00089 REAL, ALLOCATABLE, DIMENSION(:,:) :: ZPATCH ! work array for patches 00090 REAL, ALLOCATABLE, DIMENSION(:) :: ZSG1SNOW, ZSG2SNOW, ZHISTSNOW, ZAGESNOW 00091 INTEGER :: ILUOUT ! output listing logical unit 00092 ! 00093 LOGICAL :: GUNIF ! flag for prescribed uniform field 00094 INTEGER :: JVEGTYPE ! loop on vegtypes 00095 INTEGER :: JLAYER ! loop on layers 00096 INTEGER :: JI 00097 INTEGER :: IWORK ! Work integer 00098 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00099 !------------------------------------------------------------------------------------- 00100 ! 00101 ! 00102 !* 1. Reading of input file name and type 00103 ! 00104 IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_GARDEN_FIELD',0,ZHOOK_HANDLE) 00105 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00106 ! 00107 CALL READ_PREP_TEB_GARDEN_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,& 00108 HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF) 00109 ! 00110 CMASK = 'TOWN ' 00111 ! 00112 !------------------------------------------------------------------------------------- 00113 ! 00114 !* 2. Snow variables case? 00115 ! 00116 IF (HSURF=='SN_VEG ') THEN 00117 CALL READ_PREP_GARDEN_SNOW(HPROGRAM,TSNOW%SCHEME,TSNOW%NLAYER,YFILE,YFILETYPE) 00118 IF (LEN_TRIM(YFILE)>0 .AND. LEN_TRIM(YFILETYPE)>0) GUNIF = .FALSE. 00119 ALLOCATE(ZSG1SNOW(SIZE(XWSNOW))) 00120 ALLOCATE(ZSG2SNOW(SIZE(XWSNOW))) 00121 ALLOCATE(ZHISTSNOW(SIZE(XWSNOW))) 00122 ALLOCATE(ZAGESNOW(SIZE(XWSNOW))) 00123 ALLOCATE(ZPATCH(SIZE(XVEGTYPE,1),1)) 00124 ALLOCATE(ZVEGTYPE_PATCH (SIZE(XVEGTYPE,1),SIZE(XVEGTYPE,2),1)) 00125 ! 00126 ZPATCH=1. 00127 ZVEGTYPE_PATCH(:,:,1) = XVEGTYPE(:,:) 00128 CALL PREP_HOR_SNOW_FIELDS(HPROGRAM,HSURF, & 00129 YFILE,YFILETYPE, & 00130 YFILEPGD, YFILEPGDTYPE, & 00131 ILUOUT,GUNIF,1, & 00132 SIZE(XLAT),TSNOW, TTIME, & 00133 XWSNOW, XRSNOW, XTSNOW, XASNOW, & 00134 LSNOW_IDEAL, ZSG1SNOW, & 00135 ZSG2SNOW, ZHISTSNOW, ZAGESNOW, & 00136 ZVEGTYPE_PATCH, ZPATCH ) 00137 DEALLOCATE(ZSG1SNOW) 00138 DEALLOCATE(ZSG2SNOW) 00139 DEALLOCATE(ZHISTSNOW) 00140 DEALLOCATE(ZAGESNOW) 00141 DEALLOCATE(ZPATCH) 00142 DEALLOCATE(ZVEGTYPE_PATCH) 00143 IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_GARDEN_FIELD',1,ZHOOK_HANDLE) 00144 RETURN 00145 END IF 00146 ! 00147 !------------------------------------------------------------------------------------- 00148 ! 00149 !* 3. Reading of input configuration (Grid and interpolation type) 00150 ! 00151 IF (GUNIF) THEN 00152 CALL PREP_TEB_GARDEN_UNIF(ILUOUT,HSURF,ZFIELDIN) 00153 ELSE IF (YFILETYPE=='ASCLLV') THEN 00154 CALL PREP_TEB_GARDEN_ASCLLV(HPROGRAM,HSURF,ILUOUT,ZFIELDIN) 00155 ELSE IF (YFILETYPE=='GRIB ') THEN 00156 CALL PREP_TEB_GARDEN_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN) 00157 ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI ') THEN 00158 CALL PREP_TEB_GARDEN_EXTERN(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN) 00159 ELSE IF (YFILETYPE=='BUFFER') THEN 00160 CALL PREP_TEB_GARDEN_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN) 00161 ELSE 00162 CALL ABOR1_SFX('PREP_HOR_TEB_GARDEN_FIELD: data file type not supported : '//YFILETYPE) 00163 END IF 00164 ! 00165 !------------------------------------------------------------------------------------- 00166 ! 00167 !* 5. Horizontal interpolation 00168 ! 00169 ALLOCATE(ZFIELDOUT(SIZE(XLAT),SIZE(ZFIELDIN,2),SIZE(ZFIELDIN,3))) 00170 ALLOCATE(ZFIELD(SIZE(ZFIELDIN,1),SIZE(ZFIELDIN,2))) 00171 ! 00172 DO JVEGTYPE = 1, SIZE(ZFIELDIN,3) 00173 ZFIELD=ZFIELDIN(:,:,JVEGTYPE) 00174 IF (SIZE(ZFIELDIN,3)==NVEGTYPE) LINTERP = (XVEGTYPE(:,JVEGTYPE) > 0.) 00175 CALL HOR_INTERPOL(ILUOUT,ZFIELD,ZFIELDOUT(:,:,JVEGTYPE)) 00176 LINTERP = .TRUE. 00177 END DO 00178 ! 00179 DEALLOCATE(ZFIELD) 00180 00181 !------------------------------------------------------------------------------------- 00182 ! 00183 !* 6. Transformation from vegtype grid to averaged grid 00184 ! 00185 ALLOCATE(ZW (SIZE(ZFIELDOUT,1),SIZE(ZFIELDOUT,2))) 00186 ALLOCATE(ZSUM (SIZE(ZFIELDOUT,1))) 00187 ZW = 0. 00188 ! 00189 DO JLAYER=1,SIZE(ZW,2) 00190 ZSUM(:) = SUM(XVEGTYPE(:,:),2,ZFIELDOUT(:,JLAYER,:)/=XUNDEF) 00191 DO JVEGTYPE=1,NVEGTYPE 00192 WHERE (ZFIELDOUT(:,JLAYER,JVEGTYPE)/=XUNDEF) 00193 ZW(:,JLAYER) = ZW(:,JLAYER) + XVEGTYPE(:,JVEGTYPE) * ZFIELDOUT(:,JLAYER,JVEGTYPE) / ZSUM(:) 00194 END WHERE 00195 END DO 00196 DO JI=1,SIZE(ZW,1) 00197 IF (ALL(ZFIELDOUT(JI,JLAYER,:)==XUNDEF)) ZW(JI,JLAYER) = XUNDEF 00198 ENDDO 00199 END DO 00200 ! 00201 !------------------------------------------------------------------------------------- 00202 ! 00203 !* 7. Return to historical variable 00204 ! 00205 ! 00206 SELECT CASE (HSURF) 00207 ! 00208 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00209 ! 00210 CASE('WG ') 00211 ALLOCATE(ZF (SIZE(ZFIELDOUT,1),NGROUND_LAYER)) 00212 ! 00213 !* interpolates on output levels 00214 CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,XDG,ZF) 00215 ! 00216 !* retrieves soil water content from soil relative humidity 00217 ALLOCATE(XWG(SIZE(ZFIELDOUT,1),NGROUND_LAYER)) 00218 XWG(:,:) = XWWILT + ZF(:,:) * (XWFC-XWWILT) 00219 XWG(:,:) = MAX(MIN(XWG(:,:),XWSAT),XWGMIN) 00220 ! 00221 WHERE(ZF(:,:)==XUNDEF)XWG(:,:)=XUNDEF 00222 ! 00223 DEALLOCATE(ZF) 00224 ! 00225 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00226 ! 00227 CASE('WGI ') 00228 ALLOCATE(ZF (SIZE(ZFIELDOUT,1),NGROUND_LAYER)) 00229 ! 00230 !* interpolates on output levels 00231 CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,XDG,ZF) 00232 ! 00233 !* retrieves soil ice content from soil relative humidity 00234 ALLOCATE(XWGI(SIZE(ZFIELDOUT,1),NGROUND_LAYER)) 00235 XWGI(:,:) = ZF(:,:) * XWSAT 00236 XWGI(:,:) = MAX(MIN(XWGI(:,:),XWSAT),0.) 00237 ! 00238 WHERE(ZF(:,:)==XUNDEF)XWGI(:,:)=XUNDEF 00239 ! 00240 DEALLOCATE(ZF) 00241 ! 00242 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00243 ! 00244 CASE('TG ') 00245 IWORK=NGROUND_LAYER 00246 ALLOCATE(XTG(SIZE(ZFIELDOUT,1),IWORK)) 00247 ALLOCATE(ZDG(SIZE(XDG,1),IWORK)) 00248 IF (CISBA=='2-L'.OR.CISBA=='3-L') THEN 00249 ZDG(:,1) = 0. 00250 ZDG(:,2) = 0.40 ! deep temperature for force-restore taken at 20cm 00251 IF(CISBA=='3-L') ZDG(:,3) = 5.60 ! climatological temperature, usually not used 00252 ELSE 00253 !* diffusion method, the soil grid is the same as for humidity 00254 ZDG(:,:) = XDG(:,:) 00255 END IF 00256 CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,ZDG,XTG) 00257 DEALLOCATE(ZDG) 00258 ! 00259 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00260 ! 00261 CASE('WR ') 00262 ALLOCATE(XWR(SIZE(ZFIELDOUT,1))) 00263 XWR(:) = ZW(:,1) 00264 ! 00265 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00266 ! 00267 CASE('LAI ') 00268 !* LAI is updated only if present and pertinent (evolutive LAI) in input file 00269 00270 WHERE (ZW(:,1)/=XUNDEF) XLAI(:) = ZW(:,1) 00271 ! 00272 END SELECT 00273 ! 00274 DEALLOCATE(ZW) 00275 !------------------------------------------------------------------------------------- 00276 ! 00277 !* 8. Deallocations 00278 ! 00279 DEALLOCATE(ZFIELDIN ) 00280 DEALLOCATE(ZFIELDOUT) 00281 ! 00282 IF (LHOOK) CALL DR_HOOK('PREP_HOR_TEB_GARDEN_FIELD',1,ZHOOK_HANDLE) 00283 ! 00284 !------------------------------------------------------------------------------------- 00285 !------------------------------------------------------------------------------------- 00286 ! 00287 CONTAINS 00288 ! 00289 !------------------------------------------------------------------------------------- 00290 !------------------------------------------------------------------------------------- 00291 ! 00292 SUBROUTINE INIT_FROM_REF_GRID(PGRID1,PT1,PD2,PT2) 00293 ! 00294 USE MODI_INTERP_GRID 00295 ! 00296 REAL, DIMENSION(:,:), INTENT(IN) :: PT1 ! variable profile 00297 REAL, DIMENSION(:), INTENT(IN) :: PGRID1 ! normalized grid 00298 REAL, DIMENSION(:,:), INTENT(IN) :: PD2 ! output layer thickness 00299 REAL, DIMENSION(:,:), INTENT(OUT) :: PT2 ! variable profile 00300 ! 00301 INTEGER :: JI, JL ! loop counter 00302 REAL, DIMENSION(SIZE(PT1,1),SIZE(PT1,2)) :: ZD1 ! input grid 00303 REAL, DIMENSION(SIZE(PD2,1),SIZE(PD2,2)) :: ZD2 ! output grid 00304 ! 00305 INTEGER :: ILAYER1, ILAYER2 00306 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00307 ! 00308 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00309 ! 00310 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',0,ZHOOK_HANDLE) 00311 IF (SIZE(PT1,2)==3) THEN 00312 ! 00313 !* 1. case with only 3 input levels (typically coming from 'UNIF') 00314 ! ----------------------------- 00315 ! 00316 IF (CISBA=='2-L' .OR. CISBA=='3-L') THEN 00317 !* Possible LTEMP_ARP case 00318 IF(SIZE(PT2,2)>3)THEN 00319 ILAYER1=3 00320 ILAYER2=SIZE(PT2,2) 00321 ELSE 00322 ILAYER1=SIZE(PT2,2) 00323 ILAYER2=0 00324 ENDIF 00325 !* historical 2L or 3L ISBA version 00326 PT2(:,1:ILAYER1) = PT1(:,1:ILAYER1) 00327 !* Possible LTEMP_ARP case 00328 IF(ILAYER2>0)THEN 00329 DO JL=ILAYER1+1,ILAYER2 00330 PT2(:,JL) = PT2(:,ILAYER1) 00331 ENDDO 00332 ENDIF 00333 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',1,ZHOOK_HANDLE) 00334 RETURN 00335 ! 00336 ELSEIF(CISBA=='DIF')THEN 00337 !surface layer (generally 0.01m imposed) 00338 PT2(:,1) = PT1(:,1) 00339 !deep layers 00340 DO JL=2,NGROUND_LAYER 00341 PT2(:,JL) = PT1(:,3) 00342 END DO 00343 !if root layers 00344 DO JI=1,SIZE(PT1,1) 00345 DO JL=2,NGROUND_LAYER 00346 IF(XROOTFRAC(JI,JL)<=1.0)THEN 00347 PT2(JI,JL) = PT1(JI,2) 00348 EXIT 00349 ENDIF 00350 END DO 00351 END DO 00352 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',1,ZHOOK_HANDLE) 00353 RETURN 00354 END IF 00355 ! 00356 END IF 00357 ! 00358 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00359 ! 00360 !* 2. case with fine grid as input (general case) 00361 ! ---------------------------- 00362 ! 00363 ZD2(:,:) = 0. 00364 ! 00365 ZD2(:,1) = PD2(:,1)/2. 00366 DO JL=2,SIZE(ZD2,2) 00367 ZD2(:,JL) = (PD2(:,JL-1)+PD2(:,JL)) /2. 00368 END DO 00369 ! 00370 DO JL=1,SIZE(PT1,2) 00371 ZD1(:,JL) = PGRID1(JL) 00372 END DO 00373 ! 00374 CALL INTERP_GRID(ZD1,PT1(:,:),ZD2,PT2(:,:)) 00375 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',1,ZHOOK_HANDLE) 00376 ! 00377 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00378 END SUBROUTINE INIT_FROM_REF_GRID 00379 !------------------------------------------------------------------------------------- 00380 ! 00381 END SUBROUTINE PREP_HOR_TEB_GARDEN_FIELD
1.8.0
