|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_HOR_ISBA_FIELD(HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE) 00003 ! ################################################################################# 00004 ! 00005 !!**** *PREP_HOR_ISBA_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 !! M. Lafaysse 07/2012, allow netcdf input files 00028 !! B. Decharme 07/2012, Bug init uniform snow 00029 !!------------------------------------------------------------------ 00030 ! 00031 ! 00032 ! 00033 USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, & 00034 XLAT_OUT, XLON_OUT, XX_OUT, XY_OUT, & 00035 LINTERP, CMASK 00036 00037 USE MODD_PREP_ISBA, ONLY : XGRID_SOIL, NGRID_LEVEL, LSNOW_IDEAL, & 00038 XWSNOW, XRSNOW, XTSNOW, XASNOW, & 00039 XSG1SNOW, XSG2SNOW, XHISTSNOW, XAGESNOW 00040 00041 USE MODD_ISBA_n, ONLY : TTIME, XWG, XWGI, XTG, XWR, XLAI, & 00042 NGROUND_LAYER, NPATCH, NWG_LAYER, & 00043 XVEGTYPE_PATCH, XDG, XWWILT, XWFC, XPATCH,& 00044 CISBA, XROOTFRAC, XWSAT, TSNOW, XVEGTYPE, & 00045 LTEMP_ARP, NTEMPLAYER_ARP, XSODELX 00046 00047 USE MODD_ISBA_GRID_n, ONLY : XLAT, XLON 00048 USE MODD_ISBA_PAR, ONLY : XWGMIN 00049 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00050 USE MODD_SURF_PAR, ONLY : XUNDEF,NUNDEF 00051 ! 00052 USE MODI_READ_PREP_ISBA_CONF 00053 USE MODI_READ_PREP_ISBA_SNOW 00054 USE MODI_PREP_ISBA_ASCLLV 00055 USE MODI_PREP_ISBA_GRIB 00056 USE MODI_PREP_ISBA_UNIF 00057 USE MODI_PREP_ISBA_BUFFER 00058 USE MODI_ABOR1_SFX 00059 USE MODI_HOR_INTERPOL 00060 USE MODI_VEGTYPE_GRID_TO_PATCH_GRID 00061 USE MODI_PREP_HOR_SNOW_FIELDS 00062 USE MODI_GET_LUOUT 00063 USE MODI_PREP_ISBA_EXTERN 00064 USE MODI_PREP_ISBA_NETCDF 00065 ! 00066 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00067 USE PARKIND1 ,ONLY : JPRB 00068 ! 00069 IMPLICIT NONE 00070 ! 00071 !* 0.1 declarations of arguments 00072 ! 00073 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00074 CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field 00075 CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file 00076 CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! type of the Atmospheric file 00077 CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! name of the Atmospheric file 00078 CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! type of the Atmospheric file 00079 ! 00080 !* 0.2 declarations of local variables 00081 ! 00082 CHARACTER(LEN=6) :: YFILETYPE ! type of input file 00083 CHARACTER(LEN=28) :: YFILE ! name of file 00084 CHARACTER(LEN=6) :: YFILETYPE_SNOW ! type of input file 00085 CHARACTER(LEN=28) :: YFILE_SNOW ! name of file 00086 CHARACTER(LEN=6) :: YFILEPGDTYPE ! type of input file 00087 CHARACTER(LEN=28) :: YFILEPGD ! name of file 00088 REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally 00089 REAL, POINTER, DIMENSION(:,:) :: ZFIELD ! field to interpolate horizontally 00090 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUT ! field interpolated horizontally 00091 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZW ! work array (x, fine soil grid, npatch) 00092 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZF ! work array (x, output soil grid, npatch) 00093 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZDG ! out T grid (x, output soil grid, npatch) 00094 INTEGER :: ILUOUT ! output listing logical unit 00095 ! 00096 LOGICAL :: GUNIF ! flag for prescribed uniform field 00097 LOGICAL :: GUNIF_SNOW! flag for prescribed uniform field 00098 INTEGER :: JPATCH ! loop on patches 00099 INTEGER :: JVEGTYPE ! loop on vegtypes 00100 INTEGER :: INI, INL, JJ, JL! Work integer 00101 INTEGER, DIMENSION(SIZE(XDG,1),SIZE(XDG,3)) :: IWORK 00102 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00103 !------------------------------------------------------------------------------------- 00104 ! 00105 ! 00106 !* 1. Reading of input file name and type 00107 ! 00108 IF (LHOOK) CALL DR_HOOK('PREP_HOR_ISBA_FIELD',0,ZHOOK_HANDLE) 00109 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00110 ! 00111 CALL READ_PREP_ISBA_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,& 00112 HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF) 00113 ! 00114 CMASK = 'NATURE' 00115 ! 00116 INI=SIZE(XLAT) 00117 ! 00118 !------------------------------------------------------------------------------------- 00119 ! 00120 !* 2. Snow variables case? 00121 ! 00122 IF (HSURF=='SN_VEG ') THEN 00123 CALL READ_PREP_ISBA_SNOW(HPROGRAM,TSNOW%SCHEME,TSNOW%NLAYER,YFILE_SNOW,YFILETYPE_SNOW,GUNIF_SNOW) 00124 IF(.NOT.GUNIF_SNOW.AND.LEN_TRIM(YFILE_SNOW)==0.AND.LEN_TRIM(YFILETYPE_SNOW)==0)THEN 00125 IF(LEN_TRIM(YFILE)/=0.AND.LEN_TRIM(YFILETYPE)/=0)THEN 00126 YFILE_SNOW =YFILE 00127 YFILETYPE_SNOW=YFILETYPE 00128 ELSE 00129 GUNIF_SNOW=.TRUE. 00130 IF(ALL(XWSNOW==XUNDEF))XWSNOW=0.0 00131 ENDIF 00132 ENDIF 00133 CALL PREP_HOR_SNOW_FIELDS(HPROGRAM, HSURF, & 00134 YFILE_SNOW, YFILETYPE_SNOW, & 00135 YFILEPGD, YFILEPGDTYPE, & 00136 ILUOUT, GUNIF_SNOW, NPATCH, & 00137 INI,TSNOW, TTIME, & 00138 XWSNOW, XRSNOW, XTSNOW, XASNOW, & 00139 LSNOW_IDEAL, XSG1SNOW, & 00140 XSG2SNOW, XHISTSNOW, XAGESNOW, & 00141 XVEGTYPE_PATCH, XPATCH ) 00142 DEALLOCATE(XWSNOW) 00143 DEALLOCATE(XRSNOW) 00144 DEALLOCATE(XTSNOW) 00145 DEALLOCATE(XSG1SNOW) 00146 DEALLOCATE(XSG2SNOW) 00147 DEALLOCATE(XHISTSNOW) 00148 DEALLOCATE(XAGESNOW) 00149 IF (LHOOK) CALL DR_HOOK('PREP_HOR_ISBA_FIELD',1,ZHOOK_HANDLE) 00150 RETURN 00151 END IF 00152 ! 00153 !------------------------------------------------------------------------------------- 00154 ! 00155 !* 3. Reading of input configuration (Grid and interpolation type) 00156 ! 00157 IF (GUNIF) THEN 00158 CALL PREP_ISBA_UNIF(ILUOUT,HSURF,ZFIELDIN) 00159 ELSE IF (YFILETYPE=='ASCLLV') THEN 00160 CALL PREP_ISBA_ASCLLV(HPROGRAM,HSURF,ILUOUT,ZFIELDIN) 00161 ELSE IF (YFILETYPE=='GRIB ') THEN 00162 CALL PREP_ISBA_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN) 00163 ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI ') THEN 00164 CALL PREP_ISBA_EXTERN(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN) 00165 ELSE IF (YFILETYPE=='BUFFER') THEN 00166 CALL PREP_ISBA_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN) 00167 ELSE IF (YFILETYPE=='NETCDF') THEN 00168 CALL PREP_ISBA_NETCDF(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN) 00169 ELSE 00170 CALL ABOR1_SFX('PREP_HOR_ISBA_FIELD: data file type not supported : '//YFILETYPE) 00171 END IF 00172 ! 00173 !------------------------------------------------------------------------------------- 00174 ! 00175 !* 5. Horizontal interpolation 00176 ! 00177 ALLOCATE(ZFIELDOUT(INI,SIZE(ZFIELDIN,2),SIZE(ZFIELDIN,3))) 00178 ALLOCATE(ZFIELD(SIZE(ZFIELDIN,1),SIZE(ZFIELDIN,2))) 00179 ! 00180 DO JVEGTYPE = 1, SIZE(ZFIELDIN,3) 00181 ZFIELD=ZFIELDIN(:,:,JVEGTYPE) 00182 IF (SIZE(ZFIELDIN,3)==NVEGTYPE) LINTERP = (XVEGTYPE(:,JVEGTYPE) > 0.) 00183 CALL HOR_INTERPOL(ILUOUT,ZFIELD,ZFIELDOUT(:,:,JVEGTYPE)) 00184 LINTERP = .TRUE. 00185 END DO 00186 ! 00187 DEALLOCATE(ZFIELD) 00188 00189 !------------------------------------------------------------------------------------- 00190 ! 00191 !* 6. Transformation from vegtype grid to patch grid 00192 ! 00193 ALLOCATE(ZW (INI,SIZE(ZFIELDOUT,2),NPATCH)) 00194 ! 00195 ZW = 0. 00196 IF (SIZE(ZFIELDOUT,3)==NVEGTYPE) THEN 00197 CALL VEGTYPE_GRID_TO_PATCH_GRID(NPATCH,XVEGTYPE_PATCH,XPATCH,ZFIELDOUT,ZW) 00198 END IF 00199 ! 00200 !------------------------------------------------------------------------------------- 00201 ! 00202 !* 7. Return to historical variable 00203 ! 00204 ! 00205 SELECT CASE (HSURF) 00206 ! 00207 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00208 ! 00209 CASE('ZS ') 00210 ALLOCATE(XZS_LS(INI)) 00211 XZS_LS(:) = ZFIELDOUT(:,1,1) 00212 ! 00213 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00214 ! 00215 CASE('WG ') 00216 ALLOCATE(ZF (INI,NGROUND_LAYER,NPATCH)) 00217 ! 00218 !* interpolates on output levels 00219 CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,XDG,ZF) 00220 ! 00221 !* retrieves soil water content from soil relative humidity 00222 ALLOCATE(XWG(INI,NGROUND_LAYER,NPATCH)) 00223 XWG(:,:,:)=XUNDEF 00224 IF(CISBA=='DIF')THEN 00225 IWORK(:,:)=NWG_LAYER(:,:) 00226 ELSE 00227 IWORK(:,:)=SIZE(XWG,2) 00228 ENDIF 00229 DO JPATCH=1,NPATCH 00230 DO JJ=1,INI 00231 IF(IWORK(JJ,JPATCH)==NUNDEF)CYCLE 00232 INL=IWORK(JJ,JPATCH) 00233 DO JL=1,INL 00234 XWG(JJ,JL,JPATCH) = XWWILT(JJ,JL) + ZF(JJ,JL,JPATCH) * (XWFC(JJ,JL)-XWWILT(JJ,JL)) 00235 XWG(JJ,JL,JPATCH) = MAX(MIN(XWG(JJ,JL,JPATCH),XWSAT(JJ,JL)),XWGMIN) 00236 ENDDO 00237 ENDDO 00238 ENDDO 00239 ! 00240 WHERE(ZF(:,:,:)==XUNDEF)XWG(:,:,:)=XUNDEF 00241 ! 00242 DEALLOCATE(ZF) 00243 ! 00244 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00245 ! 00246 CASE('WGI ') 00247 ALLOCATE(ZF (INI,NGROUND_LAYER,NPATCH)) 00248 ! 00249 !* interpolates on output levels 00250 CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,XDG,ZF) 00251 ! 00252 !* retrieves soil ice content from soil relative humidity 00253 ALLOCATE(XWGI(INI,NGROUND_LAYER,NPATCH)) 00254 XWGI(:,:,:)=XUNDEF 00255 IF(CISBA=='DIF')THEN 00256 IWORK(:,:)=NWG_LAYER(:,:) 00257 ELSE 00258 IWORK(:,:)=SIZE(XWG,2) 00259 ENDIF 00260 DO JPATCH=1,NPATCH 00261 DO JJ=1,INI 00262 IF(IWORK(JJ,JPATCH)==NUNDEF)CYCLE 00263 INL=IWORK(JJ,JPATCH) 00264 DO JL=1,INL 00265 XWGI(JJ,JL,JPATCH) = ZF(JJ,JL,JPATCH) * XWSAT(JJ,JL) 00266 XWGI(JJ,JL,JPATCH) = MAX(MIN(XWGI(JJ,JL,JPATCH),XWSAT(JJ,JL)),0.) 00267 ENDDO 00268 ENDDO 00269 END DO 00270 ! 00271 WHERE(ZF(:,:,:)==XUNDEF)XWGI(:,:,:)=XUNDEF 00272 ! 00273 DEALLOCATE(ZF) 00274 ! 00275 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00276 ! 00277 CASE('TG ') 00278 IF(LTEMP_ARP)THEN 00279 INL=NTEMPLAYER_ARP 00280 ELSE 00281 INL=NGROUND_LAYER 00282 ENDIF 00283 ALLOCATE(XTG(INI,INL,NPATCH)) 00284 ALLOCATE(ZDG(SIZE(XDG,1),INL,SIZE(XDG,3))) 00285 IF (CISBA=='2-L'.OR.CISBA=='3-L') THEN 00286 IF(LTEMP_ARP)THEN 00287 DO JPATCH=1,NPATCH 00288 DO JL=1,INL 00289 ZDG(:,JL,JPATCH) = XSODELX(JL)-XSODELX(1) 00290 ENDDO 00291 ENDDO 00292 ELSE 00293 DO JPATCH=1,NPATCH 00294 ZDG(:,1,JPATCH) = 0. 00295 ZDG(:,2,JPATCH) = 0.40 ! deep temperature for force-restore taken at 20cm 00296 IF(CISBA=='3-L') ZDG(:,3,JPATCH) = 5.60 ! climatological temperature, usually not used 00297 ENDDO 00298 ENDIF 00299 ELSE 00300 !* diffusion method, the soil grid is the same as for humidity 00301 ZDG(:,:,:) = XDG(:,:,:) 00302 END IF 00303 CALL INIT_FROM_REF_GRID(XGRID_SOIL,ZW,ZDG,XTG) 00304 DEALLOCATE(ZDG) 00305 ! 00306 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00307 ! 00308 CASE('WR ') 00309 ALLOCATE(XWR(INI,NPATCH)) 00310 DO JPATCH=1,NPATCH 00311 XWR(:,JPATCH) = ZW(:,1,JPATCH) 00312 END DO 00313 ! 00314 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00315 ! 00316 CASE('LAI ') 00317 !* LAI is updated only if present and pertinent (evolutive LAI) in input file 00318 IF (ANY(ZW(:,:,:)/=XUNDEF)) THEN 00319 DO JPATCH=1,NPATCH 00320 XLAI(:,JPATCH) = ZW(:,1,JPATCH) 00321 END DO 00322 END IF 00323 ! 00324 END SELECT 00325 ! 00326 DEALLOCATE(ZW) 00327 !------------------------------------------------------------------------------------- 00328 ! 00329 !* 8. Deallocations 00330 ! 00331 DEALLOCATE(ZFIELDIN ) 00332 DEALLOCATE(ZFIELDOUT) 00333 IF (LHOOK) CALL DR_HOOK('PREP_HOR_ISBA_FIELD',1,ZHOOK_HANDLE) 00334 ! 00335 !------------------------------------------------------------------------------------- 00336 !------------------------------------------------------------------------------------- 00337 ! 00338 CONTAINS 00339 ! 00340 !------------------------------------------------------------------------------------- 00341 !------------------------------------------------------------------------------------- 00342 ! 00343 SUBROUTINE INIT_FROM_REF_GRID(PGRID1,PT1,PD2,PT2) 00344 ! 00345 USE MODI_INTERP_GRID 00346 ! 00347 REAL, DIMENSION(:,:,:), INTENT(IN) :: PT1 ! variable profile 00348 REAL, DIMENSION(:), INTENT(IN) :: PGRID1 ! normalized grid 00349 REAL, DIMENSION(:,:,:), INTENT(IN) :: PD2 ! output layer thickness 00350 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PT2 ! variable profile 00351 ! 00352 INTEGER :: JI,JL ! loop counter 00353 REAL, DIMENSION(SIZE(PT1,1),SIZE(PT1,2)) :: ZD1 ! input grid 00354 REAL, DIMENSION(SIZE(PD2,1),SIZE(PD2,2)) :: ZD2 ! output grid 00355 ! 00356 INTEGER :: ILAYER1, ILAYER2 00357 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00358 ! 00359 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00360 ! 00361 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',0,ZHOOK_HANDLE) 00362 IF (SIZE(PT1,2)==3) THEN 00363 ! 00364 !* 1. case with only 3 input levels (typically coming from 'UNIF') 00365 ! ----------------------------- 00366 ! 00367 IF (CISBA=='2-L' .OR. CISBA=='3-L') THEN 00368 !* Possible LTEMP_ARP case 00369 IF(SIZE(PT2,2)>3)THEN 00370 ILAYER1=3 00371 ILAYER2=SIZE(PT2,2) 00372 ELSE 00373 ILAYER1=SIZE(PT2,2) 00374 ILAYER2=0 00375 ENDIF 00376 !* historical 2L or 3L ISBA version 00377 DO JPATCH=1,NPATCH 00378 PT2(:,1:ILAYER1,JPATCH) = PT1(:,1:ILAYER1,JPATCH) 00379 !* Possible LTEMP_ARP case 00380 IF(ILAYER2>0)THEN 00381 DO JL=ILAYER1+1,ILAYER2 00382 PT2(:,JL,JPATCH) = PT2(:,ILAYER1,JPATCH) 00383 ENDDO 00384 ENDIF 00385 END DO 00386 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',1,ZHOOK_HANDLE) 00387 RETURN 00388 ! 00389 ELSEIF(CISBA=='DIF')THEN 00390 DO JPATCH=1,NPATCH 00391 !surface layer (generally 0.01m imposed) 00392 PT2(:,1,JPATCH) = PT1(:,1,JPATCH) 00393 !deep layers 00394 DO JL=2,NGROUND_LAYER 00395 PT2(:,JL,JPATCH) = PT1(:,3,JPATCH) 00396 END DO 00397 !if root layers 00398 DO JI=1,SIZE(PT1,1) 00399 DO JL=2,NGROUND_LAYER 00400 IF(XROOTFRAC(JI,JL,JPATCH)<=1.0)THEN 00401 PT2(JI,JL,JPATCH) = PT1(JI,2,JPATCH) 00402 EXIT 00403 ENDIF 00404 END DO 00405 END DO 00406 END DO 00407 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',1,ZHOOK_HANDLE) 00408 RETURN 00409 END IF 00410 ! 00411 END IF 00412 ! 00413 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00414 ! 00415 !* 2. case with fine grid as input (general case) 00416 ! ---------------------------- 00417 ! 00418 DO JPATCH=1,NPATCH 00419 ZD2(:,:) = 0. 00420 ! 00421 ZD2(:,1) = PD2(:,1,JPATCH)/2. 00422 DO JL=2,SIZE(ZD2,2) 00423 ZD2(:,JL) = (PD2(:,JL-1,JPATCH)+PD2(:,JL,JPATCH)) /2. 00424 END DO 00425 ! 00426 DO JL=1,SIZE(PT1,2) 00427 ZD1(:,JL) = PGRID1(JL) 00428 END DO 00429 ! 00430 CALL INTERP_GRID(ZD1,PT1(:,:,JPATCH),ZD2,PT2(:,:,JPATCH)) 00431 END DO 00432 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',1,ZHOOK_HANDLE) 00433 ! 00434 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00435 END SUBROUTINE INIT_FROM_REF_GRID 00436 !------------------------------------------------------------------------------------- 00437 ! 00438 END SUBROUTINE PREP_HOR_ISBA_FIELD
1.8.0
