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