|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################################### 00002 SUBROUTINE COUPLING_ISBA_n(HPROGRAM, HCOUPLING, & 00003 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, & 00004 PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, & 00005 PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, & 00006 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, & 00007 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, & 00008 PPEW_A_COEF, PPEW_B_COEF, & 00009 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, & 00010 HTEST ) 00011 ! ############################################################################### 00012 ! 00013 !!**** *COUPLING_ISBA_n * - Driver for ISBA time step 00014 !! 00015 !! PURPOSE 00016 !! ------- 00017 ! 00018 !!** METHOD 00019 !! ------ 00020 !! 00021 !! First, all actions dependant on each patch is donbe independantly 00022 !! (loop on patches) 00023 !! Second, actions common to all patches (e.g. prescription of new vegetation) 00024 !! Third, energy fluxes are averaged 00025 !! 00026 !! Nota that chemical fluxes are also treated. 00027 !! 00028 !! REFERENCE 00029 !! --------- 00030 !! 00031 !! 00032 !! AUTHOR 00033 !! ------ 00034 !! V. Masson 00035 !! 00036 !! MODIFICATIONS 00037 !! ------------- 00038 !! Original 01/2004 00039 !! P Le Moigne 11/2004 add new diagnostics for isba 00040 !! A.Bogatchev 09/2005 EBA snow option 00041 !! P Le Moigne 09/2005 AGS modifs of L. Jarlan 00042 !! P Le Moigne 02/2006 z0h with snow 00043 !! P.Le Moigne 06/2006 seeding and irrigation 00044 !! B. Decharme 2008 reset the subgrid topographic effect on the forcing 00045 !! PSNV allways <= PSNG 00046 !! News diag 00047 !! Flooding scheme and allows TRIP variables coupling 00048 !! A.L. Gibelin 04/2009 : Add respiration diagnostics 00049 !! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays 00050 !! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option 00051 !! A.L. Gibelin 05/2009 : Add carbon spinup 00052 !! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option 00053 !! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic 00054 !! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs 00055 !! S.Lafont 01/2011 : add PTSTEP as arg of diag_misc 00056 !! B.Decharme 09/2012 : Bug in hydro_glacier calculation with ES or Crocus 00057 !! New wind implicitation 00058 !! New soil carbon spinup and diag 00059 !! Isba budget 00060 !!------------------------------------------------------------------- 00061 ! 00062 USE MODD_CSTS, ONLY : XRD, XRV, XP00, XCPD, XPI 00063 USE MODD_SURF_PAR, ONLY : XUNDEF 00064 USE MODD_SNOW_PAR, ONLY : XZ0SN 00065 USE MODD_TYPE_DATE_SURF 00066 USE MODD_ISBA_n, ONLY : NSIZE_NATURE_P, NR_NATURE_P, CROUGH, NPATCH, LGLACIER, & 00067 NNBIOMASS, XABC, XPOI, CSNOWRES, CDIFSFCOND, CSOILFRZ, & 00068 CSCOND, CC1DRY, CRUNOFF, CPHOTO, LTR_ML, CISBA, XPATCH, & 00069 TTIME, CALBEDO, XCOVER, XLAI, XVEG, XZ0, XEMIS, & 00070 XALBNIR, XALBVIS, XALBUV, XEMIS_NAT, XTSRAD_NAT, & 00071 XALBNIR_VEG, XALBVIS_VEG, XALBUV_VEG, NGROUND_LAYER, & 00072 XALBNIR_DRY, XALBVIS_DRY, XALBUV_DRY, & 00073 XALBNIR_SOIL, XALBVIS_SOIL, XALBUV_SOIL, & 00074 XALBNIR_WET, XALBVIS_WET, XALBUV_WET, XWG, XWSAT, & 00075 XRSMIN, XGAMMA, XWRMAX_CF, XRGL, XCV, XZ0_O_Z0H, & 00076 XVEGTYPE, XROOTFRAC, XGMES, XBSLAI, XLAIMIN, XSEFOLD, & 00077 XGC, XF2I, LSTRESS, XH_TREE, XDMAX, XRE25, & 00078 XZ0EFFIP, XZ0EFFIM, XZ0EFFJP, XZ0EFFJM, XZ0EFFJPDIR, & 00079 XAOSIP, XAOSIM, XAOSJP, XAOSJM, & 00080 XHO2IP, XHO2IM, XHO2JP, XHO2JM, TSNOW, CRESPSL, & 00081 XCE_NITRO, XCF_NITRO, XCNA_NITRO, LECOCLIMAP, CCPSURF, & 00082 TSEED, TREAP, XWATSUP, XIRRIG, XCGMAX, & 00083 CKSAT, CSOC, CHORT, CRAIN, XMUF, XFSAT, LTRIP, & 00084 LFLOOD, XFFLOOD, XPIFLOOD, LTEMP_ARP, XSODELX, & 00085 LVEGUPD, NLAYER_HORT, NLAYER_DUN, & 00086 LSPINUPCARBS, LSPINUPCARBW, XSPINMAXS, XSPINMAXW, & 00087 NNBYEARSPINS, NNBYEARSPINW, NNBYEARSOLD, NSPINS, NSPINW 00088 ! 00089 USE MODD_SURF_ATM, ONLY : LNOSOF, CIMPLICIT_WIND 00090 USE MODD_SURF_ATM_n, ONLY : NDIM_FULL 00091 ! 00092 USE MODD_DST_n, ONLY : XSFDST, XSFDSTM, XEMISRADIUS_DST, XEMISSIG_DST 00093 USE MODD_SLT_n, ONLY : XSFSLT, XEMISRADIUS_SLT, XEMISSIG_SLT 00094 USE MODD_DST_SURF 00095 USE MODD_SLT_SURF 00096 USE MODE_DSLT_SURF 00097 ! 00098 USE MODD_PACK_ISBA, ONLY : XP_SSO_SLOPE, XP_Z0, XP_Z0REL, XP_Z0EFFIP, & 00099 XP_Z0EFFIM, XP_Z0EFFJP, XP_Z0EFFJM, XP_Z0FLOOD, & 00100 XP_AOSIP, XP_AOSIM ,XP_AOSJP, XP_AOSJM, XP_HO2IP, & 00101 XP_HO2IM, XP_HO2JP, XP_HO2JM, XP_Z0_O_Z0H, & 00102 XP_ALBNIR, XP_ALBVIS, XP_ALBUV, XP_ALBNIR_VEG, & 00103 XP_ALBVIS_VEG, XP_ALBUV_VEG, XP_ALBNIR_SOIL, & 00104 XP_ALBVIS_SOIL, XP_ALBUV_SOIL, NK_WG_LAYER, & 00105 XP_RSMIN, XP_RGL, XP_GAMMA, XP_CV, XP_RUNOFFD, & 00106 XP_WRMAX_CF, XP_VEG, XP_LAI, XP_DZG, XP_DZDIF, & 00107 XP_EMIS, XP_VEGTYPE_PATCH, XP_RUNOFFB, XP_CGSAT, & 00108 XP_C1SAT, XP_C2REF, XP_C3, XP_C4B, XP_C4REF, & 00109 XP_ACOEF, XP_PCOEF, XP_TAUICE, XP_WDRAIN, & 00110 XP_TDEEP, XP_GAMMAT, XP_PSN, XP_PSNG, XP_PSNV, & 00111 XP_PSNV_A, XP_IRRIG, XP_WATSUP, XP_THRESHOLD, & 00112 XP_LIRRIGATE, XP_LIRRIDAY, LP_STRESS, XP_GC, & 00113 XP_F2I, XP_DMAX, XP_AH, XP_BH, XP_GMES, XP_FZERO, & 00114 XP_EPSO, XP_GAMM, XP_QDGAMM, XP_QDGMES, XP_T1GMES,& 00115 XP_T2GMES, XP_AMAX, XP_QDAMAX, XP_T1AMAX, & 00116 XP_T2AMAX, XP_DG, XP_ROOTFRAC, XP_WFC, XP_WWILT, & 00117 XP_WSAT, XP_BCOEF, XP_CONDSAT, XP_MPOTSAT, & 00118 XP_HCAPSOIL, XP_CONDDRY, XP_CONDSLD, & 00119 XP_D_ICE, XP_KSAT_ICE, XP_SOILWGHT, & 00120 XP_MUF, XP_FSAT, XP_FF, XP_FFG, XP_FFV, & 00121 XP_FFROZEN, XP_ALBF, XP_EMISF, XP_FFLOOD, & 00122 XP_PIFLOOD, XP_LAT, XP_LON, XP_TG, XP_WG, XP_WGI, & 00123 XP_CPS, XP_LVTT, XP_LSTT, XP_WR, XP_RESA, XP_ANFM,& 00124 XP_SNOWALB, XP_SNOWSWE, XP_SNOWHEAT, XP_SNOWRHO, & 00125 XP_SNOWGRAN1, XP_SNOWGRAN2, XP_SNOWHIST, & 00126 XP_SNOWAGE, XP_SNOWEMIS, XP_LE, XP_FAPARC, & 00127 XP_FAPIRC, XP_LAI_EFFC, XP_MUS, XP_AN, XP_ANDAY, & 00128 XP_ANF, XP_ICE_STO, XP_ALBVIS_DRY, XP_ALBNIR_DRY, & 00129 XP_ALBUV_DRY, XP_ALBVIS_WET, XP_ALBNIR_WET, & 00130 XP_ALBUV_WET, XP_H_TREE, XP_BSLAI, XP_LAIMIN, & 00131 XP_SEFOLD, XP_ANMAX, XP_CE_NITRO, XP_CF_NITRO, & 00132 XP_CNA_NITRO, XP_BSLAI_NITRO, XP_BIOMASS, & 00133 XP_RESP_BIOMASS, XP_INCREASE, XP_TURNOVER, & 00134 XP_TAU_WOOD, TP_SEED, TP_REAP, XP_RE25, XP_LITTER,& 00135 XP_LIGNIN_STRUC, XP_SOILCARB, XP_CLAY, XP_SAND, & 00136 XP_DIR_ALB_WITH_SNOW, XP_SCA_ALB_WITH_SNOW 00137 ! 00138 USE MODD_PACK_DIAG_ISBA, ONLY : XP_Z0EFF, XP_Z0_WITH_SNOW, XP_Z0H_WITH_SNOW, & 00139 XP_SNOWFREE_ALB, XP_SNOWFREE_ALB_VEG, & 00140 XP_SNOWFREE_ALB_SOIL, XP_IFLOOD, XP_PFLOOD, & 00141 XP_LE_FLOOD, XP_LEI_FLOOD, XP_GRNDFLUX, & 00142 XP_HPSNOW, XP_SNOWHMASS, XP_SMELTFLUX, & 00143 XP_RNSNOW, XP_HSNOW, XP_GFLUXSNOW, & 00144 XP_USTARSNOW, XP_SRSFC, XP_RRSFC, XP_LESL, & 00145 XP_CDSNOW, XP_CHSNOW, XP_TSRAD, XP_TS, XP_HV, & 00146 XP_QS, XP_SNOWTEMP, XP_SNOWLIQ, XP_SNOWDZ, & 00147 XP_CG, XP_C1, XP_C2, XP_WGEQ, XP_CT, XP_CH, & 00148 XP_CD, XP_CDN, XP_RI, XP_HU, XP_HUG, XP_ALBT, & 00149 XP_RS, XP_RN, XP_H, XP_LEI, XP_LEGI, XP_LEG, & 00150 XP_LEV, XP_LES, XP_LER, XP_LETR, XP_EVAP, & 00151 XP_GFLUX, XP_RESTORE, XP_DRAIN, XP_RUNOFF, & 00152 XP_MELT, XP_MELTADV, XP_RN_ISBA, XP_H_ISBA, & 00153 XP_LEG_ISBA, XP_LEGI_ISBA, XP_LEV_ISBA, & 00154 XP_LETR_ISBA, XP_USTAR_ISBA, XP_LER_ISBA, & 00155 XP_LE_ISBA, XP_LEI_ISBA, XP_GFLUX_ISBA, & 00156 XP_HORT, XP_DRIP, XP_RRVEG, XP_IACAN, & 00157 XP_GPP, XP_FAPAR, XP_FAPIR, XP_FAPAR_BS, & 00158 XP_FAPIR_BS, XP_ICEFLUX, XP_IRRIG_FLUX, & 00159 XP_RESP_AUTO, XP_RESP_ECO, XP_DWG, XP_DWGI, & 00160 XP_DWR, XP_DSWE, XP_WATBUD 00161 ! 00162 USE MODD_PACK_CH_ISBA, ONLY : XP_SOILRC_SO2, XP_SOILRC_O3, XP_DEP 00163 00164 USE MODD_CH_ISBA_n, ONLY : CSV, CCH_DRY_DEP, LCH_BIO_FLUX, XDEP, LCH_NO_FLUX,& 00165 NBEQ, NSV_CHSBEG, NSV_CHSEND, & 00166 NSV_DSTBEG, NSV_DSTEND, NAEREQ, NDSTEQ, NSLTEQ, & 00167 NSV_AERBEG, NSV_AEREND, NSV_SLTBEG, NSV_SLTEND 00168 USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK 00169 ! 00170 USE MODD_AGRI, ONLY : LAGRIP 00171 USE MODD_DEEPSOIL, ONLY : LDEEPSOIL 00172 ! 00173 USE MODI_IRRIGATION_UPDATE 00174 USE MODI_ADD_FORECAST_TO_DATE_SURF 00175 USE MODI_Z0EFF 00176 USE MODI_ISBA 00177 USE MODI_AVERAGE_FLUX 00178 USE MODI_AVERAGE_RAD 00179 USE MODI_AVERAGE_DIAG_ISBA_n 00180 USE MODI_VEGETATION_EVOL 00181 USE MODI_VEGETATION_UPDATE 00182 USE MODI_CARBON_EVOL 00183 USE MODI_SUBSCALE_Z0EFF 00184 USE MODI_SOIL_ALBEDO 00185 USE MODI_ALBEDO 00186 USE MODI_DIAG_INLINE_ISBA_n 00187 USE MODI_DIAG_EVAP_ISBA_n 00188 USE MODI_DIAG_MISC_ISBA_n 00189 ! 00190 USE MODI_UPDATE_RAD_ISBA_n 00191 USE MODI_DEEPSOIL_UPDATE 00192 USE MODI_ISBA_SGH_UPDATE 00193 USE MODI_ISBA_FLOOD_PROPERTIES 00194 USE MODI_DIAG_CPL_ESM_ISBA 00195 USE MODI_HYDRO_GLACIER 00196 USE MODI_ISBA_ALBEDO 00197 USE MODI_CARBON_SPINUP 00198 USE MODI_PACK_ISBA_PATCH_n 00199 USE MODI_PACK_ISBA_PATCH_GET_SIZE_n 00200 USE MODI_PACK_CH_ISBA_PATCH_n 00201 USE MODI_PACK_DIAG_PATCH_n 00202 USE MODI_PACK_DIAG_PATCH_GET_SIZE_n 00203 USE MODI_UNPACK_ISBA_PATCH_n 00204 USE MODI_UNPACK_CH_ISBA_PATCH_n 00205 USE MODI_UNPACK_DIAG_PATCH_n 00206 USE MODI_CH_AER_DEP 00207 USE MODI_ABOR1_SFX 00208 USE MODI_AVERAGE_DIAG_EVAP_ISBA_n 00209 USE MODI_AVERAGE_DIAG_MISC_ISBA_n 00210 USE MODI_CH_BVOCEM_n 00211 USE MODI_SOILEMISNO_n 00212 USE MODI_CH_DEP_ISBA 00213 USE MODI_DSLT_DEP 00214 USE MODI_COUPLING_DST_n 00215 USE MODI_COUPLING_SURF_TOPD 00216 USE MODI_ISBA_BUDGET_INIT 00217 USE MODI_ISBA_BUDGET 00218 ! 00219 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00220 USE PARKIND1 ,ONLY : JPRB 00221 ! 00222 IMPLICIT NONE 00223 ! 00224 !* 0.1 declarations of arguments 00225 ! 00226 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00227 CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling 00228 ! 'E' : explicit 00229 ! 'I' : implicit 00230 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00231 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00232 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00233 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00234 INTEGER, INTENT(IN) :: KI ! number of points 00235 INTEGER, INTENT(IN) :: KSV ! number of scalars 00236 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00237 REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) 00238 REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) 00239 REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) 00240 REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) 00241 ! 00242 REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) 00243 REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) 00244 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) 00245 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables 00246 ! ! chemistry: first char. in HSV: '#' (molecule/m3) 00247 ! ! 00248 REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) 00249 REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) 00250 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) 00251 ! ! (W/m2) 00252 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) 00253 ! ! (W/m2) 00254 REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) 00255 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) 00256 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical) 00257 REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) 00258 ! ! (W/m2) 00259 REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) 00260 REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) 00261 REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) 00262 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/kg) 00263 REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) 00264 REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) 00265 ! 00266 ! 00267 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) 00268 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) 00269 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) 00270 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) 00271 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 positive toward the atmosphere (m/s*kg_CO2/kg_air) 00272 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) 00273 ! 00274 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) 00275 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) 00276 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) 00277 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) 00278 ! 00279 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients 00280 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' 00281 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF 00282 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF 00283 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF 00284 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF 00285 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00286 ! 00287 ! 00288 !* 0.2 declarations of local variables 00289 ! 00290 !* forcing variables 00291 ! 00292 REAL, DIMENSION(KI) :: ZWIND ! lowest atmospheric level wind speed (m/s) 00293 REAL, DIMENSION(KI) :: ZDIR ! wind direction (rad from N clockwise) 00294 REAL, DIMENSION(KI) :: ZEXNA ! Exner function at lowest atmospheric level (-) 00295 REAL, DIMENSION(KI) :: ZEXNS ! Exner function at surface (-) 00296 REAL, DIMENSION(KI) :: ZALFA ! Wind direction (-) 00297 REAL, DIMENSION(KI) :: ZQA ! specific humidity (kg/kg) 00298 REAL, DIMENSION(KI) :: ZCO2 ! CO2 concentration (kg/kg) 00299 REAL, DIMENSION(KI) :: ZPEQ_A_COEF ! specific humidity implicit 00300 REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! coefficients (hum. in kg/kg) 00301 ! Patch outputs: 00302 ! 00303 REAL, DIMENSION(KI,NPATCH) :: ZSFTH_TILE ! surface heat flux (W/m2) 00304 REAL, DIMENSION(KI,NPATCH) :: ZSFTQ_TILE ! surface vapor flux (kg/m2/s) 00305 REAL, DIMENSION(KI,NPATCH) :: ZSFCO2_TILE ! surface CO2 flux positive toward the atmosphere (m/s*kg_CO2/kg_air) 00306 REAL, DIMENSION(KI,NPATCH) :: ZSFU_TILE ! zonal momentum flux 00307 REAL, DIMENSION(KI,NPATCH) :: ZSFV_TILE ! meridian momentum flux 00308 REAL, DIMENSION(KI,NPATCH) :: ZTRAD_TILE ! radiative surface temperature 00309 REAL, DIMENSION(KI,NPATCH) :: ZEMIS_TILE ! emissivity 00310 REAL, DIMENSION(KI,KSW,NPATCH) :: ZDIR_ALB_TILE ! direct albedo 00311 REAL, DIMENSION(KI,KSW,NPATCH) :: ZSCA_ALB_TILE ! diffuse albedo 00312 REAL, DIMENSION(KI,KSV,NPATCH) :: ZSFTS_TILE ! scalar surface flux 00313 ! 00314 REAL, DIMENSION(KI, NPATCH) :: ZCPL_DRAIN ! For the coupling with TRIP 00315 REAL, DIMENSION(KI, NPATCH) :: ZCPL_RUNOFF ! For the coupling with TRIP 00316 REAL, DIMENSION(KI, NPATCH) :: ZCPL_EFLOOD ! For the coupling with TRIP 00317 REAL, DIMENSION(KI, NPATCH) :: ZCPL_PFLOOD ! For the coupling with TRIP 00318 REAL, DIMENSION(KI, NPATCH) :: ZCPL_IFLOOD ! For the coupling with TRIP 00319 REAL, DIMENSION(KI, NPATCH) :: ZCPL_ICEFLUX 00320 ! 00321 ! for chemical computations 00322 ! 00323 REAL, DIMENSION(KI, NPATCH) :: ZSW_FORBIO 00324 ! 00325 REAL :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST 00326 REAL :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST 00327 REAL :: ZCONVERTFACM6_SLT, ZCONVERTFACM6_DST 00328 ! 00329 ! dimensions and loop counters 00330 ! 00331 INTEGER :: INI_FLOOD 00332 INTEGER :: ISWB ! number of spectral shortwave bands 00333 INTEGER :: JSWB ! loop on number of spectral shortwave bands 00334 INTEGER :: JPATCH ! loop on patches 00335 INTEGER :: JSV, IDST, IMOMENT 00336 ! 00337 ! logical units 00338 ! 00339 INTEGER :: JJ 00340 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00341 ! 00342 ! -------------------------------------------------------------------------------------- 00343 IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_N',0,ZHOOK_HANDLE) 00344 IF (HTEST/='OK') THEN 00345 CALL ABOR1_SFX('COUPLING_ISBAN: FATAL ERROR DURING ARGUMENT TRANSFER') 00346 END IF 00347 ! -------------------------------------------------------------------------------------- 00348 ! 00349 !* 1. Initializations 00350 ! 00351 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00352 ! Allocations: 00353 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00354 ! 00355 ZSFTH_TILE (:,:) = XUNDEF 00356 ZSFTQ_TILE (:,:) = XUNDEF 00357 ZSFCO2_TILE (:,:) = XUNDEF 00358 ZSFU_TILE (:,:) = XUNDEF 00359 ZSFV_TILE (:,:) = XUNDEF 00360 ZTRAD_TILE (:,:) = XUNDEF 00361 ZEMIS_TILE (:,:) = XUNDEF 00362 ZDIR_ALB_TILE(:,:,:) = XUNDEF 00363 ZSCA_ALB_TILE(:,:,:) = XUNDEF 00364 ! 00365 ZSFTS_TILE(:,:,:) = 0. 00366 ! 00367 ZCPL_DRAIN(:,:) = 0.0 00368 ZCPL_RUNOFF(:,:) = 0.0 00369 ZCPL_EFLOOD(:,:) = 0.0 00370 ZCPL_PFLOOD(:,:) = 0.0 00371 ZCPL_IFLOOD(:,:) = 0.0 00372 ZCPL_ICEFLUX(:,:) = 0.0 00373 ! 00374 ZSW_FORBIO(:,:) = XUNDEF 00375 ! 00376 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00377 ! Forcing Modifications: 00378 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00379 ! 00380 ZDIR=0. 00381 ! 00382 DO JJ=1,SIZE(PQA) 00383 ! specific humidity (conversion from kg/m3 to kg/kg) 00384 ! 00385 ZQA(JJ) = PQA(JJ) / PRHOA(JJ) 00386 ZPEQ_A_COEF(JJ) = PPEQ_A_COEF(JJ) / PRHOA(JJ) 00387 ZPEQ_B_COEF(JJ) = PPEQ_B_COEF(JJ) / PRHOA(JJ) 00388 ! 00389 ZCO2(JJ) = PCO2(JJ) / PRHOA(JJ) 00390 ! 00391 ! 00392 ! Other forcing variables depending on incoming forcing (argument list)JJ 00393 ! 00394 ZEXNS(JJ) = (PPS(JJ)/XP00)**(XRD/XCPD) 00395 ZEXNA(JJ) = (PPA(JJ)/XP00)**(XRD/XCPD) 00396 ! 00397 !* wind strength 00398 ! 00399 ZWIND(JJ) = SQRT(PU(JJ)**2+PV(JJ)**2) 00400 ! 00401 !* wind direction 00402 ! 00403 IF (ZWIND(JJ)>0.) ZDIR(JJ)=ATAN2(PU(JJ),PV(JJ)) 00404 ! 00405 !* angle between z0eff J axis and wind direction (rad., clockwise) 00406 ! 00407 ZALFA(JJ) = ZDIR(JJ) - XZ0EFFJPDIR(JJ) * XPI/180. 00408 00409 IF (ZALFA(JJ)<-XPI) ZALFA(JJ) = ZALFA(JJ) + 2.*XPI 00410 IF (ZALFA(JJ)>=XPI) ZALFA(JJ) = ZALFA(JJ) - 2.*XPI 00411 ! 00412 ENDDO 00413 ! 00414 !* number of shortwave spectral bands 00415 ! 00416 ISWB = KSW 00417 ! 00418 !* irrigation 00419 ! 00420 IF (LAGRIP .AND. (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT'.OR. CPHOTO=='NCB') ) THEN 00421 CALL IRRIGATION_UPDATE(XIRRIG,PTSTEP,KMONTH,KDAY,PTIME, & 00422 TSEED(:,:)%TDATE%MONTH,TSEED(:,:)%TDATE%DAY, & 00423 TREAP(:,:)%TDATE%MONTH,TREAP(:,:)%TDATE%DAY ) 00424 ENDIF 00425 ! 00426 !* Actualization of the SGH variable (Fmu, Fsat) 00427 ! 00428 CALL ISBA_SGH_UPDATE(CISBA,CRUNOFF,CRAIN,PRAIN,XMUF,XFSAT) 00429 ! 00430 ! 00431 !* Actualization of deep soil characteristics 00432 ! 00433 IF (LDEEPSOIL) THEN 00434 CALL DEEPSOIL_UPDATE(TTIME%TDATE%MONTH) 00435 ENDIF 00436 ! 00437 !* Actualization of soil and wood carbon spinup 00438 ! 00439 IF(LSPINUPCARBS.OR.LSPINUPCARBW)THEN 00440 CALL CARBON_SPINUP(TTIME%TDATE%MONTH,TTIME%TDATE%DAY,TTIME%TIME, & 00441 LSPINUPCARBS, LSPINUPCARBW, XSPINMAXS, XSPINMAXW, & 00442 NNBYEARSPINS, NNBYEARSPINW, NNBYEARSOLD, CPHOTO, & 00443 CRESPSL, NSPINS, NSPINW ) 00444 ENDIF 00445 ! 00446 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00447 ! Time evolution 00448 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00449 ! 00450 TTIME%TIME = TTIME%TIME + PTSTEP 00451 CALL ADD_FORECAST_TO_DATE_SURF(TTIME%TDATE%YEAR,TTIME%TDATE%MONTH,TTIME%TDATE%DAY,TTIME%TIME) 00452 ! 00453 ! -------------------------------------------------------------------------------------- 00454 ! 00455 !* 2. Physical evolution 00456 ! 00457 CALL PACK_ISBA_PATCH_GET_SIZE_n 00458 ! 00459 CALL PACK_DIAG_PATCH_GET_SIZE_n 00460 ! 00461 ! -------------------------------------------------------------------------------------- 00462 ! Patch Dependent Calculations 00463 ! -------------------------------------------------------------------------------------- 00464 ! 00465 PATCH_LOOP: DO JPATCH=1,NPATCH 00466 ! 00467 IF (NSIZE_NATURE_P(JPATCH) == 0 ) CYCLE 00468 ! 00469 ! Pack dummy arguments for each patch: 00470 ! 00471 CALL TREAT_PATCH(NSIZE_NATURE_P(JPATCH),NR_NATURE_P(:,JPATCH)) 00472 ! 00473 ENDDO PATCH_LOOP 00474 ! 00475 ! -------------------------------------------------------------------------------------- 00476 ! TRIP coupling update if used : 00477 ! -------------------------------------------------------------------------------------- 00478 ! 00479 IF(LTRIP)THEN 00480 CALL DIAG_CPL_ESM_ISBA(PTSTEP,ZCPL_DRAIN,ZCPL_RUNOFF,ZCPL_EFLOOD, & 00481 ZCPL_PFLOOD,ZCPL_IFLOOD,ZCPL_ICEFLUX ) 00482 ENDIF 00483 ! 00484 ! -------------------------------------------------------------------------------------- 00485 ! Vegetation update (in case of non-interactive vegetation): 00486 ! -------------------------------------------------------------------------------------- 00487 ! 00488 IF ((CPHOTO=='NON' .OR. CPHOTO=='AGS' .OR. CPHOTO=='AST') .AND. LVEGUPD) THEN 00489 CALL VEGETATION_UPDATE(PTSTEP,TTIME,XCOVER, & 00490 CISBA,LECOCLIMAP, CPHOTO, LAGRIP, 'NAT', & 00491 XLAI,XVEG,XZ0, & 00492 XALBNIR,XALBVIS,XALBUV,XEMIS, & 00493 XRSMIN,XGAMMA,XWRMAX_CF, & 00494 XRGL,XCV, & 00495 XGMES,XBSLAI,XLAIMIN,XSEFOLD,XGC,XDMAX, & 00496 XF2I, LSTRESS, & 00497 XAOSIP,XAOSIM,XAOSJP,XAOSJM, & 00498 XHO2IP,XHO2IM,XHO2JP,XHO2JM, & 00499 XZ0EFFIP,XZ0EFFIM,XZ0EFFJP,XZ0EFFJM, & 00500 CALBEDO, XALBNIR_VEG, XALBVIS_VEG, XALBUV_VEG, & 00501 XALBNIR_SOIL, XALBVIS_SOIL, XALBUV_SOIL, & 00502 XCE_NITRO, XCF_NITRO, XCNA_NITRO, & 00503 TSEED, TREAP, XWATSUP, XIRRIG ) 00504 END IF 00505 ! 00506 ! -------------------------------------------------------------------------------------- 00507 ! Outputs for the atmospheric model or update the snow/flood fraction 00508 ! -------------------------------------------------------------------------------------- 00509 ! Grid box average fluxes/properties: Arguments and standard diagnostics 00510 ! 00511 CALL AVERAGE_FLUX(XPATCH, & 00512 ZSFTH_TILE, ZSFTQ_TILE, ZSFTS_TILE, ZSFCO2_TILE, & 00513 ZSFU_TILE, ZSFV_TILE, & 00514 PSFTH, PSFTQ, PSFTS, PSFCO2, & 00515 PSFU, PSFV ) 00516 ! 00517 ! Albedo, Emissivity and fraction at time t+1 00518 ! 00519 CALL UPDATE_RAD_ISBA_n(LFLOOD, TSNOW%SCHEME, PZENITH2, PSW_BANDS, & 00520 XVEG, XLAI, XZ0, XALBNIR, XALBVIS, XALBUV, XEMIS,& 00521 ZDIR_ALB_TILE,ZSCA_ALB_TILE,ZEMIS_TILE ) 00522 ! 00523 CALL AVERAGE_RAD(XPATCH, & 00524 ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, ZTRAD_TILE, & 00525 PDIR_ALB, PSCA_ALB, XEMIS_NAT, XTSRAD_NAT ) 00526 ! 00527 PEMIS = XEMIS_NAT 00528 PTRAD = XTSRAD_NAT 00529 ! 00530 ! Any additional diagnostics (stored in MODD_DIAG_ISBA_n) 00531 ! 00532 CALL AVERAGE_DIAG_ISBA_n(PUREF,PZREF,PSFCO2) 00533 ! 00534 ! Cumulated diagnostics (stored in MODD_DIAG_EVAP_ISBA_n) 00535 ! 00536 CALL AVERAGE_DIAG_EVAP_ISBA_n(PRAIN,PSNOW) 00537 ! 00538 ! Miscellaneous diagnostics (stored in MODD_DIAG_MISC_ISBA_n) 00539 ! 00540 CALL AVERAGE_DIAG_MISC_ISBA_n 00541 ! 00542 !-------------------------------------------------------------------------------------- 00543 ! 00544 CALL COUPLING_SURF_TOPD(HPROGRAM,NDIM_FULL) 00545 ! 00546 ! -------------------------------------------------------------------------------------- 00547 ! Snow/Flood fractions, albedo and emissivity update : 00548 ! -------------------------------------------------------------------------------------- 00549 ! 00550 ! -------------------------------------------------------------------------------------- 00551 ! Chemical fluxes : 00552 ! -------------------------------------------------------------------------------------- 00553 ! 00554 IF (NBEQ>0 .AND. LCH_BIO_FLUX) THEN 00555 CALL CH_BVOCEM_n(ZSW_FORBIO,PRHOA,PSFTS) 00556 ENDIF 00557 ! 00558 !SOILNOX 00559 IF (LCH_NO_FLUX) THEN 00560 CALL SOILEMISNO_n(PU,PV) 00561 ENDIF 00562 ! 00563 !========================================================================================== 00564 ! 00565 IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_N',1,ZHOOK_HANDLE) 00566 CONTAINS 00567 ! 00568 !======================================================================================= 00569 SUBROUTINE TREAT_PATCH(KSIZE,KMASK) 00570 ! 00571 IMPLICIT NONE 00572 ! 00573 INTEGER, INTENT(IN) :: KSIZE 00574 INTEGER, INTENT(IN), DIMENSION(KI) :: KMASK 00575 ! 00576 REAL, DIMENSION(KSIZE) :: ZP_ZREF ! height of T,q forcing (m) 00577 REAL, DIMENSION(KSIZE) :: ZP_UREF ! height of wind forcing (m) 00578 REAL, DIMENSION(KSIZE) :: ZP_U ! zonal wind (m/s) 00579 REAL, DIMENSION(KSIZE) :: ZP_V ! meridian wind (m/s) 00580 REAL, DIMENSION(KSIZE) :: ZP_WIND ! wind (m/s) 00581 REAL, DIMENSION(KSIZE) :: ZP_DIR ! wind direction (rad from N clockwise) 00582 REAL, DIMENSION(KSIZE) :: ZP_QA ! air specific humidity forcing (kg/kg) 00583 REAL, DIMENSION(KSIZE) :: ZP_TA ! air temperature forcing (K) 00584 REAL, DIMENSION(KSIZE) :: ZP_CO2 ! CO2 concentration in the air (kg/kg) 00585 REAL, DIMENSION(KSIZE,KSV) :: ZP_SV ! scalar concentration in the air (kg/kg) 00586 REAL, DIMENSION(KSIZE) :: ZP_ZENITH ! zenithal angle radian from the vertical) 00587 REAL, DIMENSION(KSIZE) :: ZP_PEW_A_COEF ! implicit coefficients 00588 REAL, DIMENSION(KSIZE) :: ZP_PEW_B_COEF ! needed if HCOUPLING='I' 00589 REAL, DIMENSION(KSIZE) :: ZP_PET_A_COEF 00590 REAL, DIMENSION(KSIZE) :: ZP_PET_B_COEF 00591 REAL, DIMENSION(KSIZE) :: ZP_PEQ_A_COEF 00592 REAL, DIMENSION(KSIZE) :: ZP_PEQ_B_COEF 00593 REAL, DIMENSION(KSIZE) :: ZP_RAIN ! liquid precipitation (kg/m2/s) 00594 REAL, DIMENSION(KSIZE) :: ZP_SNOW ! snow precipitation (kg/m2/s) 00595 REAL, DIMENSION(KSIZE) :: ZP_LW ! longwave radiation (W/m2) 00596 REAL, DIMENSION(KSIZE,ISWB) :: ZP_DIR_SW ! direct solar radiation (W/m2) 00597 REAL, DIMENSION(KSIZE,ISWB) :: ZP_SCA_SW ! diffuse solar radiation (W/m2) 00598 REAL, DIMENSION(KSIZE) :: ZP_PS ! pressure at atmospheric model surface (Pa) 00599 REAL, DIMENSION(KSIZE) :: ZP_PA ! pressure at forcing level (Pa) 00600 REAL, DIMENSION(KSIZE) :: ZP_ZS ! atmospheric model orography (m) 00601 REAL, DIMENSION(KSIZE) :: ZP_SFTQ ! flux of water vapor <w'q'> (kg.m-2.s-1) 00602 REAL, DIMENSION(KSIZE) :: ZP_SFTH ! flux of temperature <w'T'> (W/m2) 00603 REAL, DIMENSION(KSIZE,KSV) :: ZP_SFTS ! flux of scalar <w'sv'> (mkg/kg/s) 00604 REAL, DIMENSION(KSIZE) :: ZP_SFCO2 ! flux of CO2 positive toward the atmosphere (m/s*kg_CO2/kg_air) 00605 REAL, DIMENSION(KSIZE) :: ZP_USTAR ! friction velocity (m/s) 00606 REAL, DIMENSION(KSIZE) :: ZP_SFU ! zonal momentum flux (pa) 00607 REAL, DIMENSION(KSIZE) :: ZP_SFV ! meridian momentum flux (pa) 00608 REAL, DIMENSION(KSIZE) :: ZP_TRAD ! radiative temperature (K) 00609 ! 00610 !* other forcing variables (packed for each patch) 00611 ! 00612 REAL, DIMENSION(KSIZE) :: ZP_RHOA ! lowest atmospheric level air density (kg/m3) 00613 REAL, DIMENSION(KSIZE) :: ZP_EXNA ! Exner function at lowest atmospheric level (-) 00614 REAL, DIMENSION(KSIZE) :: ZP_EXNS ! Exner function at surface (-) 00615 REAL, DIMENSION(KSIZE) :: ZP_ALFA ! Wind direction (-) 00616 ! 00617 !* working variables (packed for each patch) 00618 ! 00619 REAL, DIMENSION(KSIZE) :: ZP_ALBNIR_TVEG ! total vegetation albedo in ir 00620 REAL, DIMENSION(KSIZE) :: ZP_ALBNIR_TSOIL ! total soil albedo in ir 00621 REAL, DIMENSION(KSIZE) :: ZP_ALBVIS_TVEG ! total vegetation albedo in vis 00622 REAL, DIMENSION(KSIZE) :: ZP_ALBVIS_TSOIL ! total soil albedo in vis 00623 REAL, DIMENSION(KSIZE) :: ZP_EMIS ! emissiviity 00624 REAL, DIMENSION(KSIZE) :: ZP_GLOBAL_SW ! global incoming SW rad. 00625 REAL, DIMENSION(KSIZE) :: ZP_SLOPE_COS ! typical slope in the grid cosine 00626 ! 00627 REAL, DIMENSION(KSIZE) :: ZP_FFGNOS !Floodplain fraction over the ground without snow 00628 REAL, DIMENSION(KSIZE) :: ZP_FFVNOS !Floodplain fraction over vegetation without snow 00629 ! 00630 REAL, DIMENSION(KSIZE,NNBIOMASS) :: ZP_RESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s) 00631 ! 00632 !* Aggregated coeffs for evaporative flux calculations 00633 ! 00634 REAL, DIMENSION(KSIZE) :: ZP_AC_AGG ! aggregated aerodynamic resistance 00635 REAL, DIMENSION(KSIZE) :: ZP_HU_AGG ! aggregated relative humidity 00636 ! 00637 !* ISBA water and energy budget 00638 ! 00639 REAL, DIMENSION(KSIZE) :: ZP_WG_INI 00640 REAL, DIMENSION(KSIZE) :: ZP_WGI_INI 00641 REAL, DIMENSION(KSIZE) :: ZP_WR_INI 00642 REAL, DIMENSION(KSIZE) :: ZP_SWE_INI 00643 ! 00644 ! miscellaneous 00645 ! 00646 REAL, DIMENSION(KSIZE) :: ZP_DEEP_FLUX ! Flux at the bottom of the soil 00647 REAL, DIMENSION(KSIZE) :: ZP_TDEEP_A ! coefficient for implicitation of Tdeep 00648 INTEGER :: JJ, JI, JK 00649 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00650 ! 00651 IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_n:TREAT_PATCH',0,ZHOOK_HANDLE) 00652 ! 00653 !-------------------------------------------------------------------------------------- 00654 ! 00655 ! Pack isba forcing outputs 00656 ! 00657 IF (NPATCH==1) THEN 00658 ZP_ZENITH(:) = PZENITH (:) 00659 ZP_ZREF(:) = PZREF (:) 00660 ZP_UREF(:) = PUREF (:) 00661 ZP_WIND(:) = ZWIND (:) 00662 ZP_U(:) = PU (:) 00663 ZP_V(:) = PV (:) 00664 ZP_DIR(:) = ZDIR (:) 00665 ZP_QA(:) = ZQA (:) 00666 ZP_TA(:) = PTA (:) 00667 ZP_CO2(:) = ZCO2 (:) 00668 ZP_SV(:,:) = PSV (:,:) 00669 ZP_PEW_A_COEF(:) = PPEW_A_COEF (:) 00670 ZP_PEW_B_COEF(:) = PPEW_B_COEF (:) 00671 ZP_PET_A_COEF(:) = PPET_A_COEF (:) 00672 ZP_PET_B_COEF(:) = PPET_B_COEF (:) 00673 ZP_PEQ_A_COEF(:) = ZPEQ_A_COEF (:) 00674 ZP_PEQ_B_COEF(:) = ZPEQ_B_COEF (:) 00675 ZP_RAIN(:) = PRAIN (:) 00676 ZP_SNOW(:) = PSNOW (:) 00677 ZP_LW(:) = PLW (:) 00678 ZP_DIR_SW(:,:) = PDIR_SW (:,:) 00679 ZP_SCA_SW(:,:) = PSCA_SW (:,:) 00680 ZP_PS(:) = PPS (:) 00681 ZP_PA(:) = PPA (:) 00682 ZP_ZS(:) = PZS (:) 00683 ! 00684 ZP_RHOA(:) = PRHOA (:) 00685 ZP_EXNA(:) = ZEXNA (:) 00686 ZP_EXNS(:) = ZEXNS (:) 00687 ZP_ALFA(:) = ZALFA (:) 00688 ELSE 00689 !cdir nodep 00690 !cdir unroll=8 00691 DO JJ=1,KSIZE 00692 JI = KMASK(JJ) 00693 ZP_ZENITH(JJ) = PZENITH (JI) 00694 ZP_ZREF(JJ) = PZREF (JI) 00695 ZP_UREF(JJ) = PUREF (JI) 00696 ZP_WIND(JJ) = ZWIND (JI) 00697 ZP_U(JJ) = PU (JI) 00698 ZP_V(JJ) = PV (JI) 00699 ZP_DIR(JJ) = ZDIR (JI) 00700 ZP_QA(JJ) = ZQA (JI) 00701 ZP_TA(JJ) = PTA (JI) 00702 ZP_CO2(JJ) = ZCO2 (JI) 00703 ZP_PEW_A_COEF(JJ) = PPEW_A_COEF (JI) 00704 ZP_PEW_B_COEF(JJ) = PPEW_B_COEF (JI) 00705 ZP_PET_A_COEF(JJ) = PPET_A_COEF (JI) 00706 ZP_PET_B_COEF(JJ) = PPET_B_COEF (JI) 00707 ZP_PEQ_A_COEF(JJ) = ZPEQ_A_COEF (JI) 00708 ZP_PEQ_B_COEF(JJ) = ZPEQ_B_COEF (JI) 00709 ZP_RAIN(JJ) = PRAIN (JI) 00710 ZP_SNOW(JJ) = PSNOW (JI) 00711 ZP_LW(JJ) = PLW (JI) 00712 ZP_PS(JJ) = PPS (JI) 00713 ZP_PA(JJ) = PPA (JI) 00714 ZP_ZS(JJ) = PZS (JI) 00715 ! 00716 ZP_RHOA(JJ) = PRHOA (JI) 00717 ZP_EXNA(JJ) = ZEXNA (JI) 00718 ZP_EXNS(JJ) = ZEXNS (JI) 00719 ZP_ALFA(JJ) = ZALFA (JI) 00720 ENDDO 00721 ! 00722 DO JK=1,KSV 00723 !cdir nodep 00724 !cdir unroll=8 00725 DO JJ=1,KSIZE 00726 JI=KMASK(JJ) 00727 ZP_SV(JJ,JK) = PSV(JI,JK) 00728 ENDDO 00729 ENDDO 00730 ! 00731 DO JK=1,SIZE(PDIR_SW,2) 00732 !cdir nodep 00733 !cdir unroll=8 00734 DO JJ=1,KSIZE 00735 JI=KMASK(JJ) 00736 ZP_DIR_SW(JJ,JK) = PDIR_SW (JI,JK) 00737 ZP_SCA_SW(JJ,JK) = PSCA_SW (JI,JK) 00738 ENDDO 00739 ENDDO 00740 ! 00741 ENDIF 00742 ! 00743 !-------------------------------------------------------------------------------------- 00744 ! 00745 ! Pack ISBA input and prognostic variables (modd_isban) for each patch: 00746 ! 00747 CALL PACK_ISBA_PATCH_n(KMASK,KSIZE,JPATCH) 00748 ! 00749 00750 ! Pack chemistry input and prognostic variables (modd_ch_isban) for each patch: 00751 ! 00752 IF (NBEQ>0) THEN 00753 IF( CCH_DRY_DEP == "WES89") THEN 00754 CALL PACK_CH_ISBA_PATCH_n(KMASK,KSIZE,NPATCH,JPATCH) 00755 END IF 00756 END IF 00757 ! 00758 ! Allocate ISBA diagnostics for each patch: 00759 ! 00760 CALL PACK_DIAG_PATCH_n(KSIZE,ISWB) 00761 ! 00762 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00763 ! Cosine of the slope typically encoutered in the grid mesh (including subgrid orography) 00764 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00765 ! 00766 ZP_SLOPE_COS(:) = 1./SQRT(1.+XP_SSO_SLOPE(:)**2) 00767 IF(LNOSOF)ZP_SLOPE_COS(:) = 1.0 00768 ! 00769 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00770 ! Snow fractions 00771 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00772 ! now caculated at the initialization and at the end of the time step 00773 ! (see update_frac_alb_emis_isban.f90) in order to close the energy budget 00774 ! between surfex and the atmosphere. This fact do not change the offline runs. 00775 ! 00776 ! 00777 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00778 ! No implicitation of Tdeep 00779 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00780 ZP_TDEEP_A = 0. 00781 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00782 ! Flood properties 00783 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00784 ! 00785 IF(LFLOOD)THEN 00786 WHERE(XP_FFLOOD(:)==0.0) 00787 XP_Z0FLOOD(:) = XZ0SN 00788 ZP_FFGNOS (:) = 0.0 00789 ZP_FFVNOS (:) = 0.0 00790 ENDWHERE 00791 INI_FLOOD =COUNT(XP_FFLOOD(:)>0.0) 00792 IF (INI_FLOOD>0) & 00793 CALL ISBA_FLOOD_PROPERTIES(INI_FLOOD,ZP_TA,ZP_EXNA,ZP_RHOA,XP_TG(:,1), & 00794 ZP_EXNS,ZP_QA,ZP_WIND,ZP_ZREF,ZP_UREF,ZP_PS,& 00795 ZP_SLOPE_COS,XP_VEG,XP_LAI,XP_FFLOOD, & 00796 XP_FFROZEN,XP_Z0FLOOD,ZP_FFGNOS,ZP_FFVNOS ) 00797 ELSE 00798 XP_Z0FLOOD = XUNDEF 00799 ZP_FFGNOS = 0.0 00800 ZP_FFVNOS = 0.0 00801 ENDIF 00802 ! 00803 00804 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00805 ! Surface Roughness lengths (m): 00806 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00807 ! 00808 !* effective roughness 00809 ! 00810 CALL Z0EFF(CROUGH, ZP_ALFA, ZP_ZREF, ZP_UREF, XP_Z0, XP_Z0REL, XP_PSN, & 00811 XP_Z0EFFIP,XP_Z0EFFIM,XP_Z0EFFJP,XP_Z0EFFJM, XP_FF, XP_Z0FLOOD, & 00812 XP_AOSIP,XP_AOSIM,XP_AOSJP,XP_AOSJM, & 00813 XP_HO2IP,XP_HO2IM,XP_HO2JP,XP_HO2JM, & 00814 XP_Z0_O_Z0H, XP_Z0_WITH_SNOW, XP_Z0H_WITH_SNOW, XP_Z0EFF ) 00815 ! 00816 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00817 ! Shortwave computations for outputs (albedo for radiative scheme) 00818 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00819 ! now caculated at the initialization and at the end of the time step 00820 ! (see update_frac_alb_emis_isban.f90) in order to close the energy budget 00821 ! between surfex and the atmosphere. This fact do not change the offline runs. 00822 ! 00823 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00824 ! Shortwave computations for ISBA inputs (global snow-free albedo) 00825 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00826 ! 00827 ! ISBA needs global incoming solar radiation: it currently does 00828 ! not distinguish between the scattered and direct components, 00829 ! or between different wavelengths. 00830 ! 00831 ! 00832 !* Snow-free surface albedo for each wavelength 00833 ! 00834 CALL ISBA_ALBEDO(TSNOW%SCHEME, LTR_ML, & 00835 ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS,ISWB, & 00836 XP_ALBNIR, XP_ALBVIS, XP_ALBUV, & 00837 XP_ALBNIR_VEG, XP_ALBVIS_VEG, XP_ALBUV_VEG, & 00838 XP_ALBNIR_SOIL, XP_ALBVIS_SOIL, XP_ALBUV_SOIL, & 00839 XP_SNOWALB, XP_PSNV, XP_PSNG, XP_ALBF, XP_FFV, XP_FFG,& 00840 ZP_GLOBAL_SW, XP_SNOWFREE_ALB, XP_SNOWFREE_ALB_VEG, & 00841 XP_SNOWFREE_ALB_SOIL, ZP_ALBNIR_TVEG, ZP_ALBVIS_TVEG, & 00842 ZP_ALBNIR_TSOIL, ZP_ALBVIS_TSOIL ) 00843 ! 00844 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00845 ! Intialize computation of ISBA water and energy budget 00846 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00847 ! 00848 CALL ISBA_BUDGET_INIT(CISBA,TSNOW%SCHEME, & 00849 XP_WG,XP_WGI,XP_WR,XP_SNOWSWE, & 00850 XP_DG, XP_DZG, ZP_WG_INI, & 00851 ZP_WGI_INI, ZP_WR_INI, & 00852 ZP_SWE_INI ) 00853 ! 00854 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00855 ! Over Natural Land Surfaces: 00856 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00857 ! 00858 CALL ISBA(CISBA, CPHOTO, LTR_ML, CRUNOFF, CKSAT, CSOC, CRAIN, CHORT, CC1DRY, CSCOND, & 00859 TSNOW%SCHEME, CSNOWRES, CCPSURF, CSOILFRZ, CDIFSFCOND, TTIME, LFLOOD, LTEMP_ARP,& 00860 LGLACIER, PTSTEP, CIMPLICIT_WIND, & 00861 XCGMAX, ZP_ZREF, ZP_UREF, ZP_SLOPE_COS, ZP_TA, ZP_QA, ZP_EXNA, & 00862 ZP_RHOA, ZP_PS, ZP_EXNS, ZP_RAIN, ZP_SNOW, ZP_ZENITH, ZP_GLOBAL_SW, ZP_LW, & 00863 ZP_WIND, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, & 00864 ZP_PET_B_COEF, ZP_PEQ_B_COEF, XP_RSMIN, XP_RGL, XP_GAMMA, XP_CV, XP_RUNOFFD, & 00865 XP_SOILWGHT, NLAYER_HORT, NLAYER_DUN, ZP_ALBNIR_TVEG, ZP_ALBVIS_TVEG, & 00866 ZP_ALBNIR_TSOIL, ZP_ALBVIS_TSOIL, XP_SNOWFREE_ALB, XP_WRMAX_CF, XP_VEG, XP_LAI, & 00867 XP_EMIS, XP_Z0_WITH_SNOW, XP_Z0H_WITH_SNOW, XP_VEGTYPE_PATCH, XP_Z0EFF, & 00868 XP_RUNOFFB, XP_CGSAT, XP_C1SAT, XP_C2REF, XP_C3, XP_C4B, XP_C4REF, XP_ACOEF, & 00869 XP_PCOEF, XP_TAUICE, XP_WDRAIN, ZP_TDEEP_A, XP_TDEEP, XP_GAMMAT, & 00870 XP_PSN, XP_PSNG, XP_PSNV, & 00871 XP_PSNV_A, XP_SNOWFREE_ALB_VEG, XP_SNOWFREE_ALB_SOIL, XP_IRRIG, XP_WATSUP, & 00872 XP_THRESHOLD, XP_LIRRIGATE, XP_LIRRIDAY, LP_STRESS, XP_GC, XP_F2I, XP_DMAX, & 00873 XP_AH, XP_BH, ZP_CO2, XP_GMES, XPOI, XP_FZERO, XP_EPSO, XP_GAMM, XP_QDGAMM, & 00874 XP_QDGMES, XP_T1GMES, XP_T2GMES, XP_AMAX, XP_QDAMAX, XP_T1AMAX, XP_T2AMAX, & 00875 XABC, XP_DG, XP_DZG, XP_DZDIF, NK_WG_LAYER, XP_ROOTFRAC, XP_WFC, & 00876 XP_WWILT, XP_WSAT, XP_BCOEF, XP_CONDSAT, XP_MPOTSAT, XP_HCAPSOIL, XP_CONDDRY, & 00877 XP_CONDSLD, XP_D_ICE, XP_KSAT_ICE, XP_MUF, XP_FF, XP_FFG, XP_FFV, ZP_FFGNOS, & 00878 ZP_FFVNOS, XP_FFROZEN, XP_ALBF, XP_EMISF, XP_FFLOOD, XP_PIFLOOD, XP_IFLOOD, & 00879 XP_PFLOOD, XP_LE_FLOOD, XP_LEI_FLOOD, XSODELX, XP_LAT, XP_LON, XP_TG, XP_WG, & 00880 XP_WGI, XP_CPS, XP_LVTT, XP_LSTT, XP_WR, XP_RESA, XP_ANFM, XP_FSAT, & 00881 XP_SNOWALB, XP_SNOWSWE, XP_SNOWHEAT, XP_SNOWRHO, XP_SNOWGRAN1, XP_SNOWGRAN2, & 00882 XP_SNOWHIST, XP_SNOWAGE, XP_GRNDFLUX, XP_HPSNOW, XP_SNOWHMASS, XP_SMELTFLUX, & 00883 XP_RNSNOW, XP_HSNOW, XP_GFLUXSNOW, XP_USTARSNOW, XP_SRSFC, XP_RRSFC, XP_LESL, & 00884 XP_SNOWEMIS, XP_CDSNOW, XP_CHSNOW, XP_TSRAD, XP_TS, XP_HV, XP_QS, XP_SNOWTEMP, & 00885 XP_SNOWLIQ, XP_SNOWDZ, XP_CG, XP_C1, XP_C2, XP_WGEQ, XP_CT, XP_CH, XP_CD, & 00886 XP_CDN, XP_RI, XP_HU, XP_HUG, ZP_EMIS, XP_ALBT, XP_RS, XP_LE, XP_RN, XP_H, & 00887 XP_LEI, XP_LEGI, XP_LEG, XP_LEV, XP_LES, XP_LER, XP_LETR, XP_EVAP, XP_GFLUX, & 00888 XP_RESTORE, ZP_USTAR, XP_DRAIN, XP_RUNOFF, XP_MELT, XP_MELTADV, XP_RN_ISBA, & 00889 XP_H_ISBA, XP_LEG_ISBA, XP_LEGI_ISBA, XP_LEV_ISBA, XP_LETR_ISBA, XP_USTAR_ISBA, & 00890 XP_LER_ISBA, XP_LE_ISBA, XP_LEI_ISBA, XP_GFLUX_ISBA, XP_HORT, XP_DRIP, XP_RRVEG,& 00891 ZP_AC_AGG, ZP_HU_AGG, XP_FAPARC, XP_FAPIRC, XP_MUS, XP_LAI_EFFC, XP_AN, & 00892 XP_ANDAY, ZP_RESP_BIOMASS_INST, XP_IACAN, XP_ANF, XP_GPP, XP_FAPAR, XP_FAPIR, & 00893 XP_FAPAR_BS, XP_FAPIR_BS, XP_IRRIG_FLUX, ZP_DEEP_FLUX ) 00894 ! 00895 ZP_TRAD=XP_TSRAD 00896 ! 00897 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00898 ! Glacier : ice runoff flux (especally for Earth System Model) 00899 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00900 ! 00901 IF(LGLACIER)THEN 00902 ! 00903 CALL HYDRO_GLACIER(PTSTEP,ZP_SNOW,XP_SNOWRHO,XP_SNOWSWE,XP_ICE_STO,XP_ICEFLUX) 00904 ! 00905 ENDIF 00906 ! 00907 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00908 ! Calculation of ISBA water and energy budget (and time tendencies of each reservoir) 00909 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00910 ! 00911 CALL ISBA_BUDGET(CISBA,TSNOW%SCHEME,LGLACIER,PTSTEP, & 00912 XP_WG,XP_WGI,XP_WR,XP_SNOWSWE,XP_DG,XP_DZG, & 00913 ZP_WG_INI,ZP_WGI_INI,ZP_WR_INI,ZP_SWE_INI, & 00914 ZP_RAIN,ZP_SNOW,XP_EVAP,XP_DRAIN,XP_RUNOFF, & 00915 XP_IFLOOD,XP_PFLOOD,XP_ICEFLUX,XP_IRRIG_FLUX,& 00916 XP_DWG,XP_DWGI,XP_DWR,XP_DSWE,XP_WATBUD ) 00917 ! 00918 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00919 ! Evolution of soil albedo, when depending on surface soil wetness: 00920 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00921 ! 00922 IF (CALBEDO=='EVOL' .AND. LECOCLIMAP) THEN 00923 CALL SOIL_ALBEDO(CALBEDO, & 00924 XP_WSAT(:,1),XP_WG(:,1), & 00925 XP_ALBVIS_DRY,XP_ALBNIR_DRY,XP_ALBUV_DRY, & 00926 XP_ALBVIS_WET,XP_ALBNIR_WET,XP_ALBUV_WET, & 00927 XP_ALBVIS_SOIL,XP_ALBNIR_SOIL,XP_ALBUV_SOIL ) 00928 ! 00929 CALL ALBEDO(CALBEDO, & 00930 XP_ALBVIS_VEG,XP_ALBNIR_VEG,XP_ALBUV_VEG,XP_VEG, & 00931 XP_ALBVIS_SOIL,XP_ALBNIR_SOIL,XP_ALBUV_SOIL, & 00932 XP_ALBVIS,XP_ALBNIR,XP_ALBUV ) 00933 END IF 00934 ! 00935 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00936 ! Vegetation evolution for interactive LAI 00937 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00938 ! 00939 IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN 00940 CALL VEGETATION_EVOL(CISBA, CPHOTO, CRESPSL, CALBEDO, LAGRIP, LTR_ML, & 00941 PTSTEP, KMONTH, KDAY, NSPINW, PTIME, XP_LAT, ZP_RHOA, & 00942 XP_DG, XP_DZG, NK_WG_LAYER, & 00943 XP_TG, XP_ALBNIR_VEG, XP_ALBVIS_VEG, XP_ALBUV_VEG, & 00944 XP_ALBNIR_SOIL, XP_ALBVIS_SOIL, XP_ALBUV_SOIL, & 00945 XP_VEGTYPE_PATCH, XP_SEFOLD, XP_ANMAX, XP_H_TREE, XP_BSLAI,& 00946 XP_LAIMIN, ZP_CO2, XP_CE_NITRO, XP_CF_NITRO, XP_CNA_NITRO, & 00947 XP_BSLAI_NITRO, XP_GMES, XP_TAU_WOOD, TP_SEED, & 00948 TP_REAP, XP_AOSIP, XP_AOSIM, XP_AOSJP, XP_AOSJM, & 00949 XP_HO2IP, XP_HO2IM, XP_HO2JP, XP_HO2JM, XP_Z0EFFIP, & 00950 XP_Z0EFFIM, XP_Z0EFFJP, XP_Z0EFFJM, XP_LAI, XP_VEG, & 00951 XP_Z0, XP_ALBNIR, XP_ALBVIS, XP_ALBUV, XP_EMIS, & 00952 XP_ANFM, XP_ANDAY, XP_BIOMASS, XP_RESP_BIOMASS, & 00953 ZP_RESP_BIOMASS_INST, XP_INCREASE, XP_TURNOVER ) 00954 END IF 00955 ! 00956 ! 00957 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00958 ! Diagnostic of respiration carbon fluxes and soil carbon evolution 00959 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00960 ! 00961 ZP_SFCO2 (:)=0. 00962 XP_RESP_ECO (:)=0. 00963 XP_RESP_AUTO(:)=0. 00964 ! 00965 IF ( CPHOTO/='NON' .AND. CRESPSL/='NON' .AND. ANY(XP_LAI(:)/=XUNDEF) ) THEN 00966 CALL CARBON_EVOL(CISBA, CRESPSL, CPHOTO, PTSTEP, NSPINS, & 00967 ZP_RHOA, XP_TG, XP_WG, XP_WFC, XP_WWILT, XP_WSAT, XP_SAND,& 00968 XP_DG, XP_DZG, NK_WG_LAYER, & 00969 XP_RE25, XP_LAI, ZP_RESP_BIOMASS_INST, XP_TURNOVER, & 00970 XP_LITTER, XP_LIGNIN_STRUC , XP_SOILCARB, & 00971 XP_RESP_AUTO, XP_RESP_ECO ) 00972 ! calculation of vegetation CO2 flux 00973 ! Positive toward the atmosphere 00974 ZP_SFCO2(:) = XP_RESP_ECO(:) - XP_GPP(:) 00975 END IF 00976 ! 00977 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00978 ! Reset effecitve roughness lentgh to its nominal value when snow has just disappeared 00979 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00980 ! 00981 CALL SUBSCALE_Z0EFF(XP_AOSIP,XP_AOSIM,XP_AOSJP,XP_AOSJM, & 00982 XP_HO2IP,XP_HO2IM,XP_HO2JP,XP_HO2JM,XP_Z0, & 00983 XP_Z0EFFIP,XP_Z0EFFIM,XP_Z0EFFJP,XP_Z0EFFJM, & 00984 OMASK=(XP_SNOWSWE(:,1)==0. .AND. XP_PSN(:)>0.) ) 00985 ! 00986 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00987 ! Turbulent fluxes 00988 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00989 ! 00990 ZP_SFTH(:) = XP_H(:) 00991 ZP_SFTQ(:) = XP_EVAP(:) 00992 00993 ZP_SFU (:) = 0. 00994 ZP_SFV (:) = 0. 00995 WHERE (ZP_WIND>0.) 00996 ZP_SFU (:) = - ZP_U(:)/ZP_WIND(:) * ZP_USTAR(:)**2 * ZP_RHOA(:) 00997 ZP_SFV (:) = - ZP_V(:)/ZP_WIND(:) * ZP_USTAR(:)**2 * ZP_RHOA(:) 00998 END WHERE 00999 ! 01000 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01001 ! Scalar fluxes 01002 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01003 ! 01004 ZP_SFTS(:,:) = 0. 01005 ! 01006 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01007 ! 01008 ! -------------------------------------------------------------------------------------- 01009 ! Chemical dry deposition : 01010 ! -------------------------------------------------------------------------------------- 01011 IF (NBEQ>0) THEN 01012 IF( CCH_DRY_DEP == "WES89") THEN 01013 01014 CALL CH_DEP_ISBA (ZP_USTAR, XP_HU, XP_PSN, & 01015 XP_VEG, XP_LAI, XP_SAND, XP_CLAY, XP_RESA, & 01016 XP_RS(:), XP_Z0(:), & 01017 ZP_TA, ZP_PA, ZP_TRAD(:), & 01018 XP_VEGTYPE_PATCH(:,NVT_NO), & 01019 XP_VEGTYPE_PATCH(:,NVT_ROCK), & 01020 CSV(NSV_CHSBEG:NSV_CHSEND), & 01021 XP_SOILRC_SO2, XP_SOILRC_O3 , & 01022 XP_DEP(:,1:NBEQ) ) 01023 01024 ZP_SFTS(:,NSV_CHSBEG:NSV_CHSEND) = - ZP_SV(:,NSV_CHSBEG:NSV_CHSEND) & 01025 * XP_DEP(:,1:NBEQ) 01026 IF (NAEREQ > 0 ) THEN 01027 CALL CH_AER_DEP(ZP_SV(:,NSV_AERBEG:NSV_AEREND),& 01028 ZP_SFTS(:,NSV_AERBEG:NSV_AEREND),& 01029 ZP_USTAR, XP_RESA,ZP_TA,ZP_RHOA) 01030 END IF 01031 ELSE 01032 ZP_SFTS(:,NSV_CHSBEG:NSV_CHSEND) = 0. 01033 ZP_SFTS(:,NSV_AERBEG:NSV_AEREND) = 0. 01034 ENDIF 01035 ENDIF 01036 ! 01037 ! -------------------------------------------------------------------------------------- 01038 ! Dust deposition and emission: 01039 ! -------------------------------------------------------------------------------------- 01040 ! 01041 IF(NDSTEQ>0)THEN 01042 IDST = NSV_DSTEND - NSV_DSTBEG + 1 01043 01044 CALL COUPLING_DST_n( & 01045 HPROGRAM, &!I [char] Name of program 01046 KSIZE, &!I [nbr] number of points in patch 01047 IDST, &!I [nbr] number of dust emissions variables 01048 JPATCH, &!I [idx] patch in question 01049 XP_CLAY(:,1), &!I [frc] mass fraction clay in first soil layer 01050 ZP_PS, &!I [Pa] surface pressure 01051 ZP_QA, &!I [kg/kg] specific humidity 01052 XP_RESA, &!I [s/m] atmospheric resistance 01053 ZP_RHOA, &!I [kg/m3] atmospheric density 01054 XP_SAND(:,1), &!I [frc] mass fraction of sand in first soil layer 01055 ZP_SFTH, &!I [W/m2] surface heat flux 01056 ZP_SFTQ, &!I [kg/m2/s] surface vapor flux 01057 ZP_TA, &!I [K] Atmospheric temperature 01058 XP_TG(:,1), &!I [K] Ground temperature 01059 ZP_U, &!I [m/s] zonal wind at atmospheric height 01060 ZP_UREF, &!I [m] reference height of wind 01061 ZP_V, &!I [m/s] meridional wind at atmospheric height 01062 XP_WG(:,1), &!I [m3/m3] ground volumetric water content 01063 XP_WSAT(:,1), &!I [m3/m3] saturation volumetric water content 01064 ZP_ZREF, &!I [m] reference height of wind 01065 XP_CD, & 01066 XP_RI, & 01067 XP_Z0H_WITH_SNOW, &!I [frc] Z0 (heat) with snow 01068 ZP_SFTS(:,NSV_DSTBEG:NSV_DSTEND) &!O [kg/m2/sec] flux of dust 01069 ) 01070 01071 !Modify fluxes due to dry deposition, we introduce a negative flux where dust is lost 01072 CALL DSLT_DEP(ZP_SV(:,NSV_DSTBEG:NSV_DSTEND), ZP_SFTS(:,NSV_DSTBEG:NSV_DSTEND), & 01073 ZP_USTAR, XP_RESA, ZP_TA, ZP_RHOA, XEMISSIG_DST, XEMISRADIUS_DST, & 01074 JPMODE_DST, XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, & 01075 ZCONVERTFACM6_DST, ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, & 01076 CVERMOD ) 01077 01078 !Transfer these fluxes to fluxes understandable by all moments 01079 CALL MASSFLUX2MOMENTFLUX( & 01080 ZP_SFTS(:,NSV_DSTBEG:NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments 01081 ZP_RHOA, & !I [kg/m3] air density 01082 XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3) 01083 XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3) 01084 NDSTMDE, & 01085 ZCONVERTFACM0_DST, & 01086 ZCONVERTFACM6_DST, & 01087 ZCONVERTFACM3_DST, & 01088 LVARSIG_DST, LRGFIX_DST ) 01089 01090 ENDIF !Check on CDSTYN 01091 ! 01092 ! -------------------------------------------------------------------------------------- 01093 ! Sea Salt deposition 01094 ! -------------------------------------------------------------------------------------- 01095 ! 01096 IF (NSLTEQ>0) THEN 01097 CALL DSLT_DEP(ZP_SV(:,NSV_SLTBEG:NSV_SLTEND), ZP_SFTS(:,NSV_SLTBEG:NSV_SLTEND), & 01098 ZP_USTAR, XP_RESA, ZP_TA, ZP_RHOA, XEMISSIG_SLT, XEMISRADIUS_SLT, & 01099 JPMODE_SLT, XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, & 01100 ZCONVERTFACM6_SLT, ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, & 01101 CVERMOD ) 01102 01103 CALL MASSFLUX2MOMENTFLUX( & 01104 ZP_SFTS(:,NSV_SLTBEG:NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments 01105 ZP_RHOA, & !I [kg/m3] air density 01106 XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3) 01107 XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3) 01108 NSLTMDE, & 01109 ZCONVERTFACM0_SLT, & 01110 ZCONVERTFACM6_SLT, & 01111 ZCONVERTFACM3_SLT, & 01112 LVARSIG_SLT, LRGFIX_SLT ) 01113 ENDIF !Check on CSLTYN 01114 ! 01115 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01116 ! Inline diagnostics 01117 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01118 ! 01119 CALL DIAG_INLINE_ISBA_n(ZP_TA, ZP_TRAD, ZP_QA, ZP_PA, ZP_PS, ZP_RHOA, ZP_U, ZP_V, & 01120 ZP_ZREF, ZP_UREF, & 01121 XP_CD, XP_CDN, XP_CH, XP_RI, XP_HU, XP_Z0_WITH_SNOW, & 01122 XP_Z0H_WITH_SNOW, XP_Z0EFF, & 01123 ZP_SFTH, ZP_SFTQ, ZP_SFU, ZP_SFV, XP_QS, & 01124 XP_DIR_ALB_WITH_SNOW, XP_SCA_ALB_WITH_SNOW, & 01125 ZP_DIR_SW, ZP_SCA_SW, ZP_LW, XP_RN ) 01126 ! 01127 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01128 ! Isba offline diagnostics for each patch 01129 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01130 ! 01131 CALL DIAG_EVAP_ISBA_n(CPHOTO,PTSTEP,KMASK,KSIZE,JPATCH,ZP_RHOA) 01132 ! 01133 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01134 ! Isba offline diagnostics for miscellaneous terms over each patch 01135 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01136 ! 01137 CALL DIAG_MISC_ISBA_n(PTSTEP, CISBA, CPHOTO, TSNOW%SCHEME, LAGRIP, LTR_ML, & 01138 PTIME, KSIZE, JPATCH, KMASK, XP_THRESHOLD, & 01139 XP_PSN, XP_PSNG, XP_PSNV, XP_FF, XP_FFG, XP_FFV, & 01140 XP_WG, XP_WGI, XP_WFC, XP_WWILT, XP_SNOWSWE, XP_SNOWRHO,& 01141 XP_FAPARC, XP_FAPIRC, XP_LAI_EFFC, XP_MUS, XP_FSAT, & 01142 XP_DG, XP_TG ) 01143 ! 01144 ! Unpack ISBA diagnostics (modd_diag_isban) for each patch:ISIZE_MAX = MAXVAL(NSIZE_NATURE_P) 01145 01146 ! (MUST be done BEFORE UNPACK_ISBA_PATCH, because of XP_LE) 01147 ! 01148 CALL UNPACK_DIAG_PATCH_n(KMASK,KSIZE,NPATCH,JPATCH, & 01149 ZCPL_DRAIN,ZCPL_RUNOFF,ZCPL_EFLOOD,ZCPL_PFLOOD, & 01150 ZCPL_IFLOOD, ZCPL_ICEFLUX) 01151 ! 01152 ! for chemical deposition 01153 ! 01154 IF (NBEQ>0) THEN 01155 IF( CCH_DRY_DEP == "WES89") THEN 01156 CALL UNPACK_CH_ISBA_PATCH_n(KMASK,KSIZE,NPATCH,JPATCH) 01157 END IF 01158 END IF 01159 ! 01160 ! Unpack ISBA variables (modd_isban) for each patch: 01161 ! 01162 CALL UNPACK_ISBA_PATCH_n(KMASK,KSIZE,JPATCH) 01163 ! 01164 !---------------------------------------------------------------------- 01165 ! 01166 ! for further chemical biogenic emissions 01167 ! 01168 IF (NBEQ>0 .AND. LCH_BIO_FLUX) THEN 01169 ! 01170 DO JJ=1,KSIZE 01171 ZSW_FORBIO(KMASK(JJ),JPATCH) = 0. 01172 ENDDO 01173 ! 01174 DO JSWB=1,ISWB 01175 !cdir nodep 01176 !cdir unroll=8 01177 DO JJ=1,KSIZE 01178 ZSW_FORBIO(KMASK(JJ),JPATCH) = ZSW_FORBIO(KMASK(JJ),JPATCH) & 01179 + ZP_DIR_SW(JJ,JSWB) + ZP_SCA_SW(JJ,JSWB) 01180 ENDDO 01181 ENDDO 01182 ! 01183 ENDIF 01184 !---------------------------------------------------------------------- 01185 ! 01186 ! Unpack output dummy arguments for each patch: 01187 ! 01188 IF (NPATCH==1) THEN 01189 ZSFTQ_TILE (:,JPATCH) = ZP_SFTQ (:) 01190 ZSFTH_TILE (:,JPATCH) = ZP_SFTH (:) 01191 ZSFTS_TILE (:,:,JPATCH)= ZP_SFTS (:,:) 01192 ZSFCO2_TILE (:,JPATCH) = ZP_SFCO2 (:) 01193 ZSFU_TILE (:,JPATCH) = ZP_SFU (:) 01194 ZSFV_TILE (:,JPATCH) = ZP_SFV (:) 01195 ZTRAD_TILE (:,JPATCH) = ZP_TRAD (:) 01196 ELSE 01197 !cdir nodep 01198 !cdir unroll=8 01199 DO JJ=1,KSIZE 01200 JI = KMASK(JJ) 01201 ZSFTQ_TILE (JI,JPATCH) = ZP_SFTQ (JJ) 01202 ZSFTH_TILE (JI,JPATCH) = ZP_SFTH (JJ) 01203 ZSFCO2_TILE (JI,JPATCH) = ZP_SFCO2 (JJ) 01204 ZSFU_TILE (JI,JPATCH) = ZP_SFU (JJ) 01205 ZSFV_TILE (JI,JPATCH) = ZP_SFV (JJ) 01206 ZTRAD_TILE (JI,JPATCH) = ZP_TRAD (JJ) 01207 ENDDO 01208 ! 01209 !cdir nodep 01210 !cdir unroll=8 01211 DO JK=1,SIZE(ZP_SFTS,2) 01212 DO JJ=1,KSIZE 01213 JI=KMASK(JJ) 01214 ZSFTS_TILE (JI,JK,JPATCH)= ZP_SFTS (JJ,JK) 01215 ENDDO 01216 ENDDO 01217 ENDIF 01218 ! 01219 !---------------------------------------------------------------------- 01220 ! 01221 ! Get output dust flux if we are calculating dust 01222 IF (NDSTMDE .GE. 1) IMOMENT = INT(IDST / NDSTMDE) 01223 IF (NDSTEQ>0) THEN 01224 DO JSV = 1,NDSTMDE 01225 IF (IMOMENT == 1) THEN 01226 XSFDST(:,JSV,JPATCH)=ZSFTS_TILE(:,NDST_MDEBEG+JSV-1,JPATCH) 01227 ELSE 01228 XSFDST(:,JSV,JPATCH)=ZSFTS_TILE(:,NDST_MDEBEG+(JSV-1)*IMOMENT+1,JPATCH) 01229 END IF 01230 01231 XSFDSTM(:,JSV,JPATCH)=XSFDSTM(:,JSV,JPATCH) + XSFDST(:,JSV,JPATCH) * PTSTEP 01232 ENDDO 01233 ENDIF 01234 ! 01235 IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_n:TREAT_PATCH',1,ZHOOK_HANDLE) 01236 ! 01237 END SUBROUTINE TREAT_PATCH 01238 !========================================================================================== 01239 END SUBROUTINE COUPLING_ISBA_n
1.8.0
