|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ##################### 00002 MODULE MODE_READ_EXTERN 00003 ! ##################### 00004 !------------------------------------------------------------------- 00005 ! 00006 USE MODI_READ_LECOCLIMAP 00007 ! 00008 USE MODI_PUT_ON_ALL_VEGTYPES 00009 USE MODI_OLD_NAME 00010 ! 00011 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00012 USE PARKIND1 ,ONLY : JPRB 00013 ! 00014 CONTAINS 00015 ! 00016 !--------------------------------------------------------------------------------------- 00017 ! 00018 ! ####################### 00019 SUBROUTINE READ_EXTERN_DEPTH(HPROGRAM,KLUOUT,HISBA,HNAT,HFIELD,KNI,KLAYER, & 00020 KPATCH,PSOILGRID,PDEPTH,KVERSION ) 00021 ! ####################### 00022 ! 00023 USE MODD_SURF_PAR, ONLY : NUNDEF, XUNDEF 00024 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NVEGTYPE 00025 ! 00026 USE MODI_READ_SURF_ISBA_PAR_n 00027 USE MODI_READ_SURF 00028 USE MODI_CONVERT_COVER_ISBA 00029 USE MODI_GARDEN_SOIL_DEPTH 00030 00031 ! Modifications : 00032 ! P.Marguinaud : 11-09-2012 : shorten field name 00033 00034 ! 00035 IMPLICIT NONE 00036 ! 00037 !* dummy arguments 00038 ! --------------- 00039 ! 00040 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! type of input file 00041 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00042 CHARACTER(LEN=3), INTENT(IN) :: HISBA ! type of ISBA soil scheme 00043 CHARACTER(LEN=3), INTENT(IN) :: HNAT ! type of surface (nature, gardens) 00044 CHARACTER(LEN=7), INTENT(IN) :: HFIELD ! field name 00045 INTEGER, INTENT(IN) :: KNI ! number of points 00046 INTEGER, INTENT(INOUT) :: KLAYER ! number of layers 00047 INTEGER, INTENT(IN) :: KPATCH ! number of patch 00048 INTEGER, INTENT(IN) :: KVERSION ! surface version 00049 REAL, DIMENSION(:), INTENT(IN) :: PSOILGRID 00050 REAL, DIMENSION(:,:,:), POINTER :: PDEPTH ! middle depth of each layer 00051 ! 00052 !* local variables 00053 ! --------------- 00054 ! 00055 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00056 CHARACTER(LEN=16) :: YRECFM2 00057 CHARACTER(LEN=100):: YCOMMENT ! Comment string 00058 INTEGER :: IRESP ! reading return code 00059 INTEGER :: ILAYER ! number of soil layers 00060 INTEGER :: JLAYER ! loop counter 00061 INTEGER :: JPATCH ! loop counter 00062 INTEGER :: JJ 00063 INTEGER :: IVERSION 00064 INTEGER :: IBUGFIX 00065 ! 00066 LOGICAL, DIMENSION(JPCOVER) :: GCOVER ! flag to read the covers 00067 REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOVER ! cover fractions 00068 REAL, DIMENSION(:,:), ALLOCATABLE :: ZGROUND_DEPTH ! cover fractions 00069 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWG_LAYER 00070 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZD ! depth of each inter-layer 00071 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDG ! depth of each inter-layer 00072 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDEPTH ! middle of each layer for each patch 00073 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! work array 00074 REAL, DIMENSION(KNI) :: ZHVEG ! high vegetation fraction 00075 REAL, DIMENSION(KNI) :: ZLVEG ! low vegetation fraction 00076 REAL, DIMENSION(KNI) :: ZNVEG ! no vegetation fraction 00077 CHARACTER(LEN=4) :: YHVEG ! type of high vegetation 00078 CHARACTER(LEN=4) :: YLVEG ! type of low vegetation 00079 CHARACTER(LEN=4) :: YNVEG ! type of no vegetation 00080 LOGICAL :: GECOCLIMAP ! T if ecoclimap is used 00081 LOGICAL :: GPAR_GARDEN! T if garden data are used 00082 LOGICAL :: GDATA_DG 00083 LOGICAL :: GDATA_GROUND_DEPTH 00084 INTEGER :: IHYDRO_LAYER 00085 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00086 ! 00087 ! 00088 !------------------------------------------------------------------------------ 00089 ! 00090 IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_DEPTH',0,ZHOOK_HANDLE) 00091 ! 00092 IF (HNAT=='NAT') THEN 00093 CALL READ_LECOCLIMAP(HPROGRAM,GECOCLIMAP) 00094 ELSE 00095 CALL READ_SURF(HPROGRAM,'PAR_GARDEN',GPAR_GARDEN,IRESP) 00096 GECOCLIMAP = .NOT. GPAR_GARDEN 00097 END IF 00098 ! 00099 !------------------------------------------------------------------------------ 00100 ! 00101 ALLOCATE(ZDG (KNI,KLAYER,KPATCH)) 00102 ALLOCATE(IWG_LAYER (KNI,KPATCH)) 00103 IWG_LAYER(:,:) = NUNDEF 00104 IHYDRO_LAYER = KLAYER 00105 ! 00106 IF (GECOCLIMAP) THEN 00107 ! 00108 !* reading of the cover to obtain the depth of inter-layers 00109 ! 00110 CALL OLD_NAME(HPROGRAM,'COVER_LIST ',YRECFM) 00111 CALL READ_SURF(HPROGRAM,YRECFM,GCOVER(:),IRESP,HDIR='-') 00112 ! 00113 ALLOCATE(ZCOVER(KNI,JPCOVER)) 00114 YRECFM='COVER' 00115 CALL READ_SURF(HPROGRAM,YRECFM,ZCOVER(:,:),GCOVER(:),IRESP,HDIR='A') 00116 ! 00117 !* computes soil layers 00118 ! 00119 CALL CONVERT_COVER_ISBA(HISBA,NUNDEF,ZCOVER,' ',HNAT,PSOILGRID=PSOILGRID,PDG=ZDG,KWG_LAYER=IWG_LAYER) 00120 IF (HISBA=='DIF') IHYDRO_LAYER = MAXVAL(IWG_LAYER(:,:),IWG_LAYER(:,:)/=NUNDEF) 00121 ! 00122 DEALLOCATE(ZCOVER) 00123 ! 00124 ENDIF 00125 ! 00126 YRECFM='VERSION' 00127 CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP) 00128 ! 00129 YRECFM='BUG' 00130 CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP) 00131 ! 00132 !------------------------------------------------------------------- 00133 IF (HNAT=='NAT' .AND. (IVERSION>=7 .OR. .NOT.GECOCLIMAP)) THEN 00134 ! 00135 !* directly read soil layers in the file for nature ISBA soil layers 00136 ! 00137 GDATA_DG = .TRUE. 00138 IF (IVERSION>=7) THEN 00139 YRECFM='L_DG' 00140 YCOMMENT=YRECFM 00141 CALL READ_SURF(HPROGRAM,YRECFM,GDATA_DG,IRESP,HCOMMENT=YCOMMENT) 00142 ENDIF 00143 ! 00144 IF (GDATA_DG) THEN 00145 ! 00146 ALLOCATE(ZWORK(KNI,KPATCH)) 00147 DO JLAYER=1,KLAYER 00148 IF (JLAYER<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JLAYER 00149 IF (JLAYER>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JLAYER 00150 CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,KLUOUT,KNI,ZWORK,IRESP,IVERSION,HDIR='A') 00151 DO JPATCH=1,KPATCH 00152 ZDG(:,JLAYER,JPATCH) = ZWORK(:,JPATCH) 00153 END DO 00154 END DO 00155 DEALLOCATE(ZWORK) 00156 ! 00157 ENDIF 00158 ! 00159 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN 00160 ! 00161 YRECFM2='L_GROUND_DEPTH' 00162 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='L_GROUND_DPT' 00163 YCOMMENT=YRECFM2 00164 CALL READ_SURF(HPROGRAM,YRECFM2,GDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT) 00165 ! 00166 IF (GDATA_GROUND_DEPTH) THEN 00167 ! 00168 YRECFM2='D_GROUND_DETPH' 00169 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='D_GROUND_DPT' 00170 ALLOCATE(ZGROUND_DEPTH(KNI,KPATCH)) 00171 CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM2,KLUOUT,KNI,ZGROUND_DEPTH(:,:),IRESP,IVERSION,HDIR='A') 00172 ! 00173 DO JPATCH=1,KPATCH 00174 DO JJ=1,KNI 00175 DO JLAYER=1,KLAYER 00176 IF ( ZDG(JJ,JLAYER,JPATCH) <= ZGROUND_DEPTH(JJ,JPATCH) .AND. ZGROUND_DEPTH(JJ,JPATCH) < XUNDEF ) & 00177 IWG_LAYER(JJ,JPATCH) = JLAYER 00178 ENDDO 00179 ENDDO 00180 ENDDO 00181 DEALLOCATE(ZGROUND_DEPTH) 00182 ! 00183 IF (HISBA=='DIF') IHYDRO_LAYER = MAXVAL(IWG_LAYER(:,:),IWG_LAYER(:,:)/=NUNDEF) 00184 ! 00185 ENDIF 00186 ! 00187 ENDIF 00188 ! 00189 ELSE IF (HNAT=='GRD' .AND. .NOT.GECOCLIMAP) THEN 00190 ! 00191 !* computes soil layers from vegetation fractions read in the file 00192 ! 00193 CALL READ_SURF(HPROGRAM,'D_TYPE_HVEG',YHVEG,IRESP) 00194 CALL READ_SURF(HPROGRAM,'D_TYPE_LVEG',YLVEG,IRESP) 00195 CALL READ_SURF(HPROGRAM,'D_TYPE_NVEG',YNVEG,IRESP) 00196 CALL READ_SURF(HPROGRAM,'D_FRAC_HVEG',ZHVEG,IRESP,HDIR='A') 00197 CALL READ_SURF(HPROGRAM,'D_FRAC_LVEG',ZLVEG,IRESP,HDIR='A') 00198 CALL READ_SURF(HPROGRAM,'D_FRAC_NVEG',ZNVEG,IRESP,HDIR='A') 00199 ! Ground layers 00200 CALL GARDEN_SOIL_DEPTH(YNVEG,YLVEG,YHVEG,ZNVEG,ZLVEG,ZHVEG,ZDG) 00201 ! 00202 END IF 00203 ! 00204 DEALLOCATE(IWG_LAYER) 00205 ! 00206 IF (HFIELD=='WG ' .OR. HFIELD=='WGI ' .OR. HFIELD=='TWN_WG ' .OR. HFIELD=='TWN_WGI ' .OR. & 00207 HFIELD=='GD_WG ' .OR. HFIELD=='GD_WGI ') THEN 00208 KLAYER = IHYDRO_LAYER 00209 ENDIF 00210 ! 00211 !------------------------------------------------------------------- 00212 ! 00213 !* In force-restore ISBA, adds a layer at bottom of surface layer and a layer 00214 ! between root and deep layers. 00215 ! 00216 IF (HISBA=='2-L' .OR. HISBA=='3-L') THEN 00217 ILAYER = KLAYER + 1 00218 IF (HISBA=='3-L') ILAYER = ILAYER + 1 00219 ALLOCATE(ZD (KNI,ILAYER,KPATCH)) 00220 DO JPATCH=1,KPATCH 00221 ! for interpolations, middle of surface layer must be at least at 1cm 00222 ZD(:,1,JPATCH) = MIN(3.*ZDG(:,1,JPATCH),MAX(ZDG(:,1,JPATCH),0.02)) 00223 ! new layer below surface layer. This layer will be at root depth layer humidity 00224 ZD(:,2,JPATCH) = MIN(4.*ZDG(:,1,JPATCH),0.5*(ZDG(:,1,JPATCH)+ZDG(:,2,JPATCH))) 00225 ! root layer 00226 ZD(:,3,JPATCH) = ZDG(:,2,JPATCH) 00227 IF (HISBA=='3-L') THEN 00228 ! between root and deep layers. This layer will have deep soil humidity. 00229 WHERE (ZDG(:,2,JPATCH)<ZDG(:,3,JPATCH)) 00230 ZD(:,4,JPATCH) = 0.75 * ZDG(:,2,JPATCH) + 0.25 * ZDG(:,3,JPATCH) 00231 ELSEWHERE 00232 ZD(:,4,JPATCH) = ZDG(:,3,JPATCH) 00233 END WHERE 00234 ! deep layer 00235 ZD(:,5,JPATCH) = ZDG(:,3,JPATCH) 00236 END IF 00237 END DO 00238 ELSE 00239 ILAYER = KLAYER 00240 ALLOCATE(ZD (KNI,ILAYER,KPATCH)) 00241 ZD(:,:,:) = ZDG(:,1:KLAYER,:) 00242 END IF 00243 ! 00244 DEALLOCATE(ZDG) 00245 ! 00246 !------------------------------------------------------------------- 00247 !* recovers middle layer depth (from the surface) 00248 ALLOCATE(ZDEPTH (KNI,ILAYER,KPATCH)) 00249 ZDEPTH = XUNDEF 00250 DO JPATCH=1,KPATCH 00251 WHERE(ZD(:,1,JPATCH)/=XUNDEF) & 00252 ZDEPTH (:,1,JPATCH)=ZD(:,1,JPATCH)/2. 00253 DO JLAYER=2,ILAYER 00254 WHERE(ZD(:,1,JPATCH)/=XUNDEF) & 00255 ZDEPTH (:,JLAYER,JPATCH) = (ZD(:,JLAYER-1,JPATCH) + ZD(:,JLAYER,JPATCH))/2. 00256 END DO 00257 END DO 00258 DEALLOCATE(ZD) 00259 !------------------------------------------------------------------- 00260 ! 00261 ALLOCATE(PDEPTH (KNI,ILAYER,NVEGTYPE)) 00262 CALL PUT_ON_ALL_VEGTYPES(KNI,ILAYER,KPATCH,NVEGTYPE,ZDEPTH,PDEPTH) 00263 DEALLOCATE(ZDEPTH) 00264 00265 IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_DEPTH',1,ZHOOK_HANDLE) 00266 !------------------------------------------------------------------- 00267 ! 00268 END SUBROUTINE READ_EXTERN_DEPTH 00269 ! 00270 ! 00271 !------------------------------------------------------------------- 00272 !--------------------------------------------------------------------------------------- 00273 ! 00274 ! ####################### 00275 SUBROUTINE READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,& 00276 KLUOUT,KNI,HFIELD,HNAME,PFIELD,PDEPTH) 00277 ! ####################### 00278 ! 00279 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00280 USE MODD_SURF_PAR, ONLY : XUNDEF 00281 USE MODD_ISBA_PAR, ONLY : XOPTIMGRID 00282 ! 00283 USE MODI_OPEN_AUX_IO_SURF 00284 USE MODI_CLOSE_AUX_IO_SURF 00285 USE MODI_READ_SURF 00286 USE MODE_SOIL 00287 ! 00288 IMPLICIT NONE 00289 ! 00290 !* dummy arguments 00291 ! --------------- 00292 ! 00293 CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file 00294 CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file 00295 CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file 00296 CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file 00297 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00298 INTEGER, INTENT(IN) :: KNI ! number of points 00299 CHARACTER(LEN=7), INTENT(IN) :: HFIELD ! field name 00300 CHARACTER(LEN=*), INTENT(IN) :: HNAME ! field name in the file 00301 REAL, DIMENSION(:,:,:), POINTER :: PFIELD ! field to initialize 00302 REAL, DIMENSION(:,:,:), POINTER :: PDEPTH ! middle depth of each layer 00303 ! 00304 ! 00305 !* local variables 00306 ! --------------- 00307 ! 00308 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00309 CHARACTER(LEN=4) :: YLVL 00310 CHARACTER(LEN=3) :: YISBA ! type of ISBA soil scheme 00311 CHARACTER(LEN=3) :: YNAT ! type of surface (nature, garden) 00312 CHARACTER(LEN=4) :: YPEDOTF ! type of pedo-transfert function 00313 INTEGER :: IRESP ! reading return code 00314 INTEGER :: ILAYER ! number of layers 00315 INTEGER :: JLAYER ! loop counter 00316 INTEGER :: IPATCH ! number of patch 00317 INTEGER :: JPATCH ! loop counter 00318 INTEGER :: JVEGTYPE ! loop counter 00319 LOGICAL :: GTEB ! TEB field 00320 ! 00321 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD ! field read, one level, all patches 00322 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! field read, one level, all patches 00323 ! 00324 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVAR ! profile of physical variable 00325 REAL, DIMENSION(:), ALLOCATABLE :: ZCLAY ! clay fraction 00326 REAL, DIMENSION(:), ALLOCATABLE :: ZSAND ! sand fraction 00327 REAL, DIMENSION(:), ALLOCATABLE :: ZWWILT ! wilting point 00328 REAL, DIMENSION(:), ALLOCATABLE :: ZWFC ! field capacity 00329 REAL, DIMENSION(:), ALLOCATABLE :: ZWSAT ! saturation 00330 REAL, DIMENSION(:), ALLOCATABLE :: ZSOILGRID 00331 ! 00332 INTEGER :: IVERSION ! surface version 00333 INTEGER :: IBUGFIX 00334 ! 00335 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00336 !------------------------------------------------------------------------------- 00337 IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_ISBA',0,ZHOOK_HANDLE) 00338 WRITE (KLUOUT,*) ' | Reading ',HFIELD,' in externalized file' 00339 ! 00340 GTEB = (HNAME(1:3)=='TWN' .OR. HNAME(1:3)=='GD_' .OR. HNAME(1:3)=='GR_' & 00341 .OR. HNAME(4:6)=='GD_' .OR. HNAME(4:6)=='GR_') 00342 ! 00343 !------------------------------------------------------------------------------ 00344 ! 00345 IF (GTEB) THEN 00346 CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ') 00347 ELSE 00348 CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE') 00349 ENDIF 00350 ! 00351 YRECFM='VERSION' 00352 CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP) 00353 ! 00354 YRECFM='BUG' 00355 CALL READ_SURF(HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP) 00356 ! 00357 !* Read number of soil layers 00358 ! 00359 YRECFM='GROUND_LAYER' 00360 IF (GTEB) THEN 00361 YRECFM='TWN_LAYER' 00362 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_LAYER' 00363 ENDIF 00364 CALL READ_SURF(HFILEPGDTYPE,YRECFM,ILAYER,IRESP) 00365 ! 00366 !* number of tiles 00367 ! 00368 IPATCH=1 00369 IF (.NOT. GTEB) THEN 00370 YRECFM='PATCH_NUMBER' 00371 CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP) 00372 END IF 00373 ! 00374 !* soil scheme 00375 ! 00376 YRECFM='ISBA' 00377 IF (GTEB) THEN 00378 YRECFM='TWN_ISBA' 00379 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_ISBA' 00380 ENDIF 00381 CALL READ_SURF(HFILEPGDTYPE,YRECFM,YISBA,IRESP) 00382 ! 00383 IF (IVERSION>=7) THEN 00384 ! 00385 !* Pedo-transfert function 00386 ! 00387 YRECFM='PEDOTF' 00388 IF (GTEB) THEN 00389 YRECFM='TWN_PEDOTF' 00390 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_PEDOTF' 00391 ENDIF 00392 CALL READ_SURF(HFILEPGDTYPE,YRECFM,YPEDOTF,IRESP) 00393 ! 00394 ELSE 00395 YPEDOTF = 'CH78' 00396 ENDIF 00397 ! 00398 !Only Brook and Corey with Force-Restore scheme 00399 IF(YISBA/='DIF')THEN 00400 YPEDOTF='CH78' 00401 ENDIF 00402 ! 00403 !------------------------------------------------------------------------------- 00404 ! 00405 ! *. Read clay fraction 00406 ! ------------------ 00407 ! 00408 ALLOCATE(ZCLAY(KNI)) 00409 YRECFM='CLAY' 00410 IF (GTEB) THEN 00411 YRECFM='TWN_CLAY' 00412 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_CLAY' 00413 ENDIF 00414 CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZCLAY(:),IRESP,HDIR='A') 00415 ! 00416 !------------------------------------------------------------------------------- 00417 ! 00418 ! *. Read sand fraction 00419 ! ------------------ 00420 ! 00421 ALLOCATE(ZSAND(KNI)) 00422 YRECFM='SAND' 00423 IF (GTEB) THEN 00424 YRECFM='TWN_SAND' 00425 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SAND' 00426 ENDIF 00427 CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSAND(:),IRESP,HDIR='A') 00428 ! 00429 !------------------------------------------------------------------------------- 00430 ! 00431 ! *. Read soil grid 00432 ! -------------- 00433 ! 00434 !* Reference grid for DIF 00435 ! 00436 IF(YISBA=='DIF') THEN 00437 ALLOCATE(ZSOILGRID(ILAYER)) 00438 ZSOILGRID=XUNDEF 00439 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN 00440 YRECFM='SOILGRID' 00441 IF (GTEB) THEN 00442 YRECFM='TWN_SOILGRID' 00443 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SOILGRID' 00444 ENDIF 00445 CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSOILGRID,IRESP,HDIR='-') 00446 ELSE 00447 ZSOILGRID(1:ILAYER) = XOPTIMGRID(1:ILAYER) 00448 ENDIF 00449 ELSE 00450 ALLOCATE(ZSOILGRID(0)) 00451 ENDIF 00452 ! 00453 IF ((HFIELD=='TG ') .AND. (YISBA=='2-L' .OR. YISBA=='3-L')) THEN 00454 ALLOCATE(PDEPTH (KNI,ILAYER,NVEGTYPE)) 00455 DO JVEGTYPE=1,NVEGTYPE 00456 PDEPTH(:,1,JVEGTYPE) = 0. 00457 PDEPTH(:,2,JVEGTYPE) = 0.2 00458 IF (ILAYER==3) PDEPTH(:,3,JVEGTYPE) = 3. 00459 END DO 00460 ELSE 00461 YNAT='NAT' 00462 IF (GTEB) YNAT='GRD' 00463 CALL READ_EXTERN_DEPTH(HFILEPGDTYPE,KLUOUT,YISBA,YNAT,HFIELD,KNI,ILAYER,IPATCH,& 00464 ZSOILGRID,PDEPTH,IVERSION) 00465 END IF 00466 ! 00467 DEALLOCATE(ZSOILGRID) 00468 ! 00469 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00470 ! 00471 !* Allocate soil variable profile 00472 ! ------------------------------ 00473 ! 00474 ! 00475 ALLOCATE(ZVAR(KNI,ILAYER,IPATCH)) 00476 ALLOCATE(ZWORK(KNI,IPATCH)) 00477 ZWORK(:,:) = XUNDEF 00478 ! 00479 ! *. Read soil variable profile 00480 ! -------------------------- 00481 ! 00482 IF (GTEB) THEN 00483 CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ') 00484 ELSE 00485 CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE') 00486 ENDIF 00487 ! 00488 DO JLAYER=1,ILAYER 00489 WRITE(YLVL,'(I4)') JLAYER 00490 YRECFM=TRIM(HNAME)//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) 00491 CALL READ_SURF(HFILETYPE,YRECFM,ZWORK(:,:),IRESP,HDIR='A') 00492 DO JPATCH=1,IPATCH 00493 ZVAR(:,JLAYER,JPATCH)=ZWORK(:,JPATCH) 00494 END DO 00495 END DO 00496 ! 00497 CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE) 00498 ! 00499 DEALLOCATE(ZWORK) 00500 ! 00501 ! 00502 ! *. Compute relative humidity from units kg/m^2 (SWI) 00503 ! ------------------------------------------------ 00504 ! 00505 !* In case of force-restore ISBA, adds one layer at bottom of surface layer 00506 IF ((HFIELD=='WG ' .OR. HFIELD=='WGI ') .AND. (YISBA=='2-L' .OR. YISBA=='3-L')) THEN 00507 ALLOCATE(ZFIELD(KNI,ILAYER,IPATCH)) 00508 ZFIELD(:,:,:) = ZVAR(:,:,:) 00509 DEALLOCATE(ZVAR) 00510 ! 00511 ILAYER = ILAYER + 1 00512 IF ( YISBA=='3-L' ) ILAYER = ILAYER + 1 00513 ALLOCATE(ZVAR(KNI,ILAYER,IPATCH)) 00514 DO JPATCH=1,IPATCH 00515 ZVAR(:,1,JPATCH)=ZFIELD(:,1,JPATCH) 00516 ZVAR(:,2,JPATCH)=ZFIELD(:,2,JPATCH) ! new layer at root layer humidity but below surface layer 00517 ZVAR(:,3,JPATCH)=ZFIELD(:,2,JPATCH) 00518 IF ( YISBA=='3-L' ) THEN 00519 ZVAR(:,4,JPATCH)=ZFIELD(:,3,JPATCH) 00520 ZVAR(:,5,JPATCH)=ZFIELD(:,3,JPATCH) 00521 END IF 00522 END DO 00523 DEALLOCATE(ZFIELD) 00524 END IF 00525 ! 00526 ALLOCATE(ZFIELD(KNI,ILAYER,IPATCH)) 00527 ZFIELD = ZVAR 00528 ! 00529 IF (HFIELD=='WG ' .OR. HFIELD=='WGI ') THEN 00530 ! 00531 ! Compute ISBA model constants 00532 ! 00533 ALLOCATE (ZWFC (KNI)) 00534 ALLOCATE (ZWWILT(KNI)) 00535 ALLOCATE (ZWSAT (KNI)) 00536 ! 00537 ZWSAT (:) = WSAT_FUNC (ZCLAY(:),ZSAND(:),YPEDOTF) 00538 ZWWILT(:) = WWILT_FUNC(ZCLAY(:),ZSAND(:),YPEDOTF) 00539 ZWFC (:) = WFC_FUNC (ZCLAY(:),ZSAND(:),YPEDOTF) 00540 ! 00541 DEALLOCATE (ZSAND) 00542 DEALLOCATE (ZCLAY) 00543 00544 ZFIELD(:,:,:) = XUNDEF 00545 ! 00546 IF (HFIELD=='WG ') THEN 00547 DO JPATCH=1,IPATCH 00548 DO JLAYER=1,ILAYER 00549 WHERE(ZVAR(:,JLAYER,JPATCH)/=XUNDEF) 00550 ZVAR(:,JLAYER,JPATCH) = MAX(MIN(ZVAR(:,JLAYER,JPATCH),ZWSAT(:)),0.) 00551 ! 00552 ZFIELD(:,JLAYER,JPATCH) = (ZVAR(:,JLAYER,JPATCH) - ZWWILT(:)) / (ZWFC(:) - ZWWILT(:)) 00553 END WHERE 00554 END DO 00555 END DO 00556 ELSE IF (HFIELD=='WGI ') THEN 00557 DO JPATCH=1,IPATCH 00558 DO JLAYER=1,ILAYER 00559 WHERE(ZVAR(:,JLAYER,JPATCH)/=XUNDEF) & 00560 ZFIELD(:,JLAYER,JPATCH) = ZVAR(:,JLAYER,JPATCH) / ZWSAT(:) 00561 END DO 00562 END DO 00563 END IF 00564 ! 00565 DEALLOCATE (ZWSAT) 00566 DEALLOCATE (ZWWILT) 00567 DEALLOCATE (ZWFC) 00568 ! 00569 ! 00570 END IF 00571 ! 00572 DEALLOCATE(ZVAR) 00573 !------------------------------------------------------------------------------- 00574 ! 00575 ! *. Set the field on all vegtypes 00576 ! ----------------------------- 00577 ! 00578 ALLOCATE(PFIELD(KNI,ILAYER,NVEGTYPE)) 00579 CALL PUT_ON_ALL_VEGTYPES(KNI,ILAYER,IPATCH,NVEGTYPE,ZFIELD,PFIELD) 00580 DEALLOCATE(ZFIELD) 00581 IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_ISBA',1,ZHOOK_HANDLE) 00582 ! 00583 !------------------------------------------------------------------------------ 00584 ! 00585 END SUBROUTINE READ_EXTERN_ISBA 00586 ! 00587 !------------------------------------------------------------------------------ 00588 ! 00589 END MODULE MODE_READ_EXTERN
1.8.0
