MODULE module_sf_noahmpdrv !------------------------------- USE module_sf_noahmplsm USE module_sf_urban USE module_model_constants, ONLY : R_D, CP, XLF, XLV, RHOWATER, KARMAN USE module_sf_noahdrv, ONLY : SOIL_VEG_GEN_PARM USE module_sf_noah_seaice USE module_sf_noahlsm_glacial_only USE MODULE_RA_GFDLETA, ONLY: CAL_MON_DAY #ifdef WRF_CHEM USE module_data_gocart_dust #endif !------------------------------- ! CONTAINS ! SUBROUTINE noahmplsm(DZ8W,QV3D,P8W3D,T3D,TSK, & HFX,QFX,LH,GRDFLX, QGH,GSW,SWDOWN,GLW,SMSTAV,SMSTOT, & SFCRUNOFF, UDRUNOFF,IVGTYP,ISLTYP,VEGFRA, & ALBEDO,ALBBCK,ZNT,Z0,TMN,XLAND,XICE,XICE_THRESHOLD,ISICE,EMISS,EMBCK, & SNOWC,QSFC,RAINBL, & num_soil_layers,DT,DZS,ITIMESTEP, & SMOIS,TSLB,SNOW,CANWAT, & CHS,CHS2,CQS2,CPM,ROVCP,SR,chklowq,qz0, & !H myj,RIB,frpcpn, & SH2O,SNOWH, & !H U_PHY,V_PHY, & !I COSZ_URB2D, XLAT_URB2D, & !I SNOALB, & !I SNOTIME,ACSNOM,ACSNOW, & !O idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz ,iopt_inf , & iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot,iopt_stc , & isnowxy ,tvxy ,tgxy ,canicexy , & canliqxy ,eahxy ,tahxy ,cmxy ,chxy , & fwetxy ,sneqvoxy ,alboldxy ,qsnowxy ,wslakexy ,zwtxy ,waxy , & wtxy ,tsnoxy ,zsnsoxy ,snicexy ,snliqxy ,lfmassxy ,rtmassxy , & stmassxy ,woodxy ,stblcpxy ,fastcpxy ,xlaixy ,xsaixy , & tradxy ,tsxy ,neexy ,gppxy ,nppxy ,fvegxy ,qinxy , & runsfxy ,runsbxy ,ecanxy ,edirxy ,etranxy ,fsaxy ,firaxy , & aparxy ,psnxy ,savxy ,sagxy , & fsnoxy ,YR ,JULIAN , & potevp, & !O !jref:start qcxy ,pblhxy ,isurban ,iz0tlnd ,dx , & !I chstarxy ,t2mvxy ,t2mbxy ,rssunxy ,rsshaxy, bgapxy ,wgapxy ,gapxy, & !O tgvxy ,tgbxy ,q2mvxy ,q2mbxy ,shdmaxxy, chvxy ,chbxy , & !jref:end ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) !---------------------------------------------------------------- IMPLICIT NONE !---------------------------------------------------------------- !---------------------------------------------------------------- ! --- atmospheric (WRF generic) variables !-- DT time step (seconds) !-- DZ8W thickness of layers (m) !-- T3D temperature (K) !-- QV3D 3D water vapor mixing ratio (Kg/Kg) !-- P3D 3D pressure (Pa) !-- FLHC exchange coefficient for heat (m/s) !-- FLQC exchange coefficient for moisture (m/s) !-- PSFC surface pressure (Pa) !-- XLAND land mask (1 for land, 2 for water) !-- QGH saturated mixing ratio at 2 meter !-- GSW downward short wave flux at ground surface (W/m^2) !-- GLW downward long wave flux at ground surface (W/m^2) !-- History variables !-- CANWAT canopy moisture content (mm) !-- TSK surface temperature (K) !-- TSLB soil temp (k) !-- SMOIS total soil moisture content (volumetric fraction) !-- SH2O unfrozen soil moisture content (volumetric fraction) ! note: frozen soil moisture (i.e., soil ice) = SMOIS - SH2O !-- SNOWH actual snow depth (m) !-- SNOW liquid water-equivalent snow depth (m) !-- ALBEDO time-varying surface albedo including snow effect (unitless fraction) !-- ALBBCK background surface albedo (unitless fraction) !-- CHS surface exchange coefficient for heat and moisture (m s-1); !-- CHS2 2m surface exchange coefficient for heat (m s-1); !-- CQS2 2m surface exchange coefficient for moisture (m s-1); ! --- soil variables !-- num_soil_layers the number of soil layers !-- ZS depths of centers of soil layers (m) !-- DZS thicknesses of soil layers (m) !-- SLDPTH thickness of each soil layer (m, same as DZS) !-- TMN soil temperature at lower boundary (K) !-- SMCMAX porosity, i.e. saturated value of soil moisture (volumetric) !-- NROOT number of root layers, a function of veg type, determined ! in subroutine redprm. !-- SMSTAV Soil moisture availability for evapotranspiration ( ! fraction between SMCWLT and SMCMXA) !-- SMSTOT Total soil moisture content frozen+unfrozen) in the soil column (mm) ! --- snow variables !-- SNOWC fraction snow coverage (0-1.0) ! --- vegetation variables !-- SNOALB upper bound on maximum albedo over deep snow !-- Z0BRD Background fixed roughness length (M) !-- Z0 Background vroughness length (M) as function !-- ZNT Time varying roughness length (M) as function !-- ALBD(IVGTPK,ISN) background albedo reading from a table ! --- LSM output !-- HFX upward heat flux at the surface (W/m^2) !-- QFX upward moisture flux at the surface (kg/m^2/s) !-- LH upward moisture flux at the surface (W m-2) !-- GRDFLX(I,J) ground heat flux (W m-2) !-- FDOWN radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN !---------------------------------------------------------------------------- !-- EC canopy water evaporation ((W m-2) !-- EDIR direct soil evaporation (W m-2) !-- ESNOW sublimation from (or deposition to if <0) snowpack (W m-2) !-- DEW dewfall (or frostfall for t<273.15) (M) ! ---------------------------------------------------------------------- !-- ETP potential evaporation (W m-2) ! ---------------------------------------------------------------------- !-- FLX1 precip-snow sfc (W m-2) !-- FLX2 freezing rain latent heat flux (W m-2) !-- FLX3 phase-change heat flux from snowmelt (W m-2) ! ---------------------------------------------------------------------- !-- ACSNOM snow melt (mm) (water equivalent) !-- ACSNOW accumulated snow fall (mm) (water equivalent) !-- POTEVP accumulated potential evaporation (W/m^2) !-- RIB Bulk Richardson number from SFCLAY routine ! ---------------------------------------------------------------------- !-- RUNOFF1 surface runoff (m s-1), not infiltrating the surface !-- RUNOFF2 subsurface runoff (m s-1), drainage out bottom of last ! soil layer (baseflow) ! ---------------------------------------------------------------------- !-- RC canopy resistance (s m-1) !-- PC plant coefficient (unitless fraction, 0-1) where PC*ETP = actual transp !-- EMISS surface emissivity (between 0 and 1) !-- EMBCK Background surface emissivity (between 0 and 1) !-- SHDMAX Maximum vegetation fraction !-- ROVCP R/CP ! (R_d/R_v) (dimensionless) !-- ids start index for i in domain !-- ide end index for i in domain !-- jds start index for j in domain !-- jde end index for j in domain !-- kds start index for k in domain !-- kde end index for k in domain !-- ims start index for i in memory !-- ime end index for i in memory !-- jms start index for j in memory !-- jme end index for j in memory !-- kms start index for k in memory !-- kme end index for k in memory !-- its start index for i in tile !-- ite end index for i in tile !-- jts start index for j in tile !-- jte end index for j in tile !-- kts start index for k in tile !-- kte end index for k in tile ! !-- SR fraction of frozen precip (0.0 to 1.0) !---------------------------------------------------------------- ! IN only INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: U_PHY REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: V_PHY REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D REAL, DIMENSION( ims:ime, jms:jme ) , & & INTENT(IN ) :: TMN, & & XLAND, & & XICE, & & VEGFRA, & & SNOALB, & & GSW, & & SWDOWN, & & GLW, & & Z0, & & ALBBCK, & & RAINBL, & & EMBCK, & & SR REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , & INTENT(IN ) :: QV3D, & p8w3D, & DZ8W, & T3D !jref:start - changed to inout REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(INOUT ) :: QGH, & CHS, & CPM !jref:end INTEGER, DIMENSION( ims:ime, jms:jme ) , & INTENT(IN ) :: IVGTYP, & ISLTYP INTEGER, INTENT(IN) :: num_soil_layers,ITIMESTEP !jref:start - xice_threshold REAL, INTENT(IN ) :: DT,ROVCP,XICE_THRESHOLD INTEGER, INTENT(IN ) :: ISICE !jref:end REAL, DIMENSION(1:num_soil_layers), INTENT(IN)::DZS ! IN and OUT REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & & INTENT(INOUT) :: SMOIS, & & SH2O, & & TSLB REAL, DIMENSION( ims:ime, jms:jme ) , & & INTENT(INOUT) :: TSK, & & HFX, & & QFX, & & LH, & & GRDFLX, & & QSFC, & & CQS2, & & CHS2, & & SNOW, & & SNOWC, & & SNOWH, & & CANWAT, & & SMSTAV, & & SMSTOT, & & SFCRUNOFF, & & UDRUNOFF, & & ACSNOM, & & ACSNOW, & & EMISS, & & POTEVP, & & RIB, & & ALBEDO, & & ZNT REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(OUT) :: CHKLOWQ REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: QZ0 !niuin: ! in INTEGER, INTENT(IN) :: idveg !dynamic vegetation (1 -> off ; 2 -> on) with opt_crs = 1 INTEGER, INTENT(IN) :: iopt_crs !canopy stomatal resistance (1-> Ball-Berry; 2->Jarvis) INTEGER, INTENT(IN) :: iopt_btr !soil moisture factor for stomatal resistance (1-> Noah; 2-> CLM; 3-> SSiB) INTEGER, INTENT(IN) :: iopt_run !runoff and groundwater (1->SIMGM; 2->SIMTOP; 3->Schaake96; 4->BATS) INTEGER, INTENT(IN) :: iopt_sfc !surface layer drag coeff (CH & CM) (1->M-O; 2->Chen97) INTEGER, INTENT(IN) :: iopt_frz !supercooled liquid water (1-> NY06; 2->Koren99) INTEGER, INTENT(IN) :: iopt_inf !frozen soil permeability (1-> NY06; 2->Koren99) INTEGER, INTENT(IN) :: iopt_rad !radiation transfer (1->gap=F(3D,cosz); 2->gap=0; 3->gap=1-Fveg) INTEGER, INTENT(IN) :: iopt_alb !snow surface albedo (1->BATS; 2->CLASS) INTEGER, INTENT(IN) :: iopt_snf !rainfall & snowfall (1-Jordan91; 2->BATS; 3->Noah) INTEGER, INTENT(IN) :: iopt_tbot !lower boundary of soil temperature (1->zero-flux; 2->Noah) INTEGER, INTENT(IN) :: iopt_stc !snow/soil temperature time scheme ! in & out INTEGER, INTENT(IN) :: YR REAL, INTENT(IN) :: JULIAN INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: isnowxy !actual no. of snow layers REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: tvxy !vegetation canopy temperature REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: tgxy !ground surface temperature REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: canicexy !canopy-intercepted ice (mm) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: canliqxy !canopy-intercepted liquid water (mm) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: eahxy !canopy air vapor pressure (pa) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: tahxy !canopy air temperature (k) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: cmxy !momentum drag coefficient REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: chxy !sensible heat exchange coefficient REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fwetxy !wetted or snowed fraction of the canopy (-) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: sneqvoxy !snow mass at last time step(mm h2o) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: alboldxy !snow albedo at last time step (-) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: qsnowxy !snowfall on the ground [mm/s] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: wslakexy !lake water storage [mm] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: zwtxy !water table depth [m] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: waxy !water in the "aquifer" [mm] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: wtxy !groundwater storage [mm] REAL, DIMENSION(ims:ime,-2:num_soil_layers,jms:jme), INTENT(INOUT) :: zsnsoxy !snow layer depth [m] REAL, DIMENSION(ims:ime,-2: 0,jms:jme), INTENT(INOUT) :: tsnoxy !snow temperature [K] REAL, DIMENSION(ims:ime,-2: 0,jms:jme), INTENT(INOUT) :: snicexy !snow layer ice [mm] REAL, DIMENSION(ims:ime,-2: 0,jms:jme), INTENT(INOUT) :: snliqxy !snow layer liquid water [mm] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: lfmassxy !leaf mass [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: rtmassxy !mass of fine roots [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: stmassxy !stem mass [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: woodxy !mass of wood (incl. woody roots) [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: stblcpxy !stable carbon in deep soil [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fastcpxy !short-lived carbon, shallow soil [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: xlaixy !leaf area index REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: xsaixy !stem area index !jref:start REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: SNOTIME !snow age time !jref:end !out REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: tradxy !surface radiative temperature (k) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: tsxy !surface temperature (k) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: neexy !net ecosys exchange (g/m2/s CO2) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: gppxy !gross primary assimilation [g/m2/s C] REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: nppxy !net primary productivity [g/m2/s C] REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: fvegxy !greenness vegetation fraction [-] REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: qinxy !groundwater recharge [mm/s] REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: runsfxy !surface runoff [mm/s] REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: runsbxy !subsurface runoff [mm/s] REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: ecanxy !evaporation of intercepted water (mm/s) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: edirxy !soil surface evaporation rate (mm/s] REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: etranxy !transpiration rate (mm/s) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: fsaxy !total absorbed solar radiation (w/m2) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: firaxy !total net longwave rad (w/m2) [+ to atm] REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: aparxy !photosyn active energy by canopy (w/m2) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: psnxy !total photosynthesis (umol co2/m2/s) [+] REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: savxy !solar rad absorbed by veg. (w/m2) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: sagxy !solar rad absorbed by ground (w/m2) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: fsnoxy !snow cover fraction (-) !jref:start REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: chstarxy !effective ch REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: t2mvxy !2m temperature of vegetation part REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: t2mbxy !2m temperature of bare ground part REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: q2mvxy !2m mixing ratio of vegetation part REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: q2mbxy !2m mixing ratio of bare ground part REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: qcxy !cloud water mixing ratio REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: pblhxy !Planetary boundary layer from sfclay INTEGER , INTENT(IN) :: isurban INTEGER , INTENT(IN) :: iz0tlnd REAL , INTENT(IN) :: dx REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: rssunxy !sunlit leaf stomatal resistance (s/m) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: rsshaxy !shaded leaf stomatal resistance (s/m) REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: bgapxy !between gap fraction REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: wgapxy !within gap fraction REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: gapxy !within gap fraction REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: tgvxy REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: tgbxy REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: shdmaxxy REAL, DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: chvxy !sensible heat exchange coefficient vegetated REAL, DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: chbxy !sensible heat exchange coefficient bare-ground !jref:end !niuout ! Local variables (moved here from driver to make routine thread safe, 20031007 jm) INTEGER :: YEARLEN REAL :: ETP, SSOIL,EC, ESNOW, & FLX1,FLX2,FLX3,DEW,FDOWN,RC,PC,FFROZP !niuin !locals (prognostic): INTEGER :: isnow !actual no. of snow layers REAL, DIMENSION(-2:num_soil_layers) :: stc !snow/soil tmperatures REAL, DIMENSION( 1:num_soil_layers) :: smc !vol. soil moisture (m3/m3) REAL, DIMENSION( 1:num_soil_layers) :: smh2o !vol. soil liquid water (m3/m3) REAL :: tv !vegetation canopy temperature REAL :: tg !ground surface temperature REAL :: canice !canopy-intercepted ice (mm) REAL :: canliq !canopy-intercepted liquid water (mm) REAL :: snowd !snow depth (m) REAL :: swe !snow water equivalent (mm) REAL :: eah !canopy air vapor pressure (pa) REAL :: tah !canopy air temperature (k) REAL :: cm !momentum drag coefficient REAL :: ch !sensible heat exchange coefficient REAL :: fwet !wetted or snowed fraction of the canopy (-) REAL :: sneqvo !snow mass at last time step(mm h2o) REAL :: albold !snow albedo at last time step (-) REAL :: qsnow !snowfall on the ground [mm/s] REAL :: wslake !lake water storage [mm] REAL :: zwt !water table depth [m] REAL :: wa !water in the "aquifer" [mm] REAL :: wt !groundwater storage [mm] REAL, DIMENSION(-2:num_soil_layers) :: zsnso !snow layer depth [m] REAL, DIMENSION(-2: 0) :: tsno !snow temperature [K] REAL, DIMENSION(-2: 0) :: snice !snow layer ice [mm] REAL, DIMENSION(-2: 0) :: snliq !snow layer liquid water [mm] REAL :: lfmass !leaf mass [g/m2] REAL :: rtmass !mass of fine roots [g/m2] REAL :: stmass !stem mass [g/m2] REAL :: wood !mass of wood (incl. woody roots) [g/m2] REAL :: stblcp !stable carbon in deep soil [g/m2] REAL :: fastcp !short-lived carbon, shallow soil [g/m2] REAL :: plai !leaf area index REAL :: psai !stem area index !jref:start REAL :: chstar2 REAL :: cqstar2 REAL :: chstar !effective ch REAL :: tstar REAL :: t2mv !2m temperature of vegetation part REAL :: t2mb !2m temperature of bare ground part REAL :: q2mv !2m mixing ratio of vegetation part REAL :: q2mb !2m mixing ratio of bare ground part REAL :: qc ! REAL :: t2m REAL :: pblh REAL :: qsfc1d REAL, DIMENSION(ims:ime,jms:jme) :: tstarxy !effective skin temperature REAL, DIMENSION(ims:ime,jms:jme) :: chstar2xy !effective 2m exchange coefficients REAL :: rssun REAL :: rssha REAL :: bgap REAL :: wgap REAL :: gap REAL :: tgv REAL :: tgb REAL :: snowhk REAL :: snotime1 REAL :: qv1d !mixing ratio REAL :: dz8w1d REAL :: shdmax REAL :: chv !sensible heat exchange coefficient vegetated REAL :: chb !sensible heat exchange coefficient bare-ground !jref:end !out (outputs) REAL :: trad !surface radiative temperature (k) REAL :: ts !surface temperature (k) REAL :: nee !net ecosys exchange (g/m2/s CO2) REAL :: gpp !gross primary assimilation [g/m2/s C] REAL :: npp !net primary productivity [g/m2/s C] REAL :: fveg !greenness vegetation fraction [-] REAL :: qin !groundwater recharge [mm/s] REAL :: runsf !surface runoff [mm/s] REAL :: runsb !subsurface runoff [mm/s] REAL :: ecan !evaporation of intercepted water (mm/s) REAL :: esoil !soil surface evaporation rate (mm/s] REAL :: etran !transpiration rate (mm/s) REAL :: fsa !total absorbed solar radiation (w/m2) REAL :: fira !total net longwave rad (w/m2) [+ to atm] REAL :: fsh !total sensible heat (w/m2) [+ to atm] REAL :: flh !total latent heat (w/m2) [+ to atm] REAL :: apar !photosyn active energy by canopy (w/m2) REAL :: psn !total photosynthesis (umol co2/m2/s) [+] REAL :: sav !solar rad absorbed by veg. (w/m2) REAL :: sag !solar rad absorbed by ground (w/m2) REAL :: fsno !snow cover fraction (-) REAL :: salb !surface albedo (-) REAL :: errwat REAL :: qmelt REAL :: ponding REAL :: ponding1 REAL :: ponding2 !local real :: fsr !total reflected solar radiation (w/m2) real :: fcev !canopy evaporation heat (w/m2) [+ to atm] real :: fgev !ground evaporation heat (w/m2) [+ to atm] real :: fctr !transpiration heat flux (w/m2) [+ to atm] real, dimension(-2: 0) :: ficeold !snow layer liquid water [mm] INTEGER :: ILOC !grid index INTEGER :: JLOC !grid index INTEGER :: ISC !soil color index INTEGER :: IST !surface type 1-soil; 2-lake !niuout LOGICAL, INTENT(IN ) :: myj,frpcpn ! DECLARATIONS - LOGICAL ! ---------------------------------------------------------------------- LOGICAL, PARAMETER :: LOCAL=.false. LOGICAL :: FRZGRA, SNOWNG LOGICAL :: IPRINT ! ---------------------------------------------------------------------- ! DECLARATIONS - INTEGER ! ---------------------------------------------------------------------- INTEGER :: I,J, ICE,NSOIL,SLOPETYP,SOILTYP,VEGTYP INTEGER :: NROOT INTEGER :: KZ ,K INTEGER :: NS ! ---------------------------------------------------------------------- ! DECLARATIONS - REAL ! ---------------------------------------------------------------------- REAL :: DQSDT2, LWDN, PRCP, PSFC, UU, VV, CO2AIR, O2AIR, & & Q2SAT,Q2SATI,SFCPRS,SFCTMP,SHDFAC,SNOALB1, & & SOLDN,TBOT,ZLVL, Q2K,ALBBRD, ETA, ETA_KINEMATIC, & & EMBRD, FOLN, LAT, & & Z0K,RUNOFF1,RUNOFF2,SOLNET,E2SAT,SFCTSNO REAL :: RIBB REAL :: FDTW REAL :: EMISSI REAL :: SNCOVR,SNEQV,CHK,TH2 REAL :: SMCMAX,SNOMLT,SOILM,SOILW,Q1,T1 REAL :: Z0BRD ! REAL :: COSZ ! !niu REAL, DIMENSION(1:num_soil_layers):: SLDPTH, STC,SMC,SWC REAL, DIMENSION(1:num_soil_layers):: SLDPTH,SWC !jref:start REAL, DIMENSION(1:num_soil_layers):: STCNEW !jref:end ! REAL, DIMENSION(1:num_soil_layers) :: ZSOIL, RTDIS REAL, PARAMETER :: TRESH=.95E0, A2=17.67,A3=273.15,A4=29.65, & T0=273.16E0, ELWV=2.50E6, A23M4=A2*(A3-A4) ! Used for calculating the 2-m Potential Temperature: REAL, PARAMETER :: CAPA=R_D/CP REAL :: APELM REAL :: APES REAL :: SFCTH2 ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! MEK JUL2007 FDTW=DT/(XLV*RHOWATER) ! debug printout IPRINT=.false. ! SLOPETYP=2 SLOPETYP=1 ! SHDMIN=0.00 YEARLEN = 365 if (mod(YR,4) == 0) then YEARLEN = 366 if (mod(YR,100) == 0) then YEARLEN = 365 if (mod(YR,400) == 0) then YEARLEN = 366 endif endif endif NSOIL=num_soil_layers DO NS=1,NSOIL SLDPTH(NS)=DZS(NS) ENDDO call noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) ISC = 4 ! soil color: assuming a middle color category ????????? ZSOIL(1) = -SLDPTH(1) ! move out of x-y do loops DO KZ = 2, NSOIL ZSOIL(KZ) = -SLDPTH(KZ) + ZSOIL(KZ-1) END DO FOLN = 1.0 !niuout DO J=jts,jte IF(ITIMESTEP.EQ.1)THEN DO I=its,ite !*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS IF((XLAND(I,J)-1.5).GE.0.)THEN ! check sea-ice point IF(XICE(I,J).EQ.1..and.IPRINT)PRINT*,' sea-ice at water point, I=',I, & 'J=',J !*** Open Water Case SMSTAV(I,J)=1.0 SMSTOT(I,J)=1.0 DO NS=1,NSOIL SMOIS(I,NS,J)=1.0 TSLB(I,NS,J)=273.16 !STEMP ENDDO ELSE IF(XICE(I,J).EQ.1.)THEN !*** SEA-ICE CASE SMSTAV(I,J)=1.0 SMSTOT(I,J)=1.0 DO NS=1,NSOIL SMOIS(I,NS,J)=1.0 ENDDO ENDIF ENDIF ! ENDDO ENDIF ! end of initialization over ocean !----------------------------------------------------------------------- DO I=its,ite ! surface pressure PSFC=P8w3D(i,1,j) ! pressure in middle of lowest layer SFCPRS=(P8W3D(I,KTS+1,j)+P8W3D(i,KTS,j))*0.5 ! convert from mixing ratio to specific humidity Q2K=QV3D(i,1,j)/(1.0+QV3D(i,1,j)) ! ! Q2SAT=QGH(I,j) Q2SAT=QGH(I,J)/(1.0+QGH(I,J)) ! Q2SAT is sp humidity ! add check on myj=.true. ! IF((Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN IF((myj).AND.(Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN CHKLOWQ(I,J)=0. ELSE CHKLOWQ(I,J)=1. ENDIF SFCTMP=T3D(i,1,j) ZLVL=0.5*DZ8W(i,1,j) ! TH2=SFCTMP+(0.0097545*ZLVL) ! calculate SFCTH2 via Exner function vs lapse-rate (above) APES=(1.E5/PSFC)**CAPA APELM=(1.E5/SFCPRS)**CAPA SFCTH2=SFCTMP*APELM TH2=SFCTH2/APES ! EMISSI = EMISS(I,J) ! LWDN=GLW(I,J)*EMISSI LWDN=GLW(I,J) ! SOLDN is total incoming solar SOLDN=SWDOWN(I,J) ! GSW is net downward solar ! SOLNET=GSW(I,J) ! use mid-day albedo to determine net downward solar (no solar zenith angle correction) SOLNET=SOLDN*(1.-ALBEDO(I,J)) PRCP=RAINBL(i,j)/DT VEGTYP=IVGTYP(I,J) SOILTYP=ISLTYP(I,J) SHDFAC=VEGFRA(I,J)/100. T1=TSK(I,J) CHK=CHS(I,J) SNOALB1=SNOALB(I,J) !NEW ! if "SR" present, set frac of frozen precip ("FFROZP") = snow-ratio ("SR", range:0-1) ! SR from e.g. Ferrier microphysics ! otherwise define from 1st atmos level temperature IF(FRPCPN) THEN FFROZP=SR(I,J) ELSE IF (SFCTMP <= 273.15) THEN FFROZP = 1.0 ELSE FFROZP = 0.0 ENDIF ENDIF !*** IF((XLAND(I,J)-1.5).GE.0.)THEN ! begining of land/sea if block ! Open water points ELSE ! Land or sea-ice case IF (XICE(I,J) .GT. 0.5) THEN ICE=1 ELSE ICE=0 ENDIF DQSDT2=Q2SAT*A23M4/(SFCTMP-A4)**2 IF(SNOW(I,J).GT.0.0)THEN ! snow on surface (use ice saturation properties) SFCTSNO=SFCTMP E2SAT=611.2*EXP(6174.*(1./273.15 - 1./SFCTSNO)) Q2SATI=0.622*E2SAT/(SFCPRS-E2SAT) Q2SATI=Q2SATI/(1.0+Q2SATI) ! spec. hum. IF(T1 .GT. 273.15)THEN ! warm ground temps, weight the saturation between ice and water according to SNOWC Q2SAT=Q2SAT*(1.-SNOWC(I,J)) + Q2SATI*SNOWC(I,J) DQSDT2=DQSDT2*(1.-SNOWC(I,J)) + Q2SATI*6174./(SFCTSNO**2)*SNOWC(I,J) ELSE ! cold ground temps, use ice saturation only Q2SAT=Q2SATI DQSDT2=Q2SATI*6174./(SFCTSNO**2) ENDIF ! for snow cover fraction at 0 C, ground temp will not change, so DQSDT2 effectively zero IF(T1 .GT. 273. .AND. SNOWC(I,J) .GT. 0.)DQSDT2=DQSDT2*(1.-SNOWC(I,J)) ENDIF IF(ICE.EQ.0)THEN TBOT=TMN(I,J) ELSE TBOT=271.16 ENDIF IF(VEGTYP.EQ.25) SHDFAC=0.0000 IF(VEGTYP.EQ.26) SHDFAC=0.0000 IF(VEGTYP.EQ.27) SHDFAC=0.0000 IF(SOILTYP.EQ.14.AND.XICE(I,J).EQ.0.)THEN IF(IPRINT)PRINT*,' SOIL TYPE FOUND TO BE WATER AT A LAND-POINT' IF(IPRINT)PRINT*,i,j,'RESET SOIL in surfce.F' SOILTYP=7 ENDIF !------------------------------------------- ALBBRD=ALBBCK(I,J) Z0BRD=Z0(I,J) EMBRD=EMBCK(I,J) !jref:start - check if this is correct!! Maybe snowd RIBB=RIB(I,J) SNOTIME1 = SNOTIME(I,J) !jref:end !FEI: temporaray arrays above need to be changed later by using SI !niu DO 70 NS=1,NSOIL !niu SMC(NS)=SMOIS(I,NS,J) !niu STC(NS)=TSLB(I,NS,J) !STEMP !niu SWC(NS)=SH2O(I,NS,J) !niu 70 CONTINUE ! IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. & IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33) THEN VEGTYP = ISURBAN ENDIF IST = 1 IF(VEGTYP == 16) IST = 2 ! lake points CALL REDPRM (VEGTYP,SOILTYP,SLOPETYP,SLDPTH,ZSOIL,NSOIL,ISURBAN) UU = U_PHY(I,1,J) VV = V_PHY(I,1,J) CO2AIR = 395.E-06 * SFCPRS !partial pressure co2 (pa) O2AIR = 0.209 * SFCPRS !partial pressure o2 (pa) COSZ = COSZ_URB2D(I,J) LAT = XLAT_URB2D(I,J) isnow = isnowxy (i,j) stc (isnow+1: 0) = tsnoxy (i,isnow+1: 0,j) stc ( 1:nsoil) = tslb (i, 1:nsoil,j) smc ( 1:nsoil) = smois (i, 1:nsoil,j) smh2o( 1:nsoil) = sh2o (i, 1:nsoil,j) tv = tvxy (i,j) tg = tgxy (i,j) canliq = canliqxy(i,j) canice = canicexy(i,j) snowd = snowh (i,j) swe = snow (i,j) eah = eahxy (i,j) tah = tahxy (i,j) cm = cmxy (i,j) ch = chxy (i,j) !jref:start chstar = chs (i,j) chstar2 = chs2 (i,j) cqstar2 = cqs2 (i,j) tstar = T1 qc = qcxy (i,j) pblh = pblhxy (i,j) qsfc1d = qsfc (i,j) t2mv = t2mvxy (i,j) t2mb = t2mbxy (i,j) q2mv = q2mvxy (i,j) q2mb = q2mbxy (i,j) qv1d = qv3d (i,1,j) ! seaice/glacial needs mixing ratio (q2k = specific hum). dz8w1d = dz8w (i,1,j) shdmax = shdmaxxy (i,j)/100. !fraction !jref:end fwet = fwetxy (i,j) sneqvo = sneqvoxy(i,j) albold = alboldxy(i,j) qsnow = qsnowxy (i,j) wslake = wslakexy(i,j) zwt = zwtxy (i,j) wa = waxy (i,j) wt = wtxy (i,j) zsnso(isnow+1:nsoil) = zsnsoxy (i,isnow+1:nsoil,j) snice(isnow+1: 0) = snicexy (i,isnow+1: 0,j) snliq(isnow+1: 0) = snliqxy (i,isnow+1: 0,j) lfmass = lfmassxy(i,j) rtmass = rtmassxy(i,j) stmass = stmassxy(i,j) wood = woodxy (i,j) stblcp = stblcpxy(i,j) fastcp = fastcpxy(i,j) plai = xlaixy (i,j) psai = xsaixy (i,j) ficeold(isnow+1:0) = snicexy(i,isnow+1:0,j) & /(snicexy(i,isnow+1:0,j)+snliqxy(i,isnow+1:0,j)) ! glacial, seaice split - jref IF ( XICE(I,J) >= XICE_THRESHOLD ) THEN SH2O (i,1:nsoil,j) = 1.0 XLAIXY(i,j) = 0.01 cycle ! Skip any processing at sea-ice points ELSE IF ( VEGTYP == ISICE ) THEN SNCOVR = SNOWC(I,J) swe = swe*0.001 !jref mm -> m if ( (swe.ne.0..AND.snowd.eq.0.).or.(snowd.le.swe) )THEN snowd= 5.*swe endif CALL SFLX_GLACIAL(I,J,ISICE,FFROZP,DT,ZLVL,NSOIL,SLDPTH, & !C & LWDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2K, & !F & TH2,Q2SAT,DQSDT2, & !I & ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI, EMBRD, & !S & tstar,STC(1:NSOIL),snowd,swe,salb,chstar, & !H & ETA,fsh, ETA_KINEMATIC,FDOWN, & !O & ESNOW,DEW, & !O & ETP,SSOIL, & !O & FLX1,FLX2,FLX3, & !O & SNOMLT,SNCOVR, & !O & runsf, & !O & Q1, & !D & SNOTIME1, & & RIBB) tgb = sfctmp ! Bare ground temperature will be the surface temperature over glacial points. tgv = 0.0 ! Temperature under vegetation undefined over glacial points. swe = swe*1000. plai = 0.01 ! Should make this zero? smc = 1.00 smh2o = 1.00 ! Something else? runsb = 0.00 fgev = ETA fcev = 0. fctr = 0. soilm = 1.0 ! Something else? ! SMAV = 1.00 ! Something else? SNOWC(I,J) = 1.0 QFX(I,J) = eta_kinematic POTEVP(I,J)=POTEVP(I,J)+ETP*FDTW CHS2(I,J) = CQS2(I,J) IF ( Q1 .GT. QSFC(I,J) ) THEN CQS2(I,J) = CHS(I,J) ENDIF ELSE !jref:end nee = -1.E36 npp = -1.E36 #if 0 if ( I == 15 .and. J == 5 ) then ! Intent (IN) or Intent (INOUT), but not Intent (OUT) write(*,'("Before call to NOAHMP_SFLX, at point ", I8, I8)') i, j write(*,'(10x, "ICE = ", I10 )') ICE write(*,'(10x, "IST = ", I10 )') IST write(*,'(10x, "VEGTYP = ", I10 )') VEGTYP write(*,'(10x, "ISC = ", I10 )') ISC write(*,'(10x, "NSOIL = ", I10 )') NSOIL write(*,'(10x, "ZSOIL = ", 7F20.10)') ZSOIL write(*,'(10x, "DT = ", F20.10)') DT write(*,'(10x, "QV1D = ", F20.10)') QV1D write(*,'(10x, "SFCTMP = ", F20.10)') SFCTMP write(*,'(10x, "UU = ", F20.10)') UU write(*,'(10x, "VV = ", F20.10)') VV write(*,'(10x, "SOLDN = ", F20.10)') SOLDN write(*,'(10x, "LWDN = ", F20.10)') LWDN write(*,'(10x, "PRCP = ", F20.10)') PRCP write(*,'(10x, "ZLVL = ", F20.10)') ZLVL write(*,'(10x, "CO2AIR = ", F20.10)') CO2AIR write(*,'(10x, "O2AIR = ", F20.10)') O2AIR write(*,'(10x, "COSZ = ", F20.10)') COSZ write(*,'(10x, "TBOT = ", F20.10)') TBOT write(*,'(10x, "FOLN = ", F20.10)') FOLN write(*,'(10x, "SFCPRS = ", F20.10)') SFCPRS write(*,'(10x, "SHDFAC = ", F20.10)') SHDFAC write(*,'(10x, "LAT = ", F20.10)') LAT write(*,'(10x, "DZ8W1D = ", F20.10)') DZ8W1D write(*,'(10x, "EAH = ", F20.10)') EAH write(*,'(10x, "TAH = ", F20.10)') TAH write(*,'(10x, "FWET = ", F20.10)') FWET write(*,'(10x, "FICEOLD = ", 7F20.10)') FICEOLD write(*,'(10x, "QSNOW = ", F20.10)') QSNOW write(*,'(10x, "SNEQVO = ", F20.10)') SNEQVO write(*,'(10x, "ISNOW = ", F20.10)') ISNOW write(*,'(10x, "ZSNSO = ", 7F20.10)') ZSNSO write(*,'(10x, "CANLIQ = ", F20.10)') CANLIQ write(*,'(10x, "CANICE = ", F20.10)') CANICE write(*,'(10x, "SNOWD = ", F20.10)') SNOWD write(*,'(10x, "SWE = ", F20.10)') SWE write(*,'(10x, "SNICE = ", 7F20.10)') SNICE write(*,'(10x, "SNLIQ = ", 7F20.10)') SNLIQ write(*,'(10x, "TV = ", F20.10)') TV write(*,'(10x, "TG = ", F20.10)') TG write(*,'(10x, "STC = ", 7F20.10)') STC write(*,'(10x, "SMH2O = ", 7F20.10)') SMH2O write(*,'(10x, "SMC = ", 7F20.10)') SMC write(*,'(10x, "ZWT = ", F20.10)') ZWT write(*,'(10x, "WA = ", F20.10)') WA write(*,'(10x, "WT = ", F20.10)') WT write(*,'(10x, "WSLAKE = ", F20.10)') WSLAKE write(*,'(10x, "LFMASS = ", F20.10)') LFMASS write(*,'(10x, "RTMASS = ", F20.10)') RTMASS write(*,'(10x, "STMASS = ", F20.10)') STMASS write(*,'(10x, "WOOD = ", F20.10)') WOOD write(*,'(10x, "STBLCP = ", F20.10)') STBLCP write(*,'(10x, "FASTCP = ", F20.10)') FASTCP write(*,'(10x, "PLAI = ", F20.10)') PLAI write(*,'(10x, "PSAI = ", F20.10)') PSAI write(*,'(10x, "ALBOLD = ", F20.10)') ALBOLD write(*,'(10x, "CM = ", F20.10)') CM write(*,'(10x, "CH = ", F20.10)') CH write(*,'(10x, "DX = ", F20.10)') DX write(*,'(10x, "ISURBAN = ", I10 )') ISURBAN write(*,'(10x, "IZ0TLND = ", I10 )') IZ0TLND write(*,'(10x, "QC = ", F20.10)') QC write(*,'(10x, "PBLH = ", F20.10)') PBLH write(*,'(10x, "QSFC1D = ", F20.10)') QSFC1D write(*,'(10x, "PSFC = ", F20.10)') PSFC endif #endif CALL NOAHMP_SFLX (& I , J , LAT , YEARLEN , JULIAN , COSZ , & ! IN : Time/Space-related DT , DX , DZ8W1D , NSOIL , ZSOIL , 3 , & ! IN : Model configuration SHDFAC , SHDMAX , VEGTYP , ISURBAN , ICE , IST , & ! IN : Vegetation/Soil characteristics ISC , & ! IN : Vegetation/Soil characteristics IZ0TLND , & ! IN : User options SFCTMP , SFCPRS , PSFC , UU , VV , QV1D , & ! IN : Forcing QC , SOLDN , LWDN , PRCP , TBOT , CO2AIR , & ! IN : Forcing O2AIR , FOLN , FICEOLD , PBLH , & ! IN : Forcing ZLVL , ALBOLD , SNEQVO , & ! IN/OUT : STC , SMH2O , SMC , TAH , EAH , FWET , & ! IN/OUT : CANLIQ , CANICE , TV , TG , QSFC1D , QSNOW , & ! IN/OUT : ISNOW , ZSNSO , SNOWD , SWE , SNICE , SNLIQ , & ! IN/OUT : ZWT , WA , WT , WSLAKE , LFMASS , RTMASS , & ! IN/OUT : STMASS , WOOD , STBLCP , FASTCP , PLAI , PSAI , & ! IN/OUT : CM , CH , CHSTAR , & ! IN/OUT : FSA , FSR , FIRA , FSH , SSOIL , FCEV , & ! OUT : FGEV , FCTR , ECAN , ETRAN , ESOIL , TRAD , & ! OUT : TS , TGB , TGV , T2MV , T2MB , TSTAR , & ! OUT : Q1 , Q2MV , Q2MB , RUNSF , RUNSB , APAR , & ! OUT : PSN , SAV , SAG , FSNO , NEE , GPP , & ! OUT : NPP , FVEG , SALB , QMELT , PONDING , PONDING1, & ! OUT : PONDING2, RSSUN , RSSHA , BGAP , WGAP , GAP , & ! OUT : ERRWAT , CHV , CHB , EMISSI) ! OUT : #if 0 if ( I == 15 .and. J == 5 ) then ! Intent (OUT) or Intent (INOUT), but not Intent (IN) write(*,'("After call to NOAHMP_SFLX, at point ", I8, I8)') i, j write(*,'(10x, "ZLVL = ", 7F20.10)') ZLVL write(*,'(10x, "EAH = ", F20.10)') EAH write(*,'(10x, "TAH = ", F20.10)') TAH write(*,'(10x, "FWET = ", F20.10)') FWET write(*,'(10x, "QSNOW = ", F20.10)') QSNOW write(*,'(10x, "SNEQVO = ", F20.10)') SNEQVO write(*,'(10x, "ISNOW = ", F20.10)') ISNOW write(*,'(10x, "ZSNSO = ", 7F20.10)') ZSNSO write(*,'(10x, "CANLIQ = ", F20.10)') CANLIQ write(*,'(10x, "CANICE = ", F20.10)') CANICE write(*,'(10x, "SNOWD = ", F20.10)') SNOWD write(*,'(10x, "SWE = ", F20.10)') SWE write(*,'(10x, "SNICE = ", 3F20.10)') SNICE write(*,'(10x, "SNLIQ = ", 3F20.10)') SNLIQ write(*,'(10x, "TV = ", F20.10)') TV write(*,'(10x, "TG = ", F20.10)') TG write(*,'(10x, "STC = ", 7F20.10)') STC write(*,'(10x, "SMH2O = ", 7F20.10)') SMH2O write(*,'(10x, "SMC = ", 7F20.10)') SMC write(*,'(10x, "ZWT = ", F20.10)') ZWT write(*,'(10x, "WA = ", F20.10)') WA write(*,'(10x, "WT = ", F20.10)') WT write(*,'(10x, "WSLAKE = ", F20.10)') WSLAKE write(*,'(10x, "LFMASS = ", F20.10)') LFMASS write(*,'(10x, "RTMASS = ", F20.10)') RTMASS write(*,'(10x, "STMASS = ", F20.10)') STMASS write(*,'(10x, "WOOD = ", F20.10)') WOOD write(*,'(10x, "STBLCP = ", F20.10)') STBLCP write(*,'(10x, "FASTCP = ", F20.10)') FASTCP write(*,'(10x, "PLAI = ", F20.10)') PLAI write(*,'(10x, "PSAI = ", F20.10)') PSAI write(*,'(10x, "ALBOLD = ", F20.10)') ALBOLD write(*,'(10x, "CM = ", F20.10)') CM write(*,'(10x, "CH = ", F20.10)') CH write(*,'(10x, "FSA = ", F20.10)') FSA write(*,'(10x, "FSR = ", F20.10)') FSR write(*,'(10x, "FIRA = ", F20.10)') FIRA write(*,'(10x, "FSH = ", F20.10)') FSH write(*,'(10x, "SSOIL = ", F20.10)') SSOIL write(*,'(10x, "FCEV = ", F20.10)') FCEV write(*,'(10x, "FGEV = ", F20.10)') FGEV write(*,'(10x, "FCTR = ", F20.10)') FCTR write(*,'(10x, "TRAD = ", F20.10)') TRAD write(*,'(10x, "ECAN = ", F20.10)') ECAN write(*,'(10x, "ETRAN = ", F20.10)') ETRAN write(*,'(10x, "ESOIL = ", F20.10)') ESOIL write(*,'(10x, "RUNSF = ", F20.10)') RUNSF write(*,'(10x, "RUNSB = ", F20.10)') RUNSB write(*,'(10x, "APAR = ", F20.10)') APAR write(*,'(10x, "PSN = ", F20.10)') PSN write(*,'(10x, "SAV = ", F20.10)') SAV write(*,'(10x, "SAG = ", F20.10)') SAG write(*,'(10x, "FSNO = ", F20.10)') FSNO write(*,'(10x, "NEE = ", F20.10)') NEE write(*,'(10x, "GPP = ", F20.10)') GPP write(*,'(10x, "NPP = ", F20.10)') NPP write(*,'(10x, "TS = ", F20.10)') TS write(*,'(10x, "FVEG = ", F20.10)') FVEG write(*,'(10x, "SALB = ", F20.10)') SALB write(*,'(10x, "ERRWAT = ", F20.10)') ERRWAT write(*,'(10x, "QMELT = ", F20.10)') QMELT write(*,'(10x, "PONDING = ", F20.10)') PONDING write(*,'(10x, "PONDING1 = ", F20.10)') PONDING1 write(*,'(10x, "PONDING2 = ", F20.10)') PONDING2 write(*,'(10x, "QSFC1D = ", F20.10)') QSFC1D write(*,'(10x, "CHSTAR = ", F20.10)') CHSTAR write(*,'(10x, "TSTAR = ", F20.10)') TSTAR write(*,'(10x, "T2MV = ", F20.10)') T2MV write(*,'(10x, "T2MB = ", F20.10)') T2MB write(*,'(10x, "RSSUN = ", F20.10)') RSSUN write(*,'(10x, "RSSHA = ", F20.10)') RSSHA write(*,'(10x, "BGAP = ", F20.10)') BGAP write(*,'(10x, "WGAP = ", F20.10)') WGAP write(*,'(10x, "GAP = ", F20.10)') GAP write(*,'(10x, "TGV = ", F20.10)') TGV write(*,'(10x, "TGB = ", F20.10)') TGB write(*,'(10x, "Q1 = ", F20.10)') Q1 endif #endif !Q1 = eah * 0.622 / (SFCPRS - 0.378*eah) chs2 (i,j) = chstar2 cqs2 (i,j) = cqstar2 QFX (I,J) = ecan + esoil + etran SNOWC (I,J) = fsno ENDIF ! glacial, seaice split ends !jref:end isnowxy (i,j) = isnow canliqxy (i,j) = canliq canicexy (i,j) = canice snowh (i,j) = snowd snow (i,j) = swe zsnsoxy (i,isnow+1:nsoil,j) = zsnso (isnow+1:nsoil) tslb (i, 1:nsoil,j) = stc ( 1:nsoil) tsnoxy (i,isnow+1: 0,j) = stc (isnow+1: 0) smois (i, 1:nsoil,j) = smc ( 1:nsoil) sh2o (i, 1:nsoil,j) = smh2o ( 1:nsoil) snicexy (i,isnow+1: 0,j) = snice (isnow+1: 0) snliqxy (i,isnow+1: 0,j) = snliq (isnow+1: 0) tvxy (i,j) = tv tgxy (i,j) = tg zwtxy (i,j) = zwt waxy (i,j) = wa wtxy (i,j) = wt lfmassxy (i,j) = lfmass rtmassxy (i,j) = rtmass stmassxy (i,j) = stmass woodxy (i,j) = wood stblcpxy (i,j) = stblcp fastcpxy (i,j) = fastcp xlaixy (i,j) = plai xsaixy (i,j) = psai emiss (i,j) = emissi eahxy (i,j) = eah tahxy (i,j) = tah fwetxy (i,j) = fwet sneqvoxy (i,j) = sneqvo alboldxy (i,j) = albold qsnowxy (i,j) = qsnow wslakexy (i,j) = wslake cmxy (i,j) = cm !jref:start chxy (i,j) = chstar rssunxy (i,j) = rssun rsshaxy (i,j) = rssha bgapxy (i,j) = bgap wgapxy (i,j) = wgap gapxy (i,j) = gap tgvxy (i,j) = tgv tgbxy (i,j) = tgb chvxy (i,j) = chv chbxy (i,j) = chb !jref:end !for output runsfxy (i,j) = runsf runsbxy (i,j) = runsb ecanxy (i,j) = ecan edirxy (i,j) = esoil etranxy (i,j) = etran aparxy (i,j) = apar psnxy (i,j) = psn savxy (i,j) = sav sagxy (i,j) = sag fsnoxy (i,j) = fsno fsaxy (i,j) = fsa firaxy (i,j) = fira hfx (i,j) = fsh lh (i,j) = fcev + fgev + fctr grdflx (i,j) = ssoil tradxy (i,j) = trad tsxy (i,j) = ts neexy (i,j) = nee gppxy (i,j) = gpp nppxy (i,j) = npp fvegxy (i,j) = fveg !jref:4/21/2011 t2mvxy (i,j) = t2mv t2mbxy (i,j) = t2mb q2mvxy (i,j) = q2mv q2mbxy (i,j) = q2mb chstarxy (i,j) = chstar chs (i,j) = chstar tstarxy (i,j) = tstar !jref:4/21/2011 CANWAT(I,J) = canliqxy (i,j) + canicexy (i,j) IF ( SALB > -999 ) THEN ALBEDO(I,J) = salb ENDIF TSK(I,J) = tradxy (i,j) !KWM TSK(I,J) = tstarxy (i,j) !niu POTEVP(I,J) = ??? !jref CHS2(I,J) = chxy (i,j) !IF (Q1.GT.QSFC(I,J)) THEN ! CQS2(I,J) = CHS(I,J) !END IF QSFC(I,J) = Q1/(1.0-Q1) !jref: specific humidity to mixing ratio q2mvxy(i,j) = q2mvxy(i,j)/(1.0-q2mvxy(i,j)) ! IF (VEGTYP == ISURBAN) write(*,*) "IN SFCDRV: q2mb=",q2mb,"q2mbxy(i,j)=",q2mbxy(i,j) q2mbxy(i,j) = q2mbxy(i,j)/(1.0-q2mbxy(i,j)) !*** DIAGNOSTICS !jref:start - THESE SHOULD BE LOOKED AT!!! SNOTIME(I,J) = SNOTIME1 SMSTAV(I,J)=SOILW SMSTOT(I,J)=SOILM*1000. ! Convert the water unit into mm SFCRUNOFF(I,J)=SFCRUNOFF(I,J)+runsfxy(i,j)*DT*1000.0 UDRUNOFF(I,J)=UDRUNOFF(I,J)+runsbxy(i,j)*DT*1000.0 !jref SFCRUNOFF(I,J)=SFCRUNOFF(I,J)+RUNOFF1*DT*1000.0 !jref UDRUNOFF(I,J)=UDRUNOFF(I,J)+(RUNOFF2+RUNOFF3)*DT*1000.0 !jref:end ! snow defined when fraction of frozen precip (FFROZP) > 0.5, IF(FFROZP.GT.0.5)THEN ACSNOW(I,J)=ACSNOW(I,J)+PRCP*DT ENDIF IF(SNOW(I,J).GT.0.)THEN !KWM ACSNOM(I,J)=ACSNOM(I,J)+SNOMLT*1000. ENDIF ENDIF ! endif of land-sea test !jref:start make sure exchange coeff and TSK include water points ! IF((XLAND(I,J)-1.5).GE.0.)THEN ! begining of land/sea if block ! chstar2xy(i,j) = CHS2(i,j) ! chstarxy(i,j) = CHS(i,j) ! tstarxy(i,j) = T1 !TSK(i,j) test with T1 ! ENDIF !jref:end ENDDO ENDDO ! of J loop !------------------------------------------------------ END SUBROUTINE noahmplsm !------------------------------------------------------ SUBROUTINE NOAHMP_INIT ( MMINLU, SNOW , SNOWH , CANWAT , ISLTYP , & TSLB , SMOIS , SH2O , DZS , FNDSOILW , FNDSNOWH , & TSK, isnowxy , tvxy ,tgxy ,canicexy , & canliqxy ,eahxy ,tahxy ,cmxy ,chxy , & fwetxy ,sneqvoxy ,alboldxy ,qsnowxy ,wslakexy ,zwtxy ,waxy , & wtxy ,tsnoxy ,zsnsoxy ,snicexy ,snliqxy ,lfmassxy ,rtmassxy , & stmassxy ,woodxy ,stblcpxy ,fastcpxy ,xsaixy , & !jref:start t2mvxy ,t2mbxy ,chstarxy , & !jref:end num_soil_layers, restart, & allowed_to_read , & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) ! Initializing Canopy air temperature to 287 K seems dangerous to me [KWM]. INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte INTEGER, INTENT(IN) :: num_soil_layers LOGICAL, INTENT(IN) :: restart, & & allowed_to_read REAL, DIMENSION( num_soil_layers), INTENT(IN) :: DZS ! Thickness of the soil layers [m] REAL, DIMENSION( ims:ime, num_soil_layers, jms:jme ) , & & INTENT(INOUT) :: SMOIS, & & SH2O, & & TSLB REAL, DIMENSION( ims:ime, jms:jme ) , & & INTENT(INOUT) :: SNOW, & & SNOWH, & & CANWAT INTEGER, DIMENSION( ims:ime, jms:jme ), & & INTENT(IN) :: ISLTYP LOGICAL, INTENT(IN) :: FNDSOILW, & & FNDSNOWH REAL, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: TSK !skin temperature (k) INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: isnowxy !actual no. of snow layers REAL, DIMENSION(ims:ime,-2:num_soil_layers,jms:jme), INTENT(INOUT) :: zsnsoxy !snow layer depth [m] REAL, DIMENSION(ims:ime,-2: 0,jms:jme), INTENT(INOUT) :: tsnoxy !snow temperature [K] REAL, DIMENSION(ims:ime,-2: 0,jms:jme), INTENT(INOUT) :: snicexy !snow layer ice [mm] REAL, DIMENSION(ims:ime,-2: 0,jms:jme), INTENT(INOUT) :: snliqxy !snow layer liquid water [mm] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: tvxy !vegetation canopy temperature REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: tgxy !ground surface temperature REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: canicexy !canopy-intercepted ice (mm) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: canliqxy !canopy-intercepted liquid water (mm) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: eahxy !canopy air vapor pressure (pa) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: tahxy !canopy air temperature (k) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: cmxy !momentum drag coefficient REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: chxy !sensible heat exchange coefficient REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fwetxy !wetted or snowed fraction of the canopy (-) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: sneqvoxy !snow mass at last time step(mm h2o) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: alboldxy !snow albedo at last time step (-) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: qsnowxy !snowfall on the ground [mm/s] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: wslakexy !lake water storage [mm] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: zwtxy !water table depth [m] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: waxy !water in the "aquifer" [mm] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: wtxy !groundwater storage [mm] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: lfmassxy !leaf mass [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: rtmassxy !mass of fine roots [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: stmassxy !stem mass [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: woodxy !mass of wood (incl. woody roots) [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: stblcpxy !stable carbon in deep soil [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fastcpxy !short-lived carbon, shallow soil [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: xsaixy !stem area index !jref:start REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: t2mvxy !2m temperature vegetation part (k) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: t2mbxy !2m temperature bare ground part (k) REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: chstarxy !effective exchange coefficient !jref:end REAL, DIMENSION(1:num_soil_layers) :: ZSOIL ! Depth of the soil layer bottom (m) from ! the surface (negative) REAL :: BX, SMCMAX, PSISAT, FREE REAL, PARAMETER :: BLIM = 5.5 REAL, PARAMETER :: HLICE = 3.335E5 REAL, PARAMETER :: GRAV = 9.81 REAL, PARAMETER :: T0 = 273.15 INTEGER :: errflag character(len=80) :: err_message character(len=4) :: MMINSL character(len=*), intent(in) :: MMINLU MMINSL='STAS' call read_mp_veg_parameters(trim(MMINLU)) ! ! initialize three Noah LSM related tables ! IF ( allowed_to_read ) THEN CALL wrf_message( 'INITIALIZE THREE Noah LSM RELATED TABLES' ) CALL SOIL_VEG_GEN_PARM( MMINLU, MMINSL ) ENDIF IF( .NOT. restart ) THEN itf=min0(ite,ide-1) jtf=min0(jte,jde-1) errflag = 0 DO j = jts,jtf DO i = its,itf IF ( ISLTYP( i,j ) .LT. 1 ) THEN errflag = 1 WRITE(err_message,*)"module_sf_noahlsm.F: lsminit: out of range ISLTYP ",i,j,ISLTYP( i,j ) CALL wrf_message(err_message) ENDIF ENDDO ENDDO IF ( errflag .EQ. 1 ) THEN CALL wrf_error_fatal( "module_sf_noahlsm.F: lsminit: out of range value "// & "of ISLTYP. Is this field in the input?" ) ENDIF #ifdef WRF_CHEM ! ! need this parameter for dust parameterization in wrf/chem ! do I=1,NSLTYPE porosity(i)=maxsmc(i) enddo #endif ! initialize soil liquid water content SH2O ! IF(.NOT.FNDSOILW) THEN ! If no SWC, do the following ! PRINT *,'SOIL WATER NOT FOUND - VALUE SET IN LSMINIT' DO J = jts , jtf DO I = its , itf BX = BB(ISLTYP(I,J)) SMCMAX = MAXSMC(ISLTYP(I,J)) PSISAT = SATPSI(ISLTYP(I,J)) IF ( ( bx > 0.0 ) .AND. ( smcmax > 0.0 ) .AND. ( psisat > 0.0 ) ) THEN DO NS=1, num_soil_layers IF ( TSLB(I,NS,J) < 273.149 ) THEN ! SH2O <= SMOIS for T < 273.149K (-0.001C) ! First guess of SH2O following explicit solution for ! Flerchinger Eqn from Koren et al, JGR, 1999, Eqn 17 ! (KCOUNT=0 in function FRH2O). BX = BB(ISLTYP(I,J)) SMCMAX = MAXSMC(ISLTYP(I,J)) PSISAT = SATPSI(ISLTYP(I,J)) IF ( BX > BLIM ) BX = BLIM FK=(( (HLICE/(GRAV*(-PSISAT))) * & ((TSLB(I,NS,J)-T0)/TSLB(I,NS,J)) )**(-1/BX) )*SMCMAX FK = MAX(FK, 0.02) SH2O(I,NS,J) = MIN( FK, SMOIS(I,NS,J) ) ! Use iterative solution for liquid soil water content ! using function FRH2O, with the initial guess for SH2O ! from the above explicit first guess. CALL FRH2O ( FREE , TSLB(I,NS,J) , SMOIS(I,NS,J) , SH2O(I,NS,J) ) SH2O(I,NS,J) = FREE ELSE ! SH2O = SMOIS ( for T => 273.149K (-0.001C) SH2O(I,NS,J)=SMOIS(I,NS,J) ENDIF END DO ELSE DO NS=1, num_soil_layers SH2O(I,NS,J)=SMOIS(I,NS,J) END DO ENDIF ENDDO ENDDO ! ENDIF ! ! initialize physical snow height SNOWH ! IF(.NOT.FNDSNOWH)THEN ! If no SNOWH do the following CALL wrf_message( 'SNOW HEIGHT NOT FOUND - VALUE DEFINED IN LSMINIT' ) DO J = jts,jtf DO I = its,itf SNOWH(I,J)=SNOW(I,J)*0.005 ! SNOW in mm and SNOWH in m ENDDO ENDDO ENDIF DO J = jts,jtf DO I = its,itf tvxy (I,J) = TSK(I,J) tgxy (I,J) = TSK(I,J) CANWAT (I,J) = 0.0 canliqxy (I,J) = CANWAT(I,J) canicexy (I,J) = 0. eahxy (I,J) = 2000. tahxy (I,J) = 287. !jref:start t2mvxy (I,J) = TSK(I,J) t2mbxy (I,J) = TSK(I,J) chstarxy (I,J) = 0.0 !jref:end cmxy (I,J) = 0.0 chxy (I,J) = 0.0 fwetxy (I,J) = 0.0 sneqvoxy (I,J) = 0.0 alboldxy (I,J) = 0.65 qsnowxy (I,J) = 0.0 wslakexy (I,J) = 0.0 waxy (I,J) = 4900. !??? wtxy (I,J) = waxy(i,j) !??? zwtxy (I,J) = (25. + 2.0) - waxy(i,j)/1000/0.2 !??? lfmassxy (I,J) = 50. ! stmassxy (I,J) = 50.0 ! rtmassxy (I,J) = 500.0 ! woodxy (I,J) = 500.0 ! stblcpxy (I,J) = 1000.0 ! fastcpxy (I,J) = 1000.0 ! xsaixy (I,J) = 0.1 ! enddo enddo ! Given the soil layer thicknesses (in DZS), initialize the soil layer ! depths from the surface. ZSOIL(1) = -DZS(1) ! negative DO NS=2, num_soil_layers ZSOIL(NS) = ZSOIL(NS-1) - DZS(NS) END DO ! Initialize snow/soil layer arrays ZSNSOXY, TSNOXY, SNICEXY, SNLIQXY, ! and ISNOWXY CALL snow_init ( ims , ime , jms , jme , its , itf , jts , jtf , 3 , & & num_soil_layers , zsoil , snow , tgxy , snowh , & & zsnsoxy , tsnoxy , snicexy , snliqxy , isnowxy ) ENDIF END SUBROUTINE NOAHMP_INIT !------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------ SUBROUTINE SNOW_INIT ( ims , ime , jms , jme , its , itf , jts , jtf , & & NSNOW , NSOIL , ZSOIL , SWE , TGXY , SNODEP , & & ZSNSOXY , TSNOXY , SNICEXY ,SNLIQXY , ISNOWXY ) !------------------------------------------------------------------------------------------ ! Initialize snow arrays for Noah-MP LSM, based in input SNOWDEP, NSNOW ! ISNOWXY is an index array, indicating the index of the top snow layer. Valid indices ! for snow layers range from 0 (no snow) and -1 (shallow snow) to (-NSNOW)+1 (deep snow). ! TSNOXY holds the temperature of the snow layer. Snow layers are initialized with ! temperature = ground temperature [?]. Snow-free levels in the array have value 0.0 ! SNICEXY is the frozen content of a snow layer. Initial estimate based on SNODEP and SWE ! SNLIQXY is the liquid content of a snow layer. Initialized to 0.0 ! ZNSNOXY is the layer depth from the surface. !------------------------------------------------------------------------------------------ IMPLICIT NONE !------------------------------------------------------------------------------------------ INTEGER, INTENT(IN) :: ims, ime, jms, jme INTEGER, INTENT(IN) :: its, itf, jts, jtf INTEGER, INTENT(IN) :: NSNOW INTEGER, INTENT(IN) :: NSOIL REAL, INTENT(IN), DIMENSION(ims:ime, jms:jme) :: SWE REAL, INTENT(IN), DIMENSION(ims:ime, jms:jme) :: SNODEP REAL, INTENT(IN), DIMENSION(ims:ime, jms:jme) :: TGXY REAL, INTENT(IN), DIMENSION(1:NSOIL) :: ZSOIL INTEGER, INTENT(OUT), DIMENSION(ims:ime, jms:jme) :: ISNOWXY ! Top snow layer index REAL, INTENT(OUT), DIMENSION(ims:ime, -NSNOW+1:NSOIL,jms:jme) :: ZSNSOXY ! Snow/soil layer depth from surface [m] REAL, INTENT(OUT), DIMENSION(ims:ime, -NSNOW+1: 0,jms:jme) :: TSNOXY ! Snow layer temperature [K] REAL, INTENT(OUT), DIMENSION(ims:ime, -NSNOW+1: 0,jms:jme) :: SNICEXY ! Snow layer ice content [mm] REAL, INTENT(OUT), DIMENSION(ims:ime, -NSNOW+1: 0,jms:jme) :: SNLIQXY ! snow layer liquid content [mm] ! Local variables: ! DZSNO holds the thicknesses of the various snow layers. ! DZSNOSO holds the thicknesses of the various soil/snow layers. INTEGER :: I,J,IZ REAL, DIMENSION(-NSNOW+1: 0) :: DZSNO REAL, DIMENSION(-NSNOW+1:NSOIL) :: DZSNSO !------------------------------------------------------------------------------------------ DO J = jts , jtf DO I = its , itf IF ( SNODEP(I,J) < 0.025 ) THEN ISNOWXY(I,J) = 0 DZSNO(-NSNOW+1:0) = 0. ELSE IF ( ( SNODEP(I,J) >= 0.025 ) .AND. ( SNODEP(I,J) <= 0.05 ) ) THEN ISNOWXY(I,J) = -1 DZSNO(0) = SNODEP(I,J) ELSE IF ( ( SNODEP(I,J) > 0.05 ) .AND. ( SNODEP(I,J) <= 0.10 ) ) THEN ISNOWXY(I,J) = -2 DZSNO(-1) = SNODEP(I,J)/2. DZSNO( 0) = SNODEP(I,J)/2. ELSE IF ( (SNODEP(I,J) > 0.10 ) .AND. ( SNODEP(I,J) <= 0.25 ) ) THEN ISNOWXY(I,J) = -2 DZSNO(-1) = 0.05 DZSNO( 0) = SNODEP(I,J) - DZSNO(-1) ELSE IF ( ( SNODEP(I,J) > 0.25 ) .AND. ( SNODEP(I,J) <= 0.35 ) ) THEN ISNOWXY(I,J) = -3 DZSNO(-2) = 0.05 DZSNO(-1) = 0.5*(SNODEP(I,J)-DZSNO(-2)) DZSNO( 0) = 0.5*(SNODEP(I,J)-DZSNO(-2)) ELSE IF ( SNODEP(I,J) > 0.35 ) THEN ISNOWXY(I,J) = -3 DZSNO(-2) = 0.05 DZSNO(-1) = 0.10 DZSNO( 0) = SNODEP(I,J) - DZSNO(-1) - DZSNO(-2) ELSE CALL wrf_error_fatal("Problem with the logic assigning snow layers.") END IF END IF TSNOXY (I,-NSNOW+1:0,J) = 0. SNICEXY(I,-NSNOW+1:0,J) = 0. SNLIQXY(I,-NSNOW+1:0,J) = 0. DO IZ = ISNOWXY(I,J)+1 , 0 TSNOXY(I,IZ,J) = TGXY(I,J) ! [k] SNLIQXY(I,IZ,J) = 0.00 SNICEXY(I,IZ,J) = 1.00 * DZSNO(IZ) * (SWE(I,J)/SNODEP(I,J)) ! [kg/m3] END DO ! Assign local variable DZSNSO, the soil/snow layer thicknesses, for snow layers DO IZ = ISNOWXY(I,J)+1 , 0 DZSNSO(IZ) = -DZSNO(IZ) END DO ! Assign local variable DZSNSO, the soil/snow layer thicknesses, for soil layers DZSNSO(1) = ZSOIL(1) DO IZ = 2 , NSOIL DZSNSO(IZ) = (ZSOIL(IZ) - ZSOIL(IZ-1)) END DO ! Assign ZSNSOXY, the layer depths, for soil and snow layers ZSNSOXY(I,ISNOWXY(I,J)+1,J) = DZSNSO(ISNOWXY(I,J)+1) DO IZ = ISNOWXY(I,J)+2 , NSOIL ZSNSOXY(I,IZ,J) = ZSNSOXY(I,IZ-1,J) + DZSNSO(IZ) ENDDO END DO END DO END SUBROUTINE SNOW_INIT ! !------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------ ! END MODULE module_sf_noahmpdrv