|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 !############################################################# 00002 SUBROUTINE COMPUTE_ISBA_PARAMETERS(HPROGRAM,HINIT,OLAND_USE, & 00003 KI,KSV,KSW, & 00004 HSV,PCO2,PRHOA, & 00005 PZENITH,PSW_BANDS,PDIR_ALB,PSCA_ALB, & 00006 PEMIS,PTSRAD, & 00007 HTEST ) 00008 !############################################################# 00009 ! 00010 !!**** *COMPUTE_ISBA_PARAMETERS_n* - routine to initialize ISBA 00011 !! 00012 !! PURPOSE 00013 !! ------- 00014 !! 00015 !!** METHOD 00016 !! ------ 00017 !! 00018 !! EXTERNAL 00019 !! -------- 00020 !! 00021 !! 00022 !! IMPLICIT ARGUMENTS 00023 !! ------------------ 00024 !! 00025 !! REFERENCE 00026 !! --------- 00027 !! 00028 !! 00029 !! AUTHOR 00030 !! ------ 00031 !! V. Masson *Meteo France* 00032 !! 00033 !! MODIFICATIONS 00034 !! ------------- 00035 !! Original 01/2004 00036 !! Modified by P. Le Moigne (11/2004): miscellaneous diagnostics 00037 !! Modified by P. Le Moigne (06/2006): seeding and irrigation 00038 !! Modified by B. Decharme (2008) : SGH and Flooding scheme 00039 !! Modified by B. Decharme (01/2009): optional deep soil temperature as in Arpege 00040 !! Modified by R. Hamdi (01/2009): Cp and L 00041 !! Modified by B. Decharme (06/2009): read topographic index statistics 00042 !! Modified by P. Le Moigne (01/2009): Beljaars sso 00043 !! Modified by B. Decharme (08/2009): Active Trip coupling variable if Earth System Model 00044 !! A.L. Gibelin 04/09 : change BSLAI_NITRO initialisation 00045 !! A.L. Gibelin 04/09 : modifications for CENTURY model 00046 !! A.L. Gibelin 06/09 : soil carbon initialisation 00047 !! Modified by B. Decharme (09/2012): Bug in exponential profile calculation with DIF 00048 !! 00049 !------------------------------------------------------------------------------- 00050 ! 00051 !* 0. DECLARATIONS 00052 ! ------------ 00053 ! 00054 USE MODD_SURFEX_MPI, ONLY : NWG_LAYER_TOT, NWG_SIZE, NPIO, NCOMM, NPROC, NRANK, WLOG_MPI 00055 ! 00056 USE MODD_IO_SURF_ASC, ONLY : NMASK_asc => NMASK 00057 USE MODD_IO_SURF_FA , ONLY : NMASK_fa => NMASK 00058 USE MODD_IO_SURF_LFI, ONLY : NMASK_lfi => NMASK 00059 ! 00060 USE MODD_ISBA_n, ONLY : CROUGH, CISBA, CPEDOTF, CPHOTO, CRUNOFF, CALBEDO, & 00061 CSCOND, CRESPSL, LTR_ML, NNBIOMASS, NNLITTER, & 00062 NNLITTLEVS, NNSOILCARB, XCLAY, XSAND, XSOC, & 00063 XWWILT, XWFC, XWSAT, XRM_PATCH, & 00064 XCOVER, XVEG, XLAI, XRSMIN, XGAMMA, XRGL, XCV, & 00065 XDG, NWG_LAYER, XDROOT, XDG2, XDZG, XDZDIF, & 00066 XZ0, XZ0_O_Z0H, XABC, XPOI, XANMAX, XFZERO, XEPSO, & 00067 XGAMM, XQDGAMM, XQDGMES, XT1GMES, XT2GMES, XAMAX, & 00068 XQDAMAX, XT1AMAX, XT2AMAX, XAH, XBH, XTAU_WOOD, & 00069 XINCREASE, XTURNOVER, XALBNIR_VEG, XALBVIS_VEG, & 00070 XALBUV_VEG, XEMIS, XVEGTYPE, XGMES, XRE25, XBSLAI, & 00071 XLAIMIN, XGC,XDMAX, LSTRESS, XF2I, & 00072 XSEFOLD, XH_TREE, XPATCH, NPATCH, XWRMAX_CF, & 00073 NR_NATURE_P, NSIZE_NATURE_P, & 00074 XALBNIR_DRY, XALBVIS_DRY, XALBUV_DRY, & 00075 XALBNIR_WET, XALBVIS_WET, XALBUV_WET, & 00076 XALBNIR_SOIL, XALBVIS_SOIL, XALBUV_SOIL, & 00077 XWG, XTG, TSNOW, XALBNIR, XALBVIS, XALBUV, & 00078 XEMIS_NAT, XFAPARC, XFAPIRC, XLAI_EFFC, XMUS, & 00079 XAOSIP,XAOSIM,XAOSJP,XAOSJM, & 00080 XHO2IP,XHO2IM,XHO2JP,XHO2JM, & 00081 XZ0EFFIP,XZ0EFFIM,XZ0EFFJP,XZ0EFFJM, XZ0REL, & 00082 XVEGTYPE_PATCH,XROOTFRAC,XRUNOFFD,XSOILWGHT, & 00083 XCGSAT, XC1SAT, XC2REF, XC3, XC4B, XACOEF, XPCOEF, & 00084 XTAUICE, XBCOEF, XCONDSAT, & 00085 XHCAPSOIL, XCONDDRY, XCONDSLD, XC4REF, XMPOTSAT, & 00086 XTDEEP, XGAMMAT, NGROUND_LAYER, XSOILGRID, TTIME, & 00087 XCE_NITRO, XCF_NITRO, & 00088 XCNA_NITRO, XBSLAI_NITRO, CCPSURF, TSEED, & 00089 TREAP, XWATSUP, XIRRIG, XCGMAX, & 00090 CKSAT, CTOPREG, CRAIN, LSOCP, CSOC, XFRACSOC, & 00091 XTI_MIN, XTI_MAX, XTI_MEAN, XTI_STD, XTI_SKEW, & 00092 XTAB_FSAT, XTAB_WTOP, XD_ICE, XKSAT_ICE, & 00093 XFSAT, XMUF, LTRIP, LFLOOD, XFFLOOD, XFFROZEN, & 00094 XPIFLOOD, XCPL_EFLOOD, XCPL_PFLOOD, XCPL_IFLOOD, & 00095 XCPL_DRAIN, XCPL_RUNOFF, LGLACIER, & 00096 LTEMP_ARP, NTEMPLAYER_ARP, XPSN, XPSNG, XPSNV, & 00097 XPSNV_A, XFF, XFFG, XFFV, XPCPS, XPLVTT, XPLSTT, & 00098 LCANOPY, LCANOPY_DRAG, XDIR_ALB_WITH_SNOW, & 00099 XSCA_ALB_WITH_SNOW, XALBF, XEMISF, XCPL_ICEFLUX, & 00100 NLAYER_HORT, NLAYER_DUN, XF_PARAM, XC_DEPTH_RATIO 00101 ! 00102 USE MODD_CH_ISBA_n, ONLY : CSV, CCH_NAMES, NBEQ, NSV_CHSBEG, NSV_CHSEND, & 00103 CCHEM_SURF_FILE, NDSTEQ, NSV_DSTBEG, NSV_DSTEND, & 00104 NSV_AERBEG, NSV_AEREND, NAEREQ, CDSTNAMES, CAER_NAMES,& 00105 NSLTEQ, NSV_SLTBEG, NSV_SLTEND, CSLTNAMES, & 00106 LCH_BIO_FLUX, CCH_DRY_DEP 00107 ! 00108 USE MODD_DEEPSOIL, ONLY : LPHYSDOMC, LDEEPSOIL, XTDEEP_CLI, XGAMMAT_CLI 00109 USE MODD_AGRI, ONLY : LAGRIP, XTHRESHOLD 00110 USE MODD_AGRI_n, ONLY : NIRRINUM, XTHRESHOLDSPT, LIRRIDAY, LIRRIGATE 00111 ! 00112 USE MODD_DIAG_ISBA_n, ONLY : LPATCH_BUDGET 00113 USE MODD_DIAG_MISC_ISBA_n, ONLY : LSURF_DIAG_ALBEDO 00114 ! 00115 USE MODD_SURF_ATM, ONLY : LCPL_ESM 00116 USE MODD_SURF_ATM_n, ONLY : NDIM_FULL 00117 ! 00118 USE MODD_SGH_PAR, ONLY : NDIMTAB, XICE_DEPH_MAX, XF_DECAY 00119 ! 00120 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00121 USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF 00122 USE MODD_SNOW_PAR, ONLY : XEMISSN 00123 ! 00124 USE MODD_TOPODYN, ONLY : NNCAT, NMESHT 00125 USE MODD_SURF_ATM_n, ONLY : NR_NATURE, NDIM_FULL 00126 ! 00127 USE MODD_DST_n 00128 USE MODD_SLT_n 00129 ! 00130 USE MODI_GET_LUOUT 00131 USE MODI_ABOR1_SFX 00132 USE MODI_INIT_IO_SURF_n 00133 USE MODI_ALLOCATE_PHYSIO 00134 USE MODI_INIT_ISBA_MIXPAR 00135 USE MODI_CONVERT_PATCH_ISBA 00136 USE MODI_INIT_VEG_PGD_n 00137 USE MODI_INIT_TOP 00138 USE MODI_EXP_DECAY_SOIL_DIF 00139 USE MODI_EXP_DECAY_SOIL_FR 00140 USE MODI_CARBON_INIT 00141 USE MODI_SOILTEMP_ARP_PAR 00142 USE MODI_WRITE_COVER_TEX_ISBA 00143 USE MODI_WRITE_COVER_TEX_ISBA_PAR 00144 USE MODI_END_IO_SURF_n 00145 ! 00146 USE MODI_READ_ISBA_n 00147 USE MODI_INIT_ISBA_LANDUSE 00148 USE MODI_READ_ISBA_CANOPY_n 00149 USE MODI_INIT_VEG_n 00150 USE MODI_AVERAGED_ALBEDO_EMIS_ISBA 00151 USE MODI_DIAG_ISBA_INIT_n 00152 USE MODI_INIT_SURF_TOPD 00153 USE MODI_ISBA_SOC_PARAMETERS 00154 ! 00155 USE MODI_GATHER_AND_WRITE_MPI 00156 ! 00157 USE MODI_READ_AND_SEND_MPI 00158 USE MODI_ISBA_TO_TOPD 00159 USE MODI_OPEN_FILE 00160 USE MODI_CLOSE_FILE 00161 ! 00162 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00163 USE PARKIND1 ,ONLY : JPRB 00164 ! 00165 IMPLICIT NONE 00166 ! 00167 #ifndef NOMPI 00168 INCLUDE "mpif.h" 00169 #endif 00170 ! 00171 !* 0.1 Declarations of arguments 00172 ! ------------------------- 00173 ! 00174 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00175 CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize 00176 LOGICAL, INTENT(IN) :: OLAND_USE ! 00177 INTEGER, INTENT(IN) :: KI ! number of points 00178 INTEGER, INTENT(IN) :: KSV ! number of scalars 00179 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00180 CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables 00181 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3) 00182 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density 00183 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle 00184 REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band 00185 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each band 00186 REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each band 00187 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity 00188 REAL, DIMENSION(KI), INTENT(OUT) :: PTSRAD ! radiative temperature 00189 ! 00190 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00191 ! 00192 ! 00193 !* 0.2 Declarations of local variables 00194 ! ------------------------------- 00195 ! 00196 REAL, DIMENSION(NDIM_FULL) :: ZF_PARAM, ZC_DEPTH_RATIO 00197 ! 00198 REAL, DIMENSION(KI) :: ZTSRAD_NAT !radiative temperature 00199 ! 00200 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWG1 ! work array for surface water content 00201 REAL, DIMENSION(:,:), ALLOCATABLE :: ZTG1 ! work array for surface temperature 00202 ! 00203 REAL, DIMENSION(:), ALLOCATABLE :: ZM, ZWORK 00204 REAL, DIMENSION(:,:), ALLOCATABLE :: ZF 00205 ! 00206 INTEGER :: IDIM_FULL, JL 00207 INTEGER :: JILU ! loop increment 00208 INTEGER :: ILUOUT ! unit of output listing file 00209 INTEGER :: IDECADE, IDECADE2 ! decade of simulation 00210 INTEGER :: JPATCH ! loop counter on tiles 00211 INTEGER :: IUNIT ! unit of f/dc map file 00212 INTEGER :: INFOMPI 00213 ! 00214 LOGICAL :: LWORK 00215 ! 00216 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00217 ! 00218 !------------------------------------------------------------------------------- 00219 ! 00220 ! Initialisation for IO 00221 ! 00222 IF (LHOOK) CALL DR_HOOK('COMPUTE_ISBA_PARAMETERS',0,ZHOOK_HANDLE) 00223 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00224 ! 00225 IF (HTEST/='OK') THEN 00226 CALL ABOR1_SFX('COMPUTE_ISBA_PARAMETERS: FATAL ERROR DURING ARGUMENT TRANSFER') 00227 END IF 00228 ! 00229 ! 00230 !* 2.3 Physiographic data fields from land cover: 00231 ! ----------------------------------------- 00232 ! 00233 CALL ALLOCATE_PHYSIO(CPHOTO, CISBA, KI, NVEGTYPE, NGROUND_LAYER, NPATCH, & 00234 XVEGTYPE, XLAI, XVEG, XZ0, XEMIS, XDG, XD_ICE, & 00235 XRSMIN, XGAMMA, XWRMAX_CF, XRGL, XCV, & 00236 XZ0_O_Z0H, XALBNIR_VEG, XALBVIS_VEG, XALBUV_VEG, & 00237 XH_TREE, XRE25, XLAIMIN, XBSLAI, XSEFOLD, & 00238 XGMES, XGC, XF2I, XDMAX, LSTRESS, & 00239 XCE_NITRO, XCF_NITRO, XCNA_NITRO, & 00240 TSEED, TREAP, XWATSUP, XIRRIG, & 00241 XROOTFRAC, NWG_LAYER, XDROOT, XDG2 ) 00242 ! 00243 IF (TTIME%TDATE%MONTH /= NUNDEF) THEN 00244 IDECADE = 3 * ( TTIME%TDATE%MONTH - 1 ) + MIN(TTIME%TDATE%DAY-1,29) / 10 + 1 00245 ELSE 00246 IDECADE = 1 00247 END IF 00248 ! 00249 IDECADE2 = IDECADE 00250 ! 00251 CALL INIT_ISBA_MIXPAR(CISBA,IDECADE,IDECADE2,XCOVER,CPHOTO,'NAT') 00252 ! 00253 CALL CONVERT_PATCH_ISBA(CISBA,IDECADE,IDECADE2,XCOVER,CPHOTO,LAGRIP, & 00254 'NAT',PVEG=XVEG,PLAI=XLAI, & 00255 PRSMIN=XRSMIN,PGAMMA=XGAMMA,PWRMAX_CF=XWRMAX_CF, & 00256 PRGL=XRGL,PCV=XCV,PSOILGRID=XSOILGRID, & 00257 PDG=XDG,KWG_LAYER=NWG_LAYER,PDROOT=XDROOT,PDG2=XDG2, & 00258 PZ0=XZ0,PZ0_O_Z0H=XZ0_O_Z0H, & 00259 PALBNIR_VEG=XALBNIR_VEG,PALBVIS_VEG=XALBVIS_VEG, & 00260 PALBUV_VEG=XALBUV_VEG,PEMIS_ECO=XEMIS, & 00261 PVEGTYPE=XVEGTYPE,PROOTFRAC=XROOTFRAC, & 00262 PGMES=XGMES,PBSLAI=XBSLAI,PLAIMIN=XLAIMIN, & 00263 PSEFOLD=XSEFOLD,PGC=XGC, & 00264 PDMAX=XDMAX,PF2I=XF2I,OSTRESS=LSTRESS,PH_TREE=XH_TREE, & 00265 PRE25=XRE25,PCE_NITRO=XCE_NITRO,PCF_NITRO=XCF_NITRO, & 00266 PCNA_NITRO=XCNA_NITRO,PD_ICE=XD_ICE,TPSEED=TSEED, & 00267 TPREAP=TREAP,PWATSUP=XWATSUP,PIRRIG=XIRRIG ) 00268 ! 00269 IF(CISBA=='DIF')THEN 00270 IDIM_FULL = SIZE(NWG_LAYER_TOT,1) 00271 !$OMP SINGLE 00272 DEALLOCATE(NWG_LAYER_TOT) 00273 ALLOCATE(NWG_LAYER_TOT(IDIM_FULL,SIZE(NWG_LAYER,2))) 00274 !$OMP END SINGLE 00275 DO JL = 1,SIZE(NWG_LAYER,2) 00276 IF (HPROGRAM=='ASCII ') THEN 00277 CALL GATHER_AND_WRITE_MPI(NWG_LAYER(:,JL),NWG_LAYER_TOT(:,JL),NMASK_asc) 00278 ELSEIF (HPROGRAM=='LFI ') THEN 00279 CALL GATHER_AND_WRITE_MPI(NWG_LAYER(:,JL),NWG_LAYER_TOT(:,JL),NMASK_lfi) 00280 ELSEIF (HPROGRAM=='FA ') THEN 00281 CALL GATHER_AND_WRITE_MPI(NWG_LAYER(:,JL),NWG_LAYER_TOT(:,JL),NMASK_fa) 00282 ELSE 00283 CALL ABOR1_SFX("COMPUTE_ISBA_PARAMETERS: WITH CISBA=DIF, THE GATHERING OF "//& 00284 "NWG_LAYER FOR ALL PROCS MUST BE IMPLEMENTED IN AROME AND MESONH CASES ") 00285 ENDIF 00286 ENDDO 00287 NWG_SIZE = 0 00288 IF (NRANK==NPIO) NWG_SIZE=MAXVAL(NWG_LAYER_TOT(:,:),NWG_LAYER_TOT(:,:)/=NUNDEF) 00289 IF (NPROC>1) THEN 00290 !$OMP SINGLE 00291 #ifndef NOMPI 00292 CALL MPI_BCAST(NWG_SIZE,KIND(NWG_SIZE)/4,MPI_INTEGER,NPIO,NCOMM,INFOMPI) 00293 #endif 00294 !$OMP END SINGLE 00295 ENDIF 00296 ! 00297 ENDIF 00298 ! 00299 !------------------------------------------------------------------------------- 00300 ! 00301 CALL INIT_VEG_PGD_n(HPROGRAM, ILUOUT, KI, NPATCH, NGROUND_LAYER, TTIME%TDATE%MONTH, & 00302 XVEGTYPE, XPATCH, XVEGTYPE_PATCH, NSIZE_NATURE_P, NR_NATURE_P, & 00303 XRM_PATCH, & 00304 LDEEPSOIL, LPHYSDOMC, XTDEEP_CLI, XGAMMAT_CLI, XTDEEP, XGAMMAT, & 00305 LAGRIP, XTHRESHOLD, NIRRINUM, LIRRIDAY, LIRRIGATE, XTHRESHOLDSPT, & 00306 CPHOTO, HINIT, LTR_ML, NNBIOMASS, PCO2, PRHOA, XABC, XPOI, & 00307 XGMES, XGC, XDMAX, XANMAX, XFZERO, XEPSO, XGAMM, XQDGAMM, & 00308 XQDGMES, XT1GMES, XT2GMES, XAMAX, XQDAMAX, XT1AMAX, XT2AMAX,& 00309 XAH, XBH, XTAU_WOOD, XINCREASE, XTURNOVER, & 00310 KSV, HSV, NBEQ, CSV, NAEREQ, NSV_CHSBEG, NSV_CHSEND, & 00311 NSV_AERBEG, NSV_AEREND, CCH_NAMES, CAER_NAMES, NDSTEQ, & 00312 NSV_DSTBEG, NSV_DSTEND, NSLTEQ, NSV_SLTBEG, NSV_SLTEND, & 00313 CDSTNAMES, CSLTNAMES, CCHEM_SURF_FILE, & 00314 XSFDST, XSFDSTM, XSFSLT, & 00315 XAOSIP, XAOSIM, XAOSJP, XAOSJM, XHO2IP, XHO2IM, XHO2JP, & 00316 XHO2JM, XZ0, XZ0EFFIP, XZ0EFFIM, XZ0EFFJP, XZ0EFFJM, XZ0REL,& 00317 XCLAY, XSAND, CPEDOTF, & 00318 XCONDSAT, XMPOTSAT, XBCOEF, XWWILT, XWFC, XWSAT, & 00319 XTAUICE, XCGSAT, XC1SAT, XC2REF, XC3, XC4B, XACOEF, XPCOEF, & 00320 XC4REF, XPCPS, XPLVTT, XPLSTT, & 00321 CSCOND, CISBA, XHCAPSOIL, XCONDDRY, XCONDSLD, CCPSURF, & 00322 XDG, XDROOT, XDG2, XROOTFRAC, XRUNOFFD, XDZG, XDZDIF, & 00323 XSOILWGHT, NWG_LAYER, NLAYER_HORT, NLAYER_DUN, XD_ICE, & 00324 XKSAT_ICE, XALBNIR_DRY, XALBVIS_DRY, XALBUV_DRY, & 00325 XALBNIR_WET, XALBVIS_WET, XALBUV_WET, XBSLAI_NITRO, & 00326 XCE_NITRO, XCNA_NITRO, XCF_NITRO ) 00327 ! 00328 !------------------------------------------------------------------------------- 00329 ! 00330 IF(CISBA=='DIF') THEN 00331 ! 00332 IF( CKSAT=='SGH' )THEN 00333 ! 00334 ALLOCATE(ZWORK(KI)) 00335 ALLOCATE(ZF(KI,NPATCH)) 00336 ZWORK(:) = XUNDEF 00337 ZF(:,:) = XUNDEF 00338 DO JPATCH=1,NPATCH 00339 IF (NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE 00340 DO JILU=1,KI 00341 IF(XPATCH(JILU,JPATCH)>0.0)THEN 00342 !no profile for non vegetated area : f and root = 0.0 00343 LWORK=(XDROOT(JILU,JPATCH)==0.0.OR.XDROOT(JILU,JPATCH)==XUNDEF) 00344 ZF (JILU,JPATCH) = MIN(XF_DECAY,4.0/MAX(0.01,XDROOT(JILU,JPATCH))) 00345 ZF (JILU,JPATCH) = MERGE(0.0,ZF (JILU,JPATCH),LWORK) 00346 ZWORK(JILU ) = MERGE(0.0,XDROOT(JILU,JPATCH),LWORK) 00347 ENDIF 00348 ENDDO 00349 CALL EXP_DECAY_SOIL_DIF(ZF(:,JPATCH),XDG(:,:,JPATCH),NWG_LAYER(:,JPATCH),ZWORK(:),& 00350 XCONDSAT(:,:,JPATCH)) 00351 ENDDO 00352 DEALLOCATE(ZWORK) 00353 DEALLOCATE(ZF) 00354 ENDIF 00355 ! 00356 IF(CSOC=='SGH')THEN 00357 IF(.NOT.LSOCP)THEN 00358 CALL ABOR1_SFX('CSOC=SGH can be activated only if SOC data given in PGD fields') 00359 ENDIF 00360 ALLOCATE(XFRACSOC(KI,NGROUND_LAYER)) 00361 XFRACSOC(:,:)=0.0 00362 CALL ISBA_SOC_PARAMETERS(XPATCH,XDG,XSOC,XBCOEF,XMPOTSAT, & 00363 XCONDSAT,XWSAT,XHCAPSOIL,XCONDDRY, & 00364 XCONDSLD,XWFC,XWWILT,XFRACSOC ) 00365 ELSE 00366 ALLOCATE(XFRACSOC(0,0)) 00367 ENDIF 00368 ! 00369 ELSE 00370 ALLOCATE(XFRACSOC(0,0)) 00371 ENDIF 00372 ! 00373 !Topmodel 00374 ! 00375 IF ((CKSAT=='SGH' .OR. CKSAT=='EXP') .AND. HINIT/='PRE' .AND. CISBA/='DIF') THEN 00376 ALLOCATE(ZF(KI,NPATCH)) 00377 ZF (:,:) = XUNDEF 00378 ENDIF 00379 ! 00380 !CRUNOFF used in hydro_sgh and isba_sgh_update 00381 IF( CRUNOFF=='SGH ') THEN 00382 ! 00383 ALLOCATE(XTAB_FSAT(KI,NDIMTAB)) 00384 ALLOCATE(XTAB_WTOP(KI,NDIMTAB)) 00385 ! 00386 XTAB_FSAT(:,:) = 0.0 00387 XTAB_WTOP(:,:) = 0.0 00388 ! 00389 IF(HINIT/='PRE')THEN 00390 ! 00391 WHERE(XCLAY(:,1)==XUNDEF.AND.XTI_MEAN(:)/=XUNDEF) XTI_MEAN(:)=XUNDEF 00392 ! 00393 IF(CTOPREG/='DEF')THEN 00394 WRITE(ILUOUT,*)'!' 00395 WRITE(ILUOUT,*)' YOU USE TOPMODEL WITHOUT THE REGRESSION ' 00396 WRITE(ILUOUT,*)' OF WOLOCK AND MCCABE (2000) (OPTION TOPREG) ' 00397 WRITE(ILUOUT,*)'!' 00398 ENDIF 00399 ! 00400 ALLOCATE(ZM(KI)) 00401 ZM (:) = XUNDEF 00402 ! 00403 CALL INIT_TOP (CISBA, CTOPREG, ILUOUT, XPATCH, XRUNOFFD, & 00404 XDZG, XWWILT, XWSAT, XTI_MIN, & 00405 XTI_MAX, XTI_MEAN, XTI_STD, XTI_SKEW, & 00406 XSOILWGHT, XTAB_FSAT, XTAB_WTOP, ZM ) 00407 ! 00408 ! 00409 IF (CKSAT=='SGH' .AND. CISBA/='DIF') THEN 00410 ! Exponential decay factor calculate using soil properties 00411 ! (eq. 11, Decharme et al., J. Hydrometeor, 2006) 00412 DO JILU=1,KI 00413 IF (ZM(JILU)/=XUNDEF) ZF(JILU,:) = (XWSAT(JILU,1)-XWWILT(JILU,1))/ZM(JILU) 00414 ENDDO 00415 ! 00416 ENDIF 00417 ! 00418 DEALLOCATE(ZM) 00419 ! 00420 ENDIF 00421 ! 00422 ELSE 00423 ! 00424 ALLOCATE(XTAB_FSAT(0,0)) 00425 ALLOCATE(XTAB_WTOP(0,0)) 00426 ! 00427 ENDIF 00428 ! 00429 !Exponential decay for ISBA-FR option 00430 !CKSAT used in hydro_soil.F90 and soil.F90 00431 IF(HINIT/='PRE'.AND.CISBA/='DIF')THEN 00432 ! 00433 IF(CKSAT=='SGH') THEN 00434 ! 00435 WHERE(ZF(:,:)==XUNDEF.AND.XDG(:,2,:)/=XUNDEF) 00436 ZF(:,:) = 4.0/XDG(:,2,:) 00437 ENDWHERE 00438 ZF(:,:) = MIN(ZF(:,:),XF_DECAY) 00439 ! 00440 ALLOCATE(XF_PARAM (KI)) 00441 ALLOCATE(XC_DEPTH_RATIO (KI)) 00442 XF_PARAM(:) = ZF(:,1) 00443 XC_DEPTH_RATIO(:) = 1.25 00444 ! 00445 DO JPATCH=1,NPATCH 00446 IF (NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE 00447 CALL EXP_DECAY_SOIL_FR(CISBA, ZF(:,JPATCH),XC1SAT(:,JPATCH),XC2REF(:,JPATCH), & 00448 XDG(:,:,JPATCH),XD_ICE(:,JPATCH),XC4REF(:,JPATCH), & 00449 XC3(:,:,JPATCH),XCONDSAT(:,:,JPATCH),XKSAT_ICE(:,JPATCH)) 00450 ENDDO 00451 ! 00452 ELSEIF ( CKSAT=='EXP' .AND. CISBA=='3-L' ) THEN 00453 ! 00454 ALLOCATE(XF_PARAM (KI)) 00455 ALLOCATE(XC_DEPTH_RATIO (KI)) 00456 XF_PARAM(:) = XUNDEF 00457 XC_DEPTH_RATIO(:) = XUNDEF 00458 ! 00459 IF (HPROGRAM/='AROME ' .AND. HPROGRAM/='MESONH ') THEN 00460 ! 00461 CALL OPEN_FILE('ASCII ',IUNIT,HFILE='carte_f_dc.txt',HFORM='FORMATTED',HACTION='READ ') 00462 DO JILU=1,NDIM_FULL 00463 READ(IUNIT,*) ZF_PARAM(JILU), ZC_DEPTH_RATIO(JILU) 00464 ENDDO 00465 CALL CLOSE_FILE('ASCII ',IUNIT) 00466 CALL READ_AND_SEND_MPI(ZF_PARAM,XF_PARAM,NR_NATURE) 00467 CALL READ_AND_SEND_MPI(ZC_DEPTH_RATIO,XC_DEPTH_RATIO,NR_NATURE) 00468 ! 00469 ELSE 00470 WRITE(ILUOUT,*) "COMPUTE_ISBA_PARAMETERS: WITH CKSAT=EXP, IN NOT OFFLINE "//& 00471 "MODE, TOPMODEL FILE FOR F_PARAM IS NOT READ " 00472 ENDIF 00473 ! 00474 DO JPATCH=1,NPATCH 00475 WHERE (XF_PARAM(:)/=XUNDEF) 00476 ZF(:,JPATCH) = XF_PARAM(:) 00477 ELSEWHERE 00478 ZF(:,JPATCH) = 4.0/XDG(:,2,JPATCH) 00479 ZF(:,JPATCH) = MIN(ZF(:,JPATCH),XF_DECAY) 00480 ENDWHERE 00481 ENDDO 00482 ! 00483 DO JPATCH=1,NPATCH 00484 CALL EXP_DECAY_SOIL_FR(CISBA, ZF(:,JPATCH),XC1SAT(:,JPATCH),XC2REF(:,JPATCH), & 00485 XDG(:,:,JPATCH),XD_ICE(:,JPATCH),XC4REF(:,JPATCH), & 00486 XC3(:,:,JPATCH),XCONDSAT(:,:,JPATCH), & 00487 XKSAT_ICE(:,JPATCH)) 00488 ENDDO 00489 ! 00490 DEALLOCATE(ZF) 00491 ! 00492 ENDIF 00493 ! 00494 ENDIF 00495 ! 00496 ! 00497 !* 2.10 Soil carbon 00498 ! ----------- 00499 ! 00500 IF (HINIT == 'ALL' .AND. CRESPSL=='CNT' .AND. CPHOTO == 'NCB') THEN 00501 CALL CARBON_INIT(NNBIOMASS, NNLITTER, NNLITTLEVS, NNSOILCARB) 00502 ENDIF 00503 ! 00504 !Rainfall spatial distribution 00505 !CRAIN used in HYDRO_VEG and HYDRO_SGH and ISBA_SGH_UPDATE 00506 IF(CRAIN=='SGH')THEN 00507 ALLOCATE(XMUF(KI)) 00508 XMUF(:)=0.0 00509 ELSE 00510 ALLOCATE(XMUF(0)) 00511 ENDIF 00512 ! 00513 ALLOCATE(XFSAT(KI)) 00514 XFSAT(:) = 0.0 00515 ! 00516 !------------------------------------------------------------------------------- 00517 ! 00518 !* 6.2 Initialize of TRIP or ESM coupling:' 00519 ! ------------------------------------ 00520 ! 00521 IF(LCPL_ESM)THEN 00522 LTRIP=.TRUE. 00523 IF(.NOT.LGLACIER)THEN 00524 CALL ABOR1_SFX('LGLACIER MUST BE ACTIVATED WITH EARTH SYSTEM MODEL') 00525 ENDIF 00526 ENDIF 00527 ! 00528 IF(LGLACIER)THEN 00529 ALLOCATE(XCPL_ICEFLUX(KI)) 00530 XCPL_ICEFLUX(:) = 0.0 00531 ELSE 00532 ALLOCATE(XCPL_ICEFLUX(0)) 00533 ENDIF 00534 ! 00535 IF(LTRIP)THEN 00536 ! 00537 ALLOCATE(XCPL_DRAIN (KI)) 00538 ALLOCATE(XCPL_RUNOFF(KI)) 00539 XCPL_DRAIN = 0.0 00540 XCPL_RUNOFF = 0.0 00541 ! 00542 IF(LFLOOD)THEN 00543 ! 00544 ALLOCATE(XFFLOOD (KI)) 00545 ALLOCATE(XPIFLOOD (KI)) 00546 ALLOCATE(XCPL_EFLOOD (KI)) 00547 ALLOCATE(XCPL_PFLOOD (KI)) 00548 ALLOCATE(XCPL_IFLOOD (KI)) 00549 ALLOCATE(XFF (KI,NPATCH)) 00550 ALLOCATE(XFFG (KI,NPATCH)) 00551 ALLOCATE(XFFV (KI,NPATCH)) 00552 ALLOCATE(XFFROZEN (KI,NPATCH)) 00553 ALLOCATE(XALBF (KI,NPATCH)) 00554 ALLOCATE(XEMISF (KI,NPATCH)) 00555 XFFLOOD = 0.0 00556 XPIFLOOD = 0.0 00557 XCPL_EFLOOD = 0.0 00558 XCPL_PFLOOD = 0.0 00559 XCPL_IFLOOD = 0.0 00560 XFF = 0.0 00561 XFFG = 0.0 00562 XFFV = 0.0 00563 XFFROZEN = 0.0 00564 XALBF = 0.0 00565 XEMISF = 0.0 00566 ELSE 00567 ALLOCATE(XFFLOOD (0)) 00568 ALLOCATE(XPIFLOOD (0)) 00569 ALLOCATE(XCPL_EFLOOD (0)) 00570 ALLOCATE(XCPL_PFLOOD (0)) 00571 ALLOCATE(XCPL_IFLOOD (0)) 00572 ALLOCATE(XFF (0,0)) 00573 ALLOCATE(XFFG (0,0)) 00574 ALLOCATE(XFFV (0,0)) 00575 ALLOCATE(XFFROZEN (0,0)) 00576 ALLOCATE(XALBF (0,0)) 00577 ALLOCATE(XEMISF (0,0)) 00578 ENDIF 00579 ! 00580 ELSE 00581 ! 00582 ALLOCATE(XCPL_DRAIN (0)) 00583 ALLOCATE(XCPL_RUNOFF(0)) 00584 ! 00585 ENDIF 00586 ! 00587 !------------------------------------------------------------------------------- 00588 ! 00589 !* 7. ISBA time-varying deep force-restore temperature initialization 00590 ! --------------------------------------------------------------- 00591 ! 00592 CALL SOILTEMP_ARP_PAR(HPROGRAM,LTEMP_ARP,NTEMPLAYER_ARP) 00593 ! 00594 !------------------------------------------------------------------------------- 00595 ! 00596 !* 9. Prints of cover parameters in a tex file 00597 ! ---------------------------------------- 00598 ! 00599 CALL WRITE_COVER_TEX_ISBA (NPATCH,NGROUND_LAYER,CISBA) 00600 CALL WRITE_COVER_TEX_ISBA_PAR(NPATCH,NGROUND_LAYER,CISBA,CPHOTO,XSOILGRID) 00601 ! 00602 !* if only physiographic fields are to be initialized, stop here. 00603 ! 00604 IF (HINIT/='ALL') THEN 00605 IF (LHOOK) CALL DR_HOOK('COMPUTE_ISBA_PARAMETERS',1,ZHOOK_HANDLE) 00606 RETURN 00607 END IF 00608 ! 00609 !------------------------------------------------------------------------------- 00610 ! 00611 CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','ISBA ','READ ') 00612 ! 00613 !* 10. Prognostic and semi-prognostic fields 00614 ! ------------------------------------- 00615 ! 00616 CALL READ_ISBA_n(HPROGRAM) 00617 ! 00618 !------------------------------------------------------------------------------- 00619 ! 00620 !* 11. Extrapolation of the prognostic and semi-prognostic fields 00621 ! LAND USE case 00622 ! ------------------------------------- 00623 ! 00624 IF (OLAND_USE) THEN 00625 CALL INIT_ISBA_LANDUSE(HPROGRAM) 00626 END IF 00627 ! 00628 !------------------------------------------------------------------------------- 00629 ! 00630 !* 12. Canopy air fields: 00631 ! ----------------- 00632 ! 00633 CALL READ_ISBA_CANOPY_n(HPROGRAM) 00634 ! 00635 !------------------------------------------------------------------------------- 00636 ! 00637 ALLOCATE(XDIR_ALB_WITH_SNOW(KI,KSW,NPATCH)) 00638 ALLOCATE(XSCA_ALB_WITH_SNOW(KI,KSW,NPATCH)) 00639 XDIR_ALB_WITH_SNOW = 0.0 00640 XSCA_ALB_WITH_SNOW = 0.0 00641 ! 00642 !------------------------------------------------------------------------------- 00643 ! 00644 CALL INIT_VEG_n(NPATCH, KI, LCANOPY, CROUGH, TSNOW, & 00645 CPHOTO, XLAIMIN, XH_TREE, XVEGTYPE_PATCH, XLAI, XZ0, XVEG, XEMIS, & 00646 LTR_ML, XFAPARC, XFAPIRC, XLAI_EFFC, XMUS, & 00647 XALBNIR_SOIL, XALBVIS_SOIL, XALBUV_SOIL, XALBNIR, XALBVIS, XALBUV, & 00648 LSURF_DIAG_ALBEDO, XPSN, XPSNG, XPSNV, XPSNV_A, & 00649 PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD ) 00650 ! 00651 ! 00652 ALLOCATE(ZWG1(KI,NPATCH)) 00653 ALLOCATE(ZTG1(KI,NPATCH)) 00654 DO JPATCH=1,NPATCH 00655 ZWG1(:,JPATCH) = XWG(:,1,JPATCH) 00656 ZTG1(:,JPATCH) = XTG(:,1,JPATCH) 00657 END DO 00658 ! 00659 CALL CONVERT_PATCH_ISBA(CISBA,IDECADE,IDECADE2,XCOVER,CPHOTO,LAGRIP,'NAT',& 00660 PWG1 = ZWG1, & 00661 PALBNIR_SOIL=XALBNIR_SOIL, & 00662 PALBVIS_SOIL=XALBVIS_SOIL, & 00663 PALBUV_SOIL=XALBUV_SOIL ) 00664 ! 00665 DEALLOCATE(ZWG1) 00666 ! 00667 ALLOCATE(XEMIS_NAT (KI)) 00668 XEMIS_NAT (:) = XUNDEF 00669 ! 00670 CALL AVERAGED_ALBEDO_EMIS_ISBA(LFLOOD, CALBEDO, PZENITH, & 00671 XVEG,XZ0,XLAI,ZTG1, & 00672 XPATCH, & 00673 PSW_BANDS, & 00674 XALBNIR_VEG,XALBVIS_VEG,XALBUV_VEG, & 00675 XALBNIR_SOIL,XALBVIS_SOIL,XALBUV_SOIL, & 00676 XEMIS, & 00677 TSNOW, & 00678 XALBNIR,XALBVIS,XALBUV, & 00679 PDIR_ALB, PSCA_ALB, & 00680 XEMIS_NAT,ZTSRAD_NAT ) 00681 ! 00682 PEMIS = XEMIS_NAT 00683 PTSRAD = ZTSRAD_NAT 00684 ! 00685 DEALLOCATE(ZTG1) 00686 !------------------------------------------------------------------------------- 00687 ! 00688 !* 15. ISBA diagnostics initialization 00689 ! ------------------------------- 00690 ! 00691 IF(NPATCH<=1) LPATCH_BUDGET=.FALSE. 00692 ! 00693 CALL DIAG_ISBA_INIT_n(HPROGRAM,KI,KSW) 00694 ! 00695 !------------------------------------------------------------------------------- 00696 ! 00697 CALL INIT_SURF_TOPD(HPROGRAM,NDIM_FULL) 00698 ! 00699 !------------------------------------------------------------------------------- 00700 ! 00701 ! End of IO 00702 ! 00703 CALL END_IO_SURF_n(HPROGRAM) 00704 IF (LHOOK) CALL DR_HOOK('COMPUTE_ISBA_PARAMETERS',1,ZHOOK_HANDLE) 00705 ! 00706 END SUBROUTINE COMPUTE_ISBA_PARAMETERS
1.8.0
