From 04cacd3295c7b8ba40bd6f090b98f0aa88b217ea Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 27 Feb 2020 12:22:30 -0700 Subject: [PATCH 1/2] initial commit of NOAH LSM for HAFS application --- CMakeLists.txt | 2 + physics/GFS_surface_generic.F90 | 8 +- physics/module_sf_noahlsm.F | 4775 +++++++++++++++++++++++++++++++ physics/sfc_drv.f | 14 +- physics/sfc_drv_hafs.F90 | 694 +++++ physics/sfc_drv_hafs.meta | 766 +++++ physics/sfc_drv_ruc.F90 | 13 +- physics/sfc_noahmp_drv.f | 15 +- 8 files changed, 6282 insertions(+), 5 deletions(-) create mode 100644 physics/module_sf_noahlsm.F create mode 100644 physics/sfc_drv_hafs.F90 create mode 100644 physics/sfc_drv_hafs.meta diff --git a/CMakeLists.txt b/CMakeLists.txt index b8d3c3e18..d251dd768 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -145,6 +145,8 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_noahlsm.F + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8 -ffree-form") if (PROJECT STREQUAL "CCPP-FV3") # Set 32-bit floating point precision flags for certain files # that are executed in the dynamics (fast physics part) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 104d57f07..9eec56ca3 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -156,10 +156,14 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, else soiltyp(i) = 9 endif - if (ivegsrc == 1) then + if (ivegsrc == 0 .or. ivegsrc == 4) then + vegtype(i) = 24 + elseif (ivegsrc == 1) then vegtype(i) = 15 - elseif(ivegsrc == 2) then + elseif (ivegsrc == 2) then vegtype(i) = 13 + elseif (ivegsrc == 3 .or. ivegsrc == 5) then + vegtype(i) = 15 endif slopetyp(i) = 9 else diff --git a/physics/module_sf_noahlsm.F b/physics/module_sf_noahlsm.F new file mode 100644 index 000000000..1a0aba547 --- /dev/null +++ b/physics/module_sf_noahlsm.F @@ -0,0 +1,4775 @@ + MODULE module_sf_noahlsm + +!ckay=KIRAN ALAPATY @ US EPA -- November 01, 2015 +! +! Tim Glotfelty@CNSU; AJ Deng@PSU +!modified for use with FASDAS +!Flux Adjusting Surface Data Assimilation System to assimilate +!surface layer and soil layers temperature and moisture using +! surfance reanalsys +!Reference: Alapaty et al., 2008: Development of the flux-adjusting surface +! data assimilation system for mesoscale models. JAMC, 47, 2331-2350 +! + + REAL, PARAMETER :: EMISSI_S = 0.95 + +! VEGETATION PARAMETERS + INTEGER :: LUCATS , BARE + INTEGER :: NATURAL + INTEGER :: LOW_DENSITY_RESIDENTIAL, HIGH_DENSITY_RESIDENTIAL, HIGH_INTENSITY_INDUSTRIAL + integer, PARAMETER :: NLUS=50 + CHARACTER(LEN=256) LUTYPE + INTEGER, DIMENSION(1:NLUS) :: NROTBL + real, dimension(1:NLUS) :: SNUPTBL, RSTBL, RGLTBL, HSTBL, & + SHDTBL, MAXALB, & + EMISSMINTBL, EMISSMAXTBL, & + LAIMINTBL, LAIMAXTBL, & + Z0MINTBL, Z0MAXTBL, & + ALBEDOMINTBL, ALBEDOMAXTBL, & + ZTOPVTBL,ZBOTVTBL + REAL :: TOPT_DATA,CMCMAX_DATA,CFACTR_DATA,RSMAX_DATA + +! SOIL PARAMETERS + INTEGER :: SLCATS + INTEGER, PARAMETER :: NSLTYPE=30 + CHARACTER(LEN=256) SLTYPE + REAL, DIMENSION (1:NSLTYPE) :: BB,DRYSMC,F11, & + MAXSMC, REFSMC,SATPSI,SATDK,SATDW, WLTSMC,QTZ + +! LSM GENERAL PARAMETERS + INTEGER :: SLPCATS + INTEGER, PARAMETER :: NSLOPE=30 + REAL, DIMENSION (1:NSLOPE) :: SLOPE_DATA + REAL :: SBETA_DATA,FXEXP_DATA,CSOIL_DATA,SALP_DATA,REFDK_DATA, & + REFKDT_DATA,FRZK_DATA,ZBOT_DATA, SMLOW_DATA,SMHIGH_DATA, & + CZIL_DATA + REAL :: LVCOEF_DATA + + integer, private :: iloc, jloc +!$omp threadprivate(iloc, jloc) +! + CONTAINS +! + + SUBROUTINE SFLX (IILOC,JJLOC,FFROZP,ISURBAN,DT,ZLVL,NSOIL,SLDPTH, & !C + LOCAL, & !L + LLANDUSE, LSOIL, & !CL + LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2,SFCSPD, & !F + COSZ,PRCPRAIN, SOLARDIRECT, & !F + TH2,Q2SAT,DQSDT2, & !I + VEGTYP,SOILTYP,SLOPETYP,SHDFAC,SHDMIN,SHDMAX, & !I + ALB, SNOALB,TBOT, Z0BRD, Z0, EMISSI, EMBRD, & !S + CMC,T1,STC,SMC,SH2O,SNOWH,SNEQV,ALBEDO,CH,CM, & !H + CP, RD, SIGMA, CPH2O, CPICE, LSUBF, & !physical constants +! ---------------------------------------------------------------------- +! OUTPUTS, DIAGNOSTICS, PARAMETERS BELOW GENERALLY NOT NECESSARY WHEN +! COUPLED WITH E.G. A NWP MODEL (SUCH AS THE NOAA/NWS/NCEP MESOSCALE ETA +! MODEL). OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES. +! ---------------------------------------------------------------------- + ETA,SHEAT, ETA_KINEMATIC,FDOWN, & !O + EC,EDIR,ET,ETT,ESNOW,DRIP,DEW, & !O + BETA,ETP,SSOIL, & !O + FLX1,FLX2,FLX3, & !O + FLX4,FVB,FBUR,FGSN,UA_PHYS, & !UA + SNOMLT,SNCOVR, & !O + RUNOFF1,RUNOFF2,RUNOFF3, & !O + RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL, & !O + SOILW,SOILM,Q1,SMAV, & !D + RDLAI2D,USEMONALB, & + SNOTIME1, & + RIBB, & + SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT, & + SFHEAD1RT, & !I + INFXS1RT,ETPND1,OPT_THCND,AOASIS, & !P + XSDA_QFX,HFX_PHY,QFX_PHY,XQNORM, & !fasdas + fasdas,HCPCT_FASDAS, & !fasdas + errflg, errmsg) + +! ---------------------------------------------------------------------- +! SUBROUTINE SFLX - UNIFIED NOAHLSM VERSION 1.0 JULY 2007 +! ---------------------------------------------------------------------- +! SUB-DRIVER FOR "Noah LSM" FAMILY OF PHYSICS SUBROUTINES FOR A +! SOIL/VEG/SNOWPACK LAND-SURFACE MODEL TO UPDATE SOIL MOISTURE, SOIL +! ICE, SOIL TEMPERATURE, SKIN TEMPERATURE, SNOWPACK WATER CONTENT, +! SNOWDEPTH, AND ALL TERMS OF THE SURFACE ENERGY BALANCE AND SURFACE +! WATER BALANCE (EXCLUDING INPUT ATMOSPHERIC FORCINGS OF DOWNWARD +! RADIATION AND PRECIP) +! ---------------------------------------------------------------------- +! SFLX ARGUMENT LIST KEY: +! ---------------------------------------------------------------------- +! C CONFIGURATION INFORMATION +! L LOGICAL +! CL 4-string character bearing logical meaning +! F FORCING DATA +! I OTHER (INPUT) FORCING DATA +! S SURFACE CHARACTERISTICS +! H HISTORY (STATE) VARIABLES +! O OUTPUT VARIABLES +! D DIAGNOSTIC OUTPUT +! P Parameters +! Msic Miscellaneous terms passed from gridded driver +! ---------------------------------------------------------------------- +! 1. CONFIGURATION INFORMATION (C): +! ---------------------------------------------------------------------- +! DT TIMESTEP (SEC) (DT SHOULD NOT EXCEED 3600 SECS, RECOMMEND +! 1800 SECS OR LESS) +! ZLVL HEIGHT (M) ABOVE GROUND OF ATMOSPHERIC FORCING VARIABLES +! NSOIL NUMBER OF SOIL LAYERS (AT LEAST 2, AND NOT GREATER THAN +! PARAMETER NSOLD SET BELOW) +! SLDPTH THE THICKNESS OF EACH SOIL LAYER (M) +! ---------------------------------------------------------------------- +! 2. LOGICAL: +! ---------------------------------------------------------------------- +! LCH Exchange coefficient (Ch) calculation flag (false: using +! ch-routine SFCDIF; true: Ch is brought in) +! LOCAL Flag for local-site simulation (where there is no +! maps for albedo, veg fraction, and roughness +! true: all LSM parameters (inluding albedo, veg fraction and +! roughness length) will be defined by three tables +! LLANDUSE (=USGS, using USGS landuse classification) +! LSOIL (=STAS, using FAO/STATSGO soil texture classification) +! OPT_THCND option for how to treat thermal conductivity +! ---------------------------------------------------------------------- +! 3. FORCING DATA (F): +! ---------------------------------------------------------------------- +! LWDN LW DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET LONGWAVE) +! SOLDN SOLAR DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET SOLAR) +! SOLNET NET DOWNWARD SOLAR RADIATION ((W M-2; POSITIVE) +! SFCPRS PRESSURE AT HEIGHT ZLVL ABOVE GROUND (PASCALS) +! PRCP PRECIP RATE (KG M-2 S-1) (NOTE, THIS IS A RATE) +! SFCTMP AIR TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND +! TH2 AIR POTENTIAL TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND +! Q2 MIXING RATIO AT HEIGHT ZLVL ABOVE GROUND (KG KG-1) +! COSZ Solar zenith angle (not used for now) +! PRCPRAIN Liquid-precipitation rate (KG M-2 S-1) (not used) +! SOLARDIRECT Direct component of downward solar radiation (W M-2) (not used) +! FFROZP FRACTION OF FROZEN PRECIPITATION +! ---------------------------------------------------------------------- +! 4. OTHER FORCING (INPUT) DATA (I): +! ---------------------------------------------------------------------- +! SFCSPD WIND SPEED (M S-1) AT HEIGHT ZLVL ABOVE GROUND +! Q2SAT SAT SPECIFIC HUMIDITY AT HEIGHT ZLVL ABOVE GROUND (KG KG-1) +! DQSDT2 SLOPE OF SAT SPECIFIC HUMIDITY CURVE AT T=SFCTMP +! (KG KG-1 K-1) +! ---------------------------------------------------------------------- +! 5. CANOPY/SOIL CHARACTERISTICS (S): +! ---------------------------------------------------------------------- +! VEGTYP VEGETATION TYPE (INTEGER INDEX) +! SOILTYP SOIL TYPE (INTEGER INDEX) +! SLOPETYP CLASS OF SFC SLOPE (INTEGER INDEX) +! SHDFAC AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION +! (FRACTION= 0.0-1.0) +! SHDMIN MINIMUM AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION +! (FRACTION= 0.0-1.0) <= SHDFAC +! PTU PHOTO THERMAL UNIT (PLANT PHENOLOGY FOR ANNUALS/CROPS) +! (NOT YET USED, BUT PASSED TO REDPRM FOR FUTURE USE IN +! VEG PARMS) +! ALB BACKROUND SNOW-FREE SURFACE ALBEDO (FRACTION), FOR JULIAN +! DAY OF YEAR (USUALLY FROM TEMPORAL INTERPOLATION OF +! MONTHLY MEAN VALUES' CALLING PROG MAY OR MAY NOT +! INCLUDE DIURNAL SUN ANGLE EFFECT) +! SNOALB UPPER BOUND ON MAXIMUM ALBEDO OVER DEEP SNOW (E.G. FROM +! ROBINSON AND KUKLA, 1985, J. CLIM. & APPL. METEOR.) +! TBOT BOTTOM SOIL TEMPERATURE (LOCAL YEARLY-MEAN SFC AIR +! TEMPERATURE) +! Z0BRD Background fixed roughness length (M) +! Z0 Time varying roughness length (M) as function of snow depth +! +! EMBRD Background surface emissivity (between 0 and 1) +! EMISSI Surface emissivity (between 0 and 1) +! ---------------------------------------------------------------------- +! 6. HISTORY (STATE) VARIABLES (H): +! ---------------------------------------------------------------------- +! CMC CANOPY MOISTURE CONTENT (M) +! T1 GROUND/CANOPY/SNOWPACK) EFFECTIVE SKIN TEMPERATURE (K) +! STC(NSOIL) SOIL TEMP (K) +! SMC(NSOIL) TOTAL SOIL MOISTURE CONTENT (VOLUMETRIC FRACTION) +! SH2O(NSOIL) UNFROZEN SOIL MOISTURE CONTENT (VOLUMETRIC FRACTION) +! NOTE: FROZEN SOIL MOISTURE = SMC - SH2O +! SNOWH ACTUAL SNOW DEPTH (M) +! SNEQV LIQUID WATER-EQUIVALENT SNOW DEPTH (M) +! NOTE: SNOW DENSITY = SNEQV/SNOWH +! ALBEDO SURFACE ALBEDO INCLUDING SNOW EFFECT (UNITLESS FRACTION) +! =SNOW-FREE ALBEDO (ALB) WHEN SNEQV=0, OR +! =FCT(MSNOALB,ALB,VEGTYP,SHDFAC,SHDMIN) WHEN SNEQV>0 +! CH SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE +! (M S-1); NOTE: CH IS TECHNICALLY A CONDUCTANCE SINCE +! IT HAS BEEN MULTIPLIED BY WIND SPEED. +! CM SURFACE EXCHANGE COEFFICIENT FOR MOMENTUM (M S-1); NOTE: +! CM IS TECHNICALLY A CONDUCTANCE SINCE IT HAS BEEN +! MULTIPLIED BY WIND SPEED. +! 6a: Physical constants +! CP specific heat of dry air at constant pressure +! RD gas constant for dry air +! SIGMA Steffan-Boltzmann constant +! CPH2O specific heat of liquid water +! CPICE specific heat of ice +! LSUBF latent heat of fusion for water +! ---------------------------------------------------------------------- +! 7. OUTPUT (O): +! ---------------------------------------------------------------------- +! OUTPUT VARIABLES NECESSARY FOR A COUPLED NUMERICAL WEATHER PREDICTION +! MODEL, E.G. NOAA/NWS/NCEP MESOSCALE ETA MODEL. FOR THIS APPLICATION, +! THE REMAINING OUTPUT/DIAGNOSTIC/PARAMETER BLOCKS BELOW ARE NOT +! NECESSARY. OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES. +! ETA ACTUAL LATENT HEAT FLUX (W m-2: NEGATIVE, IF UP FROM +! SURFACE) +! ETA_KINEMATIC atctual latent heat flux in Kg m-2 s-1 +! SHEAT SENSIBLE HEAT FLUX (W M-2: POSITIVE, IF UPWARD FROM +! SURFACE) +! 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) +! ET(NSOIL) PLANT TRANSPIRATION FROM A PARTICULAR ROOT (SOIL) LAYER +! (W m-2) +! ETT TOTAL PLANT TRANSPIRATION (W m-2) +! ESNOW SUBLIMATION FROM (OR DEPOSITION TO IF <0) SNOWPACK +! (W m-2) +! DRIP THROUGH-FALL OF PRECIP AND/OR DEW IN EXCESS OF CANOPY +! WATER-HOLDING CAPACITY (M) +! DEW DEWFALL (OR FROSTFALL FOR T<273.15) (M) +! ---------------------------------------------------------------------- +! BETA RATIO OF ACTUAL/POTENTIAL EVAP (DIMENSIONLESS) +! ETP POTENTIAL EVAPORATION (W m-2) +! SSOIL SOIL HEAT FLUX (W M-2: NEGATIVE IF DOWNWARD FROM SURFACE) +! ---------------------------------------------------------------------- +! 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) +! ---------------------------------------------------------------------- +! SNOMLT SNOW MELT (M) (WATER EQUIVALENT) +! SNCOVR FRACTIONAL SNOW COVER (UNITLESS FRACTION, 0-1) +! ---------------------------------------------------------------------- +! RUNOFF1 SURFACE RUNOFF (M S-1), NOT INFILTRATING THE SURFACE +! RUNOFF2 SUBSURFACE RUNOFF (M S-1), DRAINAGE OUT BOTTOM OF LAST +! SOIL LAYER (BASEFLOW) +! RUNOFF3 NUMERICAL TRUNCTATION IN EXCESS OF POROSITY (SMCMAX) +! FOR A GIVEN SOIL LAYER AT THE END OF A TIME STEP (M S-1). +! Note: the above RUNOFF2 is actually the sum of RUNOFF2 and RUNOFF3 +! ---------------------------------------------------------------------- +! RC CANOPY RESISTANCE (S M-1) +! PC PLANT COEFFICIENT (UNITLESS FRACTION, 0-1) WHERE PC*ETP +! = ACTUAL TRANSP +! XLAI LEAF AREA INDEX (DIMENSIONLESS) +! RSMIN MINIMUM CANOPY RESISTANCE (S M-1) +! RCS INCOMING SOLAR RC FACTOR (DIMENSIONLESS) +! RCT AIR TEMPERATURE RC FACTOR (DIMENSIONLESS) +! RCQ ATMOS VAPOR PRESSURE DEFICIT RC FACTOR (DIMENSIONLESS) +! RCSOIL SOIL MOISTURE RC FACTOR (DIMENSIONLESS) +! ---------------------------------------------------------------------- +! 8. DIAGNOSTIC OUTPUT (D): +! ---------------------------------------------------------------------- +! SOILW AVAILABLE SOIL MOISTURE IN ROOT ZONE (UNITLESS FRACTION +! BETWEEN SMCWLT AND SMCMAX) +! SOILM TOTAL SOIL COLUMN MOISTURE CONTENT (FROZEN+UNFROZEN) (M) +! Q1 Effective mixing ratio at surface (kg kg-1), used for +! diagnosing the mixing ratio at 2 meter for coupled model +! SMAV Soil Moisture Availability for each layer, as a fraction +! between SMCWLT and SMCMAX. +! Documentation for SNOTIME1 and SNOABL2 ????? +! What categories of arguments do these variables fall into ???? +! Documentation for RIBB ????? +! What category of argument does RIBB fall into ????? +! ---------------------------------------------------------------------- +! 9. PARAMETERS (P): +! ---------------------------------------------------------------------- +! SMCWLT WILTING POINT (VOLUMETRIC) +! SMCDRY DRY SOIL MOISTURE THRESHOLD WHERE DIRECT EVAP FRM TOP +! LAYER ENDS (VOLUMETRIC) +! SMCREF SOIL MOISTURE THRESHOLD WHERE TRANSPIRATION BEGINS TO +! STRESS (VOLUMETRIC) +! SMCMAX POROSITY, I.E. SATURATED VALUE OF SOIL MOISTURE +! (VOLUMETRIC) +! NROOT NUMBER OF ROOT LAYERS, A FUNCTION OF VEG TYPE, DETERMINED +! IN SUBROUTINE REDPRM. +! ---------------------------------------------------------------------- + + + IMPLICIT NONE +! ---------------------------------------------------------------------- + +! DECLARATIONS - LOGICAL AND CHARACTERS +! ---------------------------------------------------------------------- + + INTEGER, INTENT(IN) :: IILOC, JJLOC + LOGICAL, INTENT(IN):: LOCAL + LOGICAL :: FRZGRA, SNOWNG + CHARACTER (LEN=256), INTENT(IN):: LLANDUSE, LSOIL + +! ---------------------------------------------------------------------- +! 1. CONFIGURATION INFORMATION (C): +! ---------------------------------------------------------------------- + INTEGER,INTENT(IN) :: NSOIL,SLOPETYP,SOILTYP,VEGTYP + INTEGER, INTENT(IN) :: ISURBAN + INTEGER,INTENT(OUT):: NROOT + INTEGER KZ, K, iout + +! ---------------------------------------------------------------------- +! 2. LOGICAL: +! ---------------------------------------------------------------------- + LOGICAL, INTENT(IN) :: RDLAI2D + LOGICAL, INTENT(IN) :: USEMONALB + INTEGER, INTENT(IN) :: OPT_THCND + + REAL, INTENT(INOUT):: SFHEAD1RT,INFXS1RT, ETPND1 + + REAL, INTENT(IN) :: SHDMIN,SHDMAX,DT,DQSDT2,LWDN,PRCP,PRCPRAIN, & + Q2,Q2SAT,SFCPRS,SFCSPD,SFCTMP, SNOALB, & + SOLDN,SOLNET,TBOT,TH2,ZLVL, & + FFROZP,AOASIS + REAL, INTENT(IN) :: CP, RD, SIGMA, CPH2O, CPICE, LSUBF + REAL, INTENT(OUT) :: EMBRD + REAL, INTENT(OUT) :: ALBEDO + REAL, INTENT(INOUT):: COSZ, SOLARDIRECT,CH,CM, & + CMC,SNEQV,SNCOVR,SNOWH,T1,XLAI,SHDFAC,Z0BRD, & + EMISSI, ALB + REAL, INTENT(INOUT):: SNOTIME1 + REAL, INTENT(INOUT):: RIBB + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SLDPTH + REAL, DIMENSION(1:NSOIL), INTENT(OUT):: ET + REAL, DIMENSION(1:NSOIL), INTENT(OUT):: SMAV + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SH2O, SMC, STC + REAL,DIMENSION(1:NSOIL):: RTDIS, ZSOIL + + REAL,INTENT(OUT) :: ETA_KINEMATIC,BETA,DEW,DRIP,EC,EDIR,ESNOW,ETA, & + ETP,FLX1,FLX2,FLX3,SHEAT,PC,RUNOFF1,RUNOFF2, & + RUNOFF3,RC,RSMIN,RCQ,RCS,RCSOIL,RCT,SSOIL, & + SMCDRY,SMCMAX,SMCREF,SMCWLT,SNOMLT, SOILM, & + SOILW,FDOWN,Q1 + LOGICAL, INTENT(IN) :: UA_PHYS ! UA: flag for UA option + REAL,INTENT(OUT) :: FLX4 ! UA: energy added to sensible heat + REAL,INTENT(OUT) :: FVB ! UA: frac. veg. w/snow beneath + REAL,INTENT(OUT) :: FBUR ! UA: fraction of canopy buried + REAL,INTENT(OUT) :: FGSN ! UA: ground snow cover fraction + REAL :: ZTOPV ! UA: height of canopy top + REAL :: ZBOTV ! UA: height of canopy bottom + REAL :: GAMA ! UA: = EXP(-1.* XLAI) + REAL :: FNET ! UA: + REAL :: ETPN ! UA: + REAL :: RU ! UA: + + REAL :: BEXP,CFACTR,CMCMAX,CSOIL,CZIL,DF1,DF1H,DF1A,DKSAT,DWSAT, & + DSOIL,DTOT,ETT,FRCSNO,FRCSOI,EPSCA,F1,FXEXP,FRZX,HS, & + KDT,LVH2O,PRCP1,PSISAT,QUARTZ,R,RCH,REFKDT,RR,RGL, & + RSMAX, & + RSNOW,SNDENS,SNCOND,SBETA,SN_NEW,SLOPE,SNUP,SALP,SOILWM, & + SOILWW,T1V,T24,T2V,TH2V,TOPT,TFREEZ,TSNOW,ZBOT,Z0,PRCPF, & + ETNS,PTU,LSUBS + REAL :: LVCOEF + REAL :: INTERP_FRACTION + REAL :: LAIMIN, LAIMAX + REAL :: ALBEDOMIN, ALBEDOMAX + REAL :: EMISSMIN, EMISSMAX + REAL :: Z0MIN, Z0MAX + +! ---------------------------------------------------------------------- +! DECLARATIONS - PARAMETERS +! ---------------------------------------------------------------------- + PARAMETER (TFREEZ = 273.15) + PARAMETER (LVH2O = 2.501E+6) + PARAMETER (LSUBS = 2.83E+6) + PARAMETER (R = 287.04) +! +! FASDAS +! + INTEGER, INTENT(IN ) :: fasdas + REAL, INTENT(INOUT) :: XSDA_QFX, XQNORM + REAL, INTENT(INOUT) :: HFX_PHY, QFX_PHY + REAL, INTENT( OUT) :: HCPCT_FASDAS +! +! END FASDAS + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! ---------------------------------------------------------------------- +! INITIALIZATION +! ---------------------------------------------------------------------- + errmsg = '' + errflg = 0 + + ILOC = IILOC + JLOC = JJLOC + + RUNOFF1 = 0.0 + RUNOFF2 = 0.0 + RUNOFF3 = 0.0 + SNOMLT = 0.0 + + IF ( .NOT. UA_PHYS ) THEN + FLX4 = 0.0 + FVB = 0.0 + FBUR = 0.0 + FGSN = 0.0 + ENDIF + +! ---------------------------------------------------------------------- +! CALCULATE DEPTH (NEGATIVE) BELOW GROUND FROM TOP SKIN SFC TO BOTTOM OF +! EACH SOIL LAYER. NOTE: SIGN OF ZSOIL IS NEGATIVE (DENOTING BELOW +! GROUND) +! ---------------------------------------------------------------------- + ZSOIL (1) = - SLDPTH (1) + DO KZ = 2,NSOIL + ZSOIL (KZ) = - SLDPTH (KZ) + ZSOIL (KZ -1) + END DO + +! ---------------------------------------------------------------------- +! NEXT IS CRUCIAL CALL TO SET THE LAND-SURFACE PARAMETERS, INCLUDING +! SOIL-TYPE AND VEG-TYPE DEPENDENT PARAMETERS. +! ---------------------------------------------------------------------- + CALL REDPRM (VEGTYP,SOILTYP,SLOPETYP,CFACTR,CMCMAX,RSMAX,TOPT, & + REFKDT,KDT,SBETA, SHDFAC,RSMIN,RGL,HS,ZBOT,FRZX, & + PSISAT,SLOPE,SNUP,SALP,BEXP,DKSAT,DWSAT, & + SMCMAX,SMCWLT,SMCREF,SMCDRY,F1,QUARTZ,FXEXP, & + RTDIS,SLDPTH,ZSOIL,NROOT,NSOIL,CZIL, & + LAIMIN, LAIMAX, EMISSMIN, EMISSMAX, ALBEDOMIN, & + ALBEDOMAX, Z0MIN, Z0MAX, CSOIL, PTU, LLANDUSE, & + LSOIL,LOCAL,LVCOEF,ZTOPV,ZBOTV,errmsg,errflg) + if(errflg > 0) return + +!urban + IF(VEGTYP==ISURBAN)THEN + SHDFAC=0.05 + RSMIN=400.0 + SMCMAX = 0.45 + SMCREF = 0.42 + SMCWLT = 0.40 + SMCDRY = 0.40 + ENDIF + + IF ( SHDFAC >= SHDMAX ) THEN + EMBRD = EMISSMAX + IF (.NOT. RDLAI2D) THEN + XLAI = LAIMAX + ENDIF + IF (.NOT. USEMONALB) THEN + ALB = ALBEDOMIN + ENDIF + Z0BRD = Z0MAX + ELSE IF ( SHDFAC <= SHDMIN ) THEN + EMBRD = EMISSMIN + IF(.NOT. RDLAI2D) THEN + XLAI = LAIMIN + ENDIF + IF(.NOT. USEMONALB) then + ALB = ALBEDOMAX + ENDIF + Z0BRD = Z0MIN + ELSE + + IF ( SHDMAX > SHDMIN ) THEN + + INTERP_FRACTION = ( SHDFAC - SHDMIN ) / ( SHDMAX - SHDMIN ) + ! Bound INTERP_FRACTION between 0 and 1 + INTERP_FRACTION = MIN ( INTERP_FRACTION, 1.0 ) + INTERP_FRACTION = MAX ( INTERP_FRACTION, 0.0 ) + ! Scale Emissivity and LAI between EMISSMIN and EMISSMAX by INTERP_FRACTION + EMBRD = ( ( 1.0 - INTERP_FRACTION ) * EMISSMIN ) + ( INTERP_FRACTION * EMISSMAX ) + IF (.NOT. RDLAI2D) THEN + XLAI = ( ( 1.0 - INTERP_FRACTION ) * LAIMIN ) + ( INTERP_FRACTION * LAIMAX ) + ENDIF + if (.not. USEMONALB) then + ALB = ( ( 1.0 - INTERP_FRACTION ) * ALBEDOMAX ) + ( INTERP_FRACTION * ALBEDOMIN ) + endif + Z0BRD = ( ( 1.0 - INTERP_FRACTION ) * Z0MIN ) + ( INTERP_FRACTION * Z0MAX ) + + ELSE + + EMBRD = 0.5 * EMISSMIN + 0.5 * EMISSMAX + IF (.NOT. RDLAI2D) THEN + XLAI = 0.5 * LAIMIN + 0.5 * LAIMAX + ENDIF + if (.not. USEMONALB) then + ALB = 0.5 * ALBEDOMIN + 0.5 * ALBEDOMAX + endif + Z0BRD = 0.5 * Z0MIN + 0.5 * Z0MAX + + ENDIF + + ENDIF +! ---------------------------------------------------------------------- +! INITIALIZE PRECIPITATION LOGICALS. +! ---------------------------------------------------------------------- + SNOWNG = .FALSE. + FRZGRA = .FALSE. + +! ---------------------------------------------------------------------- +! IF INPUT SNOWPACK IS NONZERO, THEN COMPUTE SNOW DENSITY "SNDENS" AND +! SNOW THERMAL CONDUCTIVITY "SNCOND" (NOTE THAT CSNOW IS A FUNCTION +! SUBROUTINE) +! ---------------------------------------------------------------------- + IF ( SNEQV <= 1.E-7 ) THEN ! safer IF kmh (2008/03/25) + SNEQV = 0.0 + SNDENS = 0.0 + SNOWH = 0.0 + SNCOND = 1.0 + ELSE + SNDENS = SNEQV / SNOWH + IF(SNDENS > 1.0) THEN + errmsg = 'Physical snow depth is less than snow water equiv.' + errflg = 1 + return + ENDIF + CALL CSNOW (SNCOND,SNDENS) + END IF +! ---------------------------------------------------------------------- +! DETERMINE IF IT'S PRECIPITATING AND WHAT KIND OF PRECIP IT IS. +! IF IT'S PRCPING AND THE AIR TEMP IS COLDER THAN 0 C, IT'S SNOWING! +! IF IT'S PRCPING AND THE AIR TEMP IS WARMER THAN 0 C, BUT THE GRND +! TEMP IS COLDER THAN 0 C, FREEZING RAIN IS PRESUMED TO BE FALLING. +! ---------------------------------------------------------------------- + IF (PRCP > 0.0) THEN +! snow defined when fraction of frozen precip (FFROZP) > 0.5, +! passed in from model microphysics. + IF (FFROZP .GT. 0.5) THEN + SNOWNG = .TRUE. + ELSE + IF (T1 <= TFREEZ) FRZGRA = .TRUE. + END IF + END IF +! ---------------------------------------------------------------------- +! IF EITHER PRCP FLAG IS SET, DETERMINE NEW SNOWFALL (CONVERTING PRCP +! RATE FROM KG M-2 S-1 TO A LIQUID EQUIV SNOW DEPTH IN METERS) AND ADD +! IT TO THE EXISTING SNOWPACK. +! NOTE THAT SINCE ALL PRECIP IS ADDED TO SNOWPACK, NO PRECIP INFILTRATES +! INTO THE SOIL SO THAT PRCP1 IS SET TO ZERO. +! ---------------------------------------------------------------------- + IF ( (SNOWNG) .OR. (FRZGRA) ) THEN + SN_NEW = PRCP * DT * 0.001 + SNEQV = SNEQV + SN_NEW + PRCPF = 0.0 + +! ---------------------------------------------------------------------- +! UPDATE SNOW DENSITY BASED ON NEW SNOWFALL, USING OLD AND NEW SNOW. +! UPDATE SNOW THERMAL CONDUCTIVITY +! ---------------------------------------------------------------------- + CALL SNOW_NEW (SFCTMP,SN_NEW,SNOWH,SNDENS) + CALL CSNOW (SNCOND,SNDENS) + +! ---------------------------------------------------------------------- +! PRECIP IS LIQUID (RAIN), HENCE SAVE IN THE PRECIP VARIABLE THAT +! LATER CAN WHOLELY OR PARTIALLY INFILTRATE THE SOIL (ALONG WITH +! ANY CANOPY "DRIP" ADDED TO THIS LATER) +! ---------------------------------------------------------------------- + ELSE + PRCPF = PRCP + ENDIF +! ---------------------------------------------------------------------- +! DETERMINE SNOWCOVER AND ALBEDO OVER LAND. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! IF SNOW DEPTH=0, SET SNOW FRACTION=0, ALBEDO=SNOW FREE ALBEDO. +! ---------------------------------------------------------------------- + IF (SNEQV == 0.0) THEN + SNCOVR = 0.0 + ALBEDO = ALB + EMISSI = EMBRD + IF(UA_PHYS) FGSN = 0.0 + IF(UA_PHYS) FVB = 0.0 + IF(UA_PHYS) FBUR = 0.0 + ELSE +! ---------------------------------------------------------------------- +! DETERMINE SNOW FRACTIONAL COVERAGE. +! DETERMINE SURFACE ALBEDO MODIFICATION DUE TO SNOWDEPTH STATE. +! ---------------------------------------------------------------------- + CALL SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR, & + XLAI,SHDFAC,FVB,GAMA,FBUR, & + FGSN,ZTOPV,ZBOTV,UA_PHYS) + + IF ( UA_PHYS ) then + IF(SFCTMP <= T1) THEN + RU = 0. + ELSE + RU = 100.*SHDFAC*FGSN*MIN((SFCTMP-T1)/5., 1.)*(1.-EXP(-XLAI)) + ENDIF + CH = CH/(1.+RU*CH) + ENDIF + + SNCOVR = MIN(SNCOVR,0.98) + + CALL ALCALC (ALB,SNOALB,EMBRD,SHDFAC,SHDMIN,SNCOVR,T1, & + ALBEDO,EMISSI,DT,SNOWNG,SNOTIME1,LVCOEF) + ENDIF +! ---------------------------------------------------------------------- +! NEXT CALCULATE THE SUBSURFACE HEAT FLUX, WHICH FIRST REQUIRES +! CALCULATION OF THE THERMAL DIFFUSIVITY. TREATMENT OF THE +! LATTER FOLLOWS THAT ON PAGES 148-149 FROM "HEAT TRANSFER IN +! COLD CLIMATES", BY V. J. LUNARDINI (PUBLISHED IN 1981 +! BY VAN NOSTRAND REINHOLD CO.) I.E. TREATMENT OF TWO CONTIGUOUS +! "PLANE PARALLEL" MEDIUMS (NAMELY HERE THE FIRST SOIL LAYER +! AND THE SNOWPACK LAYER, IF ANY). THIS DIFFUSIVITY TREATMENT +! BEHAVES WELL FOR BOTH ZERO AND NONZERO SNOWPACK, INCLUDING THE +! LIMIT OF VERY THIN SNOWPACK. THIS TREATMENT ALSO ELIMINATES +! THE NEED TO IMPOSE AN ARBITRARY UPPER BOUND ON SUBSURFACE +! HEAT FLUX WHEN THE SNOWPACK BECOMES EXTREMELY THIN. +! ---------------------------------------------------------------------- +! FIRST CALCULATE THERMAL DIFFUSIVITY OF TOP SOIL LAYER, USING +! BOTH THE FROZEN AND LIQUID SOIL MOISTURE, FOLLOWING THE +! SOIL THERMAL DIFFUSIVITY FUNCTION OF PETERS-LIDARD ET AL. +! (1998,JAS, VOL 55, 1209-1224), WHICH REQUIRES THE SPECIFYING +! THE QUARTZ CONTENT OF THE GIVEN SOIL CLASS (SEE ROUTINE REDPRM) +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! NEXT ADD SUBSURFACE HEAT FLUX REDUCTION EFFECT FROM THE +! OVERLYING GREEN CANOPY, ADAPTED FROM SECTION 2.1.2 OF +! PETERS-LIDARD ET AL. (1997, JGR, VOL 102(D4)) +! ---------------------------------------------------------------------- + CALL TDFCND (DF1,SMC (1),QUARTZ,SMCMAX,SH2O (1),BEXP, PSISAT, SOILTYP, OPT_THCND) + +!urban + IF ( VEGTYP == ISURBAN ) DF1=3.24 + + DF1 = DF1 * EXP (SBETA * SHDFAC) +! +! kmh 09/03/2006 +! kmh 03/25/2008 change SNCOVR threshold to 0.97 +! + IF ( SNCOVR .GT. 0.97 ) THEN + DF1 = SNCOND + ENDIF +! +! ---------------------------------------------------------------------- +! FINALLY "PLANE PARALLEL" SNOWPACK EFFECT FOLLOWING +! V.J. LINARDINI REFERENCE CITED ABOVE. NOTE THAT DTOT IS +! COMBINED DEPTH OF SNOWDEPTH AND THICKNESS OF FIRST SOIL LAYER +! ---------------------------------------------------------------------- + + DSOIL = - (0.5 * ZSOIL (1)) + IF (SNEQV == 0.) THEN + SSOIL = DF1 * (T1- STC (1) ) / DSOIL + ELSE + DTOT = SNOWH + DSOIL + FRCSNO = SNOWH / DTOT + +! 1. HARMONIC MEAN (SERIES FLOW) +! DF1 = (SNCOND*DF1)/(FRCSOI*SNCOND+FRCSNO*DF1) + FRCSOI = DSOIL / DTOT +! 2. ARITHMETIC MEAN (PARALLEL FLOW) +! DF1 = FRCSNO*SNCOND + FRCSOI*DF1 + DF1H = (SNCOND * DF1)/ (FRCSOI * SNCOND+ FRCSNO * DF1) + +! 3. GEOMETRIC MEAN (INTERMEDIATE BETWEEN HARMONIC AND ARITHMETIC MEAN) +! DF1 = (SNCOND**FRCSNO)*(DF1**FRCSOI) +! weigh DF by snow fraction +! DF1 = DF1H*SNCOVR + DF1A*(1.0-SNCOVR) +! DF1 = DF1H*SNCOVR + DF1*(1.0-SNCOVR) + DF1A = FRCSNO * SNCOND+ FRCSOI * DF1 + +! ---------------------------------------------------------------------- +! CALCULATE SUBSURFACE HEAT FLUX, SSOIL, FROM FINAL THERMAL DIFFUSIVITY +! OF SURFACE MEDIUMS, DF1 ABOVE, AND SKIN TEMPERATURE AND TOP +! MID-LAYER SOIL TEMPERATURE +! ---------------------------------------------------------------------- + DF1 = DF1A * SNCOVR + DF1* (1.0- SNCOVR) + SSOIL = DF1 * (T1- STC (1) ) / DTOT + END IF +! ---------------------------------------------------------------------- +! DETERMINE SURFACE ROUGHNESS OVER SNOWPACK USING SNOW CONDITION FROM +! THE PREVIOUS TIMESTEP. +! ---------------------------------------------------------------------- + IF (SNCOVR > 0. ) THEN + CALL SNOWZ0 (SNCOVR,Z0,Z0BRD,SNOWH,FBUR,FGSN,SHDMAX,UA_PHYS) + ELSE + Z0=Z0BRD + IF(UA_PHYS) CALL SNOWZ0 (SNCOVR,Z0,Z0BRD,SNOWH,FBUR,FGSN, & + SHDMAX,UA_PHYS) + END IF +! ---------------------------------------------------------------------- +! NEXT CALL ROUTINE SFCDIF TO CALCULATE THE SFC EXCHANGE COEF (CH) FOR +! HEAT AND MOISTURE. + +! NOTE !!! +! DO NOT CALL SFCDIF UNTIL AFTER ABOVE CALL TO REDPRM, IN CASE +! ALTERNATIVE VALUES OF ROUGHNESS LENGTH (Z0) AND ZILINTINKEVICH COEF +! (CZIL) ARE SET THERE VIA NAMELIST I/O. + +! NOTE !!! +! ROUTINE SFCDIF RETURNS A CH THAT REPRESENTS THE WIND SPD TIMES THE +! "ORIGINAL" NONDIMENSIONAL "Ch" TYPICAL IN LITERATURE. HENCE THE CH +! RETURNED FROM SFCDIF HAS UNITS OF M/S. THE IMPORTANT COMPANION +! COEFFICIENT OF CH, CARRIED HERE AS "RCH", IS THE CH FROM SFCDIF TIMES +! AIR DENSITY AND PARAMETER "CP". "RCH" IS COMPUTED IN "CALL PENMAN". +! RCH RATHER THAN CH IS THE COEFF USUALLY INVOKED LATER IN EQNS. + +! NOTE !!! +! ---------------------------------------------------------------------- +! SFCDIF ALSO RETURNS THE SURFACE EXCHANGE COEFFICIENT FOR MOMENTUM, CM, +! ALSO KNOWN AS THE SURFACE DRAGE COEFFICIENT. Needed as a state variable +! for iterative/implicit solution of CH in SFCDIF +! ---------------------------------------------------------------------- +! IF(.NOT.LCH) THEN +! T1V = T1 * (1.0+ 0.61 * Q2) +! TH2V = TH2 * (1.0+ 0.61 * Q2) +! CALL SFCDIF_off (ZLVL,Z0,T1V,TH2V,SFCSPD,CZIL,CM,CH) +! ENDIF + +! ---------------------------------------------------------------------- +! CALL PENMAN SUBROUTINE TO CALCULATE POTENTIAL EVAPORATION (ETP), AND +! OTHER PARTIAL PRODUCTS AND SUMS SAVE IN COMMON/RITE FOR LATER +! CALCULATIONS. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! CALCULATE TOTAL DOWNWARD RADIATION (SOLAR PLUS LONGWAVE) NEEDED IN +! PENMAN EP SUBROUTINE THAT FOLLOWS +! ---------------------------------------------------------------------- +! FDOWN = SOLDN * (1.0- ALBEDO) + LWDN + FDOWN = SOLNET + LWDN +! ---------------------------------------------------------------------- +! CALC VIRTUAL TEMPS AND VIRTUAL POTENTIAL TEMPS NEEDED BY SUBROUTINES +! PENMAN. + T2V = SFCTMP * (1.0+ 0.61 * Q2 ) + + iout=0 + if(iout.eq.1) then + print*,'before penman' + print*,' SFCTMP',SFCTMP,'SFCPRS',SFCPRS,'CH',CH,'T2V',T2V, & + 'TH2',TH2,'PRCP',PRCP,'FDOWN',FDOWN,'T24',T24,'SSOIL',SSOIL, & + 'Q2',Q2,'Q2SAT',Q2SAT,'ETP',ETP,'RCH',RCH, & + 'EPSCA',EPSCA,'RR',RR ,'SNOWNG',SNOWNG,'FRZGRA',FRZGRA, & + 'DQSDT2',DQSDT2,'FLX2',FLX2,'SNOWH',SNOWH,'SNEQV',SNEQV, & + ' DSOIL',DSOIL,' FRCSNO',FRCSNO,' SNCOVR',SNCOVR,' DTOT',DTOT, & + ' ZSOIL (1)',ZSOIL(1),' DF1',DF1,'T1',T1,' STC1',STC(1), & + 'ALBEDO',ALBEDO,'SMC',SMC,'STC',STC,'SH2O',SH2O + endif + + CALL PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, & + Q2,Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA, & + DQSDT2,FLX2,EMISSI,SNEQV,T1,SNCOVR,AOASIS, & + ALBEDO,SOLDN,FVB,GAMA,STC(1),ETPN,FLX4,UA_PHYS, & + CP,RD,SIGMA,CPH2O,CPICE,LSUBF) +! +! ---------------------------------------------------------------------- +! CALL CANRES TO CALCULATE THE CANOPY RESISTANCE AND CONVERT IT INTO PC +! IF NONZERO GREENNESS FRACTION +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! FROZEN GROUND EXTENSION: TOTAL SOIL WATER "SMC" WAS REPLACED +! BY UNFROZEN SOIL WATER "SH2O" IN CALL TO CANRES BELOW +! ---------------------------------------------------------------------- + IF ( (SHDFAC > 0.) .AND. (XLAI > 0.) ) THEN + CALL CANRES (SOLDN,CH,SFCTMP,Q2,SFCPRS,SH2O,ZSOIL,NSOIL, & + SMCWLT,SMCREF,RSMIN,RC,PC,NROOT,Q2SAT,DQSDT2, & + TOPT,RSMAX,RGL,HS,XLAI, & + RCS,RCT,RCQ,RCSOIL,EMISSI,CP,RD,SIGMA) + ELSE + RC = 0.0 + END IF +! ---------------------------------------------------------------------- +! NOW DECIDE MAJOR PATHWAY BRANCH TO TAKE DEPENDING ON WHETHER SNOWPACK +! EXISTS OR NOT: +! ---------------------------------------------------------------------- + ESNOW = 0.0 + IF (SNEQV == 0.0) THEN + CALL NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT, & + SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT, & + SHDFAC, & + SBETA,Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,EMISSI, & + SSOIL, & + STC,EPSCA,BEXP,PC,RCH,RR,CFACTR, & + SH2O,SLOPE,KDT,FRZX,PSISAT,ZSOIL, & + DKSAT,DWSAT,TBOT,ZBOT,RUNOFF1,RUNOFF2, & + RUNOFF3,EDIR,EC,ET,ETT,NROOT,RTDIS, & + QUARTZ,FXEXP,CSOIL, & + BETA,DRIP,DEW,FLX1,FLX3,VEGTYP,ISURBAN, & + SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND & + ,XSDA_QFX,QFX_PHY,XQNORM,fasdas,HCPCT_FASDAS, & !fasdas + SIGMA,CPH2O) + ETA_KINEMATIC = ETA + ELSE + CALL SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT, & + SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT, & + SBETA,DF1, & + Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,SSOIL,STC,EPSCA, & + SFCPRS,BEXP,PC,RCH,RR,CFACTR,SNCOVR,SNEQV,SNDENS,& + SNOWH,SH2O,SLOPE,KDT,FRZX,PSISAT, & + ZSOIL,DWSAT,DKSAT,TBOT,ZBOT,SHDFAC,RUNOFF1, & + RUNOFF2,RUNOFF3,EDIR,EC,ET,ETT,NROOT,SNOMLT, & + RTDIS,QUARTZ,FXEXP,CSOIL, & + BETA,DRIP,DEW,FLX1,FLX2,FLX3,ESNOW,ETNS,EMISSI, & + RIBB,SOLDN, & + ISURBAN, & + VEGTYP, & + ETPN,FLX4,UA_PHYS, & + SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND & + ,QFX_PHY,fasdas,HCPCT_FASDAS,SIGMA,CPH2O,CPICE, & !fasdas + LSUBF) + ETA_KINEMATIC = ESNOW + ETNS - 1000.0*DEW + END IF + +! Calculate effective mixing ratio at grnd level (skin) +! +! Q1=Q2+ETA*CP/RCH + Q1=Q2+ETA_KINEMATIC*CP/RCH +! +! ---------------------------------------------------------------------- +! DETERMINE SENSIBLE HEAT (H) IN ENERGY UNITS (W M-2) +! ---------------------------------------------------------------------- + + SHEAT = - (CH * CP * SFCPRS)/ (R * T2V) * ( TH2- T1 ) + IF(UA_PHYS) SHEAT = SHEAT + FLX4 +! +! FASDAS +! + IF ( fasdas == 1 ) THEN + HFX_PHY = SHEAT + ENDIF +! +! END FASDAS +! +! ---------------------------------------------------------------------- +! CONVERT EVAP TERMS FROM KINEMATIC (KG M-2 S-1) TO ENERGY UNITS (W M-2) +! ---------------------------------------------------------------------- + EDIR = EDIR * LVH2O + EC = EC * LVH2O + DO K=1,4 + ET(K) = ET(K) * LVH2O + ENDDO + ETT = ETT * LVH2O + + ETPND1=ETPND1 * LVH2O + + ESNOW = ESNOW * LSUBS + ETP = ETP*((1.-SNCOVR)*LVH2O + SNCOVR*LSUBS) + IF(UA_PHYS) ETPN = ETPN*((1.-SNCOVR)*LVH2O + SNCOVR*LSUBS) + IF (ETP .GT. 0.) THEN + ETA = EDIR + EC + ETT + ESNOW + ELSE + ETA = ETP + ENDIF +! ---------------------------------------------------------------------- +! DETERMINE BETA (RATIO OF ACTUAL TO POTENTIAL EVAP) +! ---------------------------------------------------------------------- + IF (ETP == 0.0) THEN + BETA = 0.0 + ELSE + BETA = ETA/ETP + ENDIF + +! ---------------------------------------------------------------------- +! CONVERT THE SIGN OF SOIL HEAT FLUX SO THAT: +! SSOIL>0: WARM THE SURFACE (NIGHT TIME) +! SSOIL<0: COOL THE SURFACE (DAY TIME) +! ---------------------------------------------------------------------- + SSOIL = -1.0* SSOIL + +! ---------------------------------------------------------------------- +! FOR THE CASE OF LAND: +! CONVERT RUNOFF3 (INTERNAL LAYER RUNOFF FROM SUPERSAT) FROM M TO M S-1 +! AND ADD TO SUBSURFACE RUNOFF/DRAINAGE/BASEFLOW. RUNOFF2 IS ALREADY +! A RATE AT THIS POINT +! ---------------------------------------------------------------------- + RUNOFF3 = RUNOFF3/ DT + RUNOFF2 = RUNOFF2+ RUNOFF3 + SOILM = -1.0* SMC (1)* ZSOIL (1) + DO K = 2,NSOIL + SOILM = SOILM + SMC (K)* (ZSOIL (K -1) - ZSOIL (K)) + END DO + SOILWM = -1.0* (SMCMAX - SMCWLT)* ZSOIL (1) + SOILWW = -1.0* (SMC (1) - SMCWLT)* ZSOIL (1) + + DO K = 1,NSOIL + SMAV(K)=(SMC(K) - SMCWLT)/(SMCMAX - SMCWLT) + END DO + + IF (NROOT >= 2) THEN + DO K = 2,NROOT + SOILWM = SOILWM + (SMCMAX - SMCWLT)* (ZSOIL (K -1) - ZSOIL (K)) + SOILWW = SOILWW + (SMC(K) - SMCWLT)* (ZSOIL (K -1) - ZSOIL (K)) + END DO + END IF + IF (SOILWM .LT. 1.E-6) THEN + SOILWM = 0.0 + SOILW = 0.0 + SOILM = 0.0 + ELSE + SOILW = SOILWW / SOILWM + END IF + +! ---------------------------------------------------------------------- + END SUBROUTINE SFLX +! ---------------------------------------------------------------------- + + SUBROUTINE ALCALC (ALB,SNOALB,EMBRD,SHDFAC,SHDMIN,SNCOVR,TSNOW,ALBEDO,EMISSI, & + DT,SNOWNG,SNOTIME1,LVCOEF) + +! ---------------------------------------------------------------------- +! CALCULATE ALBEDO INCLUDING SNOW EFFECT (0 -> 1) +! ALB SNOWFREE ALBEDO +! SNOALB MAXIMUM (DEEP) SNOW ALBEDO +! SHDFAC AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION +! SHDMIN MINIMUM AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION +! SNCOVR FRACTIONAL SNOW COVER +! ALBEDO SURFACE ALBEDO INCLUDING SNOW EFFECT +! TSNOW SNOW SURFACE TEMPERATURE (K) +! ---------------------------------------------------------------------- + IMPLICIT NONE + +! ---------------------------------------------------------------------- +! SNOALB IS ARGUMENT REPRESENTING MAXIMUM ALBEDO OVER DEEP SNOW, +! AS PASSED INTO SFLX, AND ADAPTED FROM THE SATELLITE-BASED MAXIMUM +! SNOW ALBEDO FIELDS PROVIDED BY D. ROBINSON AND G. KUKLA +! (1985, JCAM, VOL 24, 402-411) +! ---------------------------------------------------------------------- + REAL, INTENT(IN) :: ALB, SNOALB, EMBRD, SHDFAC, SHDMIN, SNCOVR, TSNOW + REAL, INTENT(IN) :: DT + LOGICAL, INTENT(IN) :: SNOWNG + REAL, INTENT(INOUT):: SNOTIME1 + REAL, INTENT(OUT) :: ALBEDO, EMISSI + REAL :: SNOALB2 + REAL :: TM,SNOALB1 + REAL, INTENT(IN) :: LVCOEF + REAL, PARAMETER :: SNACCA=0.94,SNACCB=0.58,SNTHWA=0.82,SNTHWB=0.46 +! turn of vegetation effect +! ALBEDO = ALB + (1.0- (SHDFAC - SHDMIN))* SNCOVR * (SNOALB - ALB) +! ALBEDO = (1.0-SNCOVR)*ALB + SNCOVR*SNOALB !this is equivalent to below + ALBEDO = ALB + SNCOVR*(SNOALB-ALB) + EMISSI = EMBRD + SNCOVR*(EMISSI_S - EMBRD) + +! BASE FORMULATION (DICKINSON ET AL., 1986, COGLEY ET AL., 1990) +! IF (TSNOW.LE.263.16) THEN +! ALBEDO=SNOALB +! ELSE +! IF (TSNOW.LT.273.16) THEN +! TM=0.1*(TSNOW-263.16) +! SNOALB1=0.5*((0.9-0.2*(TM**3))+(0.8-0.16*(TM**3))) +! ELSE +! SNOALB1=0.67 +! IF(SNCOVR.GT.0.95) SNOALB1= 0.6 +! SNOALB1 = ALB + SNCOVR*(SNOALB-ALB) +! ENDIF +! ENDIF +! ALBEDO = ALB + SNCOVR*(SNOALB1-ALB) + +! ISBA FORMULATION (VERSEGHY, 1991; BAKER ET AL., 1990) +! SNOALB1 = SNOALB+COEF*(0.85-SNOALB) +! SNOALB2=SNOALB1 +!!m LSTSNW=LSTSNW+1 +! SNOTIME1 = SNOTIME1 + DT +! IF (SNOWNG) THEN +! SNOALB2=SNOALB +!!m LSTSNW=0 +! SNOTIME1 = 0.0 +! ELSE +! IF (TSNOW.LT.273.16) THEN +!! SNOALB2=SNOALB-0.008*LSTSNW*DT/86400 +!!m SNOALB2=SNOALB-0.008*SNOTIME1/86400 +! SNOALB2=(SNOALB2-0.65)*EXP(-0.05*DT/3600)+0.65 +!! SNOALB2=(ALBEDO-0.65)*EXP(-0.01*DT/3600)+0.65 +! ELSE +! SNOALB2=(SNOALB2-0.5)*EXP(-0.0005*DT/3600)+0.5 +!! SNOALB2=(SNOALB-0.5)*EXP(-0.24*LSTSNW*DT/86400)+0.5 +!!m SNOALB2=(SNOALB-0.5)*EXP(-0.24*SNOTIME1/86400)+0.5 +! ENDIF +! ENDIF +! +!! print*,'SNOALB2',SNOALB2,'ALBEDO',ALBEDO,'DT',DT +! ALBEDO = ALB + SNCOVR*(SNOALB2-ALB) +! IF (ALBEDO .GT. SNOALB2) ALBEDO=SNOALB2 +!!m LSTSNW1=LSTSNW +!! SNOTIME = SNOTIME1 + +! formulation by Livneh +! ---------------------------------------------------------------------- +! SNOALB IS CONSIDERED AS THE MAXIMUM SNOW ALBEDO FOR NEW SNOW, AT +! A VALUE OF 85%. SNOW ALBEDO CURVE DEFAULTS ARE FROM BRAS P.263. SHOULD +! NOT BE CHANGED EXCEPT FOR SERIOUS PROBLEMS WITH SNOW MELT. +! TO IMPLEMENT ACCUMULATIN PARAMETERS, SNACCA AND SNACCB, ASSERT THAT IT +! IS INDEED ACCUMULATION SEASON. I.E. THAT SNOW SURFACE TEMP IS BELOW +! ZERO AND THE DATE FALLS BETWEEN OCTOBER AND FEBRUARY +! ---------------------------------------------------------------------- + SNOALB1 = SNOALB+LVCOEF*(0.85-SNOALB) + SNOALB2=SNOALB1 +! ---------------- Initial LSTSNW -------------------------------------- + IF (SNOWNG) THEN + SNOTIME1 = 0. + ELSE + SNOTIME1=SNOTIME1+DT +! IF (TSNOW.LT.273.16) THEN + SNOALB2=SNOALB1*(SNACCA**((SNOTIME1/86400.0)**SNACCB)) +! ELSE +! SNOALB2 =SNOALB1*(SNTHWA**((SNOTIME1/86400.0)**SNTHWB)) +! ENDIF + ENDIF +! + SNOALB2 = MAX ( SNOALB2, ALB ) + ALBEDO = ALB + SNCOVR*(SNOALB2-ALB) + IF (ALBEDO .GT. SNOALB2) ALBEDO=SNOALB2 + +! IF (TSNOW.LT.273.16) THEN +! ALBEDO=SNOALB-0.008*DT/86400 +! ELSE +! ALBEDO=(SNOALB-0.5)*EXP(-0.24*DT/86400)+0.5 +! ENDIF + +! IF (ALBEDO > SNOALB) ALBEDO = SNOALB + +! ---------------------------------------------------------------------- + END SUBROUTINE ALCALC +! ---------------------------------------------------------------------- + + SUBROUTINE CANRES (SOLAR,CH,SFCTMP,Q2,SFCPRS,SMC,ZSOIL,NSOIL, & + SMCWLT,SMCREF,RSMIN,RC,PC,NROOT,Q2SAT,DQSDT2, & + TOPT,RSMAX,RGL,HS,XLAI, & + RCS,RCT,RCQ,RCSOIL,EMISSI,CP,RD,SIGMA) + +! ---------------------------------------------------------------------- +! SUBROUTINE CANRES +! ---------------------------------------------------------------------- +! CALCULATE CANOPY RESISTANCE WHICH DEPENDS ON INCOMING SOLAR RADIATION, +! AIR TEMPERATURE, ATMOSPHERIC WATER VAPOR PRESSURE DEFICIT AT THE +! LOWEST MODEL LEVEL, AND SOIL MOISTURE (PREFERABLY UNFROZEN SOIL +! MOISTURE RATHER THAN TOTAL) +! ---------------------------------------------------------------------- +! SOURCE: JARVIS (1976), NOILHAN AND PLANTON (1989, MWR), JACQUEMIN AND +! NOILHAN (1990, BLM) +! SEE ALSO: CHEN ET AL (1996, JGR, VOL 101(D3), 7251-7268), EQNS 12-14 +! AND TABLE 2 OF SEC. 3.1.2 +! ---------------------------------------------------------------------- +! INPUT: +! SOLAR INCOMING SOLAR RADIATION +! CH SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE +! SFCTMP AIR TEMPERATURE AT 1ST LEVEL ABOVE GROUND +! Q2 AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND +! Q2SAT SATURATION AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND +! DQSDT2 SLOPE OF SATURATION HUMIDITY FUNCTION WRT TEMP +! SFCPRS SURFACE PRESSURE +! SMC VOLUMETRIC SOIL MOISTURE +! ZSOIL SOIL DEPTH (NEGATIVE SIGN, AS IT IS BELOW GROUND) +! NSOIL NO. OF SOIL LAYERS +! NROOT NO. OF SOIL LAYERS IN ROOT ZONE (1.LE.NROOT.LE.NSOIL) +! XLAI LEAF AREA INDEX +! SMCWLT WILTING POINT +! SMCREF REFERENCE SOIL MOISTURE (WHERE SOIL WATER DEFICIT STRESS +! SETS IN) +! RSMIN, RSMAX, TOPT, RGL, HS ARE CANOPY STRESS PARAMETERS SET IN +! SURBOUTINE REDPRM +! CP specific heat of dry air at constant pressure +! OUTPUT: +! PC PLANT COEFFICIENT +! RC CANOPY RESISTANCE +! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTEGER, INTENT(IN) :: NROOT,NSOIL + INTEGER K + REAL, INTENT(IN) :: CH,DQSDT2,HS,Q2,Q2SAT,RSMIN,RGL,RSMAX, & + SFCPRS,SFCTMP,SMCREF,SMCWLT, SOLAR,TOPT,XLAI, & + EMISSI, CP, RD, SIGMA + REAL,DIMENSION(1:NSOIL), INTENT(IN) :: SMC,ZSOIL + REAL, INTENT(OUT):: PC,RC,RCQ,RCS,RCSOIL,RCT + REAL :: DELTA,FF,GX,P,RR + REAL, DIMENSION(1:NSOIL) :: PART + REAL, PARAMETER :: SLV = 2.501000E6 + + +! ---------------------------------------------------------------------- +! INITIALIZE CANOPY RESISTANCE MULTIPLIER TERMS. +! ---------------------------------------------------------------------- + RCS = 0.0 + RCT = 0.0 + RCQ = 0.0 + RCSOIL = 0.0 + +! ---------------------------------------------------------------------- +! CONTRIBUTION DUE TO INCOMING SOLAR RADIATION +! ---------------------------------------------------------------------- + RC = 0.0 + FF = 0.55*2.0* SOLAR / (RGL * XLAI) + RCS = (FF + RSMIN / RSMAX) / (1.0+ FF) + +! ---------------------------------------------------------------------- +! CONTRIBUTION DUE TO AIR TEMPERATURE AT FIRST MODEL LEVEL ABOVE GROUND +! RCT EXPRESSION FROM NOILHAN AND PLANTON (1989, MWR). +! ---------------------------------------------------------------------- + RCS = MAX (RCS,0.0001) + RCT = 1.0- 0.0016* ( (TOPT - SFCTMP)**2.0) + +! ---------------------------------------------------------------------- +! CONTRIBUTION DUE TO VAPOR PRESSURE DEFICIT AT FIRST MODEL LEVEL. +! RCQ EXPRESSION FROM SSIB +! ---------------------------------------------------------------------- + RCT = MAX (RCT,0.0001) + RCQ = 1.0/ (1.0+ HS * (Q2SAT - Q2)) + +! ---------------------------------------------------------------------- +! CONTRIBUTION DUE TO SOIL MOISTURE AVAILABILITY. +! DETERMINE CONTRIBUTION FROM EACH SOIL LAYER, THEN ADD THEM UP. +! ---------------------------------------------------------------------- + RCQ = MAX (RCQ,0.01) + GX = (SMC (1) - SMCWLT) / (SMCREF - SMCWLT) + IF (GX > 1.) GX = 1. + IF (GX < 0.) GX = 0. + +! ---------------------------------------------------------------------- +! USE SOIL DEPTH AS WEIGHTING FACTOR +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! USE ROOT DISTRIBUTION AS WEIGHTING FACTOR +! PART(1) = RTDIS(1) * GX +! ---------------------------------------------------------------------- + PART (1) = (ZSOIL (1)/ ZSOIL (NROOT)) * GX + DO K = 2,NROOT + GX = (SMC (K) - SMCWLT) / (SMCREF - SMCWLT) + IF (GX > 1.) GX = 1. + IF (GX < 0.) GX = 0. +! ---------------------------------------------------------------------- +! USE SOIL DEPTH AS WEIGHTING FACTOR +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! USE ROOT DISTRIBUTION AS WEIGHTING FACTOR +! PART(K) = RTDIS(K) * GX +! ---------------------------------------------------------------------- + PART (K) = ( (ZSOIL (K) - ZSOIL (K -1))/ ZSOIL (NROOT)) * GX + END DO + DO K = 1,NROOT + RCSOIL = RCSOIL + PART (K) + END DO + +! ---------------------------------------------------------------------- +! DETERMINE CANOPY RESISTANCE DUE TO ALL FACTORS. CONVERT CANOPY +! RESISTANCE (RC) TO PLANT COEFFICIENT (PC) TO BE USED WITH POTENTIAL +! EVAP IN DETERMINING ACTUAL EVAP. PC IS DETERMINED BY: +! PC * LINERIZED PENMAN POTENTIAL EVAP = +! PENMAN-MONTEITH ACTUAL EVAPORATION (CONTAINING RC TERM). +! ---------------------------------------------------------------------- + RCSOIL = MAX (RCSOIL,0.0001) + + RC = RSMIN / (XLAI * RCS * RCT * RCQ * RCSOIL) +! RR = (4.* SIGMA * RD / CP)* (SFCTMP **4.)/ (SFCPRS * CH) + 1.0 + RR = (4.* EMISSI *SIGMA * RD / CP)* (SFCTMP **4.)/ (SFCPRS * CH) & + + 1.0 + + DELTA = (SLV / CP)* DQSDT2 + + PC = (RR + DELTA)/ (RR * (1. + RC * CH) + DELTA) + +! ---------------------------------------------------------------------- + END SUBROUTINE CANRES +! ---------------------------------------------------------------------- + + SUBROUTINE CSNOW (SNCOND,DSNOW) + +! ---------------------------------------------------------------------- +! SUBROUTINE CSNOW +! FUNCTION CSNOW +! ---------------------------------------------------------------------- +! CALCULATE SNOW TERMAL CONDUCTIVITY +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: DSNOW + REAL, INTENT(OUT):: SNCOND + REAL :: C + REAL, PARAMETER :: UNIT = 0.11631 + +! ---------------------------------------------------------------------- +! SNCOND IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C) +! CSNOW IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C) +! BASIC VERSION IS DYACHKOVA EQUATION (1960), FOR RANGE 0.1-0.4 +! ---------------------------------------------------------------------- + C = 0.328*10** (2.25* DSNOW) +! CSNOW=UNIT*C + +! ---------------------------------------------------------------------- +! DE VAUX EQUATION (1933), IN RANGE 0.1-0.6 +! ---------------------------------------------------------------------- +! SNCOND=0.0293*(1.+100.*DSNOW**2) +! CSNOW=0.0293*(1.+100.*DSNOW**2) + +! ---------------------------------------------------------------------- +! E. ANDERSEN FROM FLERCHINGER +! ---------------------------------------------------------------------- +! SNCOND=0.021+2.51*DSNOW**2 +! CSNOW=0.021+2.51*DSNOW**2 + +! SNCOND = UNIT * C +! double snow thermal conductivity + SNCOND = 2.0 * UNIT * C + +! ---------------------------------------------------------------------- + END SUBROUTINE CSNOW +! ---------------------------------------------------------------------- + SUBROUTINE DEVAP (EDIR,ETP1,SMC,ZSOIL,SHDFAC,SMCMAX,BEXP, & + DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP) + +! ---------------------------------------------------------------------- +! SUBROUTINE DEVAP +! FUNCTION DEVAP +! ---------------------------------------------------------------------- +! CALCULATE DIRECT SOIL EVAPORATION +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: ETP1,SMC,BEXP,DKSAT,DWSAT,FXEXP, & + SHDFAC,SMCDRY,SMCMAX,ZSOIL,SMCREF,SMCWLT + REAL, INTENT(OUT):: EDIR + REAL :: FX, SRATIO + + +! ---------------------------------------------------------------------- +! DIRECT EVAP A FUNCTION OF RELATIVE SOIL MOISTURE AVAILABILITY, LINEAR +! WHEN FXEXP=1. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! FX > 1 REPRESENTS DEMAND CONTROL +! FX < 1 REPRESENTS FLUX CONTROL +! ---------------------------------------------------------------------- + + SRATIO = (SMC - SMCDRY) / (SMCMAX - SMCDRY) + IF (SRATIO > 0.) THEN + FX = SRATIO**FXEXP + FX = MAX ( MIN ( FX, 1. ) ,0. ) + ELSE + FX = 0. + ENDIF + +! ---------------------------------------------------------------------- +! ALLOW FOR THE DIRECT-EVAP-REDUCING EFFECT OF SHADE +! ---------------------------------------------------------------------- + EDIR = FX * ( 1.0- SHDFAC ) * ETP1 + +! ---------------------------------------------------------------------- + END SUBROUTINE DEVAP + + SUBROUTINE DEVAP_hydro (EDIR,ETP1,SMC,ZSOIL,SHDFAC,SMCMAX,BEXP, & + DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP, & + SFHEAD1RT,ETPND1,DT) + +! ---------------------------------------------------------------------- +! SUBROUTINE DEVAP +! FUNCTION DEVAP +! ---------------------------------------------------------------------- +! CALCULATE DIRECT SOIL EVAPORATION +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: ETP1,SMC,BEXP,DKSAT,DWSAT,FXEXP, & + SHDFAC,SMCDRY,SMCMAX,ZSOIL,SMCREF,SMCWLT + REAL, INTENT(OUT):: EDIR + REAL :: FX, SRATIO + + REAL, INTENT(INOUT) :: SFHEAD1RT,ETPND1 + REAL, INTENT(IN ) :: DT + REAL :: EDIRTMP + + + +! ---------------------------------------------------------------------- +! DIRECT EVAP A FUNCTION OF RELATIVE SOIL MOISTURE AVAILABILITY, LINEAR +! WHEN FXEXP=1. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! FX > 1 REPRESENTS DEMAND CONTROL +! FX < 1 REPRESENTS FLUX CONTROL +! ---------------------------------------------------------------------- + + SRATIO = (SMC - SMCDRY) / (SMCMAX - SMCDRY) + IF (SRATIO > 0.) THEN + FX = SRATIO**FXEXP + FX = MAX ( MIN ( FX, 1. ) ,0. ) + ELSE + FX = 0. + ENDIF + +!DJG NDHMS/WRF-Hydro edits... Adjustment for ponded surface water : Reduce ETP1 + EDIRTMP = 0. + ETPND1 = 0. + +!DJG NDHMS/WRF-Hydro edits... Calc Max Potential Dir Evap. (ETP1 units: }=m/s) + +!DJG NDHMS/WRF-Hydro...currently set ponded water evap to 0.0 until further notice...11/5/2012 +!EDIRTMP = ( 1.0- SHDFAC ) * ETP1 + +! Convert all units to (m) +! Convert EDIRTMP from (kg m{-2} s{-1}=m/s) to (m) ... + EDIRTMP = EDIRTMP * DT + +!DJG NDHMS/WRF-Hydro edits... Convert SFHEAD from (mm) to (m) ... + SFHEAD1RT=SFHEAD1RT * 0.001 + + + +!DJG NDHMS/WRF-Hydro edits... Calculate ETPND as reduction in EDIR(TMP)... + IF (EDIRTMP > 0.) THEN + IF ( EDIRTMP > SFHEAD1RT ) THEN + ETPND1 = SFHEAD1RT + SFHEAD1RT=0. + EDIRTMP = EDIRTMP - ETPND1 + ELSE + ETPND1 = EDIRTMP + EDIRTMP = 0. + SFHEAD1RT = SFHEAD1RT - ETPND1 + END IF + END IF + +!DJG NDHMS/WRF-Hydro edits... Convert SFHEAD units back to (mm) + IF ( SFHEAD1RT /= 0.) SFHEAD1RT=SFHEAD1RT * 1000. + +!DJG NDHMS/WRF-Hydro edits...Convert ETPND and EDIRTMP back to (mm/s=kg m{-2} s{-1}) + ETPND1 = ETPND1 / DT + EDIRTMP = EDIRTMP / DT +!DEBUG print *, "After DEVAP...SFCHEAD+ETPND1",SFHEAD1RT+ETPND1*DT + + +! ---------------------------------------------------------------------- +! ALLOW FOR THE DIRECT-EVAP-REDUCING EFFECT OF SHADE +! ---------------------------------------------------------------------- +!DJG NDHMS/WRF-Hydro edits... +! EDIR = FX * ( 1.0- SHDFAC ) * ETP1 + EDIR = FX * EDIRTMP + + + + +! ---------------------------------------------------------------------- + END SUBROUTINE DEVAP_hydro +! ---------------------------------------------------------------------- + + SUBROUTINE EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL, & + SH2O, & + SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT, & + SMCREF,SHDFAC,CMCMAX, & + SMCDRY,CFACTR, & + EDIR,EC,ET,ETT,SFCTMP,Q2,NROOT,RTDIS,FXEXP, & + SFHEAD1RT,ETPND1) + +! ---------------------------------------------------------------------- +! SUBROUTINE EVAPO +! ---------------------------------------------------------------------- +! CALCULATE SOIL MOISTURE FLUX. THE SOIL MOISTURE CONTENT (SMC - A PER +! UNIT VOLUME MEASUREMENT) IS A DEPENDENT VARIABLE THAT IS UPDATED WITH +! PROGNOSTIC EQNS. THE CANOPY MOISTURE CONTENT (CMC) IS ALSO UPDATED. +! FROZEN GROUND VERSION: NEW STATES ADDED: SH2O, AND FROZEN GROUND +! CORRECTION FACTOR, FRZFACT AND PARAMETER SLOPE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL, NROOT + INTEGER :: I,K + REAL, INTENT(IN) :: BEXP, CFACTR,CMC,CMCMAX,DKSAT, & + DT,DWSAT,ETP1,FXEXP,PC,Q2,SFCTMP, & + SHDFAC,SMCDRY,SMCMAX,SMCREF,SMCWLT + REAL, INTENT(OUT) :: EC,EDIR,ETA1,ETT + REAL :: CMC2MS + REAL,DIMENSION(1:NSOIL), INTENT(IN) :: RTDIS, SMC, SH2O, ZSOIL + REAL,DIMENSION(1:NSOIL), INTENT(OUT) :: ET + + REAL, INTENT(INOUT) :: SFHEAD1RT,ETPND1 + +! ---------------------------------------------------------------------- +! EXECUTABLE CODE BEGINS HERE IF THE POTENTIAL EVAPOTRANSPIRATION IS +! GREATER THAN ZERO. +! ---------------------------------------------------------------------- + EDIR = 0. + EC = 0. + ETT = 0. + DO K = 1,NSOIL + ET (K) = 0. + END DO + +! ---------------------------------------------------------------------- +! RETRIEVE DIRECT EVAPORATION FROM SOIL SURFACE. CALL THIS FUNCTION +! ONLY IF VEG COVER NOT COMPLETE. +! FROZEN GROUND VERSION: SH2O STATES REPLACE SMC STATES. +! ---------------------------------------------------------------------- + IF (ETP1 > 0.0) THEN + IF (SHDFAC < 1.) THEN +#ifdef WRF_HYDRO +! CALL DEVAP_hydro (EDIR,ETP1,SMC (1),ZSOIL (1),SHDFAC,SMCMAX, & +! BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP, & +! SFHEAD1RT,ETPND1,DT) +!DJG Reduce ETP1 by EDIR & ETPND1... +! ETP1=ETP1-EDIR-ETPND1 + +! following is the temparay setting ... + CALL DEVAP (EDIR,ETP1,SMC (1),ZSOIL (1),SHDFAC,SMCMAX, & + BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP) +! ETP1=ETP1-EDIR +#else + CALL DEVAP (EDIR,ETP1,SMC (1),ZSOIL (1),SHDFAC,SMCMAX, & + BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP) +#endif + END IF +! ---------------------------------------------------------------------- +! INITIALIZE PLANT TOTAL TRANSPIRATION, RETRIEVE PLANT TRANSPIRATION, +! AND ACCUMULATE IT FOR ALL SOIL LAYERS. +! ---------------------------------------------------------------------- + + IF (SHDFAC > 0.0) THEN + CALL TRANSP (ET,NSOIL,ETP1,SH2O,CMC,ZSOIL,SHDFAC,SMCWLT, & + CMCMAX,PC,CFACTR,SMCREF,SFCTMP,Q2,NROOT,RTDIS) + DO K = 1,NSOIL + ETT = ETT + ET ( K ) + END DO +! ---------------------------------------------------------------------- +! CALCULATE CANOPY EVAPORATION. +! IF STATEMENTS TO AVOID TANGENT LINEAR PROBLEMS NEAR CMC=0.0. +! ---------------------------------------------------------------------- + IF (CMC > 0.0) THEN + EC = SHDFAC * ( ( CMC / CMCMAX ) ** CFACTR ) * ETP1 + ELSE + EC = 0.0 + END IF +! ---------------------------------------------------------------------- +! EC SHOULD BE LIMITED BY THE TOTAL AMOUNT OF AVAILABLE WATER ON THE +! CANOPY. -F.CHEN, 18-OCT-1994 +! ---------------------------------------------------------------------- + CMC2MS = CMC / DT + EC = MIN ( CMC2MS, EC ) + END IF + END IF +! ---------------------------------------------------------------------- +! TOTAL UP EVAP AND TRANSP TYPES TO OBTAIN ACTUAL EVAPOTRANSP +! ---------------------------------------------------------------------- + ETA1 = EDIR + ETT + EC + +! ---------------------------------------------------------------------- + END SUBROUTINE EVAPO +! ---------------------------------------------------------------------- + + SUBROUTINE FAC2MIT(SMCMAX,FLIMIT) + IMPLICIT NONE + REAL, INTENT(IN) :: SMCMAX + REAL, INTENT(OUT) :: FLIMIT + + FLIMIT = 0.90 + + IF ( SMCMAX == 0.395 ) THEN + FLIMIT = 0.59 + ELSE IF ( ( SMCMAX == 0.434 ) .OR. ( SMCMAX == 0.404 ) ) THEN + FLIMIT = 0.85 + ELSE IF ( ( SMCMAX == 0.465 ) .OR. ( SMCMAX == 0.406 ) ) THEN + FLIMIT = 0.86 + ELSE IF ( ( SMCMAX == 0.476 ) .OR. ( SMCMAX == 0.439 ) ) THEN + FLIMIT = 0.74 + ELSE IF ( ( SMCMAX == 0.200 ) .OR. ( SMCMAX == 0.464 ) ) THEN + FLIMIT = 0.80 + ENDIF + +! ---------------------------------------------------------------------- + END SUBROUTINE FAC2MIT +! ---------------------------------------------------------------------- + + SUBROUTINE FRH2O (FREE,TKELV,SMC,SH2O,SMCMAX,BEXP,PSIS) + +! ---------------------------------------------------------------------- +! SUBROUTINE FRH2O +! ---------------------------------------------------------------------- +! CALCULATE AMOUNT OF SUPERCOOLED LIQUID SOIL WATER CONTENT IF +! TEMPERATURE IS BELOW 273.15K (T0). REQUIRES NEWTON-TYPE ITERATION TO +! SOLVE THE NONLINEAR IMPLICIT EQUATION GIVEN IN EQN 17 OF KOREN ET AL +! (1999, JGR, VOL 104(D16), 19569-19585). +! ---------------------------------------------------------------------- +! NEW VERSION (JUNE 2001): MUCH FASTER AND MORE ACCURATE NEWTON +! ITERATION ACHIEVED BY FIRST TAKING LOG OF EQN CITED ABOVE -- LESS THAN +! 4 (TYPICALLY 1 OR 2) ITERATIONS ACHIEVES CONVERGENCE. ALSO, EXPLICIT +! 1-STEP SOLUTION OPTION FOR SPECIAL CASE OF PARAMETER CK=0, WHICH +! REDUCES THE ORIGINAL IMPLICIT EQUATION TO A SIMPLER EXPLICIT FORM, +! KNOWN AS THE "FLERCHINGER EQN". IMPROVED HANDLING OF SOLUTION IN THE +! LIMIT OF FREEZING POINT TEMPERATURE T0. +! ---------------------------------------------------------------------- +! INPUT: + +! TKELV.........TEMPERATURE (Kelvin) +! SMC...........TOTAL SOIL MOISTURE CONTENT (VOLUMETRIC) +! SH2O..........LIQUID SOIL MOISTURE CONTENT (VOLUMETRIC) +! SMCMAX........SATURATION SOIL MOISTURE CONTENT (FROM REDPRM) +! B.............SOIL TYPE "B" PARAMETER (FROM REDPRM) +! PSIS..........SATURATED SOIL MATRIC POTENTIAL (FROM REDPRM) + +! OUTPUT: +! FRH2O.........SUPERCOOLED LIQUID WATER CONTENT +! FREE..........SUPERCOOLED LIQUID WATER CONTENT +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: BEXP,PSIS,SH2O,SMC,SMCMAX,TKELV + REAL, INTENT(OUT) :: FREE + REAL :: BX,DENOM,DF,DSWL,FK,SWL,SWLK + INTEGER :: NLOG,KCOUNT +! PARAMETER(CK = 0.0) + REAL, PARAMETER :: CK = 8.0, BLIM = 5.5, ERROR = 0.005, & + HLICE = 3.335E5, GS = 9.81,DICE = 920.0, & + DH2O = 1000.0, T0 = 273.15 + +! ---------------------------------------------------------------------- +! LIMITS ON PARAMETER B: B < 5.5 (use parameter BLIM) +! SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT IS +! NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES. +! ---------------------------------------------------------------------- + BX = BEXP + +! ---------------------------------------------------------------------- +! INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG. +! ---------------------------------------------------------------------- + IF (BEXP > BLIM) BX = BLIM + NLOG = 0 + +! ---------------------------------------------------------------------- +! IF TEMPERATURE NOT SIGNIFICANTLY BELOW FREEZING (T0), SH2O = SMC +! ---------------------------------------------------------------------- + KCOUNT = 0 +! FRH2O = SMC + IF (TKELV > (T0- 1.E-3)) THEN + FREE = SMC + ELSE + +! ---------------------------------------------------------------------- +! OPTION 1: ITERATED SOLUTION FOR NONZERO CK +! IN KOREN ET AL, JGR, 1999, EQN 17 +! ---------------------------------------------------------------------- +! INITIAL GUESS FOR SWL (frozen content) +! ---------------------------------------------------------------------- + IF (CK /= 0.0) THEN + SWL = SMC - SH2O +! ---------------------------------------------------------------------- +! KEEP WITHIN BOUNDS. +! ---------------------------------------------------------------------- + IF (SWL > (SMC -0.02)) SWL = SMC -0.02 + +! ---------------------------------------------------------------------- +! START OF ITERATIONS +! ---------------------------------------------------------------------- + IF (SWL < 0.) SWL = 0. + 1001 Continue + IF (.NOT.( (NLOG < 10) .AND. (KCOUNT == 0))) goto 1002 + NLOG = NLOG +1 + DF = ALOG ( ( PSIS * GS / HLICE ) * ( ( 1. + CK * SWL )**2.) * & + ( SMCMAX / (SMC - SWL) )** BX) - ALOG ( - ( & + TKELV - T0)/ TKELV) + DENOM = 2. * CK / ( 1. + CK * SWL ) + BX / ( SMC - SWL ) + SWLK = SWL - DF / DENOM +! ---------------------------------------------------------------------- +! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION. +! ---------------------------------------------------------------------- + IF (SWLK > (SMC -0.02)) SWLK = SMC - 0.02 + IF (SWLK < 0.) SWLK = 0. + +! ---------------------------------------------------------------------- +! MATHEMATICAL SOLUTION BOUNDS APPLIED. +! ---------------------------------------------------------------------- + DSWL = ABS (SWLK - SWL) + +! ---------------------------------------------------------------------- +! IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.) +! WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED. +! ---------------------------------------------------------------------- + SWL = SWLK + IF ( DSWL <= ERROR ) THEN + KCOUNT = KCOUNT +1 + END IF +! ---------------------------------------------------------------------- +! END OF ITERATIONS +! ---------------------------------------------------------------------- +! BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION. +! ---------------------------------------------------------------------- +! FRH2O = SMC - SWL + goto 1001 + 1002 continue + FREE = SMC - SWL + END IF +! ---------------------------------------------------------------------- +! END OPTION 1 +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0 +! IN KOREN ET AL., JGR, 1999, EQN 17 +! APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION +! ---------------------------------------------------------------------- + IF (KCOUNT == 0) THEN + PRINT *,'Flerchinger USEd in NEW version. Iterations=',NLOG + FK = ( ( (HLICE / (GS * ( - PSIS)))* & + ( (TKELV - T0)/ TKELV))** ( -1/ BX))* SMCMAX +! FRH2O = MIN (FK, SMC) + IF (FK < 0.02) FK = 0.02 + FREE = MIN (FK, SMC) +! ---------------------------------------------------------------------- +! END OPTION 2 +! ---------------------------------------------------------------------- + END IF + END IF +! ---------------------------------------------------------------------- + END SUBROUTINE FRH2O +! ---------------------------------------------------------------------- + + SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1, & + TBOT,ZBOT,PSISAT,SH2O,DT,BEXP,SOILTYP,OPT_THCND, & + F1,DF1,QUARTZ,CSOIL,AI,BI,CI,VEGTYP,ISURBAN & + ,HCPCT_FASDAS ) !fasdas + +! ---------------------------------------------------------------------- +! SUBROUTINE HRT +! ---------------------------------------------------------------------- +! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL +! THERMAL DIFFUSION EQUATION. ALSO TO COMPUTE ( PREPARE ) THE MATRIX +! COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME. +! ---------------------------------------------------------------------- + IMPLICIT NONE + LOGICAL :: ITAVG + INTEGER, INTENT(IN) :: OPT_THCND + INTEGER, INTENT(IN) :: NSOIL, VEGTYP, SOILTYP + INTEGER, INTENT(IN) :: ISURBAN + INTEGER :: I, K + + REAL, INTENT(IN) :: BEXP, CSOIL, DF1, DT,F1,PSISAT,QUARTZ, & + SMCMAX ,TBOT,YY,ZZ1, ZBOT + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC,STC,ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: SH2O + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: RHSTS + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: AI, BI,CI + REAL :: DDZ, DDZ2, DENOM, DF1N, DF1K, DTSDZ, & + DTSDZ2,HCPCT,QTOT,SSOIL,SICE,TAVG,TBK, & + TBK1,TSNSR,TSURF,CSOIL_LOC + REAL, PARAMETER :: T0 = 273.15, CAIR = 1004.0, CICE = 2.106E6,& + CH2O = 4.2E6 + +! +! FASDAS +! + REAL, INTENT( OUT) :: HCPCT_FASDAS +! +! END FASDAS +! + +!urban + IF( VEGTYP == ISURBAN ) then + CSOIL_LOC=3.0E6 + ELSE + CSOIL_LOC=CSOIL + ENDIF + +! ---------------------------------------------------------------------- +! INITIALIZE LOGICAL FOR SOIL LAYER TEMPERATURE AVERAGING. +! ---------------------------------------------------------------------- + ITAVG = .TRUE. +! ---------------------------------------------------------------------- +! BEGIN SECTION FOR TOP SOIL LAYER +! ---------------------------------------------------------------------- +! CALC THE HEAT CAPACITY OF THE TOP SOIL LAYER +! ---------------------------------------------------------------------- + HCPCT = SH2O (1)* CH2O + (1.0- SMCMAX)* CSOIL_LOC + (SMCMAX - SMC (1))& + * CAIR & + + ( SMC (1) - SH2O (1) )* CICE +! +! FASDAS +! + HCPCT_FASDAS = HCPCT +! +! END FASDAS +! +! ---------------------------------------------------------------------- +! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER +! ---------------------------------------------------------------------- + DDZ = 1.0 / ( -0.5 * ZSOIL (2) ) + AI (1) = 0.0 + CI (1) = (DF1 * DDZ) / (ZSOIL (1) * HCPCT) + +! ---------------------------------------------------------------------- +! CALCULATE THE VERTICAL SOIL TEMP GRADIENT BTWN THE 1ST AND 2ND SOIL +! LAYERS. THEN CALCULATE THE SUBSURFACE HEAT FLUX. USE THE TEMP +! GRADIENT AND SUBSFC HEAT FLUX TO CALC "RIGHT-HAND SIDE TENDENCY +! TERMS", OR "RHSTS", FOR TOP SOIL LAYER. +! ---------------------------------------------------------------------- + BI (1) = - CI (1) + DF1 / (0.5 * ZSOIL (1) * ZSOIL (1)* HCPCT * & + ZZ1) + DTSDZ = (STC (1) - STC (2)) / ( -0.5 * ZSOIL (2)) + SSOIL = DF1 * (STC (1) - YY) / (0.5 * ZSOIL (1) * ZZ1) +! RHSTS(1) = (DF1 * DTSDZ - SSOIL) / (ZSOIL(1) * HCPCT) + DENOM = (ZSOIL (1) * HCPCT) + +! ---------------------------------------------------------------------- +! NEXT CAPTURE THE VERTICAL DIFFERENCE OF THE HEAT FLUX AT TOP AND +! BOTTOM OF FIRST SOIL LAYER FOR USE IN HEAT FLUX CONSTRAINT APPLIED TO +! POTENTIAL SOIL FREEZING/THAWING IN ROUTINE SNKSRC. +! ---------------------------------------------------------------------- +! QTOT = SSOIL - DF1*DTSDZ + RHSTS (1) = (DF1 * DTSDZ - SSOIL) / DENOM + +! ---------------------------------------------------------------------- +! CALCULATE FROZEN WATER CONTENT IN 1ST SOIL LAYER. +! ---------------------------------------------------------------------- + QTOT = -1.0* RHSTS (1)* DENOM + +! ---------------------------------------------------------------------- +! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP): +! SET TEMP "TSURF" AT TOP OF SOIL COLUMN (FOR USE IN FREEZING SOIL +! PHYSICS LATER IN FUNCTION SUBROUTINE SNKSRC). IF SNOWPACK CONTENT IS +! ZERO, THEN TSURF EXPRESSION BELOW GIVES TSURF = SKIN TEMP. IF +! SNOWPACK IS NONZERO (HENCE ARGUMENT ZZ1=1), THEN TSURF EXPRESSION +! BELOW YIELDS SOIL COLUMN TOP TEMPERATURE UNDER SNOWPACK. THEN +! CALCULATE TEMPERATURE AT BOTTOM INTERFACE OF 1ST SOIL LAYER FOR USE +! LATER IN FUNCTION SUBROUTINE SNKSRC +! ---------------------------------------------------------------------- + SICE = SMC (1) - SH2O (1) + IF (ITAVG) THEN + TSURF = (YY + (ZZ1-1) * STC (1)) / ZZ1 +! ---------------------------------------------------------------------- +! IF FROZEN WATER PRESENT OR ANY OF LAYER-1 MID-POINT OR BOUNDING +! INTERFACE TEMPERATURES BELOW FREEZING, THEN CALL SNKSRC TO +! COMPUTE HEAT SOURCE/SINK (AND CHANGE IN FROZEN WATER CONTENT) +! DUE TO POSSIBLE SOIL WATER PHASE CHANGE +! ---------------------------------------------------------------------- + CALL TBND (STC (1),STC (2),ZSOIL,ZBOT,1,NSOIL,TBK) + IF ( (SICE > 0.) .OR. (STC (1) < T0) .OR. & + (TSURF < T0) .OR. (TBK < T0) ) THEN +! TSNSR = SNKSRC (TAVG,SMC(1),SH2O(1), + CALL TMPAVG (TAVG,TSURF,STC (1),TBK,ZSOIL,NSOIL,1) + CALL SNKSRC (TSNSR,TAVG,SMC (1),SH2O (1), & + ZSOIL,NSOIL,SMCMAX,PSISAT,BEXP,DT,1,QTOT) +! RHSTS(1) = RHSTS(1) - TSNSR / ( ZSOIL(1) * HCPCT ) + RHSTS (1) = RHSTS (1) - TSNSR / DENOM + END IF + ELSE +! TSNSR = SNKSRC (STC(1),SMC(1),SH2O(1), + IF ( (SICE > 0.) .OR. (STC (1) < T0) ) THEN + CALL SNKSRC (TSNSR,STC (1),SMC (1),SH2O (1), & + ZSOIL,NSOIL,SMCMAX,PSISAT,BEXP,DT,1,QTOT) +! RHSTS(1) = RHSTS(1) - TSNSR / ( ZSOIL(1) * HCPCT ) + RHSTS (1) = RHSTS (1) - TSNSR / DENOM + END IF +! ---------------------------------------------------------------------- +! THIS ENDS SECTION FOR TOP SOIL LAYER. +! ---------------------------------------------------------------------- + END IF + +! INITIALIZE DDZ2 +! ---------------------------------------------------------------------- + + DDZ2 = 0.0 + DF1K = DF1 + +! ---------------------------------------------------------------------- +! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS +! (EXCEPT SUBSFC OR "GROUND" HEAT FLUX NOT REPEATED IN LOWER LAYERS) +! ---------------------------------------------------------------------- +! CALCULATE HEAT CAPACITY FOR THIS SOIL LAYER. +! ---------------------------------------------------------------------- + DO K = 2,NSOIL + HCPCT = SH2O (K)* CH2O + (1.0- SMCMAX)* CSOIL_LOC + (SMCMAX - SMC ( & + K))* CAIR + ( SMC (K) - SH2O (K) )* CICE +! ---------------------------------------------------------------------- +! THIS SECTION FOR LAYER 2 OR GREATER, BUT NOT LAST LAYER. +! ---------------------------------------------------------------------- +! CALCULATE THERMAL DIFFUSIVITY FOR THIS LAYER. +! ---------------------------------------------------------------------- + IF (K /= NSOIL) THEN + +! ---------------------------------------------------------------------- +! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER +! ---------------------------------------------------------------------- + CALL TDFCND (DF1N,SMC (K),QUARTZ,SMCMAX,SH2O (K),BEXP, PSISAT, SOILTYP, OPT_THCND) + +!urban + IF ( VEGTYP == ISURBAN ) DF1N = 3.24 + + DENOM = 0.5 * ( ZSOIL (K -1) - ZSOIL (K +1) ) + +! ---------------------------------------------------------------------- +! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT +! ---------------------------------------------------------------------- + DTSDZ2 = ( STC (K) - STC (K +1) ) / DENOM + DDZ2 = 2. / (ZSOIL (K -1) - ZSOIL (K +1)) + +! ---------------------------------------------------------------------- +! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP): CALCULATE +! TEMP AT BOTTOM OF LAYER. +! ---------------------------------------------------------------------- + CI (K) = - DF1N * DDZ2 / ( (ZSOIL (K -1) - ZSOIL (K)) * & + HCPCT) + IF (ITAVG) THEN + CALL TBND (STC (K),STC (K +1),ZSOIL,ZBOT,K,NSOIL,TBK1) + END IF + + ELSE +! ---------------------------------------------------------------------- +! SPECIAL CASE OF BOTTOM SOIL LAYER: CALCULATE THERMAL DIFFUSIVITY FOR +! BOTTOM LAYER. +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! CALC THE VERTICAL SOIL TEMP GRADIENT THRU BOTTOM LAYER. +! ---------------------------------------------------------------------- + CALL TDFCND (DF1N,SMC (K),QUARTZ,SMCMAX,SH2O (K),BEXP, PSISAT, SOILTYP, OPT_THCND) + + +!urban + IF ( VEGTYP == ISURBAN ) DF1N = 3.24 + + DENOM = .5 * (ZSOIL (K -1) + ZSOIL (K)) - ZBOT + +! ---------------------------------------------------------------------- +! SET MATRIX COEF, CI TO ZERO IF BOTTOM LAYER. +! ---------------------------------------------------------------------- + DTSDZ2 = (STC (K) - TBOT) / DENOM + +! ---------------------------------------------------------------------- +! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP): CALCULATE +! TEMP AT BOTTOM OF LAST LAYER. +! ---------------------------------------------------------------------- + CI (K) = 0. + IF (ITAVG) THEN + CALL TBND (STC (K),TBOT,ZSOIL,ZBOT,K,NSOIL,TBK1) + END IF +! ---------------------------------------------------------------------- +! THIS ENDS SPECIAL LOOP FOR BOTTOM LAYER. + END IF +! ---------------------------------------------------------------------- +! CALCULATE RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT. +! ---------------------------------------------------------------------- + DENOM = ( ZSOIL (K) - ZSOIL (K -1) ) * HCPCT + RHSTS (K) = ( DF1N * DTSDZ2- DF1K * DTSDZ ) / DENOM + QTOT = -1.0* DENOM * RHSTS (K) + + SICE = SMC (K) - SH2O (K) + IF (ITAVG) THEN + CALL TMPAVG (TAVG,TBK,STC (K),TBK1,ZSOIL,NSOIL,K) +! TSNSR = SNKSRC(TAVG,SMC(K),SH2O(K),ZSOIL,NSOIL, + IF ( (SICE > 0.) .OR. (STC (K) < T0) .OR. & + (TBK .lt. T0) .OR. (TBK1 .lt. T0) ) THEN + CALL SNKSRC (TSNSR,TAVG,SMC (K),SH2O (K),ZSOIL,NSOIL, & + SMCMAX,PSISAT,BEXP,DT,K,QTOT) + RHSTS (K) = RHSTS (K) - TSNSR / DENOM + END IF + ELSE +! TSNSR = SNKSRC(STC(K),SMC(K),SH2O(K),ZSOIL,NSOIL, + IF ( (SICE > 0.) .OR. (STC (K) < T0) ) THEN + CALL SNKSRC (TSNSR,STC (K),SMC (K),SH2O (K),ZSOIL,NSOIL, & + SMCMAX,PSISAT,BEXP,DT,K,QTOT) + RHSTS (K) = RHSTS (K) - TSNSR / DENOM + END IF + END IF + +! ---------------------------------------------------------------------- +! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER. +! ---------------------------------------------------------------------- + AI (K) = - DF1K * DDZ / ( (ZSOIL (K -1) - ZSOIL (K)) * HCPCT) + +! ---------------------------------------------------------------------- +! RESET VALUES OF DF1, DTSDZ, DDZ, AND TBK FOR LOOP TO NEXT SOIL LAYER. +! ---------------------------------------------------------------------- + BI (K) = - (AI (K) + CI (K)) + TBK = TBK1 + DF1K = DF1N + DTSDZ = DTSDZ2 + DDZ = DDZ2 + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE HRT +! ---------------------------------------------------------------------- + + SUBROUTINE HSTEP (STCOUT,STCIN,RHSTS,DT,NSOIL,AI,BI,CI) + +! ---------------------------------------------------------------------- +! SUBROUTINE HSTEP +! ---------------------------------------------------------------------- +! CALCULATE/UPDATE THE SOIL TEMPERATURE FIELD. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: K + + REAL, DIMENSION(1:NSOIL), INTENT(IN):: STCIN + REAL, DIMENSION(1:NSOIL), INTENT(OUT):: STCOUT + REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: RHSTS + REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: AI,BI,CI + REAL, DIMENSION(1:NSOIL) :: RHSTSin + REAL, DIMENSION(1:NSOIL) :: CIin + REAL :: DT + +! ---------------------------------------------------------------------- +! CREATE FINITE DIFFERENCE VALUES FOR USE IN ROSR12 ROUTINE +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + RHSTS (K) = RHSTS (K) * DT + AI (K) = AI (K) * DT + BI (K) = 1. + BI (K) * DT + CI (K) = CI (K) * DT + END DO +! ---------------------------------------------------------------------- +! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12 +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + RHSTSin (K) = RHSTS (K) + END DO + DO K = 1,NSOIL + CIin (K) = CI (K) + END DO +! ---------------------------------------------------------------------- +! SOLVE THE TRI-DIAGONAL MATRIX EQUATION +! ---------------------------------------------------------------------- + CALL ROSR12 (CI,AI,BI,CIin,RHSTSin,RHSTS,NSOIL) +! ---------------------------------------------------------------------- +! CALC/UPDATE THE SOIL TEMPS USING MATRIX SOLUTION +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + STCOUT (K) = STCIN (K) + CI (K) + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE HSTEP +! ---------------------------------------------------------------------- + + SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT, & + SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT,SHDFAC, & + SBETA,Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,EMISSI, & + SSOIL, & + STC,EPSCA,BEXP,PC,RCH,RR,CFACTR, & + SH2O,SLOPE,KDT,FRZFACT,PSISAT,ZSOIL, & + DKSAT,DWSAT,TBOT,ZBOT,RUNOFF1,RUNOFF2, & + RUNOFF3,EDIR,EC,ET,ETT,NROOT,RTDIS, & + QUARTZ,FXEXP,CSOIL, & + BETA,DRIP,DEW,FLX1,FLX3,VEGTYP,ISURBAN, & + SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND & + ,XSDA_QFX,QFX_PHY,XQNORM,fasdas,HCPCT_FASDAS, & + SIGMA,CPH2O) !fasdas + +! ---------------------------------------------------------------------- +! SUBROUTINE NOPAC +! ---------------------------------------------------------------------- +! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES AND UPDATE SOIL MOISTURE +! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN NO SNOW PACK IS +! PRESENT. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: OPT_THCND + INTEGER, INTENT(IN) :: NROOT,NSOIL,VEGTYP,SOILTYP + INTEGER, INTENT(IN) :: ISURBAN + INTEGER :: K + + REAL, INTENT(IN) :: BEXP,CFACTR, CMCMAX,CSOIL,DKSAT,DT,DWSAT, & + EPSCA,ETP,FDOWN,F1,FXEXP,FRZFACT,KDT,PC, & + PRCP,PSISAT,Q2,QUARTZ,RCH,RR,SBETA,SFCTMP,& + SHDFAC,SLOPE,SMCDRY,SMCMAX,SMCREF,SMCWLT, & + T24,TBOT,TH2,ZBOT,EMISSI,SIGMA,CPH2O + REAL, INTENT(INOUT) :: CMC,BETA,T1 + REAL, INTENT(OUT) :: DEW,DRIP,EC,EDIR,ETA,ETT,FLX1,FLX3, & + RUNOFF1,RUNOFF2,RUNOFF3,SSOIL +!DJG NDHMS/WRF-Hydro edit... + REAL, INTENT(INOUT) :: SFHEAD1RT,INFXS1RT,ETPND1 + + REAL, DIMENSION(1:NSOIL),INTENT(IN) :: RTDIS,ZSOIL + REAL, DIMENSION(1:NSOIL),INTENT(OUT) :: ET + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SMC,SH2O,STC + REAL, DIMENSION(1:NSOIL) :: ET1 + REAL :: EC1,EDIR1,ETT1,DF1,ETA1,ETP1,PRCP1,YY, & + YYNUM,ZZ1 +! +! FASDAS +! + REAL :: XSDA_QFX, QFX_PHY, XQNORM + INTEGER :: fasdas + REAL , DIMENSION(1:NSOIL) :: EFT(NSOIL), wetty(1:NSOIL) + REAL :: EFDIR, EFC, EALL_now + REAL, INTENT( OUT) :: HCPCT_FASDAS +! +! END FASDAS +! +! ---------------------------------------------------------------------- +! EXECUTABLE CODE BEGINS HERE: +! CONVERT ETP Fnd PRCP FROM KG M-2 S-1 TO M S-1 AND INITIALIZE DEW. +! ---------------------------------------------------------------------- + PRCP1 = PRCP * 0.001 + ETP1 = ETP * 0.001 + DEW = 0.0 +! ---------------------------------------------------------------------- +! INITIALIZE EVAP TERMS. +! ---------------------------------------------------------------------- +! +! FASDAS +! + QFX_PHY = 0.0 +! +! END FASDAS +! + EDIR = 0. + EDIR1 = 0. + EC1 = 0. + EC = 0. + DO K = 1,NSOIL + ET(K) = 0. + ET1(K) = 0. +! +! FASDAS +! + wetty(K) = 1.0 +! +! END FASDAS +! + END DO + ETT = 0. + ETT1 = 0. + +!DJG NDHMS/WRF-Hydro edit... + ETPND1 = 0. + + + IF (ETP > 0.0) THEN + CALL EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL, & + SH2O, & + SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT, & + SMCREF,SHDFAC,CMCMAX, & + SMCDRY,CFACTR, & + EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,FXEXP, & + SFHEAD1RT,ETPND1 ) +! +! FASDAS +! + IF( fasdas == 1 ) THEN + DO K=1,NSOIL + QFX_PHY = QFX_PHY + ET1(K) ! m/s +! dont add moisture fluxes if soil moisture is = or > smcref + IF(SMC(K).GE.SMCREF.and.XSDA_QFX.gt.0.0) wetty(K)=0.0 + END DO + QFX_PHY = EDIR1+EC1+QFX_PHY ! m/s + EALL_now = QFX_PHY ! m/s + QFX_PHY = QFX_PHY*1000.0 ! Kg/m2/s + + if(EALL_now.ne.0.0) then + EFDIR = (EDIR1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + EFDIR = EFDIR * wetty(1) + !TWG2015 Bugfix Flip Sign to conform to Net upward Flux + EDIR1 = EDIR1 + EFDIR ! new value + + EFC = (EC1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + !TWG2015 Bugfix Flip Sign to conform to Net upward Flux + EC1 = EC1 + EFC ! new value + + + DO K=1,NSOIL + EFT(K) = (ET1(K)/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + EFT(K) = EFT(K) * wetty(K) + !TWG2015 Bugfix Flip Sign to conform to Net upward Flux + ET1(K) = ET1(K) + EFT(K) ! new value + END DO + + + END IF ! for non-zero eall_now + ELSE + QFX_PHY = 0.0 + ENDIF +! +! END FASDAS +! + CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL, & + SH2O,SLOPE,KDT,FRZFACT, & + SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT, & + SHDFAC,CMCMAX, & + RUNOFF1,RUNOFF2,RUNOFF3, & + EDIR1,EC1,ET1, & + DRIP, SFHEAD1RT,INFXS1RT) + +! ---------------------------------------------------------------------- +! CONVERT MODELED EVAPOTRANSPIRATION FROM M S-1 TO KG M-2 S-1. +! ---------------------------------------------------------------------- + + ETA = ETA1 * 1000.0 + +! ---------------------------------------------------------------------- +! IF ETP < 0, ASSUME DEW FORMS (TRANSFORM ETP1 INTO DEW AND REINITIALIZE +! ETP1 TO ZERO). +! ---------------------------------------------------------------------- + ELSE + DEW = - ETP1 + +! ---------------------------------------------------------------------- +! CONVERT PRCP FROM 'KG M-2 S-1' TO 'M S-1' AND ADD DEW AMOUNT. +! ---------------------------------------------------------------------- + + PRCP1 = PRCP1+ DEW +! +! FASDAS +! + IF( fasdas == 1 ) THEN + DO K=1,NSOIL + QFX_PHY = QFX_PHY + ET1(K) ! m/s +! dont add moisture fluxes if soil moisture is = or > smcref + IF(SMC(K).GE.SMCREF.and.XSDA_QFX.gt.0.0) wetty(K)=0.0 + END DO + QFX_PHY = EDIR1+EC1+QFX_PHY ! m/s + EALL_now = QFX_PHY ! m/s + QFX_PHY = QFX_PHY*1000.0 ! Kg/m2/s + + IF(EALL_now.ne.0.0) then + EFDIR = (EDIR1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + EFDIR = EFDIR * wetty(1) + !TWG2015 Bugfix Flip Sign to conform to Net Upward Flux + EDIR1 = EDIR1 + EFDIR ! new value + + EFC = (EC1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + !TWG2015 Bugfix Flip Sign to conform to Net Upward Flux + EC1 = EC1+ EFC ! new value + + DO K=1,NSOIL + EFT(K) = (ET1(K)/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + EFT(K) = EFT(K) * wetty(K) + !TWG2015 Bugfix Flip Sign to conform to Net Upward Flux + ET1(K) = ET1(K) + EFT(K) ! new value + END DO + + END IF ! for non-zero eall_now + ELSE + QFX_PHY = 0.0 + ENDIF +! +! END FASDAS +! + CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL, & + SH2O,SLOPE,KDT,FRZFACT, & + SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT, & + SHDFAC,CMCMAX, & + RUNOFF1,RUNOFF2,RUNOFF3, & + EDIR1,EC1,ET1, & + DRIP, SFHEAD1RT,INFXS1RT) + +! ---------------------------------------------------------------------- +! CONVERT MODELED EVAPOTRANSPIRATION FROM 'M S-1' TO 'KG M-2 S-1'. +! ---------------------------------------------------------------------- +! ETA = ETA1 * 1000.0 + END IF + +! ---------------------------------------------------------------------- +! BASED ON ETP AND E VALUES, DETERMINE BETA +! ---------------------------------------------------------------------- + + IF ( ETP <= 0.0 ) THEN + BETA = 0.0 + ETA = ETP + IF ( ETP < 0.0 ) THEN + BETA = 1.0 + END IF + ELSE + BETA = ETA / ETP + END IF + +! ---------------------------------------------------------------------- +! CONVERT MODELED EVAPOTRANSPIRATION COMPONENTS 'M S-1' TO 'KG M-2 S-1'. +! ---------------------------------------------------------------------- + EDIR = EDIR1*1000. + EC = EC1*1000. + DO K = 1,NSOIL + ET(K) = ET1(K)*1000. + END DO + ETT = ETT1*1000. + +! ---------------------------------------------------------------------- +! GET SOIL THERMAL DIFFUXIVITY/CONDUCTIVITY FOR TOP SOIL LYR, +! CALC. ADJUSTED TOP LYR SOIL TEMP AND ADJUSTED SOIL FLUX, THEN +! CALL SHFLX TO COMPUTE/UPDATE SOIL HEAT FLUX AND SOIL TEMPS. +! ---------------------------------------------------------------------- + + CALL TDFCND (DF1,SMC (1),QUARTZ,SMCMAX,SH2O (1),BEXP, PSISAT, SOILTYP, OPT_THCND) + +!urban + IF ( VEGTYP == ISURBAN ) DF1=3.24 +! + +! ---------------------------------------------------------------------- +! VEGETATION GREENNESS FRACTION REDUCTION IN SUBSURFACE HEAT FLUX +! VIA REDUCTION FACTOR, WHICH IS CONVENIENT TO APPLY HERE TO THERMAL +! DIFFUSIVITY THAT IS LATER USED IN HRT TO COMPUTE SUB SFC HEAT FLUX +! (SEE ADDITIONAL COMMENTS ON VEG EFFECT SUB-SFC HEAT FLX IN +! ROUTINE SFLX) +! ---------------------------------------------------------------------- + DF1 = DF1 * EXP (SBETA * SHDFAC) +! ---------------------------------------------------------------------- +! COMPUTE INTERMEDIATE TERMS PASSED TO ROUTINE HRT (VIA ROUTINE +! SHFLX BELOW) FOR USE IN COMPUTING SUBSURFACE HEAT FLUX IN HRT +! ---------------------------------------------------------------------- + YYNUM = FDOWN - EMISSI*SIGMA * T24 + YY = SFCTMP + (YYNUM / RCH + TH2- SFCTMP - BETA * EPSCA) / RR + + ZZ1 = DF1 / ( -0.5 * ZSOIL (1) * RCH * RR ) + 1.0 + +!urban + CALL SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, & + TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1, & + QUARTZ,CSOIL,VEGTYP,ISURBAN,SOILTYP,OPT_THCND & + ,HCPCT_FASDAS ) !fasdas + +! ---------------------------------------------------------------------- +! SET FLX1 AND FLX3 (SNOPACK PHASE CHANGE HEAT FLUXES) TO ZERO SINCE +! THEY ARE NOT USED HERE IN SNOPAC. FLX2 (FREEZING RAIN HEAT FLUX) WAS +! SIMILARLY INITIALIZED IN THE PENMAN ROUTINE. +! ---------------------------------------------------------------------- + FLX1 = CPH2O * PRCP * (T1- SFCTMP) + FLX3 = 0.0 + +! ---------------------------------------------------------------------- + END SUBROUTINE NOPAC +! ---------------------------------------------------------------------- + + SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, & + & Q2,Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA, & + & DQSDT2,FLX2,EMISSI_IN,SNEQV,T1,SNCOVR,AOASIS, & + & ALBEDO,SOLDN,FVB,GAMA,STC1,ETPN,FLX4,UA_PHYS, & + & CP,RD,SIGMA,CPH2O,CPICE,LSUBF) + +! ---------------------------------------------------------------------- +! SUBROUTINE PENMAN +! ---------------------------------------------------------------------- +! CALCULATE POTENTIAL EVAPORATION FOR THE CURRENT POINT. VARIOUS +! PARTIAL SUMS/PRODUCTS ARE ALSO CALCULATED AND PASSED BACK TO THE +! CALLING ROUTINE FOR LATER USE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + LOGICAL, INTENT(IN) :: SNOWNG, FRZGRA + REAL, INTENT(IN) :: CH, DQSDT2,FDOWN,PRCP, & + Q2, Q2SAT,SSOIL, SFCPRS, SFCTMP, & + T2V, TH2,EMISSI_IN,SNEQV,AOASIS, & + CP, RD, SIGMA, CPH2O, CPICE, LSUBF + REAL, INTENT(IN) :: T1 , SNCOVR + REAL, INTENT(IN) :: ALBEDO,SOLDN,FVB,GAMA,STC1 + LOGICAL, INTENT(IN) :: UA_PHYS +! + REAL, INTENT(OUT) :: EPSCA,ETP,FLX2,RCH,RR,T24 + REAL, INTENT(OUT) :: FLX4,ETPN + REAL :: A, DELTA, FNET,RAD,RHO,EMISSI,ELCP1,LVS + REAL :: TOTABS,UCABS,SIGNCK,FNETN,RADN,EPSCAN + + REAL, PARAMETER :: ELCP = 2.4888E+3, LSUBC = 2.501000E+6 + REAL, PARAMETER :: LSUBS = 2.83E+6 + REAL, PARAMETER :: ALGDSN = 0.5, ALVGSN = 0.13 + +! ---------------------------------------------------------------------- +! EXECUTABLE CODE BEGINS HERE: +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! PREPARE PARTIAL QUANTITIES FOR PENMAN EQUATION. +! ---------------------------------------------------------------------- + EMISSI=EMISSI_IN + ELCP1 = (1.0-SNCOVR)*ELCP + SNCOVR*ELCP*LSUBS/LSUBC + LVS = (1.0-SNCOVR)*LSUBC + SNCOVR*LSUBS + + FLX2 = 0.0 +! DELTA = ELCP * DQSDT2 + DELTA = ELCP1 * DQSDT2 + T24 = SFCTMP * SFCTMP * SFCTMP * SFCTMP +! RR = T24 * 6.48E-8 / (SFCPRS * CH) + 1.0 + RR = EMISSI*T24 * 6.48E-8 / (SFCPRS * CH) + 1.0 + RHO = SFCPRS / (RD * T2V) + +! ---------------------------------------------------------------------- +! ADJUST THE PARTIAL SUMS / PRODUCTS WITH THE LATENT HEAT +! EFFECTS CAUSED BY FALLING PRECIPITATION. +! ---------------------------------------------------------------------- + RCH = RHO * CP * CH + IF (.NOT. SNOWNG) THEN + IF (PRCP > 0.0) RR = RR + CPH2O * PRCP / RCH + ELSE + RR = RR + CPICE * PRCP / RCH + END IF + +! ---------------------------------------------------------------------- +! INCLUDE THE LATENT HEAT EFFECTS OF FRZNG RAIN CONVERTING TO ICE ON +! IMPACT IN THE CALCULATION OF FLX2 AND FNET. +! ---------------------------------------------------------------------- +! FNET = FDOWN - SIGMA * T24- SSOIL + FNET = FDOWN - EMISSI*SIGMA * T24- SSOIL + + FLX4 = 0.0 + IF(UA_PHYS) THEN + IF(SNEQV > 0. .AND. FNET > 0. .AND. SOLDN > 0. ) THEN + TOTABS = (1.-ALBEDO)*SOLDN*FVB ! solar radiation absorbed + ! by vegetated fraction + UCABS = MIN(TOTABS,((1.0-ALGDSN)*(1.0-ALVGSN)*SOLDN*GAMA)*FVB) +! print*,'penman',UCABS,TOTABS,SOLDN,GAMA,FVB +! UCABS = MIN(TOTABS,(0.44*SOLDN*GAMA)*FVB) + ! UCABS -> solar radiation + ! absorbed under canopy + FLX4 = MIN(TOTABS - UCABS, MIN(250., 0.5*(1.-ALBEDO)*SOLDN)) + ENDIF + + SIGNCK = (STC1-273.15)*(SFCTMP-273.15) + + IF(FLX4 > 0. .AND. (SIGNCK <= 0. .OR. STC1 < 273.15)) THEN + IF(FNET >= FLX4) THEN + FNETN = FNET - FLX4 + ELSE + FLX4 = FNET + FNETN = 0. + ENDIF + ELSE + FLX4 = 0.0 + FNETN = 0. + ENDIF + ENDIF + + IF (FRZGRA) THEN + FLX2 = - LSUBF * PRCP + FNET = FNET - FLX2 + IF(UA_PHYS) FNETN = FNETN - FLX2 +! ---------------------------------------------------------------------- +! FINISH PENMAN EQUATION CALCULATIONS. +! ---------------------------------------------------------------------- + END IF + RAD = FNET / RCH + TH2- SFCTMP +! A = ELCP * (Q2SAT - Q2) + A = ELCP1 * (Q2SAT - Q2) + EPSCA = (A * RR + RAD * DELTA) / (DELTA + RR) +! Fei-Mike + IF (EPSCA>0.) EPSCA = EPSCA * AOASIS +! ETP = EPSCA * RCH / LSUBC + ETP = EPSCA * RCH / LVS + + IF(UA_PHYS) THEN + RADN = FNETN / RCH + TH2- SFCTMP + EPSCAN = (A * RR + RADN * DELTA) / (DELTA + RR) + ETPN = EPSCAN * RCH / LVS + END IF +! ---------------------------------------------------------------------- + END SUBROUTINE PENMAN +! ---------------------------------------------------------------------- + + SUBROUTINE REDPRM (VEGTYP,SOILTYP,SLOPETYP,CFACTR,CMCMAX,RSMAX, & + TOPT, & + REFKDT,KDT,SBETA, SHDFAC,RSMIN,RGL,HS,ZBOT,FRZX, & + PSISAT,SLOPE,SNUP,SALP,BEXP,DKSAT,DWSAT, & + SMCMAX,SMCWLT,SMCREF,SMCDRY,F1,QUARTZ,FXEXP, & + RTDIS,SLDPTH,ZSOIL, NROOT,NSOIL,CZIL, & + LAIMIN, LAIMAX, EMISSMIN, EMISSMAX, ALBEDOMIN, & + ALBEDOMAX, Z0MIN, Z0MAX, CSOIL, PTU, LLANDUSE, & + LSOIL, LOCAL,LVCOEF,ZTOPV,ZBOTV,errmsg,errflg) + + IMPLICIT NONE +! ---------------------------------------------------------------------- +! Internally set (default valuess) +! all soil and vegetation parameters required for the execusion oF +! the Noah lsm are defined in VEGPARM.TBL, SOILPARM.TB, and GENPARM.TBL. +! ---------------------------------------------------------------------- +! Vegetation parameters: +! ALBBRD: SFC background snow-free albedo +! CMXTBL: MAX CNPY Capacity +! Z0BRD: Background roughness length +! SHDFAC: Green vegetation fraction +! NROOT: Rooting depth +! RSMIN: Mimimum stomatal resistance +! RSMAX: Max. stomatal resistance +! RGL: Parameters used in radiation stress function +! HS: Parameter used in vapor pressure deficit functio +! TOPT: Optimum transpiration air temperature. +! CMCMAX: Maximum canopy water capacity +! CFACTR: Parameter used in the canopy inteception calculation +! SNUP: Threshold snow depth (in water equivalent m) that +! implies 100 percent snow cover +! LAI: Leaf area index +! +! ---------------------------------------------------------------------- +! Soil parameters: +! SMCMAX: MAX soil moisture content (porosity) +! SMCREF: Reference soil moisture (field capacity) +! SMCWLT: Wilting point soil moisture +! SMCWLT: Air dry soil moist content limits +! SSATPSI: SAT (saturation) soil potential +! DKSAT: SAT soil conductivity +! BEXP: B parameter +! SSATDW: SAT soil diffusivity +! F1: Soil thermal diffusivity/conductivity coef. +! QUARTZ: Soil quartz content +! Modified by F. Chen (12/22/97) to use the STATSGO soil map +! Modified By F. Chen (01/22/00) to include PLaya, Lava, and White San +! Modified By F. Chen (08/05/02) to include additional parameters for the Noah +! NOTE: SATDW = BB*SATDK*(SATPSI/MAXSMC) +! F11 = ALOG10(SATPSI) + BB*ALOG10(MAXSMC) + 2.0 +! REFSMC1=MAXSMC*(5.79E-9/SATDK)**(1/(2*BB+3)) 5.79E-9 m/s= 0.5 mm +! REFSMC=REFSMC1+1./3.(MAXSMC-REFSMC1) +! WLTSMC1=MAXSMC*(200./SATPSI)**(-1./BB) (Wetzel and Chang, 198 +! WLTSMC=WLTSMC1-0.5*WLTSMC1 +! Note: the values for playa is set for it to have a thermal conductivit +! as sand and to have a hydrulic conductivity as clay +! +! ---------------------------------------------------------------------- +! Class parameter 'SLOPETYP' was included to estimate linear reservoir +! coefficient 'SLOPE' to the baseflow runoff out of the bottom layer. +! lowest class (slopetyp=0) means highest slope parameter = 1. +! definition of slopetyp from 'zobler' slope type: +! slope class percent slope +! 1 0-8 +! 2 8-30 +! 3 > 30 +! 4 0-30 +! 5 0-8 & > 30 +! 6 8-30 & > 30 +! 7 0-8, 8-30, > 30 +! 9 GLACIAL ICE +! BLANK OCEAN/SEA +! SLOPE_DATA: linear reservoir coefficient +! SBETA_DATA: parameter used to caluculate vegetation effect on soil heat +! FXEXP_DAT: soil evaporation exponent used in DEVAP +! CSOIL_DATA: soil heat capacity [J M-3 K-1] +! SALP_DATA: shape parameter of distribution function of snow cover +! REFDK_DATA and REFKDT_DATA: parameters in the surface runoff parameteriz +! FRZK_DATA: frozen ground parameter +! ZBOT_DATA: depth[M] of lower boundary soil temperature +! CZIL_DATA: calculate roughness length of heat +! SMLOW_DATA and MHIGH_DATA: two soil moisture wilt, soil moisture referen +! parameters +! Set maximum number of soil-, veg-, and slopetyp in data statement. +! ---------------------------------------------------------------------- + INTEGER, PARAMETER :: MAX_SLOPETYP=30,MAX_SOILTYP=30,MAX_VEGTYP=30 + LOGICAL :: LOCAL + CHARACTER (LEN=256), INTENT(IN):: LLANDUSE, LSOIL + +! Veg parameters + INTEGER, INTENT(IN) :: VEGTYP + INTEGER, INTENT(OUT) :: NROOT + REAL, INTENT(INOUT) :: SHDFAC + REAL, INTENT(OUT) :: HS,RSMIN,RGL,SNUP, & + CMCMAX,RSMAX,TOPT, & + EMISSMIN, EMISSMAX, & + LAIMIN, LAIMAX, & + Z0MIN, Z0MAX, & + ALBEDOMIN, ALBEDOMAX, ZTOPV, ZBOTV +! Soil parameters + INTEGER, INTENT(IN) :: SOILTYP + REAL, INTENT(OUT) :: BEXP,DKSAT,DWSAT,F1,QUARTZ,SMCDRY, & + SMCMAX,SMCREF,SMCWLT,PSISAT +! General parameters + INTEGER, INTENT(IN) :: SLOPETYP,NSOIL + INTEGER :: I + + REAL, INTENT(OUT) :: SLOPE,CZIL,SBETA,FXEXP, & + CSOIL,SALP,FRZX,KDT,CFACTR, & + ZBOT,REFKDT,PTU + REAL, INTENT(OUT) :: LVCOEF + REAL,DIMENSION(1:NSOIL),INTENT(IN) :: SLDPTH,ZSOIL + REAL,DIMENSION(1:NSOIL),INTENT(OUT):: RTDIS + REAL :: FRZFACT,FRZK,REFDK + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + CHARACTER*256 :: err_message + errmsg = '' + errflg = 0 + +! SAVE +! ---------------------------------------------------------------------- +! + IF (SOILTYP .gt. SLCATS) THEN + errflg = 1 + errmsg = 'Warning: too many input soil types' + return + END IF + IF (VEGTYP .gt. LUCATS) THEN + errflg = 1 + errmsg = 'Warning: too many input landuse types' + return + END IF + IF (SLOPETYP .gt. SLPCATS) THEN + errflg = 1 + errmsg = 'Warning: too many input slope types' + return + END IF + +! ---------------------------------------------------------------------- +! SET-UP SOIL PARAMETERS +! ---------------------------------------------------------------------- + CSOIL = CSOIL_DATA + BEXP = BB (SOILTYP) + DKSAT = SATDK (SOILTYP) + DWSAT = SATDW (SOILTYP) + F1 = F11 (SOILTYP) + PSISAT = SATPSI (SOILTYP) + QUARTZ = QTZ (SOILTYP) + SMCDRY = DRYSMC (SOILTYP) + SMCMAX = MAXSMC (SOILTYP) + SMCREF = REFSMC (SOILTYP) + SMCWLT = WLTSMC (SOILTYP) +! ---------------------------------------------------------------------- +! Set-up universal parameters (not dependent on SOILTYP, VEGTYP or +! SLOPETYP) +! ---------------------------------------------------------------------- + ZBOT = ZBOT_DATA + SALP = SALP_DATA + SBETA = SBETA_DATA + REFDK = REFDK_DATA + FRZK = FRZK_DATA + FXEXP = FXEXP_DATA + REFKDT = REFKDT_DATA + PTU = 0. ! (not used yet) to satisify intent(out) + KDT = REFKDT * DKSAT / REFDK + CZIL = CZIL_DATA + SLOPE = SLOPE_DATA (SLOPETYP) + LVCOEF = LVCOEF_DATA + +! ---------------------------------------------------------------------- +! TO ADJUST FRZK PARAMETER TO ACTUAL SOIL TYPE: FRZK * FRZFACT +! ---------------------------------------------------------------------- + FRZFACT = (SMCMAX / SMCREF) * (0.412 / 0.468) + FRZX = FRZK * FRZFACT + +! ---------------------------------------------------------------------- +! SET-UP VEGETATION PARAMETERS +! ---------------------------------------------------------------------- + TOPT = TOPT_DATA + CMCMAX = CMCMAX_DATA + CFACTR = CFACTR_DATA + RSMAX = RSMAX_DATA + NROOT = NROTBL (VEGTYP) + SNUP = SNUPTBL (VEGTYP) + RSMIN = RSTBL (VEGTYP) + RGL = RGLTBL (VEGTYP) + HS = HSTBL (VEGTYP) + EMISSMIN = EMISSMINTBL (VEGTYP) + EMISSMAX = EMISSMAXTBL (VEGTYP) + LAIMIN = LAIMINTBL (VEGTYP) + LAIMAX = LAIMAXTBL (VEGTYP) + Z0MIN = Z0MINTBL (VEGTYP) + Z0MAX = Z0MAXTBL (VEGTYP) + ALBEDOMIN = ALBEDOMINTBL (VEGTYP) + ALBEDOMAX = ALBEDOMAXTBL (VEGTYP) + ZTOPV = ZTOPVTBL (VEGTYP) + ZBOTV = ZBOTVTBL (VEGTYP) + + IF (VEGTYP .eq. BARE) SHDFAC = 0.0 + IF (NROOT .gt. NSOIL) THEN + errflg = 1 + WRITE (err_message,*) 'Error: too many root layers ', & + NSOIL,NROOT + errmsg = TRIM(err_message) + return +! ---------------------------------------------------------------------- +! CALCULATE ROOT DISTRIBUTION. PRESENT VERSION ASSUMES UNIFORM +! DISTRIBUTION BASED ON SOIL LAYER DEPTHS. +! ---------------------------------------------------------------------- + END IF + DO I = 1,NROOT + RTDIS (I) = - SLDPTH (I)/ ZSOIL (NROOT) +! ---------------------------------------------------------------------- +! SET-UP SLOPE PARAMETER +! ---------------------------------------------------------------------- + END DO + +! print*,'end of PRMRED' +! print*,'VEGTYP',VEGTYP,'SOILTYP',SOILTYP,'SLOPETYP',SLOPETYP, & +! & 'CFACTR',CFACTR,'CMCMAX',CMCMAX,'RSMAX',RSMAX,'TOPT',TOPT, & +! & 'REFKDT',REFKDT,'KDT',KDT,'SBETA',SBETA, 'SHDFAC',SHDFAC, & +! & 'RSMIN',RSMIN,'RGL',RGL,'HS',HS,'ZBOT',ZBOT,'FRZX',FRZX, & +! & 'PSISAT',PSISAT,'SLOPE',SLOPE,'SNUP',SNUP,'SALP',SALP,'BEXP', & +! & BEXP, & +! & 'DKSAT',DKSAT,'DWSAT',DWSAT, & +! & 'SMCMAX',SMCMAX,'SMCWLT',SMCWLT,'SMCREF',SMCREF,'SMCDRY',SMCDRY, & +! & 'F1',F1,'QUARTZ',QUARTZ,'FXEXP',FXEXP, & +! & 'RTDIS',RTDIS,'SLDPTH',SLDPTH,'ZSOIL',ZSOIL, 'NROOT',NROOT, & +! & 'NSOIL',NSOIL,'Z0',Z0,'CZIL',CZIL,'LAI',LAI, & +! & 'CSOIL',CSOIL,'PTU',PTU, & +! & 'LOCAL', LOCAL + + END SUBROUTINE REDPRM + + SUBROUTINE ROSR12 (P,A,B,C,D,DELTA,NSOIL) + +! ---------------------------------------------------------------------- +! SUBROUTINE ROSR12 +! ---------------------------------------------------------------------- +! INVERT (SOLVE) THE TRI-DIAGONAL MATRIX PROBLEM SHOWN BELOW: +! ### ### ### ### ### ### +! #B(1), C(1), 0 , 0 , 0 , . . . , 0 # # # # # +! #A(2), B(2), C(2), 0 , 0 , . . . , 0 # # # # # +! # 0 , A(3), B(3), C(3), 0 , . . . , 0 # # # # D(3) # +! # 0 , 0 , A(4), B(4), C(4), . . . , 0 # # P(4) # # D(4) # +! # 0 , 0 , 0 , A(5), B(5), . . . , 0 # # P(5) # # D(5) # +! # . . # # . # = # . # +! # . . # # . # # . # +! # . . # # . # # . # +! # 0 , . . . , 0 , A(M-2), B(M-2), C(M-2), 0 # #P(M-2)# #D(M-2)# +! # 0 , . . . , 0 , 0 , A(M-1), B(M-1), C(M-1)# #P(M-1)# #D(M-1)# +! # 0 , . . . , 0 , 0 , 0 , A(M) , B(M) # # P(M) # # D(M) # +! ### ### ### ### ### ### +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: K, KK + + REAL, DIMENSION(1:NSOIL), INTENT(IN):: A, B, D + REAL, DIMENSION(1:NSOIL),INTENT(INOUT):: C,P,DELTA + +! ---------------------------------------------------------------------- +! INITIALIZE EQN COEF C FOR THE LOWEST SOIL LAYER +! ---------------------------------------------------------------------- + C (NSOIL) = 0.0 + P (1) = - C (1) / B (1) +! ---------------------------------------------------------------------- +! SOLVE THE COEFS FOR THE 1ST SOIL LAYER +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! SOLVE THE COEFS FOR SOIL LAYERS 2 THRU NSOIL +! ---------------------------------------------------------------------- + DELTA (1) = D (1) / B (1) + DO K = 2,NSOIL + P (K) = - C (K) * ( 1.0 / (B (K) + A (K) * P (K -1)) ) + DELTA (K) = (D (K) - A (K)* DELTA (K -1))* (1.0/ (B (K) + A (K)& + * P (K -1))) + END DO +! ---------------------------------------------------------------------- +! SET P TO DELTA FOR LOWEST SOIL LAYER +! ---------------------------------------------------------------------- + P (NSOIL) = DELTA (NSOIL) + +! ---------------------------------------------------------------------- +! ADJUST P FOR SOIL LAYERS 2 THRU NSOIL +! ---------------------------------------------------------------------- + DO K = 2,NSOIL + KK = NSOIL - K + 1 + P (KK) = P (KK) * P (KK +1) + DELTA (KK) + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE ROSR12 +! ---------------------------------------------------------------------- + + + SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, & + TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1, & + QUARTZ,CSOIL,VEGTYP,ISURBAN,SOILTYP,OPT_THCND & + ,HCPCT_FASDAS ) ! fasdas + +! ---------------------------------------------------------------------- +! SUBROUTINE SHFLX +! ---------------------------------------------------------------------- +! UPDATE THE TEMPERATURE STATE OF THE SOIL COLUMN BASED ON THE THERMAL +! DIFFUSION EQUATION AND UPDATE THE FROZEN SOIL MOISTURE CONTENT BASED +! ON THE TEMPERATURE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: OPT_THCND + INTEGER, INTENT(IN) :: NSOIL, VEGTYP, ISURBAN, SOILTYP + INTEGER :: I + + REAL, INTENT(IN) :: BEXP,CSOIL,DF1,DT,F1,PSISAT,QUARTZ, & + SMCMAX, SMCWLT, TBOT,YY, ZBOT,ZZ1 + REAL, INTENT(INOUT) :: T1 + REAL, INTENT(OUT) :: SSOIL + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC,ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SH2O + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC + REAL, DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS + REAL, PARAMETER :: T0 = 273.15 + +! +! FASDAS +! + REAL, INTENT( OUT) :: HCPCT_FASDAS +! +! END FASDAS +! +! ---------------------------------------------------------------------- +! HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN +! ---------------------------------------------------------------------- + + ! Land case + + CALL HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,TBOT, & + ZBOT,PSISAT,SH2O,DT,BEXP,SOILTYP,OPT_THCND, & + F1,DF1,QUARTZ,CSOIL,AI,BI,CI,VEGTYP,ISURBAN & + ,HCPCT_FASDAS ) !fasdas + + CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI) + + DO I = 1,NSOIL + STC (I) = STCF (I) + ENDDO + +! ---------------------------------------------------------------------- +! IN THE NO SNOWPACK CASE (VIA ROUTINE NOPAC BRANCH,) UPDATE THE GRND +! (SKIN) TEMPERATURE HERE IN RESPONSE TO THE UPDATED SOIL TEMPERATURE +! PROFILE ABOVE. (NOTE: INSPECTION OF ROUTINE SNOPAC SHOWS THAT T1 +! BELOW IS A DUMMY VARIABLE ONLY, AS SKIN TEMPERATURE IS UPDATED +! DIFFERENTLY IN ROUTINE SNOPAC) +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! CALCULATE SURFACE SOIL HEAT FLUX +! ---------------------------------------------------------------------- + T1 = (YY + (ZZ1- 1.0) * STC (1)) / ZZ1 + SSOIL = DF1 * (STC (1) - T1) / (0.5 * ZSOIL (1)) + +! ---------------------------------------------------------------------- + END SUBROUTINE SHFLX +! ---------------------------------------------------------------------- + + SUBROUTINE SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL, & + & SH2O,SLOPE,KDT,FRZFACT, & + & SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT, & + & SHDFAC,CMCMAX, & + & RUNOFF1,RUNOFF2,RUNOFF3, & + & EDIR,EC,ET, & + & DRIP, SFHEAD1RT,INFXS1RT) + +! ---------------------------------------------------------------------- +! SUBROUTINE SMFLX +! ---------------------------------------------------------------------- +! CALCULATE SOIL MOISTURE FLUX. THE SOIL MOISTURE CONTENT (SMC - A PER +! UNIT VOLUME MEASUREMENT) IS A DEPENDENT VARIABLE THAT IS UPDATED WITH +! PROGNOSTIC EQNS. THE CANOPY MOISTURE CONTENT (CMC) IS ALSO UPDATED. +! FROZEN GROUND VERSION: NEW STATES ADDED: SH2O, AND FROZEN GROUND +! CORRECTION FACTOR, FRZFACT AND PARAMETER SLOPE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: I,K + + REAL, INTENT(IN) :: BEXP, CMCMAX, DKSAT,DWSAT, DT, EC, EDIR, & + KDT, PRCP1, SHDFAC, SLOPE, SMCMAX, SMCWLT + REAL, INTENT(OUT) :: DRIP, RUNOFF1, RUNOFF2, RUNOFF3 + REAL, INTENT(INOUT) :: CMC + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ET,ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: SMC, SH2O + REAL, DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS, RHSTT, & + SICE, SH2OA, SH2OFG + REAL :: DUMMY, EXCESS,FRZFACT,PCPDRP,RHSCT,TRHSCT + REAL :: FAC2 + REAL :: FLIMIT + + REAL, INTENT(INOUT) :: SFHEAD1RT,INFXS1RT + +! ---------------------------------------------------------------------- +! EXECUTABLE CODE BEGINS HERE. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! COMPUTE THE RIGHT HAND SIDE OF THE CANOPY EQN TERM ( RHSCT ) +! ---------------------------------------------------------------------- + DUMMY = 0. + +! ---------------------------------------------------------------------- +! CONVERT RHSCT (A RATE) TO TRHSCT (AN AMOUNT) AND ADD IT TO EXISTING +! CMC. IF RESULTING AMT EXCEEDS MAX CAPACITY, IT BECOMES DRIP AND WILL +! FALL TO THE GRND. +! ---------------------------------------------------------------------- + RHSCT = SHDFAC * PRCP1- EC + DRIP = 0. + TRHSCT = DT * RHSCT + EXCESS = CMC + TRHSCT + +! ---------------------------------------------------------------------- +! PCPDRP IS THE COMBINED PRCP1 AND DRIP (FROM CMC) THAT GOES INTO THE +! SOIL +! ---------------------------------------------------------------------- + IF (EXCESS > CMCMAX) DRIP = EXCESS - CMCMAX + PCPDRP = (1. - SHDFAC) * PRCP1+ DRIP / DT + +! ---------------------------------------------------------------------- +! STORE ICE CONTENT AT EACH SOIL LAYER BEFORE CALLING SRT and SSTEP +! + DO I = 1,NSOIL + SICE (I) = SMC (I) - SH2O (I) + END DO +! ---------------------------------------------------------------------- +! CALL SUBROUTINES SRT AND SSTEP TO SOLVE THE SOIL MOISTURE +! TENDENCY EQUATIONS. +! IF THE INFILTRATING PRECIP RATE IS NONTRIVIAL, +! (WE CONSIDER NONTRIVIAL TO BE A PRECIP TOTAL OVER THE TIME STEP +! EXCEEDING ONE ONE-THOUSANDTH OF THE WATER HOLDING CAPACITY OF +! THE FIRST SOIL LAYER) +! THEN CALL THE SRT/SSTEP SUBROUTINE PAIR TWICE IN THE MANNER OF +! TIME SCHEME "F" (IMPLICIT STATE, AVERAGED COEFFICIENT) +! OF SECTION 2 OF KALNAY AND KANAMITSU (1988, MWR, VOL 116, +! PAGES 1945-1958)TO MINIMIZE 2-DELTA-T OSCILLATIONS IN THE +! SOIL MOISTURE VALUE OF THE TOP SOIL LAYER THAT CAN ARISE BECAUSE +! OF THE EXTREME NONLINEAR DEPENDENCE OF THE SOIL HYDRAULIC +! DIFFUSIVITY COEFFICIENT AND THE HYDRAULIC CONDUCTIVITY ON THE +! SOIL MOISTURE STATE +! OTHERWISE CALL THE SRT/SSTEP SUBROUTINE PAIR ONCE IN THE MANNER OF +! TIME SCHEME "D" (IMPLICIT STATE, EXPLICIT COEFFICIENT) +! OF SECTION 2 OF KALNAY AND KANAMITSU +! PCPDRP IS UNITS OF KG/M**2/S OR MM/S, ZSOIL IS NEGATIVE DEPTH IN M +! ---------------------------------------------------------------------- +! According to Dr. Ken Mitchell's suggestion, add the second contraint +! to remove numerical instability of runoff and soil moisture +! FLIMIT is a limit value for FAC2 + FAC2=0.0 + DO I=1,NSOIL + FAC2=MAX(FAC2,SH2O(I)/SMCMAX) + ENDDO + CALL FAC2MIT(SMCMAX,FLIMIT) + +! ---------------------------------------------------------------------- +! FROZEN GROUND VERSION: +! SMC STATES REPLACED BY SH2O STATES IN SRT SUBR. SH2O & SICE STATES +! INC&UDED IN SSTEP SUBR. FROZEN GROUND CORRECTION FACTOR, FRZFACT +! ADDED. ALL WATER BALANCE CALCULATIONS USING UNFROZEN WATER +! ---------------------------------------------------------------------- + +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... Add previous ponded water to new precip drip... + PCPDRP = PCPDRP + SFHEAD1RT/1000./DT ! convert SFHEAD1RT to (m/s) +#endif + + + IF ( ( (PCPDRP * DT) > (0.0001*1000.0* (- ZSOIL (1))* SMCMAX) ) & + .OR. (FAC2 > FLIMIT) ) THEN + CALL SRT (RHSTT,EDIR,ET,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL, & + DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1, & + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI, & + SFHEAD1RT,INFXS1RT) + CALL SSTEP (SH2OFG,SH2O,DUMMY,RHSTT,RHSCT,DT,NSOIL,SMCMAX, & + CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI,INFXS1RT) + DO K = 1,NSOIL + SH2OA (K) = (SH2O (K) + SH2OFG (K)) * 0.5 + END DO + CALL SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,ZSOIL, & + DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1, & + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI, & + SFHEAD1RT,INFXS1RT) + CALL SSTEP (SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX, & + CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI,INFXS1RT) + + ELSE + CALL SRT (RHSTT,EDIR,ET,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL, & + DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1, & + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI, & + SFHEAD1RT,INFXS1RT) + CALL SSTEP (SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX, & + CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI,INFXS1RT) +! RUNOF = RUNOFF + + END IF + +! ---------------------------------------------------------------------- + END SUBROUTINE SMFLX +! ---------------------------------------------------------------------- + + + SUBROUTINE SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR, & + XLAI,SHDFAC,FVB,GAMA,FBUR, & + FGSN,ZTOPV,ZBOTV,UA_PHYS) + +! ---------------------------------------------------------------------- +! SUBROUTINE SNFRAC +! ---------------------------------------------------------------------- +! CALCULATE SNOW FRACTION (0 -> 1) +! SNEQV SNOW WATER EQUIVALENT (M) +! SNUP THRESHOLD SNEQV DEPTH ABOVE WHICH SNCOVR=1 +! SALP TUNING PARAMETER +! SNCOVR FRACTIONAL SNOW COVER +! ---------------------------------------------------------------------- + IMPLICIT NONE + + REAL, INTENT(IN) :: SNEQV,SNUP,SALP,SNOWH + REAL, INTENT(OUT) :: SNCOVR + REAL :: RSNOW, Z0N + LOGICAL, INTENT(IN) :: UA_PHYS ! UA: flag for UA option + REAL, INTENT(IN) :: ZTOPV ! UA: height of canopy top + REAL, INTENT(IN) :: ZBOTV ! UA: height of canopy bottom + REAL, INTENT(IN) :: SHDFAC ! UA: vegetation fraction + REAL, INTENT(INOUT) :: XLAI ! UA: LAI modified by snow + REAL, INTENT(OUT) :: FVB ! UA: frac. veg. w/snow beneath + REAL, INTENT(OUT) :: GAMA ! UA: = EXP(-1.* XLAI) + REAL, INTENT(OUT) :: FBUR ! UA: fraction of canopy buried + REAL, INTENT(OUT) :: FGSN ! UA: ground snow cover fraction + + REAL :: SNUPGRD = 0.02 ! UA: SWE limit for ground cover + +! ---------------------------------------------------------------------- +! SNUP IS VEG-CLASS DEPENDENT SNOWDEPTH THRESHHOLD (SET IN ROUTINE +! REDPRM) ABOVE WHICH SNOCVR=1. +! ---------------------------------------------------------------------- + IF (SNEQV < SNUP) THEN + RSNOW = SNEQV / SNUP + SNCOVR = 1. - ( EXP ( - SALP * RSNOW) - RSNOW * EXP ( - SALP)) + ELSE + SNCOVR = 1.0 + END IF + +! FORMULATION OF DICKINSON ET AL. 1986 +! Z0N = 0.035 + +! SNCOVR=SNOWH/(SNOWH + 5*Z0N) + +! FORMULATION OF MARSHALL ET AL. 1994 +! SNCOVR=SNEQV/(SNEQV + 2*Z0N) + + IF(UA_PHYS) THEN + +!--------------------------------------------------------------------- +! FGSN: FRACTION OF SOIL COVERED WITH SNOW +!--------------------------------------------------------------------- + IF (SNEQV < SNUPGRD) THEN + FGSN = SNEQV / SNUPGRD + ELSE + FGSN = 1.0 + END IF +!------------------------------------------------------------------ +! FBUR: VERTICAL FRACTION OF VEGETATION COVERED BY SNOW +! GRASS, CROP, AND SHRUB: MULTIPLY 0.4 BY ZTOPV AND ZBOTV BECAUSE +! THEY WILL BE PRESSED DOWN BY THE SNOW. +! FOREST: DON'T NEED TO CHANGE ZTOPV AND ZBOTV. + + IF(ZBOTV > 0. .AND. SNOWH > ZBOTV) THEN + IF(ZBOTV <= 0.5) THEN + FBUR = (SNOWH - 0.4*ZBOTV) / (0.4*(ZTOPV-ZBOTV)) ! short veg. + ELSE + FBUR = (SNOWH - ZBOTV) / (ZTOPV-ZBOTV) ! tall veg. + ENDIF + ELSE + FBUR = 0. + ENDIF + + FBUR = MIN(MAX(FBUR,0.0),1.0) + +! XLAI IS ADJUSTED FOR VERTICAL BURYING BY SNOW + XLAI = XLAI * (1.0 - FBUR) +! ---------------------------------------------------------------------- +! SNOW-COVERED SOIL: (1-SHDFAC)*FGSN +! VEGETATION WITH SNOW ABOVE DUE TO BURIAL FVEG_SN_AB = SHDFAC*FBUR +! SNOW ON THE GROUND THAT CAN BE "SEEN" BY SATELLITE +! (IF XLAI GOES TO ZERO): GAMA*FVB +! Where GAMA = exp(-XLAI) +! ---------------------------------------------------------------------- + +! VEGETATION WITH SNOW BELOW + FVB = SHDFAC * FGSN * (1.0 - FBUR) + +! GAMA IS USED TO DIVIDE FVB INTO TWO PARTS: +! GAMA=1 FOR XLAI=0 AND GAMA=0 FOR XLAI=6 + GAMA = EXP(-1.* XLAI) + ELSE + ! Define intent(out) terms for .NOT. UA_PHYS case + FVB = 0.0 + GAMA = 0.0 + FBUR = 0.0 + FGSN = 0.0 + END IF ! UA_PHYS + +! ---------------------------------------------------------------------- + END SUBROUTINE SNFRAC +! ---------------------------------------------------------------------- + + SUBROUTINE SNKSRC (TSNSR,TAVG,SMC,SH2O,ZSOIL,NSOIL, & + & SMCMAX,PSISAT,BEXP,DT,K,QTOT) +! ---------------------------------------------------------------------- +! SUBROUTINE SNKSRC +! ---------------------------------------------------------------------- +! CALCULATE SINK/SOURCE TERM OF THE TERMAL DIFFUSION EQUATION. (SH2O) IS +! AVAILABLE LIQUED WATER. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: K,NSOIL + REAL, INTENT(IN) :: BEXP, DT, PSISAT, QTOT, SMC, SMCMAX, & + TAVG + REAL, INTENT(INOUT) :: SH2O + + REAL, DIMENSION(1:NSOIL), INTENT(IN):: ZSOIL + + REAL :: DF, DZ, DZH, FREE, TSNSR, & + TDN, TM, TUP, TZ, X0, XDN, XH2O, XUP + + REAL, PARAMETER :: DH2O = 1.0000E3, HLICE = 3.3350E5, & + T0 = 2.7315E2 + + IF (K == 1) THEN + DZ = - ZSOIL (1) + ELSE + DZ = ZSOIL (K -1) - ZSOIL (K) + END IF +! ---------------------------------------------------------------------- +! VIA FUNCTION FRH2O, COMPUTE POTENTIAL OR 'EQUILIBRIUM' UNFROZEN +! SUPERCOOLED FREE WATER FOR GIVEN SOIL TYPE AND SOIL LAYER TEMPERATURE. +! FUNCTION FRH20 INVOKES EQN (17) FROM V. KOREN ET AL (1999, JGR, VOL. +! 104, PG 19573). (ASIDE: LATTER EQN IN JOURNAL IN CENTIGRADE UNITS. +! ROUTINE FRH2O USE FORM OF EQN IN KELVIN UNITS.) +! ---------------------------------------------------------------------- +! FREE = FRH2O(TAVG,SMC,SH2O,SMCMAX,BEXP,PSISAT) + +! ---------------------------------------------------------------------- +! IN NEXT BLOCK OF CODE, INVOKE EQN 18 OF V. KOREN ET AL (1999, JGR, +! VOL. 104, PG 19573.) THAT IS, FIRST ESTIMATE THE NEW AMOUNTOF LIQUID +! WATER, 'XH2O', IMPLIED BY THE SUM OF (1) THE LIQUID WATER AT THE BEGIN +! OF CURRENT TIME STEP, AND (2) THE FREEZE OF THAW CHANGE IN LIQUID +! WATER IMPLIED BY THE HEAT FLUX 'QTOT' PASSED IN FROM ROUTINE HRT. +! SECOND, DETERMINE IF XH2O NEEDS TO BE BOUNDED BY 'FREE' (EQUIL AMT) OR +! IF 'FREE' NEEDS TO BE BOUNDED BY XH2O. +! ---------------------------------------------------------------------- + CALL FRH2O (FREE,TAVG,SMC,SH2O,SMCMAX,BEXP,PSISAT) + +! ---------------------------------------------------------------------- +! FIRST, IF FREEZING AND REMAINING LIQUID LESS THAN LOWER BOUND, THEN +! REDUCE EXTENT OF FREEZING, THEREBY LETTING SOME OR ALL OF HEAT FLUX +! QTOT COOL THE SOIL TEMP LATER IN ROUTINE HRT. +! ---------------------------------------------------------------------- + XH2O = SH2O + QTOT * DT / (DH2O * HLICE * DZ) + IF ( XH2O < SH2O .AND. XH2O < FREE) THEN + IF ( FREE > SH2O ) THEN + XH2O = SH2O + ELSE + XH2O = FREE + END IF + END IF +! ---------------------------------------------------------------------- +! SECOND, IF THAWING AND THE INCREASE IN LIQUID WATER GREATER THAN UPPER +! BOUND, THEN REDUCE EXTENT OF THAW, THEREBY LETTING SOME OR ALL OF HEAT +! FLUX QTOT WARM THE SOIL TEMP LATER IN ROUTINE HRT. +! ---------------------------------------------------------------------- + IF ( XH2O > SH2O .AND. XH2O > FREE ) THEN + IF ( FREE < SH2O ) THEN + XH2O = SH2O + ELSE + XH2O = FREE + END IF + END IF + +! ---------------------------------------------------------------------- +! CALCULATE PHASE-CHANGE HEAT SOURCE/SINK TERM FOR USE IN ROUTINE HRT +! AND UPDATE LIQUID WATER TO REFLCET FINAL FREEZE/THAW INCREMENT. +! ---------------------------------------------------------------------- +! SNKSRC = -DH2O*HLICE*DZ*(XH2O-SH2O)/DT + IF (XH2O < 0.) XH2O = 0. + IF (XH2O > SMC) XH2O = SMC + TSNSR = - DH2O * HLICE * DZ * (XH2O - SH2O)/ DT + SH2O = XH2O + +! ---------------------------------------------------------------------- + END SUBROUTINE SNKSRC +! ---------------------------------------------------------------------- + + SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT, & + SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT, & + SBETA,DF1, & + Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,SSOIL,STC,EPSCA,& + SFCPRS,BEXP,PC,RCH,RR,CFACTR,SNCOVR,ESD,SNDENS,& + SNOWH,SH2O,SLOPE,KDT,FRZFACT,PSISAT, & + ZSOIL,DWSAT,DKSAT,TBOT,ZBOT,SHDFAC,RUNOFF1, & + RUNOFF2,RUNOFF3,EDIR,EC,ET,ETT,NROOT,SNOMLT, & + RTDIS,QUARTZ,FXEXP,CSOIL, & + BETA,DRIP,DEW,FLX1,FLX2,FLX3,ESNOW,ETNS,EMISSI,& + RIBB,SOLDN, & + ISURBAN, & + VEGTYP, & + ETPN,FLX4,UA_PHYS, & + SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND & + ,QFX_PHY,fasdas,HCPCT_FASDAS, & !fasdas + SIGMA,CPH2O,CPICE,LSUBF) +! ---------------------------------------------------------------------- +! SUBROUTINE SNOPAC +! ---------------------------------------------------------------------- +! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES & UPDATE SOIL MOISTURE +! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN A SNOW PACK IS +! PRESENT. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: OPT_THCND + INTEGER, INTENT(IN) :: NROOT, NSOIL,VEGTYP,SOILTYP + INTEGER, INTENT(IN) :: ISURBAN + INTEGER :: K +! +! kmh 09/03/2006 add IT16 for surface temperature iteration +! + INTEGER :: IT16 + LOGICAL, INTENT(IN) :: SNOWNG + +!DJG NDHMS/WRF-Hydro edit... + REAL, INTENT(INOUT) :: SFHEAD1RT,INFXS1RT,ETPND1 + + REAL, INTENT(IN) :: BEXP,CFACTR, CMCMAX,CSOIL,DF1,DKSAT, & + DT,DWSAT, EPSCA,FDOWN,F1,FXEXP, & + FRZFACT,KDT,PC, PRCP,PSISAT,Q2,QUARTZ, & + RCH,RR,SBETA,SFCPRS, SFCTMP, SHDFAC, & + SLOPE,SMCDRY,SMCMAX,SMCREF,SMCWLT, T24, & + TBOT,TH2,ZBOT,EMISSI,SOLDN,SIGMA,CPH2O, & + CPICE,LSUBF + REAL, INTENT(INOUT) :: CMC, BETA, ESD,FLX2,PRCPF,SNOWH,SNCOVR, & + SNDENS, T1, RIBB, ETP + REAL, INTENT(OUT) :: DEW,DRIP,EC,EDIR, ETNS, ESNOW,ETT, & + FLX1,FLX3, RUNOFF1,RUNOFF2,RUNOFF3, & + SSOIL,SNOMLT + REAL, DIMENSION(1:NSOIL),INTENT(IN) :: RTDIS,ZSOIL + REAL, DIMENSION(1:NSOIL),INTENT(OUT) :: ET + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SMC,SH2O,STC + REAL, DIMENSION(1:NSOIL) :: ET1 + REAL :: DENOM,DSOIL,DTOT,EC1,EDIR1,ESDFLX,ETA, & + ETT1, ESNOW1, ESNOW2, ETA1,ETP1,ETP2, & + ETP3, ETNS1, ETANRG, ETAX, EX, FLX3X, & + FRCSNO,FRCSOI, PRCP1, QSAT,RSNOW, SEH, & + SNCOND,SSOIL1, T11,T12, T12A, T12AX, & + T12B, T14, YY, ZZ1 +! T12B, T14, YY, ZZ1,EMISSI_S +! +! kmh 01/11/2007 add T15, T16, and DTOT2 for SFC T iteration and snow heat flux +! + REAL :: T15, T16, DTOT2 + REAL, PARAMETER :: ESDMIN = 1.E-6, LSUBC = 2.501000E+6, & + LSUBS = 2.83E+6, TFREEZ = 273.15, & + SNOEXP = 2.0 + LOGICAL, INTENT(IN) :: UA_PHYS ! UA: flag for UA option + REAL, INTENT(INOUT) :: FLX4 ! UA: energy removed by canopy + REAL, INTENT(IN) :: ETPN ! UA: adjusted pot. evap. [mm/s] + REAL :: ETP1N ! UA: adjusted pot. evap. [m/s] + +! +! FASDAS +! + REAL :: QFX_PHY + INTEGER :: fasdas + REAL, INTENT( OUT) :: HCPCT_FASDAS +! +! END FASDAS +! +! ---------------------------------------------------------------------- +! EXECUTABLE CODE BEGINS HERE: +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! INITIALIZE EVAP TERMS. +! ---------------------------------------------------------------------- +! conversions: +! ESNOW [KG M-2 S-1] +! ESDFLX [KG M-2 S-1] .le. ESNOW +! ESNOW1 [M S-1] +! ESNOW2 [M] +! ETP [KG M-2 S-1] +! ETP1 [M S-1] +! ETP2 [M] +! ---------------------------------------------------------------------- + DEW = 0. + EDIR = 0. + EDIR1 = 0. + EC1 = 0. + EC = 0. +! EMISSI_S=0.95 ! For snow + + DO K = 1,NSOIL + ET (K) = 0. + ET1 (K) = 0. + END DO + ETT = 0. + ETT1 = 0. + +!DJG NDHMS/WRF-Hydro edit... + ETPND1 = 0. + + + ETNS = 0. + ETNS1 = 0. + ESNOW = 0. + ESNOW1 = 0. + ESNOW2 = 0. + +! ---------------------------------------------------------------------- +! CONVERT POTENTIAL EVAP (ETP) FROM KG M-2 S-1 TO ETP1 IN M S-1 +! ---------------------------------------------------------------------- + PRCP1 = PRCPF *0.001 +! ---------------------------------------------------------------------- +! IF ETP<0 (DOWNWARD) THEN DEWFALL (=FROSTFALL IN THIS CASE). +! ---------------------------------------------------------------------- + BETA = 1.0 + IF (ETP <= 0.0) THEN + IF ( ( RIBB >= 0.1 ) .AND. ( FDOWN > 150.0 ) ) THEN + ETP=(MIN(ETP*(1.0-RIBB),0.)*SNCOVR/0.980 + ETP*(0.980-SNCOVR))/0.980 + ENDIF + IF(ETP == 0.) BETA = 0.0 + ETP1 = ETP * 0.001 + IF(UA_PHYS) ETP1N = ETPN * 0.001 + DEW = -ETP1 + ESNOW2 = ETP1*DT + ETANRG = ETP*((1.-SNCOVR)*LSUBC + SNCOVR*LSUBS) + ELSE + ETP1 = ETP * 0.001 + IF(UA_PHYS) ETP1N = ETPN * 0.001 + ! LAND CASE + IF (SNCOVR < 1.) THEN + CALL EVAPO (ETNS1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL, & + SH2O, & + SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT, & + SMCREF,SHDFAC,CMCMAX, & + SMCDRY,CFACTR, & + EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS, & + FXEXP, SFHEAD1RT,ETPND1) +! ---------------------------------------------------------------------------- + EDIR1 = EDIR1* (1. - SNCOVR) + EC1 = EC1* (1. - SNCOVR) + DO K = 1,NSOIL + ET1 (K) = ET1 (K)* (1. - SNCOVR) + END DO + ETT1 = ETT1*(1.-SNCOVR) +! ETNS1 = EDIR1+ EC1+ ETT1 + ETNS1 = ETNS1*(1.-SNCOVR) +! ---------------------------------------------------------------------------- + EDIR = EDIR1*1000. + EC = EC1*1000. + DO K = 1,NSOIL + ET (K) = ET1 (K)*1000. + END DO +! +! FASDAS +! + if( fasdas == 1 ) then + QFX_PHY = EDIR + EC + DO K=1,NSOIL + QFX_PHY = QFX_PHY + ET(K) + END DO + endif +! +! END FASDAS +! + ETT = ETT1*1000. + ETNS = ETNS1*1000. + + +!DJG NDHMS/WRF-Hydro edit... + ETPND1 = ETPND1*1000. + + +! ---------------------------------------------------------------------- + + ENDIF + ESNOW = ETP*SNCOVR + IF(UA_PHYS) ESNOW = ETPN*SNCOVR ! USE ADJUSTED ETP + ESNOW1 = ESNOW*0.001 + ESNOW2 = ESNOW1*DT + ETANRG = ESNOW*LSUBS + ETNS*LSUBC + ENDIF + +! ---------------------------------------------------------------------- +! IF PRECIP IS FALLING, CALCULATE HEAT FLUX FROM SNOW SFC TO NEWLY +! ACCUMULATING PRECIP. NOTE THAT THIS REFLECTS THE FLUX APPROPRIATE FOR +! THE NOT-YET-UPDATED SKIN TEMPERATURE (T1). ASSUMES TEMPERATURE OF THE +! SNOWFALL STRIKING THE GROUND IS =SFCTMP (LOWEST MODEL LEVEL AIR TEMP). +! ---------------------------------------------------------------------- + FLX1 = 0.0 + IF (SNOWNG) THEN + FLX1 = CPICE * PRCP * (T1- SFCTMP) + ELSE + IF (PRCP > 0.0) FLX1 = CPH2O * PRCP * (T1- SFCTMP) +! ---------------------------------------------------------------------- +! CALCULATE AN 'EFFECTIVE SNOW-GRND SFC TEMP' (T12) BASED ON HEAT FLUXES +! BETWEEN THE SNOW PACK AND THE SOIL AND ON NET RADIATION. +! INCLUDE FLX1 (PRECIP-SNOW SFC) AND FLX2 (FREEZING RAIN LATENT HEAT) +! FLUXES. FLX1 FROM ABOVE, FLX2 BROUGHT IN VIA COMMOM BLOCK RITE. +! FLX2 REFLECTS FREEZING RAIN LATENT HEAT FLUX USING T1 CALCULATED IN +! PENMAN. +! ---------------------------------------------------------------------- + END IF + DSOIL = - (0.5 * ZSOIL (1)) + DTOT = SNOWH + DSOIL + DENOM = 1.0+ DF1 / (DTOT * RR * RCH) +! surface emissivity weighted by snow cover fraction +! T12A = ( (FDOWN - FLX1 - FLX2 - & +! & ((SNCOVR*EMISSI_S)+EMISSI*(1.0-SNCOVR))*SIGMA *T24)/RCH & +! & + TH2 - SFCTMP - ETANRG/RCH ) / RR + T12A = ( (FDOWN - FLX1- FLX2- EMISSI * SIGMA * T24)/ RCH & + + TH2- SFCTMP - ETANRG / RCH ) / RR + + T12B = DF1 * STC (1) / (DTOT * RR * RCH) + +! ---------------------------------------------------------------------- +! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS AT OR BELOW FREEZING, NO SNOW +! MELT WILL OCCUR. SET THE SKIN TEMP TO THIS EFFECTIVE TEMP. REDUCE +! (BY SUBLIMINATION ) OR INCREASE (BY FROST) THE DEPTH OF THE SNOWPACK, +! DEPENDING ON SIGN OF ETP. +! UPDATE SOIL HEAT FLUX (SSOIL) USING NEW SKIN TEMPERATURE (T1) +! SINCE NO SNOWMELT, SET ACCUMULATED SNOWMELT TO ZERO, SET 'EFFECTIVE' +! PRECIP FROM SNOWMELT TO ZERO, SET PHASE-CHANGE HEAT FLUX FROM SNOWMELT +! TO ZERO. +! ---------------------------------------------------------------------- +! SUB-FREEZING BLOCK +! ---------------------------------------------------------------------- + T12 = (SFCTMP + T12A + T12B) / DENOM + IF (T12 <= TFREEZ) THEN + T1 = T12 + SSOIL = DF1 * (T1- STC (1)) / DTOT +! ESD = MAX (0.0, ESD- ETP2) + ESD = MAX(0.0, ESD-ESNOW2) + FLX3 = 0.0 + EX = 0.0 + + SNOMLT = 0.0 + IF(UA_PHYS) FLX4 = 0.0 +! ---------------------------------------------------------------------- +! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS ABOVE FREEZING, SNOW MELT +! WILL OCCUR. CALL THE SNOW MELT RATE,EX AND AMT, SNOMLT. REVISE THE +! EFFECTIVE SNOW DEPTH. REVISE THE SKIN TEMP BECAUSE IT WOULD HAVE CHGD +! DUE TO THE LATENT HEAT RELEASED BY THE MELTING. CALC THE LATENT HEAT +! RELEASED, FLX3. SET THE EFFECTIVE PRECIP, PRCP1 TO THE SNOW MELT RATE, +! EX FOR USE IN SMFLX. ADJUSTMENT TO T1 TO ACCOUNT FOR SNOW PATCHES. +! CALCULATE QSAT VALID AT FREEZING POINT. NOTE THAT ESAT (SATURATION +! VAPOR PRESSURE) VALUE OF 6.11E+2 USED HERE IS THAT VALID AT FRZZING +! POINT. NOTE THAT ETP FROM CALL PENMAN IN SFLX IS IGNORED HERE IN +! FAVOR OF BULK ETP OVER 'OPEN WATER' AT FREEZING TEMP. +! UPDATE SOIL HEAT FLUX (S) USING NEW SKIN TEMPERATURE (T1) +! ---------------------------------------------------------------------- +! ABOVE FREEZING BLOCK +! ---------------------------------------------------------------------- + ELSE +! From V3.9 original code (commented) replaced to allow complete melting of small snow amounts +! T1 = TFREEZ * SNCOVR ** SNOEXP + T12 * (1.0- SNCOVR ** SNOEXP) + T1 = TFREEZ * max(0.01,SNCOVR ** SNOEXP) + T12 * (1.0- max(0.01,SNCOVR ** SNOEXP)) + BETA = 1.0 + +! ---------------------------------------------------------------------- +! IF POTENTIAL EVAP (SUBLIMATION) GREATER THAN DEPTH OF SNOWPACK. +! BETA<1 +! SNOWPACK HAS SUBLIMATED AWAY, SET DEPTH TO ZERO. +! ---------------------------------------------------------------------- + SSOIL = DF1 * (T1- STC (1)) / DTOT + IF (ESD-ESNOW2 <= ESDMIN) THEN + ESD = 0.0 + EX = 0.0 + SNOMLT = 0.0 + FLX3 = 0.0 + IF(UA_PHYS) FLX4 = 0.0 +! ---------------------------------------------------------------------- +! SUBLIMATION LESS THAN DEPTH OF SNOWPACK +! SNOWPACK (ESD) REDUCED BY ESNOW2 (DEPTH OF SUBLIMATED SNOW) +! ---------------------------------------------------------------------- + ELSE + ESD = ESD-ESNOW2 + ETP3 = ETP * LSUBC + SEH = RCH * (T1- TH2) + T14 = T1* T1 + T14 = T14* T14 +! FLX3 = FDOWN - FLX1 - FLX2 - & +! ((SNCOVR*EMISSI_S)+EMISSI*(1-SNCOVR))*SIGMA*T14 - & +! SSOIL - SEH - ETANRG + FLX3 = FDOWN - FLX1- FLX2- EMISSI*SIGMA * T14- SSOIL - SEH - ETANRG + IF (FLX3 <= 0.0) FLX3 = 0.0 + + IF(UA_PHYS .AND. FLX4 > 0. .AND. FLX3 > 0.) THEN + IF(FLX3 >= FLX4) THEN + FLX3 = FLX3 - FLX4 + ELSE + FLX4 = FLX3 + FLX3 = 0. + ENDIF + ELSE + FLX4 = 0.0 + ENDIF + +! ---------------------------------------------------------------------- +! SNOWMELT REDUCTION DEPENDING ON SNOW COVER +! ---------------------------------------------------------------------- + EX = FLX3*0.001/ LSUBF + +! ---------------------------------------------------------------------- +! ESDMIN REPRESENTS A SNOWPACK DEPTH THRESHOLD VALUE BELOW WHICH WE +! CHOOSE NOT TO RETAIN ANY SNOWPACK, AND INSTEAD INCLUDE IT IN SNOWMELT. +! ---------------------------------------------------------------------- + SNOMLT = EX * DT + IF (ESD- SNOMLT >= ESDMIN) THEN + ESD = ESD- SNOMLT +! ---------------------------------------------------------------------- +! SNOWMELT EXCEEDS SNOW DEPTH +! ---------------------------------------------------------------------- + ELSE + EX = ESD / DT + FLX3 = EX *1000.0* LSUBF + SNOMLT = ESD + + ESD = 0.0 +! ---------------------------------------------------------------------- +! END OF 'ESD .LE. ETP2' IF-BLOCK +! ---------------------------------------------------------------------- + END IF + END IF + +! ---------------------------------------------------------------------- +! END OF 'T12 .LE. TFREEZ' IF-BLOCK +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! IF NON-GLACIAL LAND, ADD SNOWMELT RATE (EX) TO PRECIP RATE TO BE USED +! IN SUBROUTINE SMFLX (SOIL MOISTURE EVOLUTION) VIA INFILTRATION. +! +! RUNOFF/BASEFLOW LATER NEAR THE END OF SFLX (AFTER RETURN FROM CALL TO +! SUBROUTINE SNOPAC) +! ---------------------------------------------------------------------- + PRCP1 = PRCP1+ EX + +! ---------------------------------------------------------------------- +! SET THE EFFECTIVE POTNL EVAPOTRANSP (ETP1) TO ZERO SINCE THIS IS SNOW +! CASE, SO SURFACE EVAP NOT CALCULATED FROM EDIR, EC, OR ETT IN SMFLX +! (BELOW). +! SMFLX RETURNS UPDATED SOIL MOISTURE VALUES FOR NON-GLACIAL LAND. +! ---------------------------------------------------------------------- + END IF + CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL, & + SH2O,SLOPE,KDT,FRZFACT, & + SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT, & + SHDFAC,CMCMAX, & + RUNOFF1,RUNOFF2,RUNOFF3, & + EDIR1,EC1,ET1, & + DRIP, SFHEAD1RT,INFXS1RT) +! ---------------------------------------------------------------------- +! BEFORE CALL SHFLX IN THIS SNOWPACK CASE, SET ZZ1 AND YY ARGUMENTS TO +! SPECIAL VALUES THAT ENSURE THAT GROUND HEAT FLUX CALCULATED IN SHFLX +! MATCHES THAT ALREADY COMPUTER FOR BELOW THE SNOWPACK, THUS THE SFC +! HEAT FLUX TO BE COMPUTED IN SHFLX WILL EFFECTIVELY BE THE FLUX AT THE +! SNOW TOP SURFACE. T11 IS A DUMMY ARGUEMENT SO WE WILL NOT USE THE +! SKIN TEMP VALUE AS REVISED BY SHFLX. +! ---------------------------------------------------------------------- + ZZ1 = 1.0 + YY = STC (1) -0.5* SSOIL * ZSOIL (1)* ZZ1/ DF1 + +! ---------------------------------------------------------------------- +! SHFLX WILL CALC/UPDATE THE SOIL TEMPS. NOTE: THE SUB-SFC HEAT FLUX +! (SSOIL1) AND THE SKIN TEMP (T11) OUTPUT FROM THIS SHFLX CALL ARE NOT +! USED IN ANY SUBSEQUENT CALCULATIONS. RATHER, THEY ARE DUMMY VARIABLES +! HERE IN THE SNOPAC CASE, SINCE THE SKIN TEMP AND SUB-SFC HEAT FLUX ARE +! UPDATED INSTEAD NEAR THE BEGINNING OF THE CALL TO SNOPAC. +! ---------------------------------------------------------------------- + T11 = T1 + CALL SHFLX (SSOIL1,STC,SMC,SMCMAX,NSOIL,T11,DT,YY,ZZ1,ZSOIL, & + TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1, & + QUARTZ,CSOIL,VEGTYP,ISURBAN,SOILTYP,OPT_THCND & + ,HCPCT_FASDAS ) !fasdas + +! ---------------------------------------------------------------------- +! SNOW DEPTH AND DENSITY ADJUSTMENT BASED ON SNOW COMPACTION. YY IS +! ASSUMED TO BE THE SOIL TEMPERTURE AT THE TOP OF THE SOIL COLUMN. +! ---------------------------------------------------------------------- + ! LAND + IF (ESD > 0.) THEN + CALL SNOWPACK (ESD,DT,SNOWH,SNDENS,T1,YY,SNOMLT,UA_PHYS) + ELSE + ESD = 0. + SNOWH = 0. + SNDENS = 0. + SNCOND = 1. + SNCOVR = 0. + END IF + +! ---------------------------------------------------------------------- + END SUBROUTINE SNOPAC +! ---------------------------------------------------------------------- + + + SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL,SNOMLT,UA_PHYS) + +! ---------------------------------------------------------------------- +! SUBROUTINE SNOWPACK +! ---------------------------------------------------------------------- +! CALCULATE COMPACTION OF SNOWPACK UNDER CONDITIONS OF INCREASING SNOW +! DENSITY, AS OBTAINED FROM AN APPROXIMATE SOLUTION OF E. ANDERSON'S +! DIFFERENTIAL EQUATION (3.29), NOAA TECHNICAL REPORT NWS 19, BY VICTOR +! KOREN, 03/25/95. +! ---------------------------------------------------------------------- +! ESD WATER EQUIVALENT OF SNOW (M) +! DTSEC TIME STEP (SEC) +! SNOWH SNOW DEPTH (M) +! SNDENS SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY) +! TSNOW SNOW SURFACE TEMPERATURE (K) +! TSOIL SOIL SURFACE TEMPERATURE (K) + +! SUBROUTINE WILL RETURN NEW VALUES OF SNOWH AND SNDENS +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER :: IPOL, J + REAL, INTENT(IN) :: ESD, DTSEC,TSNOW,TSOIL + REAL, INTENT(INOUT) :: SNOWH, SNDENS + REAL :: BFAC,DSX,DTHR,DW,SNOWHC,PEXP, & + TAVGC,TSNOWC,TSOILC,ESDC,ESDCX + REAL, PARAMETER :: C1 = 0.01, C2 = 21.0, G = 9.81, & + KN = 4000.0 + LOGICAL, INTENT(IN) :: UA_PHYS ! UA: flag for UA option + REAL, INTENT(IN) :: SNOMLT ! UA: snow melt [m] + REAL :: SNOMLTC ! UA: snow melt [cm] +! ---------------------------------------------------------------------- +! CONVERSION INTO SIMULATION UNITS +! ---------------------------------------------------------------------- + SNOWHC = SNOWH *100. + ESDC = ESD *100. + IF(UA_PHYS) SNOMLTC = SNOMLT *100. + DTHR = DTSEC /3600. + TSNOWC = TSNOW -273.15 + TSOILC = TSOIL -273.15 + +! ---------------------------------------------------------------------- +! CALCULATING OF AVERAGE TEMPERATURE OF SNOW PACK +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! CALCULATING OF SNOW DEPTH AND DENSITY AS A RESULT OF COMPACTION +! SNDENS=DS0*(EXP(BFAC*ESD)-1.)/(BFAC*ESD) +! BFAC=DTHR*C1*EXP(0.08*TAVGC-C2*DS0) +! NOTE: BFAC*ESD IN SNDENS EQN ABOVE HAS TO BE CAREFULLY TREATED +! NUMERICALLY BELOW: +! C1 IS THE FRACTIONAL INCREASE IN DENSITY (1/(CM*HR)) +! C2 IS A CONSTANT (CM3/G) KOJIMA ESTIMATED AS 21 CMS/G +! ---------------------------------------------------------------------- + TAVGC = 0.5* (TSNOWC + TSOILC) + IF (ESDC > 1.E-2) THEN + ESDCX = ESDC + ELSE + ESDCX = 1.E-2 + END IF + +! DSX = SNDENS*((DEXP(BFAC*ESDC)-1.)/(BFAC*ESDC)) +! ---------------------------------------------------------------------- +! THE FUNCTION OF THE FORM (e**x-1)/x EMBEDDED IN ABOVE EXPRESSION +! FOR DSX WAS CAUSING NUMERICAL DIFFICULTIES WHEN THE DENOMINATOR "x" +! (I.E. BFAC*ESDC) BECAME ZERO OR APPROACHED ZERO (DESPITE THE FACT THAT +! THE ANALYTICAL FUNCTION (e**x-1)/x HAS A WELL DEFINED LIMIT AS +! "x" APPROACHES ZERO), HENCE BELOW WE REPLACE THE (e**x-1)/x +! EXPRESSION WITH AN EQUIVALENT, NUMERICALLY WELL-BEHAVED +! POLYNOMIAL EXPANSION. + +! NUMBER OF TERMS OF POLYNOMIAL EXPANSION, AND HENCE ITS ACCURACY, +! IS GOVERNED BY ITERATION LIMIT "IPOL". +! IPOL GREATER THAN 9 ONLY MAKES A DIFFERENCE ON DOUBLE +! PRECISION (RELATIVE ERRORS GIVEN IN PERCENT %). +! IPOL=9, FOR REL.ERROR <~ 1.6 E-6 % (8 SIGNIFICANT DIGITS) +! IPOL=8, FOR REL.ERROR <~ 1.8 E-5 % (7 SIGNIFICANT DIGITS) +! IPOL=7, FOR REL.ERROR <~ 1.8 E-4 % ... +! ---------------------------------------------------------------------- + BFAC = DTHR * C1* EXP (0.08* TAVGC - C2* SNDENS) + IPOL = 4 + PEXP = 0. +! PEXP = (1. + PEXP)*BFAC*ESDC/REAL(J+1) + DO J = IPOL,1, -1 + PEXP = (1. + PEXP)* BFAC * ESDCX / REAL (J +1) + END DO + + PEXP = PEXP + 1. +! ---------------------------------------------------------------------- +! ABOVE LINE ENDS POLYNOMIAL SUBSTITUTION +! ---------------------------------------------------------------------- +! END OF KOREAN FORMULATION + +! BASE FORMULATION (COGLEY ET AL., 1990) +! CONVERT DENSITY FROM G/CM3 TO KG/M3 +! DSM=SNDENS*1000.0 + +! DSX=DSM+DTSEC*0.5*DSM*G*ESD/ +! & (1E7*EXP(-0.02*DSM+KN/(TAVGC+273.16)-14.643)) + +! & CONVERT DENSITY FROM KG/M3 TO G/CM3 +! DSX=DSX/1000.0 + +! END OF COGLEY ET AL. FORMULATION + +! ---------------------------------------------------------------------- +! SET UPPER/LOWER LIMIT ON SNOW DENSITY +! ---------------------------------------------------------------------- + DSX = SNDENS * (PEXP) + IF (DSX > 0.40) DSX = 0.40 + IF (DSX < 0.05) DSX = 0.05 +! ---------------------------------------------------------------------- +! UPDATE OF SNOW DEPTH AND DENSITY DEPENDING ON LIQUID WATER DURING +! SNOWMELT. ASSUMED THAT 13% OF LIQUID WATER CAN BE STORED IN SNOW PER +! DAY DURING SNOWMELT TILL SNOW DENSITY 0.40. +! ---------------------------------------------------------------------- + SNDENS = DSX + IF (TSNOWC >= 0.) THEN + DW = 0.13* DTHR /24. + IF ( UA_PHYS .AND. TSOILC >= 0.) THEN + DW = MIN (DW, 0.13*SNOMLTC/(ESDCX+0.13*SNOMLTC)) + ENDIF + SNDENS = SNDENS * (1. - DW) + DW + IF (SNDENS >= 0.40) SNDENS = 0.40 +! ---------------------------------------------------------------------- +! CALCULATE SNOW DEPTH (CM) FROM SNOW WATER EQUIVALENT AND SNOW DENSITY. +! CHANGE SNOW DEPTH UNITS TO METERS +! ---------------------------------------------------------------------- + END IF + SNOWHC = ESDC / SNDENS + SNOWH = SNOWHC *0.01 + +! ---------------------------------------------------------------------- + END SUBROUTINE SNOWPACK +! ---------------------------------------------------------------------- + + SUBROUTINE SNOWZ0 (SNCOVR,Z0, Z0BRD, SNOWH,FBUR,FGSN,SHDMAX,UA_PHYS) + +! ---------------------------------------------------------------------- +! SUBROUTINE SNOWZ0 +! ---------------------------------------------------------------------- +! CALCULATE TOTAL ROUGHNESS LENGTH OVER SNOW +! SNCOVR FRACTIONAL SNOW COVER +! Z0 ROUGHNESS LENGTH (m) +! Z0S SNOW ROUGHNESS LENGTH:=0.001 (m) +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: SNCOVR, Z0BRD + REAL, INTENT(OUT) :: Z0 + REAL, PARAMETER :: Z0S=0.001 + REAL, INTENT(IN) :: SNOWH + REAL :: BURIAL + REAL :: Z0EFF + LOGICAL, INTENT(IN) :: UA_PHYS ! UA: flag for UA option + REAL, INTENT(IN) :: FBUR ! UA: fraction of canopy buried + REAL, INTENT(IN) :: FGSN ! UA: ground snow cover fraction + REAL, INTENT(IN) :: SHDMAX ! UA: maximum vegetation fraction + REAL, PARAMETER :: Z0G=0.01 ! UA: soil roughness + REAL :: FV,A1,A2 + + IF(UA_PHYS) THEN + + FV = SHDMAX * (1.-FBUR) + A1 = (1.-FV)**2*((1.-FGSN**2)*LOG(Z0G) + (FGSN**2)*LOG(Z0S)) + A2 = (1.-(1.-FV)**2)*LOG(Z0BRD) + Z0 = EXP(A1+A2) + + ELSE + +!m Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0S + BURIAL = 7.0*Z0BRD - SNOWH + IF(BURIAL.LE.0.0007) THEN + Z0EFF = Z0S + ELSE + Z0EFF = BURIAL/7.0 + ENDIF + + Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0EFF + + ENDIF +! ---------------------------------------------------------------------- + END SUBROUTINE SNOWZ0 +! ---------------------------------------------------------------------- + + + SUBROUTINE SNOW_NEW (TEMP,NEWSN,SNOWH,SNDENS) + +! ---------------------------------------------------------------------- +! SUBROUTINE SNOW_NEW +! ---------------------------------------------------------------------- +! CALCULATE SNOW DEPTH AND DENSITY TO ACCOUNT FOR THE NEW SNOWFALL. +! NEW VALUES OF SNOW DEPTH & DENSITY RETURNED. + +! TEMP AIR TEMPERATURE (K) +! NEWSN NEW SNOWFALL (M) +! SNOWH SNOW DEPTH (M) +! SNDENS SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY) +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: NEWSN, TEMP + REAL, INTENT(INOUT) :: SNDENS, SNOWH + REAL :: DSNEW, HNEWC, SNOWHC,NEWSNC,TEMPC + +! ---------------------------------------------------------------------- +! CONVERSION INTO SIMULATION UNITS +! ---------------------------------------------------------------------- + SNOWHC = SNOWH *100. + NEWSNC = NEWSN *100. + +! ---------------------------------------------------------------------- +! CALCULATING NEW SNOWFALL DENSITY DEPENDING ON TEMPERATURE +! EQUATION FROM GOTTLIB L. 'A GENERAL RUNOFF MODEL FOR SNOWCOVERED +! AND GLACIERIZED BASIN', 6TH NORDIC HYDROLOGICAL CONFERENCE, +! VEMADOLEN, SWEDEN, 1980, 172-177PP. +!----------------------------------------------------------------------- + TEMPC = TEMP -273.15 + IF (TEMPC <= -15.) THEN + DSNEW = 0.05 + ELSE + DSNEW = 0.05+0.0017* (TEMPC +15.)**1.5 + END IF +! ---------------------------------------------------------------------- +! ADJUSTMENT OF SNOW DENSITY DEPENDING ON NEW SNOWFALL +! ---------------------------------------------------------------------- + HNEWC = NEWSNC / DSNEW + IF (SNOWHC + HNEWC .LT. 1.0E-3) THEN + SNDENS = MAX(DSNEW,SNDENS) + ELSE + SNDENS = (SNOWHC * SNDENS + HNEWC * DSNEW)/ (SNOWHC + HNEWC) + ENDIF + SNOWHC = SNOWHC + HNEWC + SNOWH = SNOWHC *0.01 + +! ---------------------------------------------------------------------- + END SUBROUTINE SNOW_NEW +! ---------------------------------------------------------------------- + + SUBROUTINE SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP, & + ZSOIL,DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1, & + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZX,SICE,AI,BI,CI, & + SFHEAD1RT,INFXS1RT ) + +! ---------------------------------------------------------------------- +! SUBROUTINE SRT +! ---------------------------------------------------------------------- +! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL +! WATER DIFFUSION EQUATION. ALSO TO COMPUTE ( PREPARE ) THE MATRIX +! COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: IALP1, IOHINF, J, JJ, K, KS + +!DJG NDHMS/WRF-Hydro edit... Variables used in OV routing infiltration calcs + REAL, INTENT(INOUT) :: SFHEAD1RT, INFXS1RT + REAL :: SFCWATR,chcksm + + + + REAL, INTENT(IN) :: BEXP, DKSAT, DT, DWSAT, EDIR, FRZX, & + KDT, PCPDRP, SLOPE, SMCMAX, SMCWLT + REAL, INTENT(OUT) :: RUNOFF1, RUNOFF2 + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ET, SH2O, SH2OA, SICE, & + ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: RHSTT + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: AI, BI, CI + REAL, DIMENSION(1:NSOIL) :: DMAX + REAL :: ACRT, DD, DDT, DDZ, DDZ2, DENOM, & + DENOM2,DICE, DSMDZ, DSMDZ2, DT1, & + FCR,INFMAX,MXSMC,MXSMC2,NUMER,PDDUM, & + PX, SICEMAX,SLOPX, SMCAV, SSTT, & + SUM, VAL, WCND, WCND2, WDF, WDF2 + INTEGER, PARAMETER :: CVFRZ = 3 + +! ---------------------------------------------------------------------- +! FROZEN GROUND VERSION: +! REFERENCE FROZEN GROUND PARAMETER, CVFRZ, IS A SHAPE PARAMETER OF +! AREAL DISTRIBUTION FUNCTION OF SOIL ICE CONTENT WHICH EQUALS 1/CV. +! CV IS A COEFFICIENT OF SPATIAL VARIATION OF SOIL ICE CONTENT. BASED +! ON FIELD DATA CV DEPENDS ON AREAL MEAN OF FROZEN DEPTH, AND IT CLOSE +! TO CONSTANT = 0.6 IF AREAL MEAN FROZEN DEPTH IS ABOVE 20 CM. THAT IS +! WHY PARAMETER CVFRZ = 3 (INT{1/0.6*0.6}). +! CURRENT LOGIC DOESN'T ALLOW CVFRZ BE BIGGER THAN 3 +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF. INCLUDE THE +! INFILTRATION FORMULE FROM SCHAAKE AND KOREN MODEL. +! MODIFIED BY Q DUAN +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! LET SICEMAX BE THE GREATEST, IF ANY, FROZEN WATER CONTENT WITHIN SOIL +! LAYERS. +! ---------------------------------------------------------------------- + IOHINF = 1 + SICEMAX = 0.0 + DO KS = 1,NSOIL + IF (SICE (KS) > SICEMAX) SICEMAX = SICE (KS) +! ---------------------------------------------------------------------- +! DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF +! ---------------------------------------------------------------------- + END DO + +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... +!DJG Use previously merged Precip and Sfchead for infil. cap. calc. + SFCWATR = PCPDRP + PDDUM = SFCWATR +!DJG original PDDUM = PCPDRP + RUNOFF1 = 0.0 + INFXS1RT = 0.0 +#else + PDDUM = PCPDRP + RUNOFF1 = 0.0 +#endif + + + +! ---------------------------------------------------------------------- +! MODIFIED BY Q. DUAN, 5/16/94 +! ---------------------------------------------------------------------- +! IF (IOHINF == 1) THEN + +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... +!DJG IF (PCPDRP /= 0.0) THEN + IF (SFCWATR /= 0.0) THEN +#else + IF (PCPDRP /= 0.0) THEN +#endif + DT1 = DT /86400. + SMCAV = SMCMAX - SMCWLT + +! ---------------------------------------------------------------------- +! FROZEN GROUND VERSION: +! ---------------------------------------------------------------------- + DMAX (1)= - ZSOIL (1)* SMCAV + + DICE = - ZSOIL (1) * SICE (1) + DMAX (1)= DMAX (1)* (1.0- (SH2OA (1) + SICE (1) - SMCWLT)/ & + SMCAV) + + DD = DMAX (1) + +! ---------------------------------------------------------------------- +! FROZEN GROUND VERSION: +! ---------------------------------------------------------------------- + DO KS = 2,NSOIL + + DICE = DICE+ ( ZSOIL (KS -1) - ZSOIL (KS) ) * SICE (KS) + DMAX (KS) = (ZSOIL (KS -1) - ZSOIL (KS))* SMCAV + DMAX (KS) = DMAX (KS)* (1.0- (SH2OA (KS) + SICE (KS) & + - SMCWLT)/ SMCAV) + DD = DD+ DMAX (KS) +! ---------------------------------------------------------------------- +! VAL = (1.-EXP(-KDT*SQRT(DT1))) +! IN BELOW, REMOVE THE SQRT IN ABOVE +! ---------------------------------------------------------------------- + END DO + VAL = (1. - EXP ( - KDT * DT1)) + DDT = DD * VAL +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... +!DJG PX = PCPDRP * DT + PX = SFCWATR * DT +#else + PX = PCPDRP * DT +#endif + IF (PX < 0.0) PX = 0.0 + + + +! ---------------------------------------------------------------------- +! FROZEN GROUND VERSION: +! REDUCTION OF INFILTRATION BASED ON FROZEN GROUND PARAMETERS +! ---------------------------------------------------------------------- + INFMAX = (PX * (DDT / (PX + DDT)))/ DT + FCR = 1. + IF (DICE > 1.E-2) THEN + ACRT = CVFRZ * FRZX / DICE + SUM = 1. + IALP1 = CVFRZ - 1 + DO J = 1,IALP1 + K = 1 + DO JJ = J +1,IALP1 + K = K * JJ + END DO + SUM = SUM + (ACRT ** ( CVFRZ - J)) / FLOAT (K) + END DO + FCR = 1. - EXP ( - ACRT) * SUM + END IF + +! ---------------------------------------------------------------------- +! CORRECTION OF INFILTRATION LIMITATION: +! IF INFMAX .LE. HYDROLIC CONDUCTIVITY ASSIGN INFMAX THE VALUE OF +! HYDROLIC CONDUCTIVITY +! ---------------------------------------------------------------------- +! MXSMC = MAX ( SH2OA(1), SH2OA(2) ) + INFMAX = INFMAX * FCR + + MXSMC = SH2OA (1) + CALL WDFCND (WDF,WCND,MXSMC,SMCMAX,BEXP,DKSAT,DWSAT, & + SICEMAX) + INFMAX = MAX (INFMAX,WCND) + + INFMAX = MIN (INFMAX,PX/DT) +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... +!DJG IF (PCPDRP > INFMAX) THEN + IF (SFCWATR > INFMAX) THEN +!DJG RUNOFF1 = PCPDRP - INFMAX + RUNOFF1 = SFCWATR - INFMAX +#else + IF (PCPDRP > INFMAX) THEN + RUNOFF1 = PCPDRP - INFMAX +#endif + INFXS1RT = RUNOFF1*DT*1000. + PDDUM = INFMAX + END IF + +! ---------------------------------------------------------------------- +! TO AVOID SPURIOUS DRAINAGE BEHAVIOR, 'UPSTREAM DIFFERENCING' IN LINE +! BELOW REPLACED WITH NEW APPROACH IN 2ND LINE: +! 'MXSMC = MAX(SH2OA(1), SH2OA(2))' +! ---------------------------------------------------------------------- + END IF + + MXSMC = SH2OA (1) + CALL WDFCND (WDF,WCND,MXSMC,SMCMAX,BEXP,DKSAT,DWSAT, & + SICEMAX) +! ---------------------------------------------------------------------- +! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER +! ---------------------------------------------------------------------- + DDZ = 1. / ( - .5 * ZSOIL (2) ) + AI (1) = 0.0 + BI (1) = WDF * DDZ / ( - ZSOIL (1) ) + +! ---------------------------------------------------------------------- +! CALC RHSTT FOR THE TOP LAYER AFTER CALC'NG THE VERTICAL SOIL MOISTURE +! GRADIENT BTWN THE TOP AND NEXT TO TOP LAYERS. +! ---------------------------------------------------------------------- + CI (1) = - BI (1) + DSMDZ = ( SH2O (1) - SH2O (2) ) / ( - .5 * ZSOIL (2) ) + RHSTT (1) = (WDF * DSMDZ + WCND- PDDUM + EDIR + ET (1))/ ZSOIL (1) + +! ---------------------------------------------------------------------- +! INITIALIZE DDZ2 +! ---------------------------------------------------------------------- + SSTT = WDF * DSMDZ + WCND+ EDIR + ET (1) + +! ---------------------------------------------------------------------- +! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABV PROCESS +! ---------------------------------------------------------------------- + DDZ2 = 0.0 + DO K = 2,NSOIL + DENOM2 = (ZSOIL (K -1) - ZSOIL (K)) + IF (K /= NSOIL) THEN + +! ---------------------------------------------------------------------- +! AGAIN, TO AVOID SPURIOUS DRAINAGE BEHAVIOR, 'UPSTREAM DIFFERENCING' IN +! LINE BELOW REPLACED WITH NEW APPROACH IN 2ND LINE: +! 'MXSMC2 = MAX (SH2OA(K), SH2OA(K+1))' +! ---------------------------------------------------------------------- + SLOPX = 1. + + MXSMC2 = SH2OA (K) + CALL WDFCND (WDF2,WCND2,MXSMC2,SMCMAX,BEXP,DKSAT,DWSAT, & + SICEMAX) +! ----------------------------------------------------------------------- +! CALC SOME PARTIAL PRODUCTS FOR LATER USE IN CALC'NG RHSTT +! ---------------------------------------------------------------------- + DENOM = (ZSOIL (K -1) - ZSOIL (K +1)) + +! ---------------------------------------------------------------------- +! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT +! ---------------------------------------------------------------------- + DSMDZ2 = (SH2O (K) - SH2O (K +1)) / (DENOM * 0.5) + DDZ2 = 2.0 / DENOM + CI (K) = - WDF2 * DDZ2 / DENOM2 + + ELSE +! ---------------------------------------------------------------------- +! SLOPE OF BOTTOM LAYER IS INTRODUCED +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! RETRIEVE THE SOIL WATER DIFFUSIVITY AND HYDRAULIC CONDUCTIVITY FOR +! THIS LAYER +! ---------------------------------------------------------------------- + SLOPX = SLOPE + CALL WDFCND (WDF2,WCND2,SH2OA (NSOIL),SMCMAX,BEXP,DKSAT,DWSAT, & + SICEMAX) + +! ---------------------------------------------------------------------- +! CALC A PARTIAL PRODUCT FOR LATER USE IN CALC'NG RHSTT +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! SET MATRIX COEF CI TO ZERO +! ---------------------------------------------------------------------- + DSMDZ2 = 0.0 + CI (K) = 0.0 +! ---------------------------------------------------------------------- +! CALC RHSTT FOR THIS LAYER AFTER CALC'NG ITS NUMERATOR +! ---------------------------------------------------------------------- + END IF + NUMER = (WDF2 * DSMDZ2) + SLOPX * WCND2- (WDF * DSMDZ) & + - WCND+ ET (K) + +! ---------------------------------------------------------------------- +! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER +! ---------------------------------------------------------------------- + RHSTT (K) = NUMER / ( - DENOM2) + AI (K) = - WDF * DDZ / DENOM2 + +! ---------------------------------------------------------------------- +! RESET VALUES OF WDF, WCND, DSMDZ, AND DDZ FOR LOOP TO NEXT LYR +! RUNOFF2: SUB-SURFACE OR BASEFLOW RUNOFF +! ---------------------------------------------------------------------- + BI (K) = - ( AI (K) + CI (K) ) + IF (K .eq. NSOIL) THEN + RUNOFF2 = SLOPX * WCND2 + END IF + IF (K .ne. NSOIL) THEN + WDF = WDF2 + WCND = WCND2 + DSMDZ = DSMDZ2 + DDZ = DDZ2 + END IF + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE SRT +! ---------------------------------------------------------------------- + + SUBROUTINE SSTEP (SH2OOUT,SH2OIN,CMC,RHSTT,RHSCT,DT, & + NSOIL,SMCMAX,CMCMAX,RUNOFF3,ZSOIL,SMC,SICE, & + AI,BI,CI, INFXS1RT) + +! ---------------------------------------------------------------------- +! SUBROUTINE SSTEP +! ---------------------------------------------------------------------- +! CALCULATE/UPDATE SOIL MOISTURE CONTENT VALUES AND CANOPY MOISTURE +! CONTENT VALUES. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: I, K, KK11 + +!!DJG NDHMS/WRF-Hydro edit... + REAL, INTENT(INOUT) :: INFXS1RT + REAL :: AVAIL + + REAL, INTENT(IN) :: CMCMAX, DT, SMCMAX + REAL, INTENT(OUT) :: RUNOFF3 + REAL, INTENT(INOUT) :: CMC + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SH2OIN, SICE, ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: SH2OOUT + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: RHSTT, SMC + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: AI, BI, CI + REAL, DIMENSION(1:NSOIL) :: RHSTTin + REAL, DIMENSION(1:NSOIL) :: CIin + REAL :: DDZ, RHSCT, STOT, WPLUS + +! ---------------------------------------------------------------------- +! CREATE 'AMOUNT' VALUES OF VARIABLES TO BE INPUT TO THE +! TRI-DIAGONAL MATRIX ROUTINE. +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + RHSTT (K) = RHSTT (K) * DT + AI (K) = AI (K) * DT + BI (K) = 1. + BI (K) * DT + CI (K) = CI (K) * DT + END DO +! ---------------------------------------------------------------------- +! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12 +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + RHSTTin (K) = RHSTT (K) + END DO + DO K = 1,NSOIL + CIin (K) = CI (K) + END DO +! ---------------------------------------------------------------------- +! CALL ROSR12 TO SOLVE THE TRI-DIAGONAL MATRIX +! ---------------------------------------------------------------------- + CALL ROSR12 (CI,AI,BI,CIin,RHSTTin,RHSTT,NSOIL) +! ---------------------------------------------------------------------- +! SUM THE PREVIOUS SMC VALUE AND THE MATRIX SOLUTION TO GET A +! NEW VALUE. MIN ALLOWABLE VALUE OF SMC WILL BE 0.02. +! RUNOFF3: RUNOFF WITHIN SOIL LAYERS +! ---------------------------------------------------------------------- + WPLUS = 0.0 + RUNOFF3 = 0. + + DDZ = - ZSOIL (1) + DO K = 1,NSOIL + IF (K /= 1) DDZ = ZSOIL (K - 1) - ZSOIL (K) + SH2OOUT (K) = SH2OIN (K) + CI (K) + WPLUS / DDZ + STOT = SH2OOUT (K) + SICE (K) + IF (STOT > SMCMAX) THEN + IF (K .eq. 1) THEN + DDZ = - ZSOIL (1) + ELSE + KK11 = K - 1 + DDZ = - ZSOIL (K) + ZSOIL (KK11) + END IF + WPLUS = (STOT - SMCMAX) * DDZ + ELSE + WPLUS = 0. + END IF + SMC (K) = MAX ( MIN (STOT,SMCMAX),0.02 ) + SH2OOUT (K) = MAX ( (SMC (K) - SICE (K)),0.0) + END DO +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... +!DJG Modifications to redstribute WPLUS/RUNOFF3 (soil moisture closure error) to soil profile +!DJG beginning at bottom layer (NSOIL) + IF (WPLUS > 0.) THEN + DO K=NSOIL,2,-1 + + IF (K .eq. 2) THEN !Assign soil depths + DDZ = -ZSOIL(1) + ELSE + DDZ = ZSOIL(K-2)-ZSOIL(K-1) + END IF + + AVAIL = (SMCMAX - SMC(K-1)) * DDZ !Det. Avail. Stor. + +! print *, "ZZZZZ", K,DDZ,AVAIL,WPLUS,SMC(K),SMC(K-1),SMCMAX + + IF (WPLUS <= AVAIL) THEN + SMC(K-1) = SMC(K-1) + WPLUS/DDZ + WPLUS = 0. + ELSE + SMC(K-1) = SMCMAX + WPLUS = WPLUS - AVAIL + IF (K-1 .eq. 1) THEN + INFXS1RT = INFXS1RT + WPLUS*1000 + WPLUS = 0. + END IF + END IF + +! SMC (K) = MAX ( MIN (STOT,SMCMAX),0.02 ) + SH2OOUT (K) = MAX ( (SMC (K) - SICE (K)),0.0) + + END DO + END IF +!DJG NDHMS/WRF-Hydro edit...End of modification +#endif + + +! ---------------------------------------------------------------------- +! UPDATE CANOPY WATER CONTENT/INTERCEPTION (CMC). CONVERT RHSCT TO +! AN 'AMOUNT' VALUE AND ADD TO PREVIOUS CMC VALUE TO GET NEW CMC. +! ---------------------------------------------------------------------- + RUNOFF3 = WPLUS + CMC = CMC + DT * RHSCT + IF (CMC < 1.E-20) CMC = 0.0 + CMC = MIN (CMC,CMCMAX) + +! ---------------------------------------------------------------------- + END SUBROUTINE SSTEP +! ---------------------------------------------------------------------- + + SUBROUTINE TBND (TU,TB,ZSOIL,ZBOT,K,NSOIL,TBND1) + +! ---------------------------------------------------------------------- +! SUBROUTINE TBND +! ---------------------------------------------------------------------- +! CALCULATE TEMPERATURE ON THE BOUNDARY OF THE LAYER BY INTERPOLATION OF +! THE MIDDLE LAYER TEMPERATURES +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: K + REAL, INTENT(IN) :: TB, TU, ZBOT + REAL, INTENT(OUT) :: TBND1 + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL + REAL :: ZB, ZUP + REAL, PARAMETER :: T0 = 273.15 + +! ---------------------------------------------------------------------- +! USE SURFACE TEMPERATURE ON THE TOP OF THE FIRST LAYER +! ---------------------------------------------------------------------- + IF (K == 1) THEN + ZUP = 0. + ELSE + ZUP = ZSOIL (K -1) + END IF +! ---------------------------------------------------------------------- +! USE DEPTH OF THE CONSTANT BOTTOM TEMPERATURE WHEN INTERPOLATE +! TEMPERATURE INTO THE LAST LAYER BOUNDARY +! ---------------------------------------------------------------------- + IF (K == NSOIL) THEN + ZB = 2.* ZBOT - ZSOIL (K) + ELSE + ZB = ZSOIL (K +1) + END IF +! ---------------------------------------------------------------------- +! LINEAR INTERPOLATION BETWEEN THE AVERAGE LAYER TEMPERATURES +! ---------------------------------------------------------------------- + + TBND1 = TU + (TB - TU)* (ZUP - ZSOIL (K))/ (ZUP - ZB) +! ---------------------------------------------------------------------- + END SUBROUTINE TBND +! ---------------------------------------------------------------------- + + + SUBROUTINE TDFCND ( DF, SMC, QZ, SMCMAX, SH2O, BEXP, PSISAT, SOILTYP, OPT_THCND) + +! ---------------------------------------------------------------------- +! SUBROUTINE TDFCND +! ---------------------------------------------------------------------- +! CALCULATE THERMAL DIFFUSIVITY AND CONDUCTIVITY OF THE SOIL FOR A GIVEN +! POINT AND TIME. +! ---------------------------------------------------------------------- +! PETERS-LIDARD APPROACH (PETERS-LIDARD et al., 1998) +! June 2001 CHANGES: FROZEN SOIL CONDITION. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: SOILTYP, OPT_THCND + REAL, INTENT(IN) :: QZ, SMC, SMCMAX, SH2O, BEXP, PSISAT + REAL, INTENT(OUT) :: DF + REAL :: AKE, GAMMD, THKDRY, THKICE, THKO, & + THKQTZ,THKSAT,THKS,THKW,SATRATIO,XU, & + XUNFROZ,AKEI,AKEL,PSIF,PF + +! ---------------------------------------------------------------------- +! WE NOW GET QUARTZ AS AN INPUT ARGUMENT (SET IN ROUTINE REDPRM): +! DATA QUARTZ /0.82, 0.10, 0.25, 0.60, 0.52, +! & 0.35, 0.60, 0.40, 0.82/ +! ---------------------------------------------------------------------- +! IF THE SOIL HAS ANY MOISTURE CONTENT COMPUTE A PARTIAL SUM/PRODUCT +! OTHERWISE USE A CONSTANT VALUE WHICH WORKS WELL WITH MOST SOILS +! ---------------------------------------------------------------------- +! THKW ......WATER THERMAL CONDUCTIVITY +! THKQTZ ....THERMAL CONDUCTIVITY FOR QUARTZ +! THKO ......THERMAL CONDUCTIVITY FOR OTHER SOIL COMPONENTS +! THKS ......THERMAL CONDUCTIVITY FOR THE SOLIDS COMBINED(QUARTZ+OTHER) +! THKICE ....ICE THERMAL CONDUCTIVITY +! SMCMAX ....POROSITY (= SMCMAX) +! QZ .........QUARTZ CONTENT (SOIL TYPE DEPENDENT) +! ---------------------------------------------------------------------- +! USE AS IN PETERS-LIDARD, 1998 (MODIF. FROM JOHANSEN, 1975). + +! PABLO GRUNMANN, 08/17/98 +! REFS.: +! FAROUKI, O.T.,1986: THERMAL PROPERTIES OF SOILS. SERIES ON ROCK +! AND SOIL MECHANICS, VOL. 11, TRANS TECH, 136 PP. +! JOHANSEN, O., 1975: THERMAL CONDUCTIVITY OF SOILS. PH.D. THESIS, +! UNIVERSITY OF TRONDHEIM, +! PETERS-LIDARD, C. D., ET AL., 1998: THE EFFECT OF SOIL THERMAL +! CONDUCTIVITY PARAMETERIZATION ON SURFACE ENERGY FLUXES +! AND TEMPERATURES. JOURNAL OF THE ATMOSPHERIC SCIENCES, +! VOL. 55, PP. 1209-1224. +! ---------------------------------------------------------------------- + +IF ( OPT_THCND == 1 .OR. ( OPT_THCND == 2 .AND. (SOILTYP /= 4 .AND. SOILTYP /= 3)) )THEN + +! NEEDS PARAMETERS +! POROSITY(SOIL TYPE): +! POROS = SMCMAX +! SATURATION RATIO: +! PARAMETERS W/(M.K) + SATRATIO = SMC / SMCMAX +! ICE CONDUCTIVITY: + THKICE = 2.2 +! WATER CONDUCTIVITY: + THKW = 0.57 +! THERMAL CONDUCTIVITY OF "OTHER" SOIL COMPONENTS +! IF (QZ .LE. 0.2) THKO = 3.0 + THKO = 2.0 +! QUARTZ' CONDUCTIVITY + THKQTZ = 7.7 +! SOLIDS' CONDUCTIVITY + THKS = (THKQTZ ** QZ)* (THKO ** (1. - QZ)) + +! UNFROZEN FRACTION (FROM 1., i.e., 100%LIQUID, TO 0. (100% FROZEN)) + XUNFROZ = SH2O / SMC +! UNFROZEN VOLUME FOR SATURATION (POROSITY*XUNFROZ) + XU = XUNFROZ * SMCMAX + +! SATURATED THERMAL CONDUCTIVITY + THKSAT = THKS ** (1. - SMCMAX)* THKICE ** (SMCMAX - XU)* THKW ** & + (XU) + +! DRY DENSITY IN KG/M3 + GAMMD = (1. - SMCMAX)*2700. + +! DRY THERMAL CONDUCTIVITY IN W.M-1.K-1 + THKDRY = (0.135* GAMMD+ 64.7)/ (2700. - 0.947* GAMMD) +! FROZEN + AKEI = SATRATIO +! UNFROZEN +! RANGE OF VALIDITY FOR THE KERSTEN NUMBER (AKE) + +! KERSTEN NUMBER (USING "FINE" FORMULA, VALID FOR SOILS CONTAINING AT +! LEAST 5% OF PARTICLES WITH DIAMETER LESS THAN 2.E-6 METERS.) +! (FOR "COARSE" FORMULA, SEE PETERS-LIDARD ET AL., 1998). + + IF ( SATRATIO > 0.1 ) THEN + + AKEL = LOG10 (SATRATIO) + 1.0 + +! USE K = KDRY + ELSE + + AKEL = 0.0 + END IF + AKE = ((SMC-SH2O)*AKEI + SH2O*AKEL)/SMC +! THERMAL CONDUCTIVITY + + + DF = AKE * (THKSAT - THKDRY) + THKDRY + + ELSE + +! use the Mccumber and Pielke approach for silt loam (4), sandy loam (3) + + PSIF = PSISAT*100.*(SMCMAX/(SMC))**BEXP +!--- PSIF should be in [CM] to compute PF + PF=log10(abs(PSIF)) +!--- HK is for McCumber thermal conductivity + IF(PF.LE.5.1) THEN + DF=420.*EXP(-(PF+2.7)) + ELSE + DF=.1744 + END IF + + ENDIF ! for OPT_THCND OPTIONS +! ---------------------------------------------------------------------- + END SUBROUTINE TDFCND +! ---------------------------------------------------------------------- + + SUBROUTINE TMPAVG (TAVG,TUP,TM,TDN,ZSOIL,NSOIL,K) + +! ---------------------------------------------------------------------- +! SUBROUTINE TMPAVG +! ---------------------------------------------------------------------- +! CALCULATE SOIL LAYER AVERAGE TEMPERATURE (TAVG) IN FREEZING/THAWING +! LAYER USING UP, DOWN, AND MIDDLE LAYER TEMPERATURES (TUP, TDN, TM), +! WHERE TUP IS AT TOP BOUNDARY OF LAYER, TDN IS AT BOTTOM BOUNDARY OF +! LAYER. TM IS LAYER PROGNOSTIC STATE TEMPERATURE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER K + + INTEGER NSOIL + REAL DZ + REAL DZH + REAL T0 + REAL TAVG + REAL TDN + REAL TM + REAL TUP + REAL X0 + REAL XDN + REAL XUP + + REAL ZSOIL (NSOIL) + +! ---------------------------------------------------------------------- + PARAMETER (T0 = 2.7315E2) + IF (K .eq. 1) THEN + DZ = - ZSOIL (1) + ELSE + DZ = ZSOIL (K -1) - ZSOIL (K) + END IF + + DZH = DZ *0.5 + IF (TUP .lt. T0) THEN + IF (TM .lt. T0) THEN +! ---------------------------------------------------------------------- +! TUP, TM, TDN < T0 +! ---------------------------------------------------------------------- + IF (TDN .lt. T0) THEN + TAVG = (TUP + 2.0* TM + TDN)/ 4.0 +! ---------------------------------------------------------------------- +! TUP & TM < T0, TDN .ge. T0 +! ---------------------------------------------------------------------- + ELSE + X0 = (T0- TM) * DZH / (TDN - TM) + TAVG = 0.5 * (TUP * DZH + TM * (DZH + X0) + T0* ( & + & 2.* DZH - X0)) / DZ + END IF + ELSE +! ---------------------------------------------------------------------- +! TUP < T0, TM .ge. T0, TDN < T0 +! ---------------------------------------------------------------------- + IF (TDN .lt. T0) THEN + XUP = (T0- TUP) * DZH / (TM - TUP) + XDN = DZH - (T0- TM) * DZH / (TDN - TM) + TAVG = 0.5 * (TUP * XUP + T0* (2.* DZ - XUP - XDN) & + & + TDN * XDN) / DZ +! ---------------------------------------------------------------------- +! TUP < T0, TM .ge. T0, TDN .ge. T0 +! ---------------------------------------------------------------------- + ELSE + XUP = (T0- TUP) * DZH / (TM - TUP) + TAVG = 0.5 * (TUP * XUP + T0* (2.* DZ - XUP)) / DZ + END IF + END IF + ELSE + IF (TM .lt. T0) THEN +! ---------------------------------------------------------------------- +! TUP .ge. T0, TM < T0, TDN < T0 +! ---------------------------------------------------------------------- + IF (TDN .lt. T0) THEN + XUP = DZH - (T0- TUP) * DZH / (TM - TUP) + TAVG = 0.5 * (T0* (DZ - XUP) + TM * (DZH + XUP) & + & + TDN * DZH) / DZ +! ---------------------------------------------------------------------- +! TUP .ge. T0, TM < T0, TDN .ge. T0 +! ---------------------------------------------------------------------- + ELSE + XUP = DZH - (T0- TUP) * DZH / (TM - TUP) + XDN = (T0- TM) * DZH / (TDN - TM) + TAVG = 0.5 * (T0* (2.* DZ - XUP - XDN) + TM * & + & (XUP + XDN)) / DZ + END IF + ELSE +! ---------------------------------------------------------------------- +! TUP .ge. T0, TM .ge. T0, TDN < T0 +! ---------------------------------------------------------------------- + IF (TDN .lt. T0) THEN + XDN = DZH - (T0- TM) * DZH / (TDN - TM) + TAVG = (T0* (DZ - XDN) +0.5* (T0+ TDN)* XDN) / DZ +! ---------------------------------------------------------------------- +! TUP .ge. T0, TM .ge. T0, TDN .ge. T0 +! ---------------------------------------------------------------------- + ELSE + TAVG = (TUP + 2.0* TM + TDN) / 4.0 + END IF + END IF + END IF +! ---------------------------------------------------------------------- + END SUBROUTINE TMPAVG +! ---------------------------------------------------------------------- + + SUBROUTINE TRANSP (ET,NSOIL,ETP1,SMC,CMC,ZSOIL,SHDFAC,SMCWLT, & + & CMCMAX,PC,CFACTR,SMCREF,SFCTMP,Q2,NROOT, & + & RTDIS) + +! ---------------------------------------------------------------------- +! SUBROUTINE TRANSP +! ---------------------------------------------------------------------- +! CALCULATE TRANSPIRATION FOR THE VEG CLASS. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER I + INTEGER K + INTEGER NSOIL + + INTEGER NROOT + REAL CFACTR + REAL CMC + REAL CMCMAX + REAL DENOM + REAL ET (NSOIL) + REAL ETP1 + REAL ETP1A +!.....REAL PART(NSOIL) + REAL GX (NROOT) + REAL PC + REAL Q2 + REAL RTDIS (NSOIL) + REAL RTX + REAL SFCTMP + REAL SGX + REAL SHDFAC + REAL SMC (NSOIL) + REAL SMCREF + REAL SMCWLT + +! ---------------------------------------------------------------------- +! INITIALIZE PLANT TRANSP TO ZERO FOR ALL SOIL LAYERS. +! ---------------------------------------------------------------------- + REAL ZSOIL (NSOIL) + DO K = 1,NSOIL + ET (K) = 0. +! ---------------------------------------------------------------------- +! CALCULATE AN 'ADJUSTED' POTENTIAL TRANSPIRATION +! IF STATEMENT BELOW TO AVOID TANGENT LINEAR PROBLEMS NEAR ZERO +! NOTE: GX AND OTHER TERMS BELOW REDISTRIBUTE TRANSPIRATION BY LAYER, +! ET(K), AS A FUNCTION OF SOIL MOISTURE AVAILABILITY, WHILE PRESERVING +! TOTAL ETP1A. +! ---------------------------------------------------------------------- + END DO + IF (CMC .ne. 0.0) THEN + ETP1A = SHDFAC * PC * ETP1 * (1.0- (CMC / CMCMAX) ** CFACTR) + ELSE + ETP1A = SHDFAC * PC * ETP1 + END IF + SGX = 0.0 + DO I = 1,NROOT + GX (I) = ( SMC (I) - SMCWLT ) / ( SMCREF - SMCWLT ) + GX (I) = MAX ( MIN ( GX (I), 1. ), 0. ) + SGX = SGX + GX (I) + END DO + + SGX = SGX / NROOT + DENOM = 0. + DO I = 1,NROOT + RTX = RTDIS (I) + GX (I) - SGX + GX (I) = GX (I) * MAX ( RTX, 0. ) + DENOM = DENOM + GX (I) + END DO + + IF (DENOM .le. 0.0) DENOM = 1. + DO I = 1,NROOT + ET (I) = ETP1A * GX (I) / DENOM +! ---------------------------------------------------------------------- +! ABOVE CODE ASSUMES A VERTICALLY UNIFORM ROOT DISTRIBUTION +! CODE BELOW TESTS A VARIABLE ROOT DISTRIBUTION +! ---------------------------------------------------------------------- +! ET(1) = ( ZSOIL(1) / ZSOIL(NROOT) ) * GX * ETP1A +! ET(1) = ( ZSOIL(1) / ZSOIL(NROOT) ) * ETP1A +! ---------------------------------------------------------------------- +! USING ROOT DISTRIBUTION AS WEIGHTING FACTOR +! ---------------------------------------------------------------------- +! ET(1) = RTDIS(1) * ETP1A +! ET(1) = ETP1A * PART(1) +! ---------------------------------------------------------------------- +! LOOP DOWN THRU THE SOIL LAYERS REPEATING THE OPERATION ABOVE, +! BUT USING THE THICKNESS OF THE SOIL LAYER (RATHER THAN THE +! ABSOLUTE DEPTH OF EACH LAYER) IN THE FINAL CALCULATION. +! ---------------------------------------------------------------------- +! DO K = 2,NROOT +! GX = ( SMC(K) - SMCWLT ) / ( SMCREF - SMCWLT ) +! GX = MAX ( MIN ( GX, 1. ), 0. ) +! TEST CANOPY RESISTANCE +! GX = 1.0 +! ET(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT))*GX*ETP1A +! ET(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT))*ETP1A +! ---------------------------------------------------------------------- +! USING ROOT DISTRIBUTION AS WEIGHTING FACTOR +! ---------------------------------------------------------------------- +! ET(K) = RTDIS(K) * ETP1A +! ET(K) = ETP1A*PART(K) +! END DO + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE TRANSP +! ---------------------------------------------------------------------- + + SUBROUTINE WDFCND (WDF,WCND,SMC,SMCMAX,BEXP,DKSAT,DWSAT, & + & SICEMAX) + +! ---------------------------------------------------------------------- +! SUBROUTINE WDFCND +! ---------------------------------------------------------------------- +! CALCULATE SOIL WATER DIFFUSIVITY AND SOIL HYDRAULIC CONDUCTIVITY. +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL BEXP + REAL DKSAT + REAL DWSAT + REAL EXPON + REAL FACTR1 + REAL FACTR2 + REAL SICEMAX + REAL SMC + REAL SMCMAX + REAL VKwgt + REAL WCND + +! ---------------------------------------------------------------------- +! CALC THE RATIO OF THE ACTUAL TO THE MAX PSBL SOIL H2O CONTENT +! ---------------------------------------------------------------------- + REAL WDF + FACTR1 = 0.05 / SMCMAX + +! ---------------------------------------------------------------------- +! PREP AN EXPNTL COEF AND CALC THE SOIL WATER DIFFUSIVITY +! ---------------------------------------------------------------------- + FACTR2 = SMC / SMCMAX + FACTR1 = MIN(FACTR1,FACTR2) + EXPON = BEXP + 2.0 + +! ---------------------------------------------------------------------- +! FROZEN SOIL HYDRAULIC DIFFUSIVITY. VERY SENSITIVE TO THE VERTICAL +! GRADIENT OF UNFROZEN WATER. THE LATTER GRADIENT CAN BECOME VERY +! EXTREME IN FREEZING/THAWING SITUATIONS, AND GIVEN THE RELATIVELY +! FEW AND THICK SOIL LAYERS, THIS GRADIENT SUFFERES SERIOUS +! TRUNCTION ERRORS YIELDING ERRONEOUSLY HIGH VERTICAL TRANSPORTS OF +! UNFROZEN WATER IN BOTH DIRECTIONS FROM HUGE HYDRAULIC DIFFUSIVITY. +! THEREFORE, WE FOUND WE HAD TO ARBITRARILY CONSTRAIN WDF +! -- +! VERSION D_10CM: ........ FACTR1 = 0.2/SMCMAX +! WEIGHTED APPROACH...................... PABLO GRUNMANN, 28_SEP_1999. +! ---------------------------------------------------------------------- + WDF = DWSAT * FACTR2 ** EXPON + IF (SICEMAX .gt. 0.0) THEN + VKWGT = 1./ (1. + (500.* SICEMAX)**3.) + WDF = VKWGT * WDF + (1. - VKWGT)* DWSAT * FACTR1** EXPON +! ---------------------------------------------------------------------- +! RESET THE EXPNTL COEF AND CALC THE HYDRAULIC CONDUCTIVITY +! ---------------------------------------------------------------------- + END IF + EXPON = (2.0 * BEXP) + 3.0 + WCND = DKSAT * FACTR2 ** EXPON + +! ---------------------------------------------------------------------- + END SUBROUTINE WDFCND +! ---------------------------------------------------------------------- + + SUBROUTINE SFCDIF_off (ZLM,Z0,THZ0,THLM,SFCSPD,CZIL,AKMS,AKHS) + +! ---------------------------------------------------------------------- +! SUBROUTINE SFCDIF (renamed SFCDIF_off to avoid clash with Eta PBL) +! ---------------------------------------------------------------------- +! CALCULATE SURFACE LAYER EXCHANGE COEFFICIENTS VIA ITERATIVE PROCESS. +! SEE CHEN ET AL (1997, BLM) +! ---------------------------------------------------------------------- + + IMPLICIT NONE + REAL WWST, WWST2, G, VKRM, EXCM, BETA, BTG, ELFC, WOLD, WNEW + REAL PIHF, EPSU2, EPSUST, EPSIT, EPSA, ZTMIN, ZTMAX, HPBL, & + & SQVISC + REAL RIC, RRIC, FHNEU, RFC, RFAC, ZZ, PSLMU, PSLMS, PSLHU, & + & PSLHS + REAL XX, PSPMU, YY, PSPMS, PSPHU, PSPHS, ZLM, Z0, THZ0, THLM + REAL SFCSPD, CZIL, AKMS, AKHS, ZILFC, ZU, ZT, RDZ, CXCH + REAL DTHV, DU2, BTGH, WSTAR2, USTAR, ZSLU, ZSLT, RLOGU, RLOGT + REAL RLMO, ZETALT, ZETALU, ZETAU, ZETAT, XLU4, XLT4, XU4, XT4 +!CC ......REAL ZTFC + + REAL XLU, XLT, XU, XT, PSMZ, SIMM, PSHZ, SIMH, USTARK, RLMN, & + & RLMA + + INTEGER ITRMX, ILECH, ITR + PARAMETER & + & (WWST = 1.2,WWST2 = WWST * WWST,G = 9.8,VKRM = 0.40, & + & EXCM = 0.001 & + & ,BETA = 1./270.,BTG = BETA * G,ELFC = VKRM * BTG & + & ,WOLD =.15,WNEW = 1. - WOLD,ITRMX = 05, & + & PIHF = 3.14159265/2.) + PARAMETER & + & (EPSU2 = 1.E-4,EPSUST = 0.07,EPSIT = 1.E-4,EPSA = 1.E-8 & + & ,ZTMIN = -5.,ZTMAX = 1.,HPBL = 1000.0 & + & ,SQVISC = 258.2) + PARAMETER & + & (RIC = 0.183,RRIC = 1.0/ RIC,FHNEU = 0.8,RFC = 0.191 & + & ,RFAC = RIC / (FHNEU * RFC * RFC)) + +! ---------------------------------------------------------------------- +! NOTE: THE TWO CODE BLOCKS BELOW DEFINE FUNCTIONS +! ---------------------------------------------------------------------- +! LECH'S SURFACE FUNCTIONS +! ---------------------------------------------------------------------- + PSLMU (ZZ)= -0.96* log (1.0-4.5* ZZ) + PSLMS (ZZ)= ZZ * RRIC -2.076* (1. -1./ (ZZ +1.)) + PSLHU (ZZ)= -0.96* log (1.0-4.5* ZZ) + +! ---------------------------------------------------------------------- +! PAULSON'S SURFACE FUNCTIONS +! ---------------------------------------------------------------------- + PSLHS (ZZ)= ZZ * RFAC -2.076* (1. -1./ (ZZ +1.)) + PSPMU (XX)= -2.* log ( (XX +1.)*0.5) - log ( (XX * XX +1.)*0.5) & + & +2.* ATAN (XX) & + &- PIHF + PSPMS (YY)= 5.* YY + PSPHU (XX)= -2.* log ( (XX * XX +1.)*0.5) + +! ---------------------------------------------------------------------- +! THIS ROUTINE SFCDIF CAN HANDLE BOTH OVER OPEN WATER (SEA, OCEAN) AND +! OVER SOLID SURFACE (LAND, SEA-ICE). +! ---------------------------------------------------------------------- + PSPHS (YY)= 5.* YY + +! ---------------------------------------------------------------------- +! ZTFC: RATIO OF ZOH/ZOM LESS OR EQUAL THAN 1 +! C......ZTFC=0.1 +! CZIL: CONSTANT C IN Zilitinkevich, S. S.1995,:NOTE ABOUT ZT +! ---------------------------------------------------------------------- + ILECH = 0 + +! ---------------------------------------------------------------------- + ZILFC = - CZIL * VKRM * SQVISC +! C.......ZT=Z0*ZTFC + ZU = Z0 + RDZ = 1./ ZLM + CXCH = EXCM * RDZ + DTHV = THLM - THZ0 + +! ---------------------------------------------------------------------- +! BELJARS CORRECTION OF USTAR +! ---------------------------------------------------------------------- + DU2 = MAX (SFCSPD * SFCSPD,EPSU2) +!cc If statements to avoid TANGENT LINEAR problems near zero + BTGH = BTG * HPBL + IF (BTGH * AKHS * DTHV .ne. 0.0) THEN + WSTAR2 = WWST2* ABS (BTGH * AKHS * DTHV)** (2./3.) + ELSE + WSTAR2 = 0.0 + END IF + +! ---------------------------------------------------------------------- +! ZILITINKEVITCH APPROACH FOR ZT +! ---------------------------------------------------------------------- + USTAR = MAX (SQRT (AKMS * SQRT (DU2+ WSTAR2)),EPSUST) + +! ---------------------------------------------------------------------- + ZT = EXP (ZILFC * SQRT (USTAR * Z0))* Z0 + ZSLU = ZLM + ZU +! PRINT*,'ZSLT=',ZSLT +! PRINT*,'ZLM=',ZLM +! PRINT*,'ZT=',ZT + + ZSLT = ZLM + ZT + RLOGU = log (ZSLU / ZU) + + RLOGT = log (ZSLT / ZT) +! PRINT*,'RLMO=',RLMO +! PRINT*,'ELFC=',ELFC +! PRINT*,'AKHS=',AKHS +! PRINT*,'DTHV=',DTHV +! PRINT*,'USTAR=',USTAR + + RLMO = ELFC * AKHS * DTHV / USTAR **3 +! ---------------------------------------------------------------------- +! 1./MONIN-OBUKKHOV LENGTH-SCALE +! ---------------------------------------------------------------------- + DO ITR = 1,ITRMX + ZETALT = MAX (ZSLT * RLMO,ZTMIN) + RLMO = ZETALT / ZSLT + ZETALU = ZSLU * RLMO + ZETAU = ZU * RLMO + + ZETAT = ZT * RLMO + IF (ILECH .eq. 0) THEN + IF (RLMO .lt. 0.)THEN + XLU4 = 1. -16.* ZETALU + XLT4 = 1. -16.* ZETALT + XU4 = 1. -16.* ZETAU + + XT4 = 1. -16.* ZETAT + XLU = SQRT (SQRT (XLU4)) + XLT = SQRT (SQRT (XLT4)) + XU = SQRT (SQRT (XU4)) + + XT = SQRT (SQRT (XT4)) +! PRINT*,'-----------1------------' +! PRINT*,'PSMZ=',PSMZ +! PRINT*,'PSPMU(ZETAU)=',PSPMU(ZETAU) +! PRINT*,'XU=',XU +! PRINT*,'------------------------' + PSMZ = PSPMU (XU) + SIMM = PSPMU (XLU) - PSMZ + RLOGU + PSHZ = PSPHU (XT) + SIMH = PSPHU (XLT) - PSHZ + RLOGT + ELSE + ZETALU = MIN (ZETALU,ZTMAX) + ZETALT = MIN (ZETALT,ZTMAX) +! PRINT*,'-----------2------------' +! PRINT*,'PSMZ=',PSMZ +! PRINT*,'PSPMS(ZETAU)=',PSPMS(ZETAU) +! PRINT*,'ZETAU=',ZETAU +! PRINT*,'------------------------' + PSMZ = PSPMS (ZETAU) + SIMM = PSPMS (ZETALU) - PSMZ + RLOGU + PSHZ = PSPHS (ZETAT) + SIMH = PSPHS (ZETALT) - PSHZ + RLOGT + END IF +! ---------------------------------------------------------------------- +! LECH'S FUNCTIONS +! ---------------------------------------------------------------------- + ELSE + IF (RLMO .lt. 0.)THEN +! PRINT*,'-----------3------------' +! PRINT*,'PSMZ=',PSMZ +! PRINT*,'PSLMU(ZETAU)=',PSLMU(ZETAU) +! PRINT*,'ZETAU=',ZETAU +! PRINT*,'------------------------' + PSMZ = PSLMU (ZETAU) + SIMM = PSLMU (ZETALU) - PSMZ + RLOGU + PSHZ = PSLHU (ZETAT) + SIMH = PSLHU (ZETALT) - PSHZ + RLOGT + ELSE + ZETALU = MIN (ZETALU,ZTMAX) + + ZETALT = MIN (ZETALT,ZTMAX) +! PRINT*,'-----------4------------' +! PRINT*,'PSMZ=',PSMZ +! PRINT*,'PSLMS(ZETAU)=',PSLMS(ZETAU) +! PRINT*,'ZETAU=',ZETAU +! PRINT*,'------------------------' + PSMZ = PSLMS (ZETAU) + SIMM = PSLMS (ZETALU) - PSMZ + RLOGU + PSHZ = PSLHS (ZETAT) + SIMH = PSLHS (ZETALT) - PSHZ + RLOGT + END IF +! ---------------------------------------------------------------------- +! BELJAARS CORRECTION FOR USTAR +! ---------------------------------------------------------------------- + END IF + +! ---------------------------------------------------------------------- +! ZILITINKEVITCH FIX FOR ZT +! ---------------------------------------------------------------------- + USTAR = MAX (SQRT (AKMS * SQRT (DU2+ WSTAR2)),EPSUST) + + ZT = EXP (ZILFC * SQRT (USTAR * Z0))* Z0 + ZSLT = ZLM + ZT +!----------------------------------------------------------------------- + RLOGT = log (ZSLT / ZT) + USTARK = USTAR * VKRM + AKMS = MAX (USTARK / SIMM,CXCH) +!----------------------------------------------------------------------- +! IF STATEMENTS TO AVOID TANGENT LINEAR PROBLEMS NEAR ZERO +!----------------------------------------------------------------------- + AKHS = MAX (USTARK / SIMH,CXCH) + IF (BTGH * AKHS * DTHV .ne. 0.0) THEN + WSTAR2 = WWST2* ABS (BTGH * AKHS * DTHV)** (2./3.) + ELSE + WSTAR2 = 0.0 + END IF +!----------------------------------------------------------------------- + RLMN = ELFC * AKHS * DTHV / USTAR **3 +!----------------------------------------------------------------------- +! IF(ABS((RLMN-RLMO)/RLMA).LT.EPSIT) GO TO 110 +!----------------------------------------------------------------------- + RLMA = RLMO * WOLD+ RLMN * WNEW +!----------------------------------------------------------------------- + RLMO = RLMA +! PRINT*,'----------------------------' +! PRINT*,'SFCDIF OUTPUT ! ! ! ! ! ! ! ! ! ! ! !' + +! PRINT*,'ZLM=',ZLM +! PRINT*,'Z0=',Z0 +! PRINT*,'THZ0=',THZ0 +! PRINT*,'THLM=',THLM +! PRINT*,'SFCSPD=',SFCSPD +! PRINT*,'CZIL=',CZIL +! PRINT*,'AKMS=',AKMS +! PRINT*,'AKHS=',AKHS +! PRINT*,'----------------------------' + + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE SFCDIF_off +! ---------------------------------------------------------------------- + +END MODULE module_sf_noahlsm diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 75afaa6ff..ecfeeac92 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -31,7 +31,19 @@ subroutine lsm_noah_init(me, isot, ivegsrc, nlunit, ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + if (ivegsrc > 2) then + errmsg = 'The NOAH LSM expects that the ivegsrc physics '// + & 'namelist parameter is 0, 1, or 2. Exiting...' + errflg = 1 + return + end if + if (isot > 1) then + errmsg = 'The NOAH LSM expects that the isot physics '// + & 'namelist parameter is 0, or 1. Exiting...' + errflg = 1 + return + end if !--- initialize soil vegetation call set_soilveg(me, isot, ivegsrc, nlunit) diff --git a/physics/sfc_drv_hafs.F90 b/physics/sfc_drv_hafs.F90 new file mode 100644 index 000000000..5bed9a85a --- /dev/null +++ b/physics/sfc_drv_hafs.F90 @@ -0,0 +1,694 @@ +!> \file sfc_drv_hafs.f +!! This file contains the Noah land surface scheme driver. + +!> This module contains the CCPP-compliant Noah land surface scheme driver for the hurricane application. + module lsm_noah_hafs + + implicit none + + private + + public :: lsm_noah_hafs_init, lsm_noah_hafs_run, lsm_noah_hafs_finalize + + contains + +!>\ingroup Noah_LSM_hafs +!! \section arg_table_lsm_noah_hafs_init Argument Table +!! \htmlinclude lsm_noah_hafs_init.html +!! + subroutine lsm_noah_hafs_init(lsm, lsm_noah_hafs, restart, veg_data_choice, soil_data_choice, ialb, ncol, nsoil, vtype, snoalb, isurban, sthick, errmsg, errflg) + + use machine, only : kind_phys + use module_sf_noahlsm, only: maxalb + + implicit none + + integer, intent(in) :: lsm, lsm_noah_hafs, veg_data_choice, soil_data_choice, ialb, ncol, nsoil + real(kind=kind_phys), dimension(ncol), intent(in) :: vtype + logical, intent(in) :: restart + + integer, intent(inout) :: isurban + real(kind=kind_phys), dimension(ncol), intent(inout) :: snoalb + real(kind=kind_phys), dimension(nsoil), intent(inout) :: sthick + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + + character(len=256) :: mminlu, mminsl + + integer :: i, k + !integer :: ite, ide, itf + !integer :: ids,ide, jds,jde, kds,kde, & + ! ims,ime, jms,jme, kms,kme, & + ! its,ite, jts,jte, kts,kte + + real(kind=kind_phys), parameter, dimension(4) :: zsoil = (/ -0.1,-0.4,-1.0,-2.0/) !what if nsoil /= 4? + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lsm/=lsm_noah_hafs) then + write(errmsg,'(*(a))') "Logic error: namelist choice of LSM is different from NOAH HAFS" + errflg = 1 + return + end if + + select case (veg_data_choice) + case (0) + mminlu = 'USGS' + isurban = 1 + case (1) + mminlu = 'MODIFIED_IGBP_MODIS_NOAH' + isurban = 13 + case (3) + mminlu = 'NLCD40' + isurban = 13 + case (4) + mminlu = 'USGS-RUC' + isurban = 1 + case (5) + mminlu = 'MODI-RUC' + isurban = 13 + case default + errmsg = 'The value of the ivegsrc physics namelist parameter is incompatible with this version of NOAH LSM' + errflg = 1 + return + end select + + select case (soil_data_choice) + case (1) + mminsl = 'STAS' + case (2) + mminsl = 'STAS-RUC' + case default + errmsg = 'The value of the isot physics namelist parameter is incompatible with this version of NOAH LSM' + errflg = 1 + return + end select + + call soil_veg_gen_parm(trim(mminlu), trim(mminsl), errmsg, errflg) + + ! Set internal dimensions + ! ids = 1 + ! ims = 1 + ! its = 1 + ! ide = ncol + ! ime = ncol + ! ite = ncol + ! jds = 1 + ! jms = 1 + ! jts = 1 + ! jde = 1 + ! jme = 1 + ! jte = 1 + ! kds = 1 + ! kms = 1 + ! kts = 1 + ! kde = nlev + ! kme = nlev + ! kte = nlev + + if (.not. restart) then + do i = 1, ncol + if(ialb == 0) then + snoalb(i) = maxalb(int(0.5 + vtype(i)))*0.01 + endif + end do + end if + + sthick(1) = - zsoil(1) + do k = 2, nsoil + sthick(k) = zsoil(k-1) - zsoil(k) + enddo + + end subroutine lsm_noah_hafs_init + + +!! \section arg_table_lsm_noah_hafs_finalize Argument Table +!! \htmlinclude lsm_noah_hafs_finalize.html +!! + subroutine lsm_noah_hafs_finalize(errmsg, errflg) + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + end subroutine lsm_noah_hafs_finalize + + +!>\defgroup Noah_LSM_hafs Noah LSM Model for the hurricane application +!! \section arg_table_lsm_noah_hafs_run Argument Table +!! \htmlinclude lsm_noah_hafs_run.html +!! +!> \section general_noah_hafs_drv GFS sfc_drv General Algorithm +!> @{ + subroutine lsm_noah_hafs_run & + & (im, land, flag_iter, srflag, isurban, opt_thcnd, dt, rhowater, & + eps, epsm1, cp, rd, rvrdm1, sigma, cph2o, cpice, lsubf, zlvl, nsoil, & + sthick, lwdn, soldn, solnet, sfcprs, tprcp, sfctmp, q1, prslki, & + vegtyp, soiltyp, slopetyp, shmin, shmax, snoalb, tbot, wind, shdfac, & + albbrd, z0brd, z0k, emissi, canopy, t1, stc, smc, swc, snwdph, sneqv, & + ch, ribb, eta_kinematic, shflx, embrd, ec, edir, ett, esnow, etp, & + ssoil, snohf, sncovr, snowc, runoff, drain, stm, qsurf, smcwlt, smcref, errmsg, errflg & + & ) +! + use machine , only : kind_phys + use module_sf_noahlsm, only: sflx, lutype, sltype + use funcphys, only : fpvs + + implicit none + + integer, intent(in) :: im, isurban, opt_thcnd, nsoil + real(kind=kind_phys), intent(in) :: dt, rhowater, eps, epsm1, cp, rd, rvrdm1, sigma, cph2o, cpice, lsubf + + integer, dimension(im), intent(in) :: vegtyp, soiltyp, slopetyp + logical, dimension(im), intent(in) :: flag_iter, land + real(kind=kind_phys), dimension(im), intent(in) :: srflag, zlvl, lwdn, soldn, solnet, sfcprs, tprcp, sfctmp, q1, prslki, shmin, shmax, snoalb, tbot, wind + real(kind=kind_phys), dimension(nsoil), intent(in) :: sthick + + real(kind=kind_phys), dimension(im), intent(inout) :: shdfac, albbrd, z0brd, z0k, emissi, canopy, t1, snwdph, sneqv, ch, ribb + real(kind=kind_phys), dimension(im,nsoil), intent(inout) :: stc, smc, swc + + real(kind=kind_phys), dimension(im), intent(out) :: embrd, eta_kinematic, shflx, ec, edir, ett, esnow, etp, ssoil, snohf, sncovr, snowc, runoff, drain, stm, qsurf, smcwlt, smcref + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! local Variables + integer :: i, k + logical, parameter :: local = .false. + logical, parameter :: ua_phys = .false. + logical, parameter :: rdlai2d = .false. + logical, parameter :: usemonalb = .true. !Biswas says true for HWRF + real(kind=kind_phys), parameter :: aoasis = 1.0 !hard-coded to 1 in module_sf_noahdrv or set to value from urban module? + integer, parameter :: fasdas = 0 ! = 1 if using "flux-adjusting surface data assimilation system" + real(kind=kind_phys) :: prcp, rho, qs1, q2k, th2, dqsdt2, dummy, cmc, snowhk, chk, sheat, flx1, flx2, flx3, runoff1, runoff2, soilm, smcmax + + + integer :: nroot + real(kind=kind_phys) :: albedok, eta, fdown, drip, dew, beta, snomlt, runoff3, rc, pc, rsmin, xlai, rcs, rct, rcq, rcsoil, soilw, snotime1, smcdry + real (kind=kind_phys), dimension(nsoil) :: et, smav + real(kind=kind_phys) :: sfcheadrt, infxsrt, etpnd1 !doesn't appear to be used unless WRF_HYDRO preprocessor directive is defined and no documentation + real(kind=kind_phys) :: xsda_qfx, hfx_phy, qfx_phy, xqnorm, hcpct_fasdas !only used if fasdas = 1 ("flux-adjusting surface data assimilation system") + + !GJF: + ! albedok is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: + ! SURFACE ALBEDO INCLUDING SNOW EFFECT (UNITLESS FRACTION) + ! =SNOW-FREE ALBEDO (ALB) WHEN SNEQV=0, OR + ! =FCT(MSNOALB,ALB,VEGTYP,SHDFAC,SHDMIN) WHEN SNEQV>0 + ! if needed by other schemes or diagnostics, one needs to add it to the host model and CCPP metadata; could also just pass in dummy argument + ! eta is an output from sflx, but eta_kinematic is what is passed out + ! fdown is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: + ! Radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN + ! et is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: + ! plant transpiration from a particular root (soil) layer (W m-2) + ! drip is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: + ! through-fall of precip and/or dew in excess of canopy water-holding capacity (m) + ! dew is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: + ! dewfall (or frostfall for t<273.15) (m) + ! beta is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: + ! ratio of actual/potential evap (dimensionless) + ! snomlt is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: + ! snow melt (m) (water equivalent) + ! rc is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: + ! canopy resistance (s m-1) + ! pc : plant coefficient (unitless fraction, 0-1) where pc*etp = actual transp + ! rsmin : minimum canopy resistance (s m-1) + ! xlai: leaf area index (dimensionless) + ! rcs: incoming solar rc factor (dimensionless) + ! rct: air temperature rc factor (dimensionless) + ! rcq: atmos vapor pressure deficit rc factor (dimensionless) + ! rcsoil: soil moisture rc factor (dimensionless) + ! soilw: available soil moisture in root zone (unitless fraction between smcwlt and smcmax) + ! smav: soil moisture availability for each layer, as a fraction between smcwlt and smcmax. + ! snotime1: no documentation in module_sf_noahlsm.F, but described as "initial number of timesteps since last snowfall" in module_sf_noahdrv.F; related to CCPP nondimensional_snow_age for NoahMP? Since inout, need to initialize here? + ! smcdry: dry soil moisture threshold where direct evap frm top layer ends (volumetric) + ! nroot: number of root layers, a function of veg type, determined in subroutine redprm. + + !variables associated with UA_PHYS (not used for now) + real(kind=kind_phys) :: flx4, fvb, fbur, fgsn + + REAL, PARAMETER :: A2=17.67,A3=273.15,A4=29.65, & + A23M4=A2*(A3-A4) + +!> - Initialize CCPP error handling variables + + errmsg = '' + errflg = 0 + + do i=1, im + if (flag_iter(i) .and. land(i)) then + !GJF: module_sf_noahdrv.F from WRF has hardcoded slopetyp = 1; why? replicate here? + !GJF: shdfac is zeroed out for particular combinations of vegetation table source and vegetation types; replicate here? + + !GJF: could potentially pass in pre-calculated rates instead of calculating here + prcp = rhowater * tprcp(i) / dt + + !GJF: The GFS version of NOAH prepares the specific humidity in sfc_drv.f as follows: + q2k = max(q1(i), 1.e-8) + rho = sfcprs(i) / (rd*t1(i)*(1.0+rvrdm1*q2k)) + qs1 = fpvs( sfctmp(i) ) + qs1 = max(eps*qs1 / (sfcprs(i)+epsm1*qs1), 1.e-8) + q2k = min(qs1, q2k) + + !GJF: could potentially pass in pre-calcualted potential temperature if other schemes also need it (to avoid redundant calculation) + th2 = t1(i) * prslki(i) + + !GJF: module_sf_noahdrv.F from WRF modifies dqsdt2 if the surface has snow. + dqsdt2=qs1*a23m4/(sfctmp(i)-a4)**2 + + !GJF: convert canopy moisture from kg m-2 to m + canopy(i) = max(canopy(i), 0.0) !check for positive values in sfc_drv.f + cmc = canopy(i)/rhowater + + !GJF: snow depth passed in to NOAH is conditionally modified differently in GFS and WRF: + if ( (sneqv(i) /= 0.0 .and. snwdph(i) == 0.) .or. (snwdph(i) <= sneqv(i)) ) then + snowhk = 5.*sneqv(i) + endif + !GJF: GFS version: + ! if (sneqv(i) /= 0.0 .and. snwdph(i) == 0.0) then + ! snowhk = 10.0 * sneqv(i) + ! endif + + !GJF: calculate conductance from surface exchange coefficient + chk = ch(i) * wind(i) + + call sflx (i, 1, srflag(i), & + isurban, dt, zlvl(i), nsoil, sthick, & !c + local, & !L + lutype, sltype, & !CL + lwdn(i),soldn(i),solnet(i),sfcprs(i),prcp,sfctmp(i),q2k,dummy,& !F + dummy,dummy, dummy, & !F + th2,qs1,dqsdt2, & !I + vegtyp(i),soiltyp(i),slopetyp(i),shdfac(i),shmin(i),shmax(i), & !I + albbrd(i), snoalb(i), tbot(i), z0brd(i), z0k(i), emissi(i), embrd(i), & !S + cmc,t1(i),stc(i,:),smc(i,:),swc(i,:),snowhk,sneqv(i),albedok,chk,dummy,& !H + cp, rd, sigma, cph2o, cpice, lsubf,& + eta,sheat,eta_kinematic(i),fdown, & !O + ec(i),edir(i),et,ett(i),esnow(i),drip,dew, & !O + beta,etp(i),ssoil(i), & !O + flx1,flx2,flx3, & !O + flx4,fvb,fbur,fgsn,ua_phys, & !UA + snomlt,sncovr(i), & !O + runoff1,runoff2,runoff3, & !O + rc,pc,rsmin,xlai,rcs,rct,rcq,rcsoil, & !O + soilw,soilm,qsurf(i),smav, & !D + rdlai2d,usemonalb, & + snotime1, & + ribb(i), & + smcwlt(i),smcdry,smcref(i),smcmax,nroot, & + sfcheadrt, & !I + infxsrt,etpnd1,opt_thcnd,aoasis, & !O + xsda_qfx, hfx_phy, qfx_phy, xqnorm, fasdas, hcpct_fasdas, & ! fasdas + errflg, errmsg) + if (errflg > 0) return + !set fasdas = 0; all other vars can be dummy, I think + + canopy(i) = cmc*rhowater + snwdph(i) = snowhk + + shflx(i) = sheat / (cp*rho) + + !aggregating several outputs into one like GFS sfc_drv.F + snohf(i) = flx1 + flx2 + flx3 + + snowc(i) = sncovr(i) !GJF: redundant? + + !convert from m s-1 to kg m-2 s-1 by multiplying by rhowater + runoff(i) = runoff1 * rhowater + drain(i) = runoff2 * rhowater + stm(i) = soilm * rhowater + + !wet1(i) = smc(i,1) / smcmax !Sarah Lu added 09/09/2010 (for GOCART) + + endif + end do + + + end subroutine lsm_noah_hafs_run + + subroutine soil_veg_gen_parm( mminlu, mminsl, errmsg, errflg) + !use namelist_soilveg_hafs + use module_sf_noahlsm, only: shdtbl, nrotbl, rstbl, rgltbl, hstbl, snuptbl, & ! begin land use / vegetation variables + maxalb, laimintbl, laimaxtbl, z0mintbl, z0maxtbl, & + albedomintbl, albedomaxtbl, ztopvtbl,zbotvtbl, & + emissmintbl, emissmaxtbl, topt_data, cmcmax_data, & + cfactr_data, rsmax_data, bare, natural, & + low_density_residential, high_density_residential, & + high_intensity_industrial, lucats, lutype, & !end land use / vegetation variables + bb,drysmc,f11, & ! begin soil variables + maxsmc, refsmc,satpsi,satdk,satdw, wltsmc,qtz,& + slcats, sltype, & ! end soil variables + slope_data, sbeta_data,fxexp_data,csoil_data,salp_data,refdk_data, & ! begin NOAH "general" variables + refkdt_data,frzk_data,zbot_data, smlow_data,smhigh_data, & + czil_data, lvcoef_data, slpcats ! end NOAH "general" variables + implicit none + + character(len=*), intent(in) :: mminlu, mminsl + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg + + integer :: lumatch, iindex, lc, num_slope, iunit_noah + integer :: ierr + integer , parameter :: open_ok = 0 + logical :: opened + + character*128 :: mess , message + character*256 :: a_string + integer , parameter :: loop_max = 10 + integer :: loop_count, i + +!-----SPECIFY VEGETATION RELATED CHARACTERISTICS : +! ALBBCK: SFC albedo (in percentage) +! Z0: Roughness length (m) +! SHDFAC: Green vegetation fraction (in percentage) +! Note: The ALBEDO, Z0, and SHDFAC values read from the following table +! ALBEDO, amd Z0 are specified in LAND-USE TABLE; and SHDFAC is +! the monthly green vegetation data +! CMXTBL: MAX CNPY Capacity (m) +! NROTBL: Rooting depth (layer) +! RSMIN: Mimimum stomatal resistance (s m-1) +! RSMAX: Max. stomatal resistance (s m-1) +! RGL: Parameters used in radiation stress function +! HS: Parameter used in vapor pressure deficit functio +! TOPT: Optimum transpiration air temperature. (K) +! CMCMAX: Maximum canopy water capacity +! CFACTR: Parameter used in the canopy inteception calculati +! SNUP: Threshold snow depth (in water equivalent m) that +! implies 100% snow cover +! LAI: Leaf area index (dimensionless) +! MAXALB: Upper bound on maximum albedo over deep snow +! +!-----READ IN VEGETAION PROPERTIES FROM VEGPARM.TBL +! + iunit_noah = -1 + do i = 20,99 + inquire ( i , opened = opened ) + if ( .not. opened ) then + iunit_noah = i + exit + endif + enddo + + if ( iunit_noah < 0 ) then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: '// & + 'can not find unused fortran unit to read.' + return + endif + + open(iunit_noah, file='VEGPARM.TBL',form='formatted',status='old',iostat=ierr) + if(ierr .ne. open_ok ) then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: failure opening VEGPARM.TBL' + return + end if + + lumatch=0 + + loop_count = 0 + read (iunit_noah,fmt='(a)',end=2002) a_string + find_lutype : do while (lumatch == 0) + read (iunit_noah,*,end=2002)lutype + read (iunit_noah,*)lucats,iindex + if(lutype.eq.mminlu)then + !write( mess , * ) 'landuse type = ' // trim ( lutype ) // ' found', lucats,' categories' + !call wrf_message( mess ) + lumatch=1 + else + loop_count = loop_count+1 + !call wrf_message ( "skipping over lutype = " // trim ( lutype ) ) + find_vegetation_parameter_flag : do + read (iunit_noah,fmt='(a)', end=2002) a_string + if ( a_string(1:21) .eq. 'Vegetation Parameters' ) then + exit find_vegetation_parameter_flag + else if ( loop_count .ge. loop_max ) then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: too many loops in VEGPARM.TBL' + return + endif + enddo find_vegetation_parameter_flag + endif + enddo find_lutype + +! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008 + if ( size(shdtbl) < lucats .or. & + size(nrotbl) < lucats .or. & + size(rstbl) < lucats .or. & + size(rgltbl) < lucats .or. & + size(hstbl) < lucats .or. & + size(snuptbl) < lucats .or. & + size(maxalb) < lucats .or. & + size(laimintbl) < lucats .or. & + size(laimaxtbl) < lucats .or. & + size(z0mintbl) < lucats .or. & + size(z0maxtbl) < lucats .or. & + size(albedomintbl) < lucats .or. & + size(albedomaxtbl) < lucats .or. & + size(ztopvtbl) < lucats .or. & + size(zbotvtbl) < lucats .or. & + size(emissmintbl ) < lucats .or. & + size(emissmaxtbl ) < lucats ) then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: table sizes too small for value of lucats' + return + endif + + if(lutype.eq.mminlu)then + do lc=1,lucats + read (iunit_noah,*)iindex,shdtbl(lc), & + nrotbl(lc),rstbl(lc),rgltbl(lc),hstbl(lc), & + snuptbl(lc),maxalb(lc), laimintbl(lc), & + laimaxtbl(lc),emissmintbl(lc), & + emissmaxtbl(lc), albedomintbl(lc), & + albedomaxtbl(lc), z0mintbl(lc), z0maxtbl(lc),& + ztopvtbl(lc), zbotvtbl(lc) + enddo + + read (iunit_noah,*) + read (iunit_noah,*)topt_data + read (iunit_noah,*) + read (iunit_noah,*)cmcmax_data + read (iunit_noah,*) + read (iunit_noah,*)cfactr_data + read (iunit_noah,*) + read (iunit_noah,*)rsmax_data + read (iunit_noah,*) + read (iunit_noah,*)bare + read (iunit_noah,*) + read (iunit_noah,*)natural + read (iunit_noah,*) + read (iunit_noah,*) + read (iunit_noah,fmt='(a)') a_string + if ( a_string(1:21) .eq. 'Vegetation Parameters' ) then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: expected low and high density residential, and high density industrial information in VEGPARM.TBL' + return + endif + read (iunit_noah,*)low_density_residential + read (iunit_noah,*) + read (iunit_noah,*)high_density_residential + read (iunit_noah,*) + read (iunit_noah,*)high_intensity_industrial + endif + +2002 continue + + close (iunit_noah) + if (lumatch == 0) then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: land use dataset '//mminlu//' not found in VEGPARM.TBL.' + return + endif + + + !CALL wrf_dm_bcast_string ( LUTYPE , 4 ) + !CALL wrf_dm_bcast_integer ( LUCATS , 1 ) + !CALL wrf_dm_bcast_integer ( IINDEX , 1 ) + !CALL wrf_dm_bcast_integer ( LUMATCH , 1 ) + !CALL wrf_dm_bcast_real ( SHDTBL , NLUS ) + !CALL wrf_dm_bcast_real ( NROTBL , NLUS ) + !CALL wrf_dm_bcast_real ( RSTBL , NLUS ) + !CALL wrf_dm_bcast_real ( RGLTBL , NLUS ) + !CALL wrf_dm_bcast_real ( HSTBL , NLUS ) + !CALL wrf_dm_bcast_real ( SNUPTBL , NLUS ) + !CALL wrf_dm_bcast_real ( LAIMINTBL , NLUS ) + !CALL wrf_dm_bcast_real ( LAIMAXTBL , NLUS ) + !CALL wrf_dm_bcast_real ( Z0MINTBL , NLUS ) + !CALL wrf_dm_bcast_real ( Z0MAXTBL , NLUS ) + !CALL wrf_dm_bcast_real ( EMISSMINTBL , NLUS ) + !CALL wrf_dm_bcast_real ( EMISSMAXTBL , NLUS ) + !CALL wrf_dm_bcast_real ( ALBEDOMINTBL , NLUS ) + !CALL wrf_dm_bcast_real ( ALBEDOMAXTBL , NLUS ) + !CALL wrf_dm_bcast_real ( ZTOPVTBL , NLUS ) + !CALL wrf_dm_bcast_real ( ZBOTVTBL , NLUS ) + !CALL wrf_dm_bcast_real ( MAXALB , NLUS ) + !CALL wrf_dm_bcast_real ( TOPT_DATA , 1 ) + !CALL wrf_dm_bcast_real ( CMCMAX_DATA , 1 ) + !CALL wrf_dm_bcast_real ( CFACTR_DATA , 1 ) + !CALL wrf_dm_bcast_real ( RSMAX_DATA , 1 ) + !CALL wrf_dm_bcast_integer ( BARE , 1 ) + !CALL wrf_dm_bcast_integer ( NATURAL , 1 ) + !CALL wrf_dm_bcast_integer ( LOW_DENSITY_RESIDENTIAL , 1 ) + !CALL wrf_dm_bcast_integer ( HIGH_DENSITY_RESIDENTIAL , 1 ) + !CALL wrf_dm_bcast_integer ( HIGH_INTENSITY_INDUSTRIAL , 1 ) + +! +!-----READ IN SOIL PROPERTIES FROM SOILPARM.TBL +! + + open(iunit_noah, file='SOILPARM.TBL',form='formatted',status='old',iostat=ierr) + if(ierr .ne. open_ok ) then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: failure opening SOILPARM.TBL' + return + end if + + !write(mess,*) 'input soil texture classification = ', trim ( mminsl ) + !call wrf_message( mess ) + + lumatch=0 + + read (iunit_noah,*) + read (iunit_noah,2000,end=2003)sltype +2000 format (a4) + read (iunit_noah,*)slcats,iindex + if(sltype.eq.mminsl)then + !write( mess , * ) 'soil texture classification = ', trim ( sltype ) , ' found', & + ! slcats,' categories' + !call wrf_message ( mess ) + lumatch=1 + endif +! prevent possible array overwrite, bill bovermann, ibm, may 6, 2008 + if ( size(bb ) < slcats .or. & + size(drysmc) < slcats .or. & + size(f11 ) < slcats .or. & + size(maxsmc) < slcats .or. & + size(refsmc) < slcats .or. & + size(satpsi) < slcats .or. & + size(satdk ) < slcats .or. & + size(satdw ) < slcats .or. & + size(wltsmc) < slcats .or. & + size(qtz ) < slcats ) then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: table sizes too small for value of slcats' + return + endif + if(sltype.eq.mminsl)then + do lc=1,slcats + read (iunit_noah,*) iindex,bb(lc),drysmc(lc),f11(lc),maxsmc(lc),& + refsmc(lc),satpsi(lc),satdk(lc), satdw(lc), & + wltsmc(lc), qtz(lc) + enddo + endif + +2003 continue + + close (iunit_noah) + + + ! CALL wrf_dm_bcast_integer ( LUMATCH , 1 ) + ! CALL wrf_dm_bcast_string ( SLTYPE , 4 ) + ! CALL wrf_dm_bcast_string ( MMINSL , 4 ) ! since this is reset above, see oct2 ^ + ! CALL wrf_dm_bcast_integer ( SLCATS , 1 ) + ! CALL wrf_dm_bcast_integer ( IINDEX , 1 ) + ! CALL wrf_dm_bcast_real ( BB , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( DRYSMC , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( F11 , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( MAXSMC , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( REFSMC , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( SATPSI , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( SATDK , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( SATDW , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( WLTSMC , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( QTZ , NSLTYPE ) + + if(lumatch.eq.0)then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: soil texture dataset '//mminsl//' not found in SOILPARM.TBL.' + return + endif + +! +!-----READ IN GENERAL PARAMETERS FROM GENPARM.TBL +! + + open(iunit_noah, file='GENPARM.TBL',form='formatted',status='old',iostat=ierr) + if(ierr .ne. open_ok ) then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: failure opening GENPARM.TBL' + return + end if + + read (iunit_noah,*) + read (iunit_noah,*) + read (iunit_noah,*) num_slope + + slpcats=num_slope +! prevent possible array overwrite, bill bovermann, ibm, may 6, 2008 + if ( size(slope_data) < num_slope ) then + errflg = 1 + errmsg = 'module_lsm_noah_hafs: set_soil_veg_parm: num_slope too large for slope_data array' + return + endif + + do lc=1,slpcats + read (iunit_noah,*)slope_data(lc) + enddo + + read (iunit_noah,*) + read (iunit_noah,*)sbeta_data + read (iunit_noah,*) + read (iunit_noah,*)fxexp_data + read (iunit_noah,*) + read (iunit_noah,*)csoil_data + read (iunit_noah,*) + read (iunit_noah,*)salp_data + read (iunit_noah,*) + read (iunit_noah,*)refdk_data + read (iunit_noah,*) + read (iunit_noah,*)refkdt_data + read (iunit_noah,*) + read (iunit_noah,*)frzk_data + read (iunit_noah,*) + read (iunit_noah,*)zbot_data + read (iunit_noah,*) + read (iunit_noah,*)czil_data + read (iunit_noah,*) + read (iunit_noah,*)smlow_data + read (iunit_noah,*) + read (iunit_noah,*)smhigh_data + read (iunit_noah,*) + read (iunit_noah,*)lvcoef_data + close (iunit_noah) + + + ! call wrf_dm_bcast_integer ( num_slope , 1 ) + ! call wrf_dm_bcast_integer ( slpcats , 1 ) + ! call wrf_dm_bcast_real ( slope_data , nslope ) + ! call wrf_dm_bcast_real ( sbeta_data , 1 ) + ! call wrf_dm_bcast_real ( fxexp_data , 1 ) + ! call wrf_dm_bcast_real ( csoil_data , 1 ) + ! call wrf_dm_bcast_real ( salp_data , 1 ) + ! call wrf_dm_bcast_real ( refdk_data , 1 ) + ! call wrf_dm_bcast_real ( refkdt_data , 1 ) + ! call wrf_dm_bcast_real ( frzk_data , 1 ) + ! call wrf_dm_bcast_real ( zbot_data , 1 ) + ! call wrf_dm_bcast_real ( czil_data , 1 ) + ! call wrf_dm_bcast_real ( smlow_data , 1 ) + ! call wrf_dm_bcast_real ( smhigh_data , 1 ) + ! call wrf_dm_bcast_real ( lvcoef_data , 1 ) + + end subroutine soil_veg_gen_parm +!----------------------------- +!> @} + +end module lsm_noah_hafs diff --git a/physics/sfc_drv_hafs.meta b/physics/sfc_drv_hafs.meta new file mode 100644 index 000000000..8f29ae827 --- /dev/null +++ b/physics/sfc_drv_hafs.meta @@ -0,0 +1,766 @@ +[ccpp-arg-table] + name = lsm_noah_hafs_init + type = scheme +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noah_hafs] + standard_name = flag_for_noah_hafs_land_surface_scheme + long_name = flag for NOAH HAFS land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[veg_data_choice] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[soil_data_choice] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ialb] + standard_name = flag_for_using_climatology_albedo + long_name = flag for using climatology alb, based on sfc type + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[isurban] + standard_name = urban_vegetation_category + long_name = index of the urban vegetation category in the chosen vegetation dataset + units = index + dimensions = () + type = integer + intent = inout + optional = F +[sthick] + standard_name = soil_layer_thickness + long_name = soil layer thickness + units = m + dimensions = (soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = lsm_noah_hafs_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = lsm_noah_hafs_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[srflag] + standard_name = flag_for_precipitation_type + long_name = flag for snow or rain precipitation + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[isurban] + standard_name = urban_vegetation_category + long_name = index of the urban vegetation category in the chosen vegetation dataset + units = index + dimensions = () + type = integer + intent = in + optional = F +[opt_thcnd] + standard_name = flag_for_thermal_conductivity_option + long_name = choice for thermal conductivity option (see module_sf_noahlsm) + units = index + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rhowater] + standard_name = liquid_water_density + long_name = density of liquid water + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sigma] + standard_name = stefan_boltzmann_constant + long_name = Steffan-Boltzmann constant + units = W m-2 K-4 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cph2o] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cpice] + standard_name = specific_heat_of_ice_water_at_constant_pressure + long_name = specific heat of ice water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsubf] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[zlvl] + standard_name = height_above_ground_at_lowest_model_layer + long_name = height above ground at 1st model layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[nsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[sthick] + standard_name = soil_layer_thickness + long_name = soil layer thickness + units = m + dimensions = (soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lwdn] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land + long_name = total sky surface downward longwave flux absorbed by the ground over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[soldn] + standard_name = surface_downwelling_shortwave_flux + long_name = total sky surface downward shortwave flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[solnet] + standard_name = surface_net_downwelling_shortwave_flux + long_name = total sky surface net shortwave flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sfcprs] + standard_name = air_pressure_at_lowest_model_layer + long_name = Model layer 1 mean pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sfctmp] + standard_name = air_temperature_at_lowest_model_layer + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = 1st model layer specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[vegtyp] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[slopetyp] + standard_name = surface_slope_classification + long_name = surface slope type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[shmin] + standard_name = minimum_vegetation_area_fraction + long_name = min fractional coverage of green vegetation + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[shmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractional coverage of green vegetation + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tbot] + standard_name = deep_soil_temperature + long_name = bottom soil temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[shdfac] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[albbrd] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused shortwave albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[z0brd] + standard_name = baseline_surface_roughness_length + long_name = baseline surface roughness length for momentum in meter + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[z0k] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[emissi] + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy moisture content + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[t1] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = volumetric fraction of soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[swc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = volume fraction of unfrozen soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sneqv] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ribb] + standard_name = bulk_richardson_number_at_lowest_model_level_over_land + long_name = bulk Richardson number at the surface over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[eta_kinematic] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[shflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[embrd] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[ec] + standard_name = canopy_upward_latent_heat_flux + long_name = canopy upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[edir] + standard_name = soil_upward_latent_heat_flux + long_name = soil upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[ett] + standard_name = transpiration_flux + long_name = total plant transpiration rate + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[esnow] + standard_name = snow_deposition_sublimation_upward_latent_heat_flux + long_name = latent heat flux from snow depo/subl + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[etp] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[ssoil] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[snohf] + standard_name = snow_freezing_rain_upward_latent_heat_flux + long_name = latent heat flux due to snow and frz rain + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[snowc] + standard_name = surface_snow_area_fraction + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[runoff] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[stm] + standard_name = soil_moisture_content + long_name = soil moisture content + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[qsurf] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[smcwlt] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = soil water fraction at wilting point + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[smcref] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 3b4b8a118..bd76ddf07 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -35,7 +35,18 @@ subroutine lsm_ruc_init (me, isot, ivegsrc, nlunit, & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + if (ivegsrc /= 1) then + errmsg = 'The RUC LSM expects that the ivegsrc physics namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + if (isot > 1) then + errmsg = 'The RUC LSM expects that the isot physics namelist parameter is 0, or 1. Exiting...' + errflg = 1 + return + end if + !--- initialize soil vegetation call set_soilveg_ruc(me, isot, ivegsrc, nlunit) diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f index 5ddd5aefc..4c2299244 100644 --- a/physics/sfc_noahmp_drv.f +++ b/physics/sfc_noahmp_drv.f @@ -38,7 +38,20 @@ subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, errmsg, & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + if (ivegsrc /= 1) then + errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// + & 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + if (isot /= 1) then + errmsg = 'The NOAHMP LSM expects that the isot physics '// + & 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + !--- initialize soil vegetation call set_soilveg(me, isot, ivegsrc, nlunit) From 041a43b9426d9b03a5b349c7047576d473f1479f Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 7 Apr 2020 14:42:48 -0600 Subject: [PATCH 2/2] reworked NOAH LSM HAFS to have a more portable interface with variable prep occuring in interstitial schemes --- physics/sfc_noah.F90 | 236 +++++ physics/{sfc_drv_hafs.meta => sfc_noah.meta} | 527 +++++----- ...hafs.F90 => sfc_noah_GFS_interstitial.F90} | 379 +++---- physics/sfc_noah_GFS_interstitial.meta | 957 ++++++++++++++++++ 4 files changed, 1642 insertions(+), 457 deletions(-) create mode 100644 physics/sfc_noah.F90 rename physics/{sfc_drv_hafs.meta => sfc_noah.meta} (78%) rename physics/{sfc_drv_hafs.F90 => sfc_noah_GFS_interstitial.F90} (65%) create mode 100644 physics/sfc_noah_GFS_interstitial.meta diff --git a/physics/sfc_noah.F90 b/physics/sfc_noah.F90 new file mode 100644 index 000000000..5a09c6713 --- /dev/null +++ b/physics/sfc_noah.F90 @@ -0,0 +1,236 @@ +!> \file sfc_noah.F90 +!! This file contains the Noah land surface scheme driver. + +!> This module contains the CCPP-compliant Noah land surface scheme driver for +!! the hurricane application. + module sfc_noah + + implicit none + + private + + public :: sfc_noah_init, sfc_noah_run, sfc_noah_finalize + + contains + +!> \ingroup Noah_LSM_hafs +!! \section arg_table_sfc_noah_init Argument Table +!! \htmlinclude sfc_noah_init.html +!! + subroutine sfc_noah_init(lsm, lsm_noah_hafs, nsoil, ua_phys, fasdas, errmsg, errflg) + + use machine, only : kind_phys + + implicit none + + integer, intent(in) :: lsm, lsm_noah_hafs, nsoil, fasdas + logical, intent(in) :: ua_phys + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lsm/=lsm_noah_hafs) then + write(errmsg,'(*(a))') "Logic error: namelist choice of LSM is different from NOAH HAFS" + errflg = 1 + return + end if + + if (nsoil < 2) then + write(errmsg,'(*(a))') "The NOAH HAFS scheme expects at least 2 soil layers." + errflg = 1 + return + end if + + if (ua_phys) then + write(errmsg,'(*(a))') "The NOAH HAFS scheme has not been tested with ua_phys = T" + errflg = 1 + return + end if + + + if (fasdas > 0) then + write(errmsg,'(*(a))') "The NOAH HAFS scheme has not been tested with fasdas > 0" + errflg = 1 + return + end if + + !GJF: check for rdlai != F? + !GJF: check for usemonalb != T? + + end subroutine sfc_noah_init + + +!! \section arg_table_sfc_noah_finalize Argument Table +!! \htmlinclude sfc_noah_finalize.html +!! + subroutine sfc_noah_finalize(errmsg, errflg) + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + end subroutine sfc_noah_finalize + + +!> \defgroup Noah_LSM_hafs Noah LSM Model for the hurricane application +!! \section arg_table_sfc_noah_run Argument Table +!! \htmlinclude sfc_noah_run.html +!! +!> \section general_noah_hafs_drv GFS sfc_drv General Algorithm +!> @{ + subroutine sfc_noah_run (im, flag_lsm, srflag, isurban, rdlai, & + ua_phys, usemonalb, aoasis, fasdas, dt, zlvl, & + nsoil, sthick, lwdn, soldn, solnet, sfcprs, prcp, sfctmp, q1k, & + th1, qs1, dqsdt2, vegtyp, soiltyp, slopetyp, shdfac, shmin, & + shmax, albbrd, snoalb, tbot, z0brd, z0k, emissi, embrd, cmc, t1,& + stc, smc, swc, snowhk, sneqv, chk, cp, rd, sigma, cph2o, cpice, & + lsubf, sheat, eta_kinematic, ec, edir, ett, esnow, etp, ssoil, & + flx1, flx2, flx3, sncovr, runoff1, runoff2, soilm, qsurf, ribb, & + smcwlt, smcref, smcmax, opt_thcnd, errmsg, errflg) + + use machine , only : kind_phys + use module_sf_noahlsm, only: sflx, lutype, sltype + + implicit none + + integer, intent(in) :: im, isurban, nsoil, opt_thcnd, fasdas + logical, intent(in) :: rdlai, ua_phys, usemonalb + !GJF: usemonalb = True if the surface diffused shortwave albedo is EITHER read from input OR + ! provided by a previous scheme (like radiation: as is done in GFS_rrtmgp_sw_pre) + real(kind=kind_phys), intent(in) :: aoasis + + real(kind=kind_phys), intent(in) :: dt, cp, rd, sigma, cph2o, cpice, lsubf + + integer, dimension(im), intent(in) :: vegtyp, soiltyp, slopetyp + logical, dimension(im), intent(in) :: flag_lsm + real(kind=kind_phys), dimension(im), intent(in) :: srflag, zlvl, lwdn, soldn, solnet, & + sfcprs, prcp, sfctmp, q1k, th1, qs1, & + dqsdt2, shmin, shmax, snoalb, tbot + real(kind=kind_phys), dimension(nsoil), intent(in) :: sthick + + real(kind=kind_phys), dimension(im), intent(inout) :: shdfac, albbrd, z0brd, z0k, emissi, & + cmc, t1, snowhk, sneqv, chk, flx1, & + flx2, flx3, ribb + real(kind=kind_phys), dimension(im,nsoil), intent(inout) :: stc, smc, swc + + !variables that are intent(out) in module_sf_noahlsm, but are inout here due to being set within an IF statement + real(kind=kind_phys), dimension(im), intent(inout) :: embrd, sheat, eta_kinematic, ec, & + edir, ett, esnow, etp, ssoil, sncovr, & + runoff1, runoff2, soilm, qsurf, smcwlt, & + smcref, smcmax + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !GJF: There is some confusion regarding specific humidities vs mixing ratios in NOAH LSM. + ! Looking at module_sf_noahlsm.F, sometimes the comments say mixing ratio and sometimes + ! specific humidity. The WRF code (module_sf_noahdrv.F) specifically converts from mixing + ! ratio to specific humidity in preparation for calling SFLX, so I am assuming that + ! all inputs/outputs into SFLX should be specific humidities, despite some comments in + ! module_sf_noahdrv.F describing arguments saying "mixing ratios". This applies to many + ! arguments into SFLX (q1k, qs1, dqsdt2, eta_kinematic, qsurf, etc.). + +! local Variables + integer :: i, k + logical, parameter :: local = .false. !(not actually used in SFLX) described in module_sf_noahlsm as: + ! Flag for local-site simulation (where there is no maps for albedo, veg fraction, and roughness + ! true: all LSM parameters (inluding albedo, veg fraction and roughness length) will be defined by three tables + + real(kind=kind_phys) :: dummy + + !GJF: The following variables are part of the interface to SFLX but not required as diagnostic + ! output or otherwise outside of this subroutine (at least as part of a GFS-based suite). + ! If any of these variables are needed by other schemes or diagnostics, one needs to add it to + ! the host model and CCPP metadata. Alternatively, none of these variables NEED to be allocated + ! and one could also just pass in dummy arguments. + ! + ! The variables descriptions are from module_sf_noahlsm.F: + ! + ! albedok (output from SFLX): surface albedo including snow effect (unitless fraction) + ! =snow-free albedo (alb) when sneqv=0, or + ! =fct(msnoalb,alb,vegtyp,shdfac,shdmin) when sneqv>0 + ! eta (output from SFLX), eta_kinematic is what is passed out instead of eta + ! fdown (output from SFLX) : Radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN + ! et (output from SFLX): plant transpiration from a particular root (soil) layer (W m-2) + ! drip (output from SFLX): through-fall of precip and/or dew in excess of canopy water-holding capacity (m) + ! dew (output from SFLX): dewfall (or frostfall for t<273.15) (m) + ! beta (output from SFLX): ratio of actual/potential evap (dimensionless) + ! snomlt (output from SFLX): snow melt (m) (water equivalent) + ! runoff3 (output from SFLX): numerical trunctation in excess of porosity (smcmax) for a given soil layer at the end of a time step (m s-1). + ! rc (output from SFLX): canopy resistance (s m-1) + ! pc (output from SFLX): plant coefficient (unitless fraction, 0-1) where pc*etp = actual transp + ! rsmin (output from SFLX): minimum canopy resistance (s m-1) + ! xlai (output from SFLX): leaf area index (dimensionless) + ! rcs (output from SFLX): incoming solar rc factor (dimensionless) + ! rct (output from SFLX): air temperature rc factor (dimensionless) + ! rcq (output from SFLX): atmos vapor pressure deficit rc factor (dimensionless) + ! rcsoil (output from SFLX): soil moisture rc factor (dimensionless) + ! soilw (output from SFLX): available soil moisture in root zone (unitless fraction between smcwlt and smcmax) + ! smav (output from SFLX): soil moisture availability for each layer, as a fraction between smcwlt and smcmax. + ! snotime1 (input/output from SFLX): no documentation in module_sf_noahlsm.F, but described as "initial number of timesteps since last snowfall" in module_sf_noahdrv.F; related to CCPP nondimensional_snow_age for NoahMP? Since inout, need to initialize here? + ! smcdry (output from SFLX): dry soil moisture threshold where direct evap frm top layer ends (volumetric) + ! smcmax (output from SFLX): porosity, i.e. saturated value of soil moisture (volumetric) + ! nroot (output from SFLX): number of root layers, a function of veg type, determined in subroutine redprm. + + integer :: nroot + real(kind=kind_phys) :: albedok, eta, fdown, drip, dew, beta, snomlt, & + runoff3, rc, pc, rsmin, xlai, rcs, rct, rcq, & + rcsoil, soilw, snotime1, smcdry + real (kind=kind_phys), dimension(nsoil) :: et, smav + real(kind=kind_phys) :: sfcheadrt, infxsrt, etpnd1 !don't appear to be used unless WRF_HYDRO preprocessor directive is defined and no documentation + real(kind=kind_phys) :: xsda_qfx, hfx_phy, qfx_phy, xqnorm, hcpct_fasdas !only used if fasdas = 1 + + !variables associated with UA_PHYS (not used for now) + real(kind=kind_phys) :: flx4, fvb, fbur, fgsn + + errmsg = '' + errflg = 0 + + do i=1, im + if (flag_lsm(i)) then + !GJF: Why do LSMs want the dynamics time step instead of the physics time step? + call sflx (i, 1, srflag(i), & + isurban, dt, zlvl(i), nsoil, sthick, & !c + local, & !L + lutype, sltype, & !CL + lwdn(i), soldn(i), solnet(i), sfcprs(i), prcp(i), & !F + sfctmp(i), q1k(i), dummy, dummy, dummy, dummy, & !F + th1(i), qs1(i), dqsdt2(i), & !I + vegtyp(i), soiltyp(i), slopetyp(i), shdfac(i), & !I + shmin(i), shmax(i), & !I + albbrd(i), snoalb(i), tbot(i), z0brd(i), z0k(i), & !S + emissi(i), embrd(i), & !S + cmc(i), t1(i), stc(i,:), smc(i,:), swc(i,:), & !H + snowhk(i), sneqv(i), albedok, chk(i), dummy, & !H + cp, rd, sigma, cph2o, cpice, lsubf, & + eta, sheat(i), eta_kinematic(i), fdown, & !O + ec(i), edir(i), et, ett(i), esnow(i), drip, dew, & !O + beta, etp(i), ssoil(i), flx1(i), flx2(i), flx3(i),& !O + flx4, fvb, fbur, fgsn, ua_phys, & !UA + snomlt, sncovr(i), runoff1(i), runoff2(i),runoff3,& !O + rc, pc, rsmin, xlai, rcs, rct, rcq, rcsoil, & !O + soilw, soilm(i), qsurf(i), smav, & !D + rdlai, usemonalb, snotime1, ribb(i), & + smcwlt(i), smcdry, smcref(i), smcmax(i), nroot, & + sfcheadrt, infxsrt, etpnd1, opt_thcnd, aoasis, & + xsda_qfx, hfx_phy, qfx_phy, xqnorm, fasdas, & !fasdas + hcpct_fasdas, & !fasdas + errflg, errmsg) + if (errflg > 0) return + endif + end do + + + end subroutine sfc_noah_run +!> @} + +end module sfc_noah diff --git a/physics/sfc_drv_hafs.meta b/physics/sfc_noah.meta similarity index 78% rename from physics/sfc_drv_hafs.meta rename to physics/sfc_noah.meta index 8f29ae827..30e82172d 100644 --- a/physics/sfc_drv_hafs.meta +++ b/physics/sfc_noah.meta @@ -1,5 +1,5 @@ [ccpp-arg-table] - name = lsm_noah_hafs_init + name = sfc_noah_init type = scheme [lsm] standard_name = flag_for_land_surface_scheme @@ -17,46 +17,6 @@ type = integer intent = in optional = F -[restart] - standard_name = flag_for_restart - long_name = flag for restart (warmstart) or coldstart - units = flag - dimensions = () - type = logical - intent = in - optional = F -[veg_data_choice] - standard_name = vegetation_type_dataset_choice - long_name = land use dataset choice - units = index - dimensions = () - type = integer - intent = in - optional = F -[soil_data_choice] - standard_name = soil_type_dataset_choice - long_name = soil type dataset choice - units = index - dimensions = () - type = integer - intent = in - optional = F -[ialb] - standard_name = flag_for_using_climatology_albedo - long_name = flag for using climatology alb, based on sfc type - units = flag - dimensions = () - type = integer - intent = in - optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F [nsoil] standard_name = soil_vertical_dimension long_name = soil vertical layer dimension @@ -65,40 +25,21 @@ type = integer intent = in optional = F -[vtype] - standard_name = vegetation_type_classification_real - long_name = vegetation type for lsm - units = index - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys +[ua_phys] + standard_name = flag_for_noah_lsm_ua_extension + long_name = flag for using University of Arizona(?) extension for NOAH LSM (see module_sf_noahlsm.F) + units = flag + dimensions = () + type = logical intent = in optional = F -[snoalb] - standard_name = upper_bound_on_max_albedo_over_deep_snow - long_name = maximum snow albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[isurban] - standard_name = urban_vegetation_category - long_name = index of the urban vegetation category in the chosen vegetation dataset - units = index +[fasdas] + standard_name = flag_flux_adjusting_surface_data_assimilation_system + long_name = flag to use the flux adjusting surface data assimilation system for NOAH LSM HAFS (see module_sf_noahlsm.F) + units = flag dimensions = () type = integer - intent = inout - optional = F -[sthick] - standard_name = soil_layer_thickness - long_name = soil layer thickness - units = m - dimensions = (soil_vertical_dimension) - type = real - kind = kind_phys - intent = inout + intent = in optional = F [errmsg] standard_name = ccpp_error_message @@ -120,7 +61,7 @@ ######################################################################## [ccpp-arg-table] - name = lsm_noah_hafs_finalize + name = sfc_noah_finalize type = scheme [errmsg] standard_name = ccpp_error_message @@ -142,7 +83,7 @@ ######################################################################## [ccpp-arg-table] - name = lsm_noah_hafs_run + name = sfc_noah_run type = scheme [im] standard_name = horizontal_loop_extent @@ -152,22 +93,14 @@ type = integer intent = in optional = F -[land] - standard_name = flag_nonzero_land_surface_fraction - long_name = flag indicating presence of some land surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = in - optional = F -[flag_iter] - standard_name = flag_for_iteration - long_name = flag for iteration +[flag_lsm] + standard_name = flag_for_calling_land_surface_model + long_name = flag for calling land surface model units = flag dimensions = (horizontal_loop_extent) type = logical intent = in - optional = F + optional = F [srflag] standard_name = flag_for_precipitation_type long_name = flag for snow or rain precipitation @@ -176,7 +109,7 @@ type = real kind = kind_phys intent = in - optional = F + optional = F [isurban] standard_name = urban_vegetation_category long_name = index of the urban vegetation category in the chosen vegetation dataset @@ -185,108 +118,51 @@ type = integer intent = in optional = F -[opt_thcnd] - standard_name = flag_for_thermal_conductivity_option - long_name = choice for thermal conductivity option (see module_sf_noahlsm) - units = index - dimensions = () - type = integer - intent = in - optional = F -[dt] - standard_name = time_step_for_dynamics - long_name = dynamics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[rhowater] - standard_name = liquid_water_density - long_name = density of liquid water - units = kg m-3 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[eps] - standard_name = ratio_of_dry_air_to_water_vapor_gas_constants - long_name = rd/rv - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[epsm1] - standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one - long_name = (rd/rv) - 1 - units = none +[rdlai] + standard_name = flag_for_reading_leaf_area_index_from_input + long_name = flag for reading leaf area index from initial conditions + units = flag dimensions = () - type = real - kind = kind_phys + type = logical intent = in optional = F -[cp] - standard_name = specific_heat_of_dry_air_at_constant_pressure - long_name = specific heat of dry air at constant pressure - units = J kg-1 K-1 +[ua_phys] + standard_name = flag_for_noah_lsm_ua_extension + long_name = flag for using University of Arizona(?) extension for NOAH LSM (see module_sf_noahlsm.F) + units = flag dimensions = () - type = real - kind = kind_phys + type = logical intent = in optional = F -[rd] - standard_name = gas_constant_dry_air - long_name = ideal gas constant for dry air - units = J kg-1 K-1 +[usemonalb] + standard_name = flag_for_reading_surface_diffused_shortwave_albedo_from_input + long_name = flag for reading surface diffused shortwave albedo for NOAH LSM HAFS (see module_sf_noahlsm.F) + units = flag dimensions = () - type = real - kind = kind_phys + type = logical intent = in optional = F -[rvrdm1] - standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one - long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) +[aoasis] + standard_name = potential_evaporation_multiplicative_factor + long_name = potential evaporation multiplicative factor for NOAH LSM HAFS (see module_sf_noahlsm.F) units = none dimensions = () type = real kind = kind_phys intent = in optional = F -[sigma] - standard_name = stefan_boltzmann_constant - long_name = Steffan-Boltzmann constant - units = W m-2 K-4 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[cph2o] - standard_name = specific_heat_of_liquid_water_at_constant_pressure - long_name = specific heat of liquid water at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[cpice] - standard_name = specific_heat_of_ice_water_at_constant_pressure - long_name = specific heat of ice water at constant pressure - units = J kg-1 K-1 +[fasdas] + standard_name = flag_flux_adjusting_surface_data_assimilation_system + long_name = flag to use the flux adjusting surface data assimilation system for NOAH LSM HAFS (see module_sf_noahlsm.F) + units = flag dimensions = () - type = real - kind = kind_phys + type = integer intent = in optional = F -[lsubf] - standard_name = latent_heat_of_fusion_of_water_at_0C - long_name = latent heat of fusion - units = J kg-1 +[dt] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s dimensions = () type = real kind = kind_phys @@ -300,7 +176,7 @@ type = real kind = kind_phys intent = in - optional = F + optional = F [nsoil] standard_name = soil_vertical_dimension long_name = soil vertical layer dimension @@ -308,7 +184,7 @@ dimensions = () type = integer intent = in - optional = F + optional = F [sthick] standard_name = soil_layer_thickness long_name = soil layer thickness @@ -317,7 +193,7 @@ type = real kind = kind_phys intent = in - optional = F + optional = F [lwdn] standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land long_name = total sky surface downward longwave flux absorbed by the ground over land @@ -326,7 +202,7 @@ type = real kind = kind_phys intent = in - optional = F + optional = F [soldn] standard_name = surface_downwelling_shortwave_flux long_name = total sky surface downward shortwave flux @@ -354,10 +230,10 @@ kind = kind_phys intent = in optional = F -[tprcp] - standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land - long_name = total precipitation amount in each time step over land - units = m +[prcp] + standard_name = total_precipitation_rate_on_dynamics_timestep_over_land + long_name = total precipitation rate in each time step over land + units = kg m-2 s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -372,19 +248,37 @@ kind = kind_phys intent = in optional = F -[q1] - standard_name = water_vapor_specific_humidity_at_lowest_model_layer - long_name = 1st model layer specific humidity +[q1k] + standard_name = bounded_specific_humidity_at_lowest_model_layer_over_land + long_name = specific humidity at lowest model layer over land bounded between a nonzero epsilon and saturation units = kg kg-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F -[prslki] - standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer - long_name = Exner function ratio bt midlayer and interface at 1st layer - units = ratio +[th1] + standard_name = potential_temperature_at_lowest_model_layer + long_name = potential_temperature_at_lowest_model_layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[qs1] + standard_name = saturation_specific_humidity_at_lowest_model_layer + long_name = saturation specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[dqsdt2] + standard_name = saturation_specific_humidity_slope + long_name = saturation specific humidity slope at lowest model layer + units = K-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -414,6 +308,15 @@ type = integer intent = in optional = F +[shdfac] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [shmin] standard_name = minimum_vegetation_area_fraction long_name = min fractional coverage of green vegetation @@ -432,6 +335,15 @@ kind = kind_phys intent = in optional = F +[albbrd] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused shortwave albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [snoalb] standard_name = upper_bound_on_max_albedo_over_deep_snow long_name = maximum snow albedo @@ -450,33 +362,6 @@ kind = kind_phys intent = in optional = F -[wind] - standard_name = wind_speed_at_lowest_model_layer - long_name = wind speed at lowest model level - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[shdfac] - standard_name = bounded_vegetation_area_fraction - long_name = areal fractional cover of green vegetation bounded on the bottom - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[albbrd] - standard_name = surface_diffused_shortwave_albedo - long_name = mean surface diffused shortwave albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [z0brd] standard_name = baseline_surface_roughness_length long_name = baseline surface roughness length for momentum in meter @@ -504,10 +389,19 @@ kind = kind_phys intent = inout optional = F -[canopy] - standard_name = canopy_water_amount - long_name = canopy moisture content - units = kg m-2 +[embrd] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cmc] + standard_name = canopy_water_amount_in_m + long_name = canopy water amount in m + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -549,9 +443,9 @@ kind = kind_phys intent = inout optional = F -[snwdph] - standard_name = surface_snow_thickness_water_equivalent_over_land - long_name = water equivalent snow depth over land +[snowhk] + standard_name = actual_snow_depth + long_name = actual snow depth units = m dimensions = (horizontal_loop_extent) type = real @@ -567,50 +461,86 @@ kind = kind_phys intent = inout optional = F -[ch] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land - long_name = surface exchange coeff heat & moisture over land - units = none +[chk] + standard_name = surface_conductance_for_heat_and_moisture_in_air_over_land + long_name = surface conductance for heat & moisture over land + units = m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout optional = F -[ribb] - standard_name = bulk_richardson_number_at_lowest_model_level_over_land - long_name = bulk Richardson number at the surface over land - units = none - dimensions = (horizontal_loop_extent) +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () type = real kind = kind_phys - intent = inout + intent = in optional = F -[eta_kinematic] - standard_name = kinematic_surface_upward_latent_heat_flux_over_land - long_name = kinematic surface upward latent heat flux over land - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () type = real kind = kind_phys - intent = out + intent = in + optional = F +[sigma] + standard_name = stefan_boltzmann_constant + long_name = Steffan-Boltzmann constant + units = W m-2 K-4 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cph2o] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cpice] + standard_name = specific_heat_of_ice_water_at_constant_pressure + long_name = specific heat of ice water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsubf] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in optional = F -[shflx] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_land - long_name = kinematic surface upward sensible heat flux over land - units = K m s-1 +[sheat] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F -[embrd] - standard_name = baseline_surface_longwave_emissivity - long_name = baseline surface lw emissivity in fraction - units = frac +[eta_kinematic] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [ec] standard_name = canopy_upward_latent_heat_flux @@ -619,7 +549,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [edir] standard_name = soil_upward_latent_heat_flux @@ -628,7 +558,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [ett] standard_name = transpiration_flux @@ -637,7 +567,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [esnow] standard_name = snow_deposition_sublimation_upward_latent_heat_flux @@ -646,7 +576,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [etp] standard_name = surface_upward_potential_latent_heat_flux_over_land @@ -655,7 +585,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [ssoil] standard_name = upward_heat_flux_in_soil_over_land @@ -664,61 +594,70 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F -[snohf] - standard_name = snow_freezing_rain_upward_latent_heat_flux - long_name = latent heat flux due to snow and frz rain +[flx1] + standard_name = latent_heat_flux_from_precipitating_snow + long_name = latent heat flux due to precipitating snow units = W m-2 dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac +[flx2] + standard_name = latent_heat_flux_from_freezing_rain + long_name = latent heat flux due to freezing rain + units = W m-2 dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F -[snowc] - standard_name = surface_snow_area_fraction +[flx3] + standard_name = latent_heat_flux_due_to_snowmelt + long_name = latent heat flux due to snowmelt phase change + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F -[runoff] - standard_name = surface_runoff_flux - long_name = surface runoff flux - units = kg m-2 s-1 +[runoff1] + standard_name = surface_runoff_flux_in_m_sm1 + long_name = surface runoff flux in m s-1 + units = m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F -[drain] - standard_name = subsurface_runoff_flux - long_name = subsurface runoff flux - units = kg m-2 s-1 +[runoff2] + standard_name = subsurface_runoff_flux_in_m_sm1 + long_name = subsurface runoff flux in m s-1 + units = m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F -[stm] - standard_name = soil_moisture_content - long_name = soil moisture content - units = kg m-2 +[soilm] + standard_name = soil_moisture_content_in_m + long_name = soil moisture in meters + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [qsurf] standard_name = surface_specific_humidity_over_land @@ -727,7 +666,16 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout + optional = F +[ribb] + standard_name = bulk_richardson_number_at_lowest_model_level_over_land + long_name = bulk Richardson number at the surface over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout optional = F [smcwlt] standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point @@ -736,7 +684,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [smcref] standard_name = threshold_volume_fraction_of_condensed_water_in_soil @@ -745,7 +693,24 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout + optional = F +[smcmax] + standard_name = soil_porosity + long_name = volumetric soil porosity + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[opt_thcnd] + standard_name = flag_for_thermal_conductivity_option + long_name = choice for thermal conductivity option (see module_sf_noahlsm) + units = index + dimensions = () + type = integer + intent = in optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/sfc_drv_hafs.F90 b/physics/sfc_noah_GFS_interstitial.F90 similarity index 65% rename from physics/sfc_drv_hafs.F90 rename to physics/sfc_noah_GFS_interstitial.F90 index 5bed9a85a..f93bb91b3 100644 --- a/physics/sfc_drv_hafs.F90 +++ b/physics/sfc_noah_GFS_interstitial.F90 @@ -1,29 +1,33 @@ -!> \file sfc_drv_hafs.f -!! This file contains the Noah land surface scheme driver. +!> \file sfc_noah_GFS_interstitial.F90 +!! This file contains data preparation for the Noah LSM as part of the GFS suite. -!> This module contains the CCPP-compliant Noah land surface scheme driver for the hurricane application. - module lsm_noah_hafs +!> This module contains the CCPP-compliant data preparation for the Noah LSM for the hurricane application. + module sfc_noah_GFS_pre implicit none private - public :: lsm_noah_hafs_init, lsm_noah_hafs_run, lsm_noah_hafs_finalize + public :: sfc_noah_GFS_pre_init, sfc_noah_GFS_pre_run, sfc_noah_GFS_pre_finalize contains -!>\ingroup Noah_LSM_hafs -!! \section arg_table_lsm_noah_hafs_init Argument Table -!! \htmlinclude lsm_noah_hafs_init.html +!> \ingroup Noah_LSM_hafs +!! \section arg_table_sfc_noah_GFS_pre_init Argument Table +!! \htmlinclude sfc_noah_GFS_pre_init.html !! - subroutine lsm_noah_hafs_init(lsm, lsm_noah_hafs, restart, veg_data_choice, soil_data_choice, ialb, ncol, nsoil, vtype, snoalb, isurban, sthick, errmsg, errflg) + subroutine sfc_noah_GFS_pre_init(lsm, lsm_noah_hafs, restart, veg_data_choice, & + soil_data_choice, ialb, ncol, nsoil, vtype, snoalb, isurban, sthick, & + errmsg, errflg) use machine, only : kind_phys use module_sf_noahlsm, only: maxalb implicit none - integer, intent(in) :: lsm, lsm_noah_hafs, veg_data_choice, soil_data_choice, ialb, ncol, nsoil + integer, intent(in) :: lsm, lsm_noah_hafs, & + veg_data_choice, soil_data_choice, & + ialb, ncol, nsoil real(kind=kind_phys), dimension(ncol), intent(in) :: vtype logical, intent(in) :: restart @@ -39,10 +43,6 @@ subroutine lsm_noah_hafs_init(lsm, lsm_noah_hafs, restart, veg_data_choice, soil character(len=256) :: mminlu, mminsl integer :: i, k - !integer :: ite, ide, itf - !integer :: ids,ide, jds,jde, kds,kde, & - ! ims,ime, jms,jme, kms,kme, & - ! its,ite, jts,jte, kts,kte real(kind=kind_phys), parameter, dimension(4) :: zsoil = (/ -0.1,-0.4,-1.0,-2.0/) !what if nsoil /= 4? @@ -91,26 +91,6 @@ subroutine lsm_noah_hafs_init(lsm, lsm_noah_hafs, restart, veg_data_choice, soil call soil_veg_gen_parm(trim(mminlu), trim(mminsl), errmsg, errflg) - ! Set internal dimensions - ! ids = 1 - ! ims = 1 - ! its = 1 - ! ide = ncol - ! ime = ncol - ! ite = ncol - ! jds = 1 - ! jms = 1 - ! jts = 1 - ! jde = 1 - ! jme = 1 - ! jte = 1 - ! kds = 1 - ! kms = 1 - ! kts = 1 - ! kde = nlev - ! kme = nlev - ! kte = nlev - if (.not. restart) then do i = 1, ncol if(ialb == 0) then @@ -124,13 +104,13 @@ subroutine lsm_noah_hafs_init(lsm, lsm_noah_hafs, restart, veg_data_choice, soil sthick(k) = zsoil(k-1) - zsoil(k) enddo - end subroutine lsm_noah_hafs_init + end subroutine sfc_noah_GFS_pre_init -!! \section arg_table_lsm_noah_hafs_finalize Argument Table -!! \htmlinclude lsm_noah_hafs_finalize.html +!! \section arg_table_sfc_noah_GFS_pre_finalize Argument Table +!! \htmlinclude sfc_noah_GFS_pre_finalize.html !! - subroutine lsm_noah_hafs_finalize(errmsg, errflg) + subroutine sfc_noah_GFS_pre_finalize(errmsg, errflg) implicit none @@ -141,100 +121,51 @@ subroutine lsm_noah_hafs_finalize(errmsg, errflg) errmsg = '' errflg = 0 - end subroutine lsm_noah_hafs_finalize + end subroutine sfc_noah_GFS_pre_finalize -!>\defgroup Noah_LSM_hafs Noah LSM Model for the hurricane application -!! \section arg_table_lsm_noah_hafs_run Argument Table -!! \htmlinclude lsm_noah_hafs_run.html +!> \defgroup Noah_LSM_hafs Noah LSM Model for the hurricane application +!! \section arg_table_sfc_noah_GFS_pre_run Argument Table +!! \htmlinclude sfc_noah_GFS_pre_run.html !! !> \section general_noah_hafs_drv GFS sfc_drv General Algorithm !> @{ - subroutine lsm_noah_hafs_run & - & (im, land, flag_iter, srflag, isurban, opt_thcnd, dt, rhowater, & - eps, epsm1, cp, rd, rvrdm1, sigma, cph2o, cpice, lsubf, zlvl, nsoil, & - sthick, lwdn, soldn, solnet, sfcprs, tprcp, sfctmp, q1, prslki, & - vegtyp, soiltyp, slopetyp, shmin, shmax, snoalb, tbot, wind, shdfac, & - albbrd, z0brd, z0k, emissi, canopy, t1, stc, smc, swc, snwdph, sneqv, & - ch, ribb, eta_kinematic, shflx, embrd, ec, edir, ett, esnow, etp, & - ssoil, snohf, sncovr, snowc, runoff, drain, stm, qsurf, smcwlt, smcref, errmsg, errflg & - & ) -! + subroutine sfc_noah_GFS_pre_run (im, nsoil, land, flag_guess, flag_iter, flag_lsm, & + dt, rhowater, rd, rvrdm1, eps, epsm1, sfcprs, tprcp, sfctmp, & + q1, prslki, wind, t1, snwdph, cm, ch, weasd, tsfc, smc, stc, slc, prcp, q2k, rho1, qs1,& + th1, dqsdt2, canopy, cmc, snowhk, chk, cmm, chh, weasd_save, snwdph_save, tsfc_save, canopy_save, smc_save, stc_save, slc_save, errmsg, errflg) + use machine , only : kind_phys - use module_sf_noahlsm, only: sflx, lutype, sltype use funcphys, only : fpvs implicit none + + !GJF: Data preparation and output preparation from SFLX follows the GFS physics code (sfc_drv.F) + ! rather than the WRF code (module_sf_noahdrv.F) in order to "fit in" with other GFS physics-based + ! suites. Another version of this scheme (and the associated post) could potentially be + ! created from the WRF version. No attempt was made to test sensitivities to either approach. + ! Note that the version of NOAH LSM expected here is "generic" - there are no urban, fasdas, or + ! or University of Arizona(?) additions. - integer, intent(in) :: im, isurban, opt_thcnd, nsoil - real(kind=kind_phys), intent(in) :: dt, rhowater, eps, epsm1, cp, rd, rvrdm1, sigma, cph2o, cpice, lsubf + integer, intent(in) :: im, nsoil + real(kind=kind_phys), intent(in) :: dt, rhowater, rd, rvrdm1, eps, epsm1 - integer, dimension(im), intent(in) :: vegtyp, soiltyp, slopetyp - logical, dimension(im), intent(in) :: flag_iter, land - real(kind=kind_phys), dimension(im), intent(in) :: srflag, zlvl, lwdn, soldn, solnet, sfcprs, tprcp, sfctmp, q1, prslki, shmin, shmax, snoalb, tbot, wind - real(kind=kind_phys), dimension(nsoil), intent(in) :: sthick + logical, dimension(im), intent(in) :: flag_guess, flag_iter, land + real(kind=kind_phys), dimension(im), intent(in) :: sfcprs, tprcp, sfctmp, q1, prslki, wind, cm, ch, t1, snwdph + real(kind=kind_phys), dimension(im), intent(in) :: weasd, tsfc + real(kind=kind_phys), dimension(im,nsoil), intent(in) :: smc, stc, slc - real(kind=kind_phys), dimension(im), intent(inout) :: shdfac, albbrd, z0brd, z0k, emissi, canopy, t1, snwdph, sneqv, ch, ribb - real(kind=kind_phys), dimension(im,nsoil), intent(inout) :: stc, smc, swc - - real(kind=kind_phys), dimension(im), intent(out) :: embrd, eta_kinematic, shflx, ec, edir, ett, esnow, etp, ssoil, snohf, sncovr, snowc, runoff, drain, stm, qsurf, smcwlt, smcref + logical, dimension(im), intent(inout) :: flag_lsm + real(kind=kind_phys), dimension(im), intent(inout) :: prcp, q2k, rho1, qs1, th1, dqsdt2, canopy, cmc, snowhk, chk, cmm, chh + real(kind=kind_phys), dimension(im), intent(inout) :: weasd_save, snwdph_save, tsfc_save, canopy_save + real(kind=kind_phys), dimension(im,nsoil), intent(inout) :: smc_save, stc_save, slc_save character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! local Variables integer :: i, k - logical, parameter :: local = .false. - logical, parameter :: ua_phys = .false. - logical, parameter :: rdlai2d = .false. - logical, parameter :: usemonalb = .true. !Biswas says true for HWRF - real(kind=kind_phys), parameter :: aoasis = 1.0 !hard-coded to 1 in module_sf_noahdrv or set to value from urban module? - integer, parameter :: fasdas = 0 ! = 1 if using "flux-adjusting surface data assimilation system" - real(kind=kind_phys) :: prcp, rho, qs1, q2k, th2, dqsdt2, dummy, cmc, snowhk, chk, sheat, flx1, flx2, flx3, runoff1, runoff2, soilm, smcmax - - - integer :: nroot - real(kind=kind_phys) :: albedok, eta, fdown, drip, dew, beta, snomlt, runoff3, rc, pc, rsmin, xlai, rcs, rct, rcq, rcsoil, soilw, snotime1, smcdry - real (kind=kind_phys), dimension(nsoil) :: et, smav - real(kind=kind_phys) :: sfcheadrt, infxsrt, etpnd1 !doesn't appear to be used unless WRF_HYDRO preprocessor directive is defined and no documentation - real(kind=kind_phys) :: xsda_qfx, hfx_phy, qfx_phy, xqnorm, hcpct_fasdas !only used if fasdas = 1 ("flux-adjusting surface data assimilation system") - - !GJF: - ! albedok is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: - ! SURFACE ALBEDO INCLUDING SNOW EFFECT (UNITLESS FRACTION) - ! =SNOW-FREE ALBEDO (ALB) WHEN SNEQV=0, OR - ! =FCT(MSNOALB,ALB,VEGTYP,SHDFAC,SHDMIN) WHEN SNEQV>0 - ! if needed by other schemes or diagnostics, one needs to add it to the host model and CCPP metadata; could also just pass in dummy argument - ! eta is an output from sflx, but eta_kinematic is what is passed out - ! fdown is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: - ! Radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN - ! et is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: - ! plant transpiration from a particular root (soil) layer (W m-2) - ! drip is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: - ! through-fall of precip and/or dew in excess of canopy water-holding capacity (m) - ! dew is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: - ! dewfall (or frostfall for t<273.15) (m) - ! beta is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: - ! ratio of actual/potential evap (dimensionless) - ! snomlt is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: - ! snow melt (m) (water equivalent) - ! rc is an output from sflx (but is not sent outside of the scheme in GFS) and is defined as: - ! canopy resistance (s m-1) - ! pc : plant coefficient (unitless fraction, 0-1) where pc*etp = actual transp - ! rsmin : minimum canopy resistance (s m-1) - ! xlai: leaf area index (dimensionless) - ! rcs: incoming solar rc factor (dimensionless) - ! rct: air temperature rc factor (dimensionless) - ! rcq: atmos vapor pressure deficit rc factor (dimensionless) - ! rcsoil: soil moisture rc factor (dimensionless) - ! soilw: available soil moisture in root zone (unitless fraction between smcwlt and smcmax) - ! smav: soil moisture availability for each layer, as a fraction between smcwlt and smcmax. - ! snotime1: no documentation in module_sf_noahlsm.F, but described as "initial number of timesteps since last snowfall" in module_sf_noahdrv.F; related to CCPP nondimensional_snow_age for NoahMP? Since inout, need to initialize here? - ! smcdry: dry soil moisture threshold where direct evap frm top layer ends (volumetric) - ! nroot: number of root layers, a function of veg type, determined in subroutine redprm. - - !variables associated with UA_PHYS (not used for now) - real(kind=kind_phys) :: flx4, fvb, fbur, fgsn + real(kind=kind_phys) :: sneqv, snwd REAL, PARAMETER :: A2=17.67,A3=273.15,A4=29.65, & A23M4=A2*(A3-A4) @@ -244,96 +175,97 @@ subroutine lsm_noah_hafs_run & errmsg = '' errflg = 0 + do i=1, im + if (land(i) .and. flag_guess(i)) then + weasd_save(i) = weasd(i) + snwdph_save(i) = snwdph(i) + tsfc_save(i) = tsfc(i) + canopy_save(i) = canopy(i) + end if + + do k=1,nsoil + smc_save(i,k) = smc(i,k) + stc_save(i,k) = stc(i,k) + slc_save(i,k) = slc(i,k) + end do + end do + + flag_lsm(:) = .false. do i=1, im if (flag_iter(i) .and. land(i)) then + flag_lsm(i) = .true. !GJF: module_sf_noahdrv.F from WRF has hardcoded slopetyp = 1; why? replicate here? !GJF: shdfac is zeroed out for particular combinations of vegetation table source and vegetation types; replicate here? !GJF: could potentially pass in pre-calculated rates instead of calculating here - prcp = rhowater * tprcp(i) / dt + prcp(i) = rhowater * tprcp(i) / dt !GJF: The GFS version of NOAH prepares the specific humidity in sfc_drv.f as follows: - q2k = max(q1(i), 1.e-8) - rho = sfcprs(i) / (rd*t1(i)*(1.0+rvrdm1*q2k)) - qs1 = fpvs( sfctmp(i) ) - qs1 = max(eps*qs1 / (sfcprs(i)+epsm1*qs1), 1.e-8) - q2k = min(qs1, q2k) + q2k(i) = max(q1(i), 1.e-8) + rho1(i) = sfcprs(i) / (rd*t1(i)*(1.0+rvrdm1*q2k(i))) + qs1(i) = fpvs( sfctmp(i) ) + qs1(i) = max(eps*qs1(i) / (sfcprs(i)+epsm1*qs1(i)), 1.e-8) + q2k(i) = min(qs1(i), q2k(i)) !GJF: could potentially pass in pre-calcualted potential temperature if other schemes also need it (to avoid redundant calculation) - th2 = t1(i) * prslki(i) + th1(i) = t1(i) * prslki(i) !GJF: module_sf_noahdrv.F from WRF modifies dqsdt2 if the surface has snow. - dqsdt2=qs1*a23m4/(sfctmp(i)-a4)**2 + dqsdt2(i)=qs1(i)*a23m4/(sfctmp(i)-a4)**2 !GJF: convert canopy moisture from kg m-2 to m canopy(i) = max(canopy(i), 0.0) !check for positive values in sfc_drv.f - cmc = canopy(i)/rhowater + cmc(i) = canopy(i)/rhowater !GJF: snow depth passed in to NOAH is conditionally modified differently in GFS and WRF: - if ( (sneqv(i) /= 0.0 .and. snwdph(i) == 0.) .or. (snwdph(i) <= sneqv(i)) ) then - snowhk = 5.*sneqv(i) - endif + sneqv = weasd(i) * 0.001 + snwd = snwdph(i) * 0.001 + if ( (sneqv /= 0.0 .and. snwd == 0.) .or. (snwd <= sneqv) ) then + snowhk(i) = 5.*sneqv + end if !GJF: GFS version: ! if (sneqv(i) /= 0.0 .and. snwdph(i) == 0.0) then - ! snowhk = 10.0 * sneqv(i) + ! snowhk(i) = 10.0 * sneqv(i) ! endif !GJF: calculate conductance from surface exchange coefficient - chk = ch(i) * wind(i) - - call sflx (i, 1, srflag(i), & - isurban, dt, zlvl(i), nsoil, sthick, & !c - local, & !L - lutype, sltype, & !CL - lwdn(i),soldn(i),solnet(i),sfcprs(i),prcp,sfctmp(i),q2k,dummy,& !F - dummy,dummy, dummy, & !F - th2,qs1,dqsdt2, & !I - vegtyp(i),soiltyp(i),slopetyp(i),shdfac(i),shmin(i),shmax(i), & !I - albbrd(i), snoalb(i), tbot(i), z0brd(i), z0k(i), emissi(i), embrd(i), & !S - cmc,t1(i),stc(i,:),smc(i,:),swc(i,:),snowhk,sneqv(i),albedok,chk,dummy,& !H - cp, rd, sigma, cph2o, cpice, lsubf,& - eta,sheat,eta_kinematic(i),fdown, & !O - ec(i),edir(i),et,ett(i),esnow(i),drip,dew, & !O - beta,etp(i),ssoil(i), & !O - flx1,flx2,flx3, & !O - flx4,fvb,fbur,fgsn,ua_phys, & !UA - snomlt,sncovr(i), & !O - runoff1,runoff2,runoff3, & !O - rc,pc,rsmin,xlai,rcs,rct,rcq,rcsoil, & !O - soilw,soilm,qsurf(i),smav, & !D - rdlai2d,usemonalb, & - snotime1, & - ribb(i), & - smcwlt(i),smcdry,smcref(i),smcmax,nroot, & - sfcheadrt, & !I - infxsrt,etpnd1,opt_thcnd,aoasis, & !O - xsda_qfx, hfx_phy, qfx_phy, xqnorm, fasdas, hcpct_fasdas, & ! fasdas - errflg, errmsg) - if (errflg > 0) return - !set fasdas = 0; all other vars can be dummy, I think - - canopy(i) = cmc*rhowater - snwdph(i) = snowhk - - shflx(i) = sheat / (cp*rho) - - !aggregating several outputs into one like GFS sfc_drv.F - snohf(i) = flx1 + flx2 + flx3 + chk(i) = ch(i) * wind(i) - snowc(i) = sncovr(i) !GJF: redundant? + chh(i) = chk(i) * rho1(i) + cmm(i) = cm(i) * wind(i) - !convert from m s-1 to kg m-2 s-1 by multiplying by rhowater - runoff(i) = runoff1 * rhowater - drain(i) = runoff2 * rhowater - stm(i) = soilm * rhowater - - !wet1(i) = smc(i,1) / smcmax !Sarah Lu added 09/09/2010 (for GOCART) + +!GJF: If the perturbations of vegetation fraction is desired, one could uncomment this code +! and add appropriate arguments to make this work. This is from the GFS version of NOAH LSM +! in sfc_drv.f. +!> - Call surface_perturbation::ppfbet() to perturb vegetation fraction that goes into gsflx(). +! perturb vegetation fraction that goes into sflx, use the same +! perturbation strategy as for albedo (percentile matching) +!! Following Gehne et al. (2018) \cite gehne_et_al_2018, a perturbation of vegetation +!! fraction is added to account for the uncertainty. A percentile matching technique +!! is applied to guarantee the perturbed vegetation fraction is bounded between 0 and +!! 1. The standard deviation of the perturbations is 0.25 for vegetation fraction of +!! 0.5 and the perturbations go to zero as vegetation fraction approaches its upper +!! or lower bound. + ! vegfp = vegfpert(i) ! sfc-perts, mgehne + ! if (pertvegf(1)>0.0) then + ! ! compute beta distribution parameters for vegetation fraction + ! mv = shdfac + ! sv = pertvegf(1)*mv*(1.-mv) + ! alphav = mv*mv*(1.0-mv)/(sv*sv)-mv + ! betav = alphav*(1.0-mv)/mv + ! ! compute beta distribution value corresponding + ! ! to the given percentile albPpert to use as new albedo + ! call ppfbet(vegfp,alphav,betav,iflag,vegftmp) + ! shdfac = vegftmp + ! endif +! *** sfc-perts, mgehne endif end do - end subroutine lsm_noah_hafs_run + end subroutine sfc_noah_GFS_pre_run subroutine soil_veg_gen_parm( mminlu, mminsl, errmsg, errflg) !use namelist_soilveg_hafs @@ -691,4 +623,99 @@ end subroutine soil_veg_gen_parm !----------------------------- !> @} -end module lsm_noah_hafs + end module sfc_noah_GFS_pre + + module sfc_noah_GFS_post + + implicit none + + private + + public :: sfc_noah_GFS_post_init, sfc_noah_GFS_post_run, sfc_noah_GFS_post_finalize + + contains + + subroutine sfc_noah_GFS_post_init () + end subroutine sfc_noah_GFS_post_init + + subroutine sfc_noah_GFS_post_finalize () + end subroutine sfc_noah_GFS_post_finalize + +!! \section arg_table_sfc_noah_GFS_post_run Argument Table +!! \htmlinclude sfc_noah_GFS_post_run.html +!! + subroutine sfc_noah_GFS_post_run (im, nsoil, land, flag_guess, flag_lsm, rhowater, cp, cmc, & + rho1, sheat, flx1, flx2, flx3, sncovr, runoff1, runoff2, soilm, snowhk, weasd_save, snwdph_save, tsfc_save, t1, canopy_save, smc_save, stc_save, slc_save, smcmax, canopy, shflx, snohf, snowc, runoff, drain, stm, weasd, snwdph, tsfc, smc, stc, slc, wet1, errmsg, errflg) + + use machine, only : kind_phys + + implicit none + + integer, intent(in) :: im, nsoil + logical, dimension(im), intent(in) :: land, flag_guess, flag_lsm + real(kind=kind_phys), intent(in) :: rhowater, cp + real(kind=kind_phys), dimension(im), intent(in) :: cmc, rho1, sheat, & + flx1, flx2, flx3, sncovr, runoff1, runoff2, soilm, snowhk + real(kind=kind_phys), dimension(im), intent(in) :: weasd_save, snwdph_save, tsfc_save, t1, canopy_save, smcmax + real(kind=kind_phys), dimension(im,nsoil), intent(in) :: smc_save, stc_save, slc_save + + real(kind=kind_phys), dimension(im), intent(inout) :: canopy, shflx, & + snohf, snowc, runoff, drain, stm, wet1 + real(kind=kind_phys), dimension(im), intent(inout) :: weasd, snwdph, tsfc + real(kind=kind_phys), dimension(im, nsoil), intent(inout) :: smc, stc, slc + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !local variables + integer :: i, k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i=1, im + if (flag_lsm(i)) then + canopy(i) = cmc(i)*rhowater + snwdph(i) = 1000.0*snowhk(i) + + shflx(i) = sheat(i) / (cp*rho1(i)) + + !aggregating several outputs into one like GFS sfc_drv.F + snohf(i) = flx1(i) + flx2(i) + flx3(i) + + snowc(i) = sncovr(i) !GJF: redundant? + + !convert from m s-1 to kg m-2 s-1 by multiplying by rhowater + runoff(i) = runoff1(i) * rhowater + drain(i) = runoff2(i) * rhowater + + stm(i) = soilm(i) * rhowater + + wet1(i) = smc(i,1) / smcmax(i) !Sarah Lu added 09/09/2010 (for GOCART) + end if + end do + + do i=1, im + if (land(i)) then + if (flag_guess(i)) then + weasd(i) = weasd_save(i) + snwdph(i) = snwdph_save(i) + tsfc(i) = tsfc_save(i) + canopy(i) = canopy_save(i) + + do k=1,nsoil + smc(i,k) = smc_save(i,k) + stc(i,k) = stc_save(i,k) + slc(i,k) = slc_save(i,k) + end do + + else + tsfc(i) = t1(i) + end if + end if + end do + + end subroutine sfc_noah_GFS_post_run + + end module sfc_noah_GFS_post diff --git a/physics/sfc_noah_GFS_interstitial.meta b/physics/sfc_noah_GFS_interstitial.meta new file mode 100644 index 000000000..8233e8388 --- /dev/null +++ b/physics/sfc_noah_GFS_interstitial.meta @@ -0,0 +1,957 @@ +[ccpp-arg-table] + name = sfc_noah_GFS_pre_init + type = scheme +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noah_hafs] + standard_name = flag_for_noah_hafs_land_surface_scheme + long_name = flag for NOAH HAFS land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[veg_data_choice] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[soil_data_choice] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ialb] + standard_name = flag_for_using_climatology_albedo + long_name = flag for using climatology alb, based on sfc type + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[isurban] + standard_name = urban_vegetation_category + long_name = index of the urban vegetation category in the chosen vegetation dataset + units = index + dimensions = () + type = integer + intent = inout + optional = F +[sthick] + standard_name = soil_layer_thickness + long_name = soil layer thickness + units = m + dimensions = (soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sfc_noah_GFS_pre_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sfc_noah_GFS_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_lsm] + standard_name = flag_for_calling_land_surface_model + long_name = flag for calling land surface model + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout + optional = F +[dt] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rhowater] + standard_name = liquid_water_density + long_name = density of liquid water + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sfcprs] + standard_name = air_pressure_at_lowest_model_layer + long_name = Model layer 1 mean pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sfctmp] + standard_name = air_temperature_at_lowest_model_layer + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = 1st model layer specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = volumetric fraction of soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prcp] + standard_name = total_precipitation_rate_on_dynamics_timestep_over_land + long_name = total precipitation rate in each time step over land + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[q2k] + standard_name = bounded_specific_humidity_at_lowest_model_layer_over_land + long_name = specific humidity at lowest model layer over land bounded between a nonzero epsilon and saturation + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[rho1] + standard_name = air_density_at_lowest_model_layer + long_name = air density at lowest model layer + units = kg m-3 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[qs1] + standard_name = saturation_specific_humidity_at_lowest_model_layer + long_name = saturation specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[th1] + standard_name = potential_temperature_at_lowest_model_layer + long_name = potential_temperature_at_lowest_model_layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[dqsdt2] + standard_name = saturation_specific_humidity_slope + long_name = saturation specific humidity slope at lowest model layer + units = K-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy moisture content + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cmc] + standard_name = canopy_water_amount_in_m + long_name = canopy water amount in m + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snowhk] + standard_name = actual_snow_depth + long_name = actual snow depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[chk] + standard_name = surface_conductance_for_heat_and_moisture_in_air_over_land + long_name = surface conductance for heat & moisture over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd_save] + standard_name = water_equivalent_accumulated_snow_depth_over_land_save + long_name = water equiv of acc snow depth over land before entering a physics scheme + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph_save] + standard_name = surface_snow_thickness_water_equivalent_over_land_save + long_name = water equivalent snow depth over land before entering a physics scheme + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_save] + standard_name = surface_skin_temperature_over_land_interstitial_save + long_name = surface skin temperature over land before entering a physics scheme (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[canopy_save] + standard_name = canopy_water_amount_save + long_name = canopy water amount before entering a physics scheme + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[smc_save] + standard_name = volume_fraction_of_soil_moisture_save + long_name = total soil moisture before entering a physics scheme + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc_save] + standard_name = soil_temperature_save + long_name = soil temperature before entering a physics scheme + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slc_save] + standard_name = volume_fraction_of_unfrozen_soil_moisture_save + long_name = liquid soil moisture before entering a physics scheme + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sfc_noah_GFS_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_lsm] + standard_name = flag_for_calling_land_surface_model + long_name = flag for calling land surface model + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[rhowater] + standard_name = liquid_water_density + long_name = density of liquid water + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cmc] + standard_name = canopy_water_amount_in_m + long_name = canopy water amount in m + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[rho1] + standard_name = air_density_at_lowest_model_layer + long_name = air density at lowest model layer + units = kg m-3 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sheat] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[flx1] + standard_name = latent_heat_flux_from_precipitating_snow + long_name = latent heat flux due to precipitating snow + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[flx2] + standard_name = latent_heat_flux_from_freezing_rain + long_name = latent heat flux due to freezing rain + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[flx3] + standard_name = latent_heat_flux_due_to_snowmelt + long_name = latent heat flux due to snowmelt phase change + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[runoff1] + standard_name = surface_runoff_flux_in_m_sm1 + long_name = surface runoff flux in m s-1 + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[runoff2] + standard_name = subsurface_runoff_flux_in_m_sm1 + long_name = subsurface runoff flux in m s-1 + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[soilm] + standard_name = soil_moisture_content_in_m + long_name = soil moisture in meters + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snowhk] + standard_name = actual_snow_depth + long_name = actual snow depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[weasd_save] + standard_name = water_equivalent_accumulated_snow_depth_over_land_save + long_name = water equiv of acc snow depth over land before entering a physics scheme + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snwdph_save] + standard_name = surface_snow_thickness_water_equivalent_over_land_save + long_name = water equivalent snow depth over land before entering a physics scheme + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc_save] + standard_name = surface_skin_temperature_over_land_interstitial_save + long_name = surface skin temperature over land before entering a physics scheme (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[canopy_save] + standard_name = canopy_water_amount_save + long_name = canopy water amount before entering a physics scheme + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[smc_save] + standard_name = volume_fraction_of_soil_moisture_save + long_name = total soil moisture before entering a physics scheme + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stc_save] + standard_name = soil_temperature_save + long_name = soil temperature before entering a physics scheme + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slc_save] + standard_name = volume_fraction_of_unfrozen_soil_moisture_save + long_name = liquid soil moisture before entering a physics scheme + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[smcmax] + standard_name = soil_porosity + long_name = volumetric soil porosity + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy moisture content + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[shflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snohf] + standard_name = snow_freezing_rain_upward_latent_heat_flux + long_name = latent heat flux due to snow and frz rain + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snowc] + standard_name = surface_snow_area_fraction + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[runoff] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[stm] + standard_name = soil_moisture_content + long_name = soil moisture + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = volumetric fraction of soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wet1] + standard_name = normalized_soil_wetness + long_name = normalized soil wetness + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F