|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PGD_ISBA(HPROGRAM,OECOCLIMAP) 00003 ! ############################################################## 00004 ! 00005 !!**** *PGD_ISBA* monitor for averaging and interpolations of ISBA physiographic fields 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! METHOD 00011 !! ------ 00012 !! 00013 ! 00014 !! EXTERNAL 00015 !! -------- 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! AUTHOR 00024 !! ------ 00025 !! 00026 !! V. Masson Meteo-France 00027 !! 00028 !! MODIFICATION 00029 !! ------------ 00030 !! 00031 !! Original 10/12/97 00032 !! P. Le Moigne 12/2004 : add type of photosynthesis and correct computation 00033 !! of ground layers number in diffusion case 00034 !! P. Le Moigne 09/2005 : AGS modifs of L. Jarlan 00035 !! B. Decharme 2008 : XWDRAIN 00036 !! E. Martin 12/2008 : files of data for runoffb and wdrain 00037 !! B. Decharme 06/2009 : files of data for topographic index 00038 !! A.L. Gibelin 04/2009 : dimension NBIOMASS for ISBA-A-gs 00039 !! 00040 !---------------------------------------------------------------------------- 00041 ! 00042 !* 0. DECLARATION 00043 ! ----------- 00044 ! 00045 USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF 00046 USE MODD_PGD_GRID, ONLY : NL 00047 USE MODD_PGDWORK, ONLY : CATYPE 00048 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, JPCOVER 00049 USE MODD_ISBA_n, ONLY : NPATCH, NGROUND_LAYER, NNBIOMASS, CISBA, & 00050 CPEDOTF, XCOVER, LCOVER, XZS, & 00051 XZ0EFFJPDIR, CPHOTO, LTR_ML, XRM_PATCH, & 00052 XCLAY, XSAND, XSOC, LSOCP, LNOF, & 00053 XRUNOFFB, XWDRAIN, LECOCLIMAP, & 00054 XSOILGRID, LPERM, XPERM, XPH, XFERT 00055 USE MODD_ISBA_GRID_n, ONLY : CGRID, XGRID_PAR, XLAT, XLON, XMESH_SIZE 00056 ! 00057 USE MODD_ISBA_PAR, ONLY : NOPTIMLAYER, XOPTIMGRID 00058 ! 00059 USE MODI_GET_LUOUT 00060 USE MODI_READ_NAM_PGD_ISBA 00061 USE MODI_PGD_FIELD 00062 USE MODI_TEST_NAM_VAR_SURF 00063 ! 00064 USE MODI_GET_AOS_n 00065 USE MODI_GET_SSO_n 00066 USE MODI_GET_SURF_SIZE_n 00067 USE MODI_PACK_PGD_ISBA 00068 USE MODI_PACK_PGD 00069 USE MODI_WRITE_COVER_TEX_ISBA 00070 USE MODI_WRITE_COVER_TEX_ISBA_PAR 00071 USE MODI_PGD_TOPO_INDEX 00072 USE MODI_PGD_ISBA_PAR 00073 USE MODI_PGD_TOPD 00074 ! 00075 USE MODI_READ_SURF 00076 USE MODI_INIT_IO_SURF_n 00077 USE MODI_END_IO_SURF_n 00078 #ifdef ASC 00079 USE MODD_IO_SURF_ASC, ONLY : CFILEIN 00080 #endif 00081 #ifdef FA 00082 USE MODD_IO_SURF_FA, ONLY : CFILEIN_FA 00083 #endif 00084 #ifdef LFI 00085 USE MODD_IO_SURF_LFI, ONLY : CFILEIN_LFI 00086 #endif 00087 ! 00088 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00089 USE PARKIND1 ,ONLY : JPRB 00090 ! 00091 USE MODI_ABOR1_SFX 00092 ! 00093 IMPLICIT NONE 00094 ! 00095 !* 0.1 Declaration of arguments 00096 ! ------------------------ 00097 ! 00098 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00099 LOGICAL, INTENT(IN) :: OECOCLIMAP ! T if parameters are computed with ecoclimap 00100 ! ! F if all parameters must be specified 00101 ! 00102 ! 00103 !* 0.2 Declaration of local variables 00104 ! ------------------------------ 00105 ! 00106 INTEGER :: ILUOUT ! output listing logical unit 00107 INTEGER :: JLAYER ! loop counter 00108 INTEGER :: ILU ! number of points 00109 REAL, DIMENSION(NL) :: ZAOSIP ! A/S i+ on all surface points 00110 REAL, DIMENSION(NL) :: ZAOSIM ! A/S i- on all surface points 00111 REAL, DIMENSION(NL) :: ZAOSJP ! A/S j+ on all surface points 00112 REAL, DIMENSION(NL) :: ZAOSJM ! A/S j- on all surface points 00113 REAL, DIMENSION(NL) :: ZHO2IP ! h/2 i+ on all surface points 00114 REAL, DIMENSION(NL) :: ZHO2IM ! h/2 i- on all surface points 00115 REAL, DIMENSION(NL) :: ZHO2JP ! h/2 j+ on all surface points 00116 REAL, DIMENSION(NL) :: ZHO2JM ! h/2 j- on all surface points 00117 REAL, DIMENSION(NL) :: ZSSO_SLOPE! subgrid slope on all surface points 00118 INTEGER :: IRESP ! error code 00119 ! 00120 !* 0.3 Declaration of namelists 00121 ! ------------------------ 00122 ! 00123 ! 00124 INTEGER :: IPATCH ! number of patches 00125 INTEGER :: IGROUND_LAYER ! number of soil layers 00126 CHARACTER(LEN=3) :: YISBA ! ISBA option 00127 CHARACTER(LEN=4) :: YPEDOTF ! Pedo transfert function for DIF 00128 CHARACTER(LEN=3) :: YPHOTO ! photosynthesis option 00129 LOGICAL :: GTR_ML ! new radiative transfert 00130 REAL :: ZRM_PATCH ! threshold to remove little fractions of patches 00131 CHARACTER(LEN=28) :: YSAND ! file name for sand fraction 00132 CHARACTER(LEN=28) :: YCLAY ! file name for clay fraction 00133 CHARACTER(LEN=28) :: YSOC_TOP ! file name for organic carbon top soil 00134 CHARACTER(LEN=28) :: YSOC_SUB ! file name for organic carbon sub soil 00135 CHARACTER(LEN=28) :: YCTI ! file name for topographic index 00136 CHARACTER(LEN=28) :: YRUNOFFB ! file name for runoffb parameter 00137 CHARACTER(LEN=28) :: YWDRAIN ! file name for wdrain parameter 00138 CHARACTER(LEN=28) :: YPERM ! file name for permafrost distribution 00139 CHARACTER(LEN=6) :: YSANDFILETYPE ! sand data file type 00140 CHARACTER(LEN=6) :: YCLAYFILETYPE ! clay data file type 00141 CHARACTER(LEN=6) :: YSOCFILETYPE ! organic carbon data file type 00142 CHARACTER(LEN=6) :: YCTIFILETYPE ! topographic index data file type 00143 CHARACTER(LEN=6) :: YRUNOFFBFILETYPE ! subgrid runoff data file type 00144 CHARACTER(LEN=6) :: YWDRAINFILETYPE ! subgrid drainage data file type 00145 CHARACTER(LEN=6) :: YPERMFILETYPE ! permafrost distribution data file type 00146 REAL :: XUNIF_SAND ! uniform value of sand fraction (-) 00147 REAL :: XUNIF_CLAY ! uniform value of clay fraction (-) 00148 REAL :: XUNIF_SOC_TOP ! uniform value of organic carbon top soil (kg/m2) 00149 REAL :: XUNIF_SOC_SUB ! uniform value of organic carbon sub soil (kg/m2) 00150 REAL :: XUNIF_RUNOFFB ! uniform value of subgrid runoff coefficient 00151 REAL :: XUNIF_WDRAIN ! uniform subgrid drainage parameter 00152 REAL :: XUNIF_PERM ! uniform permafrost distribution 00153 LOGICAL :: LIMP_SAND ! Imposed maps of Sand 00154 LOGICAL :: LIMP_CLAY ! Imposed maps of Clay 00155 LOGICAL :: LIMP_SOC ! Imposed maps of organic carbon 00156 LOGICAL :: LIMP_CTI ! Imposed maps of topographic index statistics 00157 LOGICAL :: LIMP_PERM ! Imposed maps of permafrost distribution 00158 REAL, DIMENSION(150) :: ZSOILGRID ! Soil grid reference for DIF 00159 CHARACTER(LEN=28) :: YPH ! file name for pH 00160 CHARACTER(LEN=28) :: YFERT ! file name for fertilisation rate 00161 CHARACTER(LEN=6) :: YPHFILETYPE ! pH data file type 00162 CHARACTER(LEN=6) :: YFERTFILETYPE ! fertilisation data file type 00163 REAL :: XUNIF_PH ! uniform value of pH 00164 REAL :: XUNIF_FERT ! uniform value of fertilisation rate 00165 ! 00166 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00167 ! 00168 !------------------------------------------------------------------------------- 00169 ! 00170 IF (LHOOK) CALL DR_HOOK('PGD_ISBA',0,ZHOOK_HANDLE) 00171 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00172 ! 00173 !------------------------------------------------------------------------------- 00174 ! 00175 !* 2. Reading of namelist 00176 ! ------------------- 00177 ! 00178 CALL READ_NAM_PGD_ISBA(HPROGRAM, IPATCH, IGROUND_LAYER, & 00179 YISBA, YPEDOTF, YPHOTO, GTR_ML, ZRM_PATCH, & 00180 YCLAY, YCLAYFILETYPE, XUNIF_CLAY, LIMP_CLAY, & 00181 YSAND, YSANDFILETYPE, XUNIF_SAND, LIMP_SAND, & 00182 YSOC_TOP, YSOC_SUB, YSOCFILETYPE, XUNIF_SOC_TOP, & 00183 XUNIF_SOC_SUB, LIMP_SOC, YCTI, YCTIFILETYPE, LIMP_CTI, & 00184 YPERM, YPERMFILETYPE, XUNIF_PERM, LIMP_PERM, & 00185 YRUNOFFB, YRUNOFFBFILETYPE, XUNIF_RUNOFFB, & 00186 YWDRAIN, YWDRAINFILETYPE , XUNIF_WDRAIN, ZSOILGRID, & 00187 YPH, YPHFILETYPE, XUNIF_PH, YFERT, YFERTFILETYPE, & 00188 XUNIF_FERT ) 00189 ! 00190 NPATCH = IPATCH 00191 NGROUND_LAYER = IGROUND_LAYER 00192 CISBA = YISBA 00193 CPEDOTF = YPEDOTF 00194 CPHOTO = YPHOTO 00195 LTR_ML = GTR_ML 00196 XRM_PATCH = MAX(MIN(ZRM_PATCH,1.),0.) 00197 ! 00198 !------------------------------------------------------------------------------- 00199 ! 00200 !* 3. Coherence of options 00201 ! -------------------- 00202 ! 00203 CALL TEST_NAM_VAR_SURF(ILUOUT,'CISBA',CISBA,'2-L','3-L','DIF') 00204 CALL TEST_NAM_VAR_SURF(ILUOUT,'CPEDOTF',CPEDOTF,'CH78','CO84') 00205 CALL TEST_NAM_VAR_SURF(ILUOUT,'CPHOTO',CPHOTO,'NON','AGS','LAI','AST','LST','NIT','NCB') 00206 ! 00207 SELECT CASE (CISBA) 00208 ! 00209 CASE ('2-L') 00210 ! 00211 NGROUND_LAYER = 2 00212 CPEDOTF ='CH78' 00213 WRITE(ILUOUT,*) '*****************************************' 00214 WRITE(ILUOUT,*) '* With option CISBA = ',CISBA,' *' 00215 WRITE(ILUOUT,*) '* the number of soil layers is set to 2 *' 00216 WRITE(ILUOUT,*) '* Pedo transfert function = CH78 *' 00217 WRITE(ILUOUT,*) '*****************************************' 00218 ! 00219 CASE ('3-L') 00220 ! 00221 NGROUND_LAYER = 3 00222 CPEDOTF ='CH78' 00223 WRITE(ILUOUT,*) '*****************************************' 00224 WRITE(ILUOUT,*) '* With option CISBA = ',CISBA,' *' 00225 WRITE(ILUOUT,*) '* the number of soil layers is set to 3 *' 00226 WRITE(ILUOUT,*) '* Pedo transfert function = CH78 *' 00227 WRITE(ILUOUT,*) '*****************************************' 00228 ! 00229 CASE ('DIF') 00230 ! 00231 IF(NGROUND_LAYER==NUNDEF)THEN 00232 IF(OECOCLIMAP)THEN 00233 NGROUND_LAYER=NOPTIMLAYER 00234 ELSE 00235 WRITE(ILUOUT,*) '****************************************' 00236 WRITE(ILUOUT,*) '* Number of ground layer not specified *' 00237 WRITE(ILUOUT,*) '****************************************' 00238 CALL ABOR1_SFX('PGD_ISBA: NGROUND_LAYER MUST BE DONE IN NAM_ISBA') 00239 ENDIF 00240 ENDIF 00241 ! 00242 ALLOCATE(XSOILGRID(NGROUND_LAYER)) 00243 XSOILGRID(:)=XUNDEF 00244 XSOILGRID(:)=ZSOILGRID(1:NGROUND_LAYER) 00245 IF (ALL(ZSOILGRID(:)==XUNDEF)) THEN 00246 IF(OECOCLIMAP) XSOILGRID(1:NGROUND_LAYER)=XOPTIMGRID(1:NGROUND_LAYER) 00247 ELSEIF (COUNT(XSOILGRID/=XUNDEF)/=NGROUND_LAYER) THEN 00248 WRITE(ILUOUT,*) '********************************************************' 00249 WRITE(ILUOUT,*) '* Soil grid reference values /= number of ground layer *' 00250 WRITE(ILUOUT,*) '********************************************************' 00251 CALL ABOR1_SFX('PGD_ISBA: XSOILGRID must be coherent with NGROUND_LAYER in NAM_ISBA') 00252 ELSEIF (XSOILGRID(1).GT.0.01) THEN 00253 CALL ABOR1_SFX('PGD_ISBA: First layer of XSOILGRID must be lower than 1cm') 00254 ENDIF 00255 ! 00256 WRITE(ILUOUT,*) '*****************************************' 00257 WRITE(ILUOUT,*) '* Option CISBA = ',CISBA 00258 WRITE(ILUOUT,*) '* Pedo transfert function = ',CPEDOTF 00259 WRITE(ILUOUT,*) '* Number of soil layers = ',NGROUND_LAYER 00260 IF(OECOCLIMAP)THEN 00261 WRITE(ILUOUT,*) '* Soil layers grid (m) = ',XSOILGRID(1:NGROUND_LAYER) 00262 ENDIF 00263 WRITE(ILUOUT,*) '*****************************************' 00264 ! 00265 END SELECT 00266 ! 00267 SELECT CASE (CPHOTO) 00268 CASE ('AGS','LAI','AST','LST') 00269 NNBIOMASS = 1 00270 CASE ('NIT') 00271 NNBIOMASS = 3 00272 CASE ('NCB') 00273 NNBIOMASS = 6 00274 END SELECT 00275 WRITE(ILUOUT,*) '*****************************************' 00276 WRITE(ILUOUT,*) '* With option CPHOTO = ',CPHOTO,' *' 00277 WRITE(ILUOUT,*) '* the number of biomass pools is set to ', NNBIOMASS 00278 WRITE(ILUOUT,*) '*****************************************' 00279 ! 00280 IF (NPATCH<1 .OR. NPATCH>NVEGTYPE) THEN 00281 WRITE(ILUOUT,*) '*****************************************' 00282 WRITE(ILUOUT,*) '* Number of patch must be between 1 and ', NVEGTYPE 00283 WRITE(ILUOUT,*) '* You have chosen NPATCH = ', NPATCH 00284 WRITE(ILUOUT,*) '*****************************************' 00285 CALL ABOR1_SFX('PGD_ISBA: NPATCH MUST BE BETWEEN 1 AND NVEGTYPE') 00286 END IF 00287 ! 00288 IF ( CPHOTO/='NON' .AND. NPATCH/=12 ) THEN 00289 WRITE(ILUOUT,*) '*****************************************' 00290 WRITE(ILUOUT,*) '* With option CPHOTO = ', CPHOTO 00291 WRITE(ILUOUT,*) '* Number of patch must be equal to 12 ' 00292 WRITE(ILUOUT,*) '* But you have chosen NPATCH = ', NPATCH 00293 WRITE(ILUOUT,*) '*****************************************' 00294 CALL ABOR1_SFX('PGD_ISBA: CPHOTO='//CPHOTO//' REQUIRES NPATCH=12') 00295 END IF 00296 ! 00297 IF ( CPHOTO=='NON' .AND. LTR_ML ) THEN 00298 WRITE(ILUOUT,*) '*****************************************' 00299 WRITE(ILUOUT,*) '* With option CPHOTO == NON ' 00300 WRITE(ILUOUT,*) '* New radiative transfert TR_ML ' 00301 WRITE(ILUOUT,*) '* cant be used ' 00302 WRITE(ILUOUT,*) '*****************************************' 00303 CALL ABOR1_SFX('PGD_ISBA: WITH CPHOTO= NON LTR_ML MUST BE FALSE') 00304 END IF 00305 ! 00306 !------------------------------------------------------------------------------- 00307 ! 00308 !* 4. Number of points and packing of general fields 00309 ! ---------------------------------------------- 00310 ! 00311 CALL GET_SURF_SIZE_n('NATURE',ILU) 00312 ! 00313 ALLOCATE(LCOVER (JPCOVER)) 00314 ALLOCATE(XCOVER (ILU,JPCOVER)) 00315 ALLOCATE(XZS (ILU)) 00316 ALLOCATE(XLAT (ILU)) 00317 ALLOCATE(XLON (ILU)) 00318 ALLOCATE(XMESH_SIZE (ILU)) 00319 ALLOCATE(XZ0EFFJPDIR(ILU)) 00320 ! 00321 CALL PACK_PGD(HPROGRAM, 'NATURE', & 00322 CGRID, XGRID_PAR, & 00323 LCOVER, XCOVER, XZS, & 00324 XLAT, XLON, XMESH_SIZE, XZ0EFFJPDIR ) 00325 ! 00326 !------------------------------------------------------------------------------- 00327 ! 00328 !* 5. Packing of ISBA specific fields 00329 ! ------------------------------- 00330 ! 00331 CALL GET_AOS_n(HPROGRAM,NL,ZAOSIP,ZAOSIM,ZAOSJP,ZAOSJM,ZHO2IP,ZHO2IM,ZHO2JP,ZHO2JM) 00332 CALL GET_SSO_n(HPROGRAM,NL,ZSSO_SLOPE) 00333 ! 00334 CALL PACK_PGD_ISBA(HPROGRAM, & 00335 ZAOSIP, ZAOSIM, ZAOSJP, ZAOSJM, & 00336 ZHO2IP, ZHO2IM, ZHO2JP, ZHO2JM, & 00337 ZSSO_SLOPE ) 00338 ! 00339 !------------------------------------------------------------------------------- 00340 ! 00341 !* 6. Topographic index for TOPMODEL 00342 ! ------------------------------ 00343 ! 00344 CALL PGD_TOPO_INDEX(HPROGRAM,ILU,YCTI,YCTIFILETYPE,LIMP_CTI) 00345 ! 00346 !------------------------------------------------------------------------------- 00347 ! 00348 !* 7. Sand fraction 00349 ! ------------- 00350 ! 00351 CATYPE='ARI' 00352 ! 00353 ALLOCATE(XSAND(ILU,NGROUND_LAYER)) 00354 ! 00355 IF(LIMP_SAND)THEN 00356 ! 00357 IF(YSANDFILETYPE=='NETCDF')THEN 00358 CALL ABOR1_SFX('Use another format than netcdf for sand input file with LIMP_SAND') 00359 ELSE 00360 #ifdef ASC 00361 CFILEIN = ADJUSTL(ADJUSTR(YSAND)//'.txt') 00362 #endif 00363 #ifdef FA 00364 CFILEIN_FA = ADJUSTL(ADJUSTR(YSAND)//'.fa') 00365 #endif 00366 #ifdef LFI 00367 CFILEIN_LFI = ADJUSTL(YSAND) 00368 #endif 00369 CALL INIT_IO_SURF_n(YSANDFILETYPE,'NATURE','ISBA ','READ ') 00370 ENDIF 00371 ! 00372 CALL READ_SURF(YSANDFILETYPE,'SAND',XSAND(:,1),IRESP) 00373 ! 00374 CALL END_IO_SURF_n(YSANDFILETYPE) 00375 ! 00376 ELSE 00377 CALL PGD_FIELD(HPROGRAM,'sand fraction','NAT',YSAND,YSANDFILETYPE,XUNIF_SAND,XSAND(:,1)) 00378 ENDIF 00379 ! 00380 DO JLAYER=1,NGROUND_LAYER 00381 XSAND(:,JLAYER) = XSAND(:,1) 00382 END DO 00383 !------------------------------------------------------------------------------- 00384 ! 00385 !* 8. Clay fraction 00386 ! ------------- 00387 ! 00388 ALLOCATE(XCLAY(ILU,NGROUND_LAYER)) 00389 ! 00390 IF(LIMP_CLAY)THEN 00391 ! 00392 IF(YCLAYFILETYPE=='NETCDF')THEN 00393 CALL ABOR1_SFX('Use another format than netcdf for clay input file with LIMP_CLAY') 00394 ELSE 00395 #ifdef ASC 00396 CFILEIN = ADJUSTL(ADJUSTR(YSAND)//'.txt') 00397 #endif 00398 #ifdef FA 00399 CFILEIN_FA = ADJUSTL(ADJUSTR(YSAND)//'.fa') 00400 #endif 00401 #ifdef LFI 00402 CFILEIN_LFI = ADJUSTL(YSAND) 00403 #endif 00404 CALL INIT_IO_SURF_n(YCLAYFILETYPE,'NATURE','ISBA ','READ ') 00405 ENDIF 00406 ! 00407 CALL READ_SURF(YCLAYFILETYPE,'CLAY',XCLAY(:,1),IRESP) 00408 ! 00409 CALL END_IO_SURF_n(YCLAYFILETYPE) 00410 ! 00411 ELSE 00412 CALL PGD_FIELD(HPROGRAM,'clay fraction','NAT',YCLAY,YCLAYFILETYPE,XUNIF_CLAY,XCLAY(:,1)) 00413 ENDIF 00414 ! 00415 DO JLAYER=1,NGROUND_LAYER 00416 XCLAY(:,JLAYER) = XCLAY(:,1) 00417 END DO 00418 ! 00419 !------------------------------------------------------------------------------- 00420 ! 00421 !* 9. organic carbon profile 00422 ! ---------------------- 00423 ! 00424 IF(LEN_TRIM(YSOCFILETYPE)/=0.OR.(XUNIF_SOC_TOP/=XUNDEF.AND.XUNIF_SOC_SUB/=XUNDEF))THEN 00425 ! 00426 ALLOCATE(XSOC(ILU,NGROUND_LAYER)) 00427 ! 00428 LSOCP=.TRUE. 00429 ! 00430 IF((LEN_TRIM(YSOC_TOP)==0.AND.LEN_TRIM(YSOC_SUB)/=0).OR.(LEN_TRIM(YSOC_TOP)/=0.AND.LEN_TRIM(YSOC_SUB)==0))THEN 00431 WRITE(ILUOUT,*) ' ' 00432 WRITE(ILUOUT,*) '***********************************************************' 00433 WRITE(ILUOUT,*) '* Error in soil organic carbon preparation *' 00434 WRITE(ILUOUT,*) '* If used, sub and top soil input file must be given *' 00435 WRITE(ILUOUT,*) '***********************************************************' 00436 WRITE(ILUOUT,*) ' ' 00437 CALL ABOR1_SFX('PGD_ISBA: TOP AND SUB SOC INPUT FILE REQUIRED') 00438 ENDIF 00439 ! 00440 IF(LIMP_SOC)THEN 00441 ! 00442 ! Topsoil 00443 ! 00444 IF(YSOCFILETYPE=='NETCDF')THEN 00445 CALL ABOR1_SFX('Use another format than netcdf for organic carbon input file with LIMP_SOC') 00446 ELSE 00447 #ifdef ASC 00448 CFILEIN = ADJUSTL(ADJUSTR(YSOC_TOP)//'.txt') 00449 #endif 00450 #ifdef FA 00451 CFILEIN_FA = ADJUSTL(ADJUSTR(YSOC_TOP)//'.fa') 00452 #endif 00453 #ifdef LFI 00454 CFILEIN_LFI = ADJUSTL(YSOC_TOP) 00455 #endif 00456 CALL INIT_IO_SURF_n(YSOCFILETYPE,'NATURE','ISBA ','READ ') 00457 ENDIF 00458 ! 00459 CALL READ_SURF(YSOCFILETYPE,'SOC_TOP',XSOC(:,1),IRESP) 00460 ! 00461 CALL END_IO_SURF_n(YSOCFILETYPE) 00462 ! 00463 ! Subsoil 00464 ! 00465 IF(YSOCFILETYPE=='NETCDF')THEN 00466 CALL ABOR1_SFX('Use another format than netcdf for organic carbon input file with LIMP_SOC') 00467 ELSE 00468 #ifdef ASC 00469 CFILEIN = ADJUSTL(ADJUSTR(YSOC_SUB)//'.txt') 00470 #endif 00471 #ifdef FA 00472 CFILEIN_FA = ADJUSTL(ADJUSTR(YSOC_SUB)//'.fa') 00473 #endif 00474 #ifdef LFI 00475 CFILEIN_LFI = ADJUSTL(YSOC_SUB) 00476 #endif 00477 CALL INIT_IO_SURF_n(YSOCFILETYPE,'NATURE','ISBA ','READ ') 00478 ENDIF 00479 ! 00480 CALL READ_SURF(YSOCFILETYPE,'SOC_SUB',XSOC(:,2),IRESP) 00481 ! 00482 CALL END_IO_SURF_n(YSOCFILETYPE) 00483 ! 00484 ELSE 00485 CALL PGD_FIELD(HPROGRAM,'organic carbon','NAT',YSOC_TOP,YSOCFILETYPE,XUNIF_SOC_TOP,XSOC(:,1)) 00486 CALL PGD_FIELD(HPROGRAM,'organic carbon','NAT',YSOC_SUB,YSOCFILETYPE,XUNIF_SOC_SUB,XSOC(:,2)) 00487 ENDIF 00488 ! 00489 DO JLAYER=2,NGROUND_LAYER 00490 XSOC(:,JLAYER) = XSOC(:,2) 00491 END DO 00492 ! 00493 ELSE 00494 ! 00495 LSOCP=.FALSE. 00496 ALLOCATE(XSOC(0,0)) 00497 ! 00498 ENDIF 00499 ! 00500 !* 10. Permafrost distribution 00501 ! ----------------------- 00502 ! 00503 IF(LEN_TRIM(YPERM)/=0.OR.XUNIF_PERM/=XUNDEF)THEN 00504 ! 00505 ALLOCATE(XPERM(ILU)) 00506 ! 00507 LPERM=.TRUE. 00508 ! 00509 IF(LIMP_PERM)THEN 00510 ! 00511 IF(YPERMFILETYPE=='NETCDF')THEN 00512 CALL ABOR1_SFX('Use another format than netcdf for permafrost input file with LIMP_PERM') 00513 ELSE 00514 #ifdef ASC 00515 CFILEIN = ADJUSTL(ADJUSTR(YPERM)//'.txt') 00516 #endif 00517 #ifdef FA 00518 CFILEIN_FA = ADJUSTL(ADJUSTR(YPERM)//'.fa') 00519 #endif 00520 #ifdef LFI 00521 CFILEIN_LFI = ADJUSTL(YPERM) 00522 #endif 00523 CALL INIT_IO_SURF_n(YPERMFILETYPE,'NATURE','ISBA ','READ ') 00524 ENDIF 00525 ! 00526 CALL READ_SURF(YPERMFILETYPE,'PERM',XPERM(:),IRESP) 00527 ! 00528 CALL END_IO_SURF_n(YPERMFILETYPE) 00529 ELSE 00530 CALL PGD_FIELD(HPROGRAM,'permafrost','NAT',YPERM,YPERMFILETYPE,XUNIF_PERM,XPERM(:)) 00531 ENDIF 00532 ! 00533 ELSE 00534 ! 00535 LPERM=.FALSE. 00536 ALLOCATE(XPERM(0)) 00537 ! 00538 ENDIF 00539 ! 00540 !------------------------------------------------------------------------------- 00541 ! 00542 !* 11. pH and fertlisation data 00543 ! -------------------------- 00544 ! 00545 IF((LEN_TRIM(YPHFILETYPE)/=0.OR.XUNIF_PH/=XUNDEF) .AND. (LEN_TRIM(YFERTFILETYPE)/=0.OR.XUNIF_FERT/=XUNDEF)) THEN 00546 ! 00547 ALLOCATE(XPH(ILU)) 00548 ALLOCATE(XFERT(ILU)) 00549 ! 00550 LNOF = .TRUE. 00551 ! 00552 CALL PGD_FIELD(HPROGRAM,'pH value','NAT',YPH,YPHFILETYPE,XUNIF_PH,XPH(:)) 00553 CALL PGD_FIELD(HPROGRAM,'fertilisation','NAT',YFERT,YFERTFILETYPE,XUNIF_FERT,XFERT(:)) 00554 ! 00555 ENDIF 00556 ! 00557 !------------------------------------------------------------------------------- 00558 ! 00559 !* 12. Subgrid runoff 00560 ! -------------- 00561 ! 00562 ALLOCATE(XRUNOFFB(ILU)) 00563 CALL PGD_FIELD & 00564 (HPROGRAM,'subgrid runoff','NAT',YRUNOFFB,YRUNOFFBFILETYPE,XUNIF_RUNOFFB,XRUNOFFB(:)) 00565 ! 00566 !------------------------------------------------------------------------------- 00567 ! 00568 !* 13. Drainage coefficient 00569 ! -------------------- 00570 ! 00571 ALLOCATE(XWDRAIN(ILU)) 00572 CALL PGD_FIELD & 00573 (HPROGRAM,'subgrid drainage','NAT',YWDRAIN,YWDRAINFILETYPE,XUNIF_WDRAIN,XWDRAIN(:)) 00574 ! 00575 !------------------------------------------------------------------------------- 00576 ! 00577 !* 14. ISBA specific fields 00578 ! -------------------- 00579 ! 00580 LECOCLIMAP = OECOCLIMAP 00581 ! 00582 CALL PGD_ISBA_PAR(HPROGRAM) 00583 ! 00584 !------------------------------------------------------------------------------- 00585 ! 00586 CALL PGD_TOPD(HPROGRAM) 00587 ! 00588 !------------------------------------------------------------------------------- 00589 ! 00590 !* 15. Prints of cover parameters in a tex file 00591 ! ---------------------------------------- 00592 ! 00593 IF (OECOCLIMAP) THEN 00594 CALL WRITE_COVER_TEX_ISBA (NPATCH,NGROUND_LAYER,CISBA) 00595 CALL WRITE_COVER_TEX_ISBA_PAR(NPATCH,NGROUND_LAYER,CISBA,CPHOTO,XSOILGRID) 00596 END IF 00597 IF (LHOOK) CALL DR_HOOK('PGD_ISBA',1,ZHOOK_HANDLE) 00598 ! 00599 !------------------------------------------------------------------------------- 00600 ! 00601 END SUBROUTINE PGD_ISBA
1.8.0
