|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PGD_TEB_VEG(HPROGRAM) 00003 ! ############################################################## 00004 ! 00005 !!**** *PGD_TEB_VEG* monitor for averaging and interpolations of physiographic fields 00006 !! for natural covers of TEB 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 !! 00011 !! METHOD 00012 !! ------ 00013 !! 00014 ! 00015 !! EXTERNAL 00016 !! -------- 00017 !! 00018 !! IMPLICIT ARGUMENTS 00019 !! ------------------ 00020 !! 00021 !! REFERENCE 00022 !! --------- 00023 !! 00024 !! AUTHOR 00025 !! ------ 00026 !! 00027 !! V. Masson Meteo-France 00028 !! 00029 !! MODIFICATION 00030 !! ------------ 00031 !! 00032 !! Original 03/2010 00033 !! 00034 !---------------------------------------------------------------------------- 00035 ! 00036 !* 0. DECLARATION 00037 ! ----------- 00038 ! 00039 USE MODD_PGD_GRID, ONLY : NL 00040 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00041 USE MODD_TEB_n, ONLY : XCOVER, LCOVER, XZS, & 00042 LECOCLIMAP, LGREENROOF, LHYDRO 00043 USE MODD_TEB_VEG_n, ONLY : NNBIOMASS, & 00044 CISBA, CPHOTO, CPEDOTF, LTR_ML 00045 USE MODD_TEB_GARDEN_n, ONLY : NGROUND_LAYER, XSOILGRID, & 00046 XCLAY, XSAND, XRUNOFFB, XWDRAIN 00047 USE MODD_TEB_GRID_n, ONLY : CGRID, XGRID_PAR, XLAT, XLON, XMESH_SIZE, NDIM 00048 USE MODD_DATA_TEB_GARDEN_n, ONLY : NTIME 00049 ! 00050 USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF 00051 USE MODD_ISBA_PAR, ONLY : NOPTIMLAYER, XOPTIMGRID 00052 ! 00053 USE MODI_GET_LUOUT 00054 USE MODI_READ_NAM_PGD_ISBA 00055 USE MODI_PGD_FIELD 00056 USE MODI_TEST_NAM_VAR_SURF 00057 ! 00058 USE MODI_PGD_TEB_GARDEN_PAR 00059 ! 00060 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00061 USE PARKIND1 ,ONLY : JPRB 00062 ! 00063 USE MODI_ABOR1_SFX 00064 ! 00065 IMPLICIT NONE 00066 ! 00067 !* 0.1 Declaration of arguments 00068 ! ------------------------ 00069 ! 00070 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program 00071 ! ! F if all parameters must be specified 00072 ! 00073 ! 00074 !* 0.2 Declaration of local variables 00075 ! ------------------------------ 00076 ! 00077 INTEGER :: ILUOUT ! output listing logical unit 00078 INTEGER :: JLAYER ! loop counter 00079 ! 00080 !* 0.3 Declaration of namelists 00081 ! ------------------------ 00082 ! 00083 INTEGER :: IPATCH ! number of patches 00084 INTEGER :: IGROUND_LAYER ! number of soil layers 00085 CHARACTER(LEN=3) :: YISBA ! ISBA option 00086 CHARACTER(LEN=4) :: YPEDOTF ! Pedo-transfert function for DIF 00087 CHARACTER(LEN=3) :: YPHOTO ! photosynthesis option 00088 LOGICAL :: GTR_ML ! new radiative transfert 00089 REAL :: ZRM_PATCH ! threshold to remove little fractions of patches 00090 CHARACTER(LEN=28) :: YSAND ! file name for sand fraction 00091 CHARACTER(LEN=28) :: YCLAY ! file name for clay fraction 00092 CHARACTER(LEN=28) :: YCTI ! file name for topographic index 00093 CHARACTER(LEN=28) :: YRUNOFFB ! file name for runoffb parameter 00094 CHARACTER(LEN=28) :: YWDRAIN ! file name for wdrain parameter 00095 CHARACTER(LEN=6) :: YSANDFILETYPE ! sand data file type 00096 CHARACTER(LEN=6) :: YCLAYFILETYPE ! clay data file type 00097 CHARACTER(LEN=6) :: YCTIFILETYPE ! topographic index data file type 00098 CHARACTER(LEN=6) :: YRUNOFFBFILETYPE ! subgrid runoff data file type 00099 CHARACTER(LEN=6) :: YWDRAINFILETYPE ! subgrid drainage data file type 00100 REAL :: XUNIF_SAND ! uniform value of sand fraction 00101 REAL :: XUNIF_CLAY ! uniform value of clay fraction 00102 REAL :: XUNIF_RUNOFFB ! uniform value of subgrid runoff coefficient 00103 REAL :: XUNIF_WDRAIN ! uniform subgrid drainage parameter 00104 LOGICAL :: LIMP_SAND ! Imposed maps of Sand 00105 LOGICAL :: LIMP_CLAY ! Imposed maps of Clay 00106 LOGICAL :: LIMP_CTI ! Imposed maps of topographic index statistics 00107 REAL, DIMENSION(150) :: ZSOILGRID ! Soil layer thickness for DIF 00108 ! 00109 ! Not used in TEB garden 00110 ! 00111 CHARACTER(LEN=28) :: YSOC_TOP ! file name for organic carbon 00112 CHARACTER(LEN=28) :: YSOC_SUB ! file name for organic carbon 00113 CHARACTER(LEN=28) :: YPERM ! file name for permafrost distribution 00114 CHARACTER(LEN=6) :: YSOCFILETYPE ! organic carbon data file type 00115 CHARACTER(LEN=6) :: YPERMFILETYPE ! permafrost distribution data file type 00116 REAL :: XUNIF_SOC_TOP ! uniform value of organic carbon top soil (kg/m2) 00117 REAL :: XUNIF_SOC_SUB ! uniform value of organic carbon sub soil (kg/m2) 00118 REAL :: XUNIF_PERM ! uniform permafrost distribution 00119 LOGICAL :: LIMP_SOC ! Imposed maps of organic carbon 00120 LOGICAL :: LIMP_PERM ! Imposed maps of permafrost distribution 00121 CHARACTER(LEN=28) :: YPH ! file name for pH 00122 CHARACTER(LEN=28) :: YFERT ! file name for fertilisation rate 00123 CHARACTER(LEN=6) :: YPHFILETYPE ! pH data file type 00124 CHARACTER(LEN=6) :: YFERTFILETYPE ! fertilisation data file type 00125 REAL :: XUNIF_PH ! uniform value of pH 00126 REAL :: XUNIF_FERT ! uniform value of fertilisation rate 00127 ! 00128 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00129 !------------------------------------------------------------------------------- 00130 ! 00131 IF (LHOOK) CALL DR_HOOK('PGD_TEB_VEG',0,ZHOOK_HANDLE) 00132 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00133 ! 00134 !------------------------------------------------------------------------------- 00135 ! 00136 !* 1. Reading of namelist NAM_ISBA for general options of vegetation 00137 ! -------------------------------------------------------------- 00138 ! 00139 NGROUND_LAYER = 0 00140 CISBA = ' ' 00141 CPEDOTF = ' ' 00142 CPHOTO = ' ' 00143 ! 00144 CALL READ_NAM_PGD_ISBA(HPROGRAM, IPATCH, IGROUND_LAYER, & 00145 YISBA, YPEDOTF, YPHOTO, GTR_ML, ZRM_PATCH, & 00146 YCLAY, YCLAYFILETYPE, XUNIF_CLAY, LIMP_CLAY, & 00147 YSAND, YSANDFILETYPE, XUNIF_SAND, LIMP_SAND, & 00148 YSOC_TOP, YSOC_SUB, YSOCFILETYPE, XUNIF_SOC_TOP, & 00149 XUNIF_SOC_SUB, LIMP_SOC, YCTI, YCTIFILETYPE, LIMP_CTI, & 00150 YPERM, YPERMFILETYPE, XUNIF_PERM, LIMP_PERM, & 00151 YRUNOFFB, YRUNOFFBFILETYPE, XUNIF_RUNOFFB, & 00152 YWDRAIN, YWDRAINFILETYPE , XUNIF_WDRAIN, ZSOILGRID, & 00153 YPH, YPHFILETYPE, XUNIF_PH, YFERT, YFERTFILETYPE, & 00154 XUNIF_FERT ) 00155 ! 00156 NGROUND_LAYER = IGROUND_LAYER 00157 CISBA = YISBA 00158 CPEDOTF = YPEDOTF 00159 CPHOTO = YPHOTO 00160 LTR_ML = GTR_ML 00161 ! 00162 !------------------------------------------------------------------------------- 00163 ! 00164 !* 2. Coherence of options 00165 ! -------------------- 00166 ! 00167 CALL TEST_NAM_VAR_SURF(ILUOUT,'CISBA',CISBA,'2-L','3-L','DIF') 00168 CALL TEST_NAM_VAR_SURF(ILUOUT,'CPEDOTF',CPEDOTF,'CH78','CO84') 00169 CALL TEST_NAM_VAR_SURF(ILUOUT,'CPHOTO',CPHOTO,'NON','AGS','LAI','AST','LST','NIT','NCB') 00170 ! 00171 IF (CPHOTO=='NCB') THEN 00172 CPHOTO = 'NIT' 00173 WRITE(ILUOUT,*) '****************************************************************' 00174 WRITE(ILUOUT,*) '* FOR GARDENS, AGS OPTION HAS BEEN CHANGED FROM "NCB" TO "NIT" *' 00175 WRITE(ILUOUT,*) '****************************************************************' 00176 END IF 00177 ! 00178 SELECT CASE (CISBA) 00179 CASE ('2-L') 00180 NGROUND_LAYER = 2 00181 CPEDOTF ='CH78' 00182 WRITE(ILUOUT,*) '*****************************************' 00183 WRITE(ILUOUT,*) '* With option CISBA = ',CISBA,' *' 00184 WRITE(ILUOUT,*) '* the number of soil layers is set to 2 *' 00185 WRITE(ILUOUT,*) '* theta(psi) function = Brook and Corey *' 00186 WRITE(ILUOUT,*) '* Pedo transfert function = CH78 *' 00187 WRITE(ILUOUT,*) '*****************************************' 00188 CASE ('3-L') 00189 NGROUND_LAYER = 3 00190 CPEDOTF ='CH78' 00191 WRITE(ILUOUT,*) '*****************************************' 00192 WRITE(ILUOUT,*) '* With option CISBA = ',CISBA,' *' 00193 WRITE(ILUOUT,*) '* the number of soil layers is set to 3 *' 00194 WRITE(ILUOUT,*) '* theta(psi) function = Brook and Corey *' 00195 WRITE(ILUOUT,*) '* Pedo transfert function = CH78 *' 00196 WRITE(ILUOUT,*) '*****************************************' 00197 CASE ('DIF') 00198 IF(NGROUND_LAYER==NUNDEF)THEN 00199 IF(LECOCLIMAP)THEN 00200 NGROUND_LAYER=NOPTIMLAYER 00201 ELSE 00202 WRITE(ILUOUT,*) '****************************************' 00203 WRITE(ILUOUT,*) '* Number of ground layer not specified *' 00204 WRITE(ILUOUT,*) '****************************************' 00205 CALL ABOR1_SFX('PGD_TEB_GARDEN: NGROUND_LAYER MUST BE DONE IN NAM_ISBA') 00206 ENDIF 00207 ENDIF 00208 ! 00209 ALLOCATE(XSOILGRID(NGROUND_LAYER)) 00210 XSOILGRID(:)=XUNDEF 00211 XSOILGRID(:)=ZSOILGRID(1:NGROUND_LAYER) 00212 IF(ALL(ZSOILGRID(:)==XUNDEF))THEN 00213 IF(LECOCLIMAP) XSOILGRID(1:NGROUND_LAYER)=XOPTIMGRID(1:NGROUND_LAYER) 00214 ELSEIF(COUNT(XSOILGRID/=XUNDEF)/=NGROUND_LAYER)THEN 00215 WRITE(ILUOUT,*) '********************************************************' 00216 WRITE(ILUOUT,*) '* Soil grid reference values /= number of ground layer *' 00217 WRITE(ILUOUT,*) '********************************************************' 00218 CALL ABOR1_SFX('PGD_TEB_GARDEN: XSOILGRID must be coherent with NGROUND_LAYER in NAM_ISBA') 00219 ENDIF 00220 ! 00221 WRITE(ILUOUT,*) '*****************************************' 00222 WRITE(ILUOUT,*) '* Option CISBA = ',CISBA 00223 WRITE(ILUOUT,*) '* Pedo transfert function = ',CPEDOTF 00224 WRITE(ILUOUT,*) '* Number of soil layers = ',NGROUND_LAYER 00225 IF(LECOCLIMAP)THEN 00226 WRITE(ILUOUT,*) '* Soil layers grid (m) = ',XSOILGRID(1:NGROUND_LAYER) 00227 ENDIF 00228 WRITE(ILUOUT,*) '*****************************************' 00229 00230 END SELECT 00231 ! 00232 SELECT CASE (CPHOTO) 00233 CASE ('AGS','LAI','AST','LST') 00234 NNBIOMASS = 1 00235 CASE ('NIT') 00236 NNBIOMASS = 3 00237 END SELECT 00238 WRITE(ILUOUT,*) '*****************************************' 00239 WRITE(ILUOUT,*) '* With option CPHOTO = ',CPHOTO,' *' 00240 WRITE(ILUOUT,*) '* the number of biomass pools is set to ', NNBIOMASS 00241 WRITE(ILUOUT,*) '*****************************************' 00242 ! 00243 !------------------------------------------------------------------------------- 00244 ! 00245 !* 3. Sand fraction 00246 ! ------------- 00247 ! 00248 ALLOCATE(XSAND(NDIM,NGROUND_LAYER)) 00249 ! 00250 IF(LIMP_SAND)THEN 00251 ! 00252 CALL ABOR1_SFX('PGD_TEB_VEG: LIMP_SAND IS NOT CONSISTENT WITH TEB_GARDEN') 00253 ! 00254 ELSE 00255 ! 00256 CALL PGD_FIELD(HPROGRAM,'sand fraction','TWN',YSAND,YSANDFILETYPE,XUNIF_SAND,XSAND(:,1)) 00257 ENDIF 00258 ! 00259 DO JLAYER=1,NGROUND_LAYER 00260 XSAND(:,JLAYER) = XSAND(:,1) 00261 END DO 00262 !------------------------------------------------------------------------------- 00263 ! 00264 !* 4. Clay fraction 00265 ! ------------- 00266 ! 00267 ALLOCATE(XCLAY(NDIM,NGROUND_LAYER)) 00268 ! 00269 IF(LIMP_CLAY)THEN 00270 ! 00271 CALL ABOR1_SFX('PGD_TEB_VEG: LIMP_SAND IS NOT CONSISTENT WITH TEB_GARDEN') 00272 ! 00273 ELSE 00274 CALL PGD_FIELD(HPROGRAM,'clay fraction','TWN',YCLAY,YCLAYFILETYPE,XUNIF_CLAY,XCLAY(:,1)) 00275 ENDIF 00276 ! 00277 DO JLAYER=1,NGROUND_LAYER 00278 XCLAY(:,JLAYER) = XCLAY(:,1) 00279 END DO 00280 !------------------------------------------------------------------------------- 00281 ! 00282 !* 5. Subgrid runoff 00283 ! -------------- 00284 ! 00285 ALLOCATE(XRUNOFFB(NDIM)) 00286 CALL PGD_FIELD & 00287 (HPROGRAM,'subgrid runoff','TWN',YRUNOFFB,YRUNOFFBFILETYPE,XUNIF_RUNOFFB,XRUNOFFB(:)) 00288 ! 00289 !------------------------------------------------------------------------------- 00290 ! 00291 !* 6. Drainage coefficient 00292 ! -------------------- 00293 ! 00294 ALLOCATE(XWDRAIN(NDIM)) 00295 CALL PGD_FIELD & 00296 (HPROGRAM,'subgrid drainage','TWN',YWDRAIN,YWDRAINFILETYPE,XUNIF_WDRAIN,XWDRAIN(:)) 00297 ! 00298 !------------------------------------------------------------------------------- 00299 ! 00300 !* 7. Interpolation of GARDEN physiographic fields 00301 ! -------------------------------------------- 00302 ! 00303 NTIME = 12 00304 CALL PGD_TEB_GARDEN_PAR(HPROGRAM) 00305 ! 00306 !------------------------------------------------------------------------------- 00307 ! 00308 !* 8. Case of greenroofs 00309 ! ------------------ 00310 ! 00311 IF (LGREENROOF) CALL PGD_TEB_GREENROOF(HPROGRAM) 00312 ! 00313 !------------------------------------------------------------------------------- 00314 ! 00315 !* 9. Case of urban hydrology 00316 ! ----------------------- 00317 ! 00318 IF (LHYDRO) print*," CALL PGD_TEB_URBHYDRO(HPROGRAM,LECOCLIMAP)" 00319 ! 00320 !------------------------------------------------------------------------------- 00321 ! 00322 IF (LHOOK) CALL DR_HOOK('PGD_TEB_GARDEN',1,ZHOOK_HANDLE) 00323 ! 00324 ! 00325 !------------------------------------------------------------------------------- 00326 ! 00327 ! 00328 END SUBROUTINE PGD_TEB_VEG
1.8.0
