diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 000000000..781809bdf --- /dev/null +++ b/.gitmodules @@ -0,0 +1,4 @@ +[submodule "lis/surfacemodels/land/noahmp.5.0/phys/noahmp"] + path = lis/surfacemodels/land/noahmp.5.0/phys/noahmp + url = https://github.com/NCAR/noahmp + branch = release-v5.0-LIS diff --git a/lis/configs/Noah-MPv5.0/MODEL_OUTPUT_LIST_noahmp5.TBL b/lis/configs/Noah-MPv5.0/MODEL_OUTPUT_LIST_noahmp5.TBL new file mode 100644 index 000000000..53e475b14 --- /dev/null +++ b/lis/configs/Noah-MPv5.0/MODEL_OUTPUT_LIST_noahmp5.TBL @@ -0,0 +1,145 @@ +#short_name select? units signconv timeavg? min/max? std? vert.levels grib_id grib_scalefactor longname +#Energy balance components +Swnet: 1 W/m2 DN 0 0 0 1 111 10 # Net Shortwave Radiation (W/m2) +Lwnet: 1 W/m2 DN 0 0 0 1 112 10 # Net Longwave Radiation (W/m2) +Qle: 1 W/m2 UP 0 0 0 1 121 10 # Latent Heat Flux (W/m2) +Qh: 1 W/m2 UP 0 0 0 1 122 10 # Sensible Heat Flux (W/m2) +Qg: 1 W/m2 DN 0 0 0 1 155 10 # Ground Heat Flux (W/m2) +Qf: 0 W/m2 S2L 0 0 0 1 229 10 # Energy of fusion (W/m2) +Qv: 0 W/m2 S2V 0 0 0 1 134 10 # Energy of sublimation (W/m2) +Qa: 0 W/m2 DN 0 0 0 1 136 10 # Advective Energy (W/m2) +Qtau: 0 N/m2 DN 0 0 0 1 135 10 # Momentum flux (N/m2) +DelSurfHeat: 0 J/m2 INC 0 0 0 1 137 10 # Change in surface heat storage (J/m2) +DelColdCont: 0 J/m2 INC 0 0 0 1 138 10 # Change in snow cold content (J/m2) +BR: 0 - - 0 0 1 1 256 10 # Bowen ratio +EF: 0 - - 0 0 1 1 256 10 # Evaporative fraction + +#Water balance components +Snowf: 1 kg/m2s DN 0 0 0 1 161 10000 # Snowfall rate (kg/m2s) +Rainf: 1 kg/m2s DN 0 0 0 1 162 10000 # Rainfall rate (kg/m2s) +RainfConv: 0 kg/m2s DN 0 0 0 1 163 10000 # Convective Rainfall rate (kg/m2s) +TotalPrecip: 0 kg/m2s DN 0 0 0 1 164 10000 # Total Precipitation rate (kg/m2s) +Evap: 1 kg/m2s UP 0 0 0 1 57 10000 # Total Evapotranspiration (kg/m2s) +Qs: 1 kg/m2s OUT 0 0 0 1 235 10000 # Surface runoff (kg/m2s) +Qrec: 0 kg/m2s IN 0 0 0 1 143 10000 # Recharge (kg/m2s) +Qsb: 1 kg/m2s OUT 0 0 0 1 254 10000 # Subsurface runoff (kg/m2s) +Qsm: 0 kg/m2s S2L 0 0 0 1 99 10000 # Snowmelt (kg/m2s) +Qfz: 0 kg/m2s L2S 0 0 0 1 146 10000 # Refreezing of water in the snowpack (kg/m2s) +Qst: 0 kg/m2s - 0 0 0 1 147 10000 # Snow throughfall (kg/m2s) +DelSoilMoist: 0 kg/m2 INC 0 0 0 1 148 10000 # Change in soil moisture (kg/m2) +DelSWE: 0 kg/m2 INC 0 0 0 1 149 1000 # Change in snow water equivalent (kg/m2) +DelSurfStor: 0 kg/m2 INC 0 0 0 1 150 1000 # Change in surface water storage (kg/m2) +DelIntercept: 0 kg/m2 INC 0 0 0 1 151 1000 # Change in interception storage (kg/m2) +RHMin: 0 - - 0 0 0 1 51 10 # Minimum 2 meter relative humidity (-) + +#Surface state variables +SnowT: 0 K - 0 0 0 1 152 10 # Snow surface temperature (K) +VegT: 1 K - 0 0 0 1 153 10 # Vegetation canopy temperature (K) +BareSoilT: 1 K - 0 0 0 1 154 10 # Temperature of bare soil (K) +AvgSurfT: 0 K - 0 0 0 1 148 10 # Average surface temperature (K) +RadT: 1 K - 0 0 0 1 156 10 # Surface Radiative Temperature (K) +Albedo: 1 - - 0 0 0 1 84 100 # Surface Albedo (-) +SWE: 1 kg/m2 - 0 0 0 1 65 1000 # Snow Water Equivalent (kg/m2) +SWEVeg: 0 kg/m2 - 0 0 0 1 159 1000 # SWE intercepted by vegetation (kg/m2) +SurfStor: 0 kg/m2 - 0 0 0 1 160 1000 # Surface water storage (kg/m2) +TWS: 1 mm - 0 0 0 1 160 1000 # Terrestrial water storage (mm) +GWS: 0 mm - 0 0 0 1 176 100 # Ground water storage (mm) +WaterTableD: 0 m - 0 0 0 1 174 1 # Water table depth (m) +SWS: 0 mm - 0 0 0 1 333 10 # Surface water storage + +#Subsurface state variables +SoilMoist: 1 m3/m3 - 0 0 0 4 86 1000 # Average layer soil moisture (kg/m2) +SoilTemp: 1 K - 0 0 0 4 85 1000 # Average layer soil temperature (K) +SmLiqFrac: 1 m3/m3 - 0 0 0 4 85 100 # Average layer fraction of liquid moisture (-) +SmFrozFrac: 0 - - 0 0 0 4 85 100 # Average layer fraction of frozen moisture (-) +SoilWet: 0 - - 0 0 0 1 85 100 # Total soil wetness (-) +RelSMC: 0 m3/m3 - 0 0 0 1 86 1000 # Relative soil moisture +RootTemp: 0 K - 0 0 0 1 85 1000 # Rootzone temperature (K) + +#Evaporation components +PotEvap: 0 kg/m2s UP 0 0 0 1 166 1 # Potential Evapotranspiration (kg/m2s) +ECanop: 1 kg/m2s UP 0 0 0 1 200 1 # Interception evaporation (kg/m2s) +TVeg: 1 kg/m2s UP 0 0 0 1 210 1 # Vegetation transpiration (kg/m2s) +ESoil: 1 kg/m2s UP 0 0 0 1 199 1 # Bare soil evaporation (kg/m2s) +EWater: 0 kg/m2s UP 0 0 0 1 170 1 # Open water evaporation (kg/m2s) +RootMoist: 0 kg/m2 - 0 0 0 1 171 1 # Root zone soil moisture (kg/m2) +CanopInt: 1 kg/m2 - 0 0 0 1 223 1000 # Total canopy water storage (kg/m2) +EvapSnow: 0 kg/m2s - 0 0 0 1 173 1000 # Snow evaporation (kg/m2s) +SubSnow: 1 kg/m2s - 0 0 0 1 198 1000 # Snow sublimation (kg/m2s) +SubSurf: 0 kg/m2s - 0 0 0 1 175 1000 # Sublimation of the snow free area (kg/m2s) + +#Cold season processes +Snowcover: 1 - - 0 0 0 1 66 100 # Snow Cover (-) +SnowDepth: 1 m - 0 0 0 1 66 1000 # Snow Depth (m) +SLiqFrac: 0 - - 0 0 0 1 65 1000 # Fraction of SWE in the liquid phase +SnowTProf: 1 K - 0 0 0 3 239 1000 # Temperature of the snow pack (K) + +#Forcings +Wind_f: 1 m/s - 0 0 0 1 177 10 # Near Surface Wind (m/s) +Rainf_f: 1 kg/m2s DN 0 0 0 1 162 1000 # Average rainfall rate +Snowf_f: 0 kg/m2s DN 0 0 0 1 161 1000 # Average snowfall rate +Tair_f: 1 K - 0 0 0 1 11 10 # Near surface air temperature +Qair_f: 1 kg/kg - 0 0 0 1 51 1000 # Near surface specific humidity +Psurf_f: 1 Pa - 0 0 0 1 1 10 # Surface pressure +SWdown_f: 1 W/m2 DN 0 0 0 1 204 10 # Surface incident shortwave radiation +LWdown_f: 1 W/m2 DN 0 0 0 1 205 10 # Surface incident longwave radiation + +#Additional forcings +DirectSW_f: 0 W/m2 - 0 0 0 1 256 10 # Surface direct incident shortwave radiation +DiffuseSW_f: 0 W/m2 - 0 0 0 1 256 10 # Surface diffuse incident shortwave radiation +NWind_f: 0 m/s N 0 0 0 1 256 10 # Northward wind +EWind_f: 0 m/s E 0 0 0 1 256 10 # Eastward wind +FHeight_f: 0 m - 0 0 0 1 256 10 # Height of forcing variables +CH_f: 0 - - 0 0 0 1 256 10 # Surface exchange coefficient for heat +CM_f: 0 - - 0 0 0 1 256 10 # Surface Exchange Coefficient for momentum +Emiss_f: 1 - - 0 0 0 1 256 10 # Surface emissivity +MixRatio_f: 0 kg/kg - 0 0 0 1 256 10 # Surface mixing ration +CosZenith_f: 0 - - 0 0 0 1 256 10 # Cosine of zenith angle +Albedo_f: 0 - - 0 0 0 1 256 10 # Surface albedo + +#Parameters +Landmask: 0 - - 0 0 0 1 81 1 # Land Mask (0 - Water, 1- Land) +Landcover: 1 - - 0 0 0 1 186 1 # Land cover +Soiltype: 0 - - 0 0 0 1 187 1 # Soil type +SandFrac: 0 - - 0 0 0 1 999 1 # Sand fraction +ClayFrac: 0 - - 0 0 0 1 999 1 # Clay fraction +SiltFrac: 0 - - 0 0 0 1 999 1 # Silt fraction +Porosity: 0 - - 0 0 0 1 999 1 # Porosity +Soilcolor: 0 - - 0 0 0 1 188 1 # Soil color +Elevation: 0 m - 0 0 0 1 189 10 # Elevation +Slope: 0 - - 0 0 0 1 999 10 # Slope +LAI: 1 - - 0 0 0 1 190 100 # LAI +SAI: 1 - - 0 0 0 1 191 100 # SAI +Snfralbedo: 0 - - 0 0 0 1 192 100 # Snow fraction albedo +Mxsnalbedo: 0 - - 0 0 0 1 192 100 # Maximum snow albedo +Greenness: 1 - - 0 0 0 1 87 100 # Greenness +Tempbot: 0 - - 0 0 0 1 194 10 # Bottom soil temperature + +#Routing +Streamflow: 0 m3/s - 2 0 0 1 333 10 #Streamflow +RiverStor: 0 m3 - 0 0 0 1 333 10 #RiverStorage +RiverDepth: 0 m - 0 0 0 1 333 10 #RiverDepth +RiverVelocity: 0 m/s - 0 0 0 1 333 10 #RiverVelocity +FloodQ: 0 m3/s - 0 0 0 1 333 10 #FloodDischarge +FloodEvap: 0 m3 - 0 0 0 1 333 10 #FloodEvap +FloodStor: 0 m3 - 0 0 0 1 333 10 #FloodStorage +FloodDepth: 0 m - 0 0 0 1 333 10 #FloodDepth +FloodVelocity: 0 m/s - 0 0 0 1 333 10 #FloodVelocity +FloodedFrac: 0 - - 2 0 0 1 333 10 #FloodedFrac +FloodedArea: 0 m2 - 2 0 0 1 333 10 #FloodedArea +SurfElev: 0 m - 0 0 0 1 333 10 #SurfElev + +#Carbon variables +GPP: 0 kg/m2s2 DN 1 0 0 1 256 1 # Gross Primary Production +NPP: 0 kg/m2s2 DN 1 0 0 1 256 1 # Net Primary Production +NEE: 0 kg/m2s2 UP 1 0 0 1 256 1 # Net Ecosystem Exchange + +#Irrigation +Irrigated water: 0 kg/m2s - 0 0 0 1 333 10 #Irrigation amount + +#Temperature +VegGrndT: 0 K - 0 0 0 1 152 10 #vegetated_ground_surface_temperature +VegCanopT: 1 K - 0 0 0 1 152 10 #canopy_air_temperature +AvgGrndT: 1 K - 0 0 0 1 152 10 #average_ground_surface_temperature +VegT2m: 1 K - 0 0 0 1 152 10 #2-m_air_temperature_over_vegetated_part +BARE2MT: 1 K - 0 0 0 1 152 10 #2-m_air_temperature_over_bareground_part diff --git a/lis/configs/Noah-MPv5.0/forcing_variables.txt b/lis/configs/Noah-MPv5.0/forcing_variables.txt new file mode 100644 index 000000000..ad27ce185 --- /dev/null +++ b/lis/configs/Noah-MPv5.0/forcing_variables.txt @@ -0,0 +1,22 @@ +#ALMA Name select vlevels units +Tair: 1 1 K # Near Surface Air Temperature +Qair: 1 1 kg/kg # Near Surface Specific Humidity +SWdown: 1 1 W/m2 # Incident Shortwave Radiation +SWdirect: 0 1 W/m2 # Incident Shortwave Radiation +SWdiffuse: 0 1 W/m2 # Incident Shortwave Radiation +LWdown: 1 1 W/m2 # Incident Longwave Radiation +Wind_E: 1 1 W/m2 # Eastward Wind +Wind_N: 1 1 m/s # Northward Wind +Psurf: 1 1 Pa # Surface Pressure +Rainf: 1 1 kg/m2s # Rainfall Rate +Snowf: 0 1 kg/m2s # Snowfall Rate +CRainf: 1 1 kg/m2s # Convective Rainfall Rate +Forc_Hgt: 0 1 m # Height of Forcing Variables +Ch: 0 1 - # Surface Exchange Coefficient for Heat +Cm: 0 1 - # Surface Exchange Coefficient for Momentum +Q2sat: 0 1 - # Saturated Mixing Ratio +Emiss: 0 1 - # Surface Emissivity +Cosz: 0 1 - # Cosine of Zenith Angle +Albedo: 0 1 - # Surface Albedo +LPressure: 0 1 Pa # Level pressure +O3: 0 1 - # Ozone concentration diff --git a/lis/configs/Noah-MPv5.0/lis.config_noahmp5_NLDAS2 b/lis/configs/Noah-MPv5.0/lis.config_noahmp5_NLDAS2 new file mode 100644 index 000000000..6fd1be7de --- /dev/null +++ b/lis/configs/Noah-MPv5.0/lis.config_noahmp5_NLDAS2 @@ -0,0 +1,221 @@ +#Overall driver options +Running mode: retrospective +Map projection of the LIS domain: latlon +Number of nests: 1 +Number of surface model types: 1 +Surface model types: "LSM" "Openwater" +Surface model output interval: 1hr +Land surface model: "Noah-MP.5.0" +Open water model: "template open water" +Number of met forcing sources: 1 +Blending method for forcings: overlay +Met forcing sources: "NLDAS2" +Topographic correction method (met forcing): "none" +Enable spatial downscaling of precipitation: 0 +Spatial upscaling method (met forcing): "average" +Spatial interpolation method (met forcing): "neighbor" +Temporal interpolation method (met forcing): "linear" + +#Runtime options +Forcing variables list file: ./input/forcing_variables.txt +Output forcing: 1 #1-yes +Output parameters: 0 #0- no +Output methodology: "2d gridspace" +Output model restart files: 1 +Output data format: "netcdf" +Output naming style: "3 level hierarchy" +Start mode: coldstart #coldstart, restart +Starting year: 2013 +Starting month: 1 +Starting day: 1 +Starting hour: 0 +Starting minute: 0 +Starting second: 0 +Ending year: 2013 +Ending month: 1 +Ending day: 30 +Ending hour: 0 +Ending minute: 0 +Ending second: 0 +Undefined value: -9999 +Output directory: './OUTPUT' +Diagnostic output file: './logfiles/lislog' +Number of ensembles per tile: 1 + +#The following options are used for subgrid tiling based on vegetation +Maximum number of surface type tiles per grid: 1 +Minimum cutoff percentage (surface type tiles): 0.05 +Maximum number of soil texture tiles per grid: 1 +Minimum cutoff percentage (soil texture tiles): 0.05 +Maximum number of soil fraction tiles per grid: 1 +Minimum cutoff percentage (soil fraction tiles): 0.05 +Maximum number of elevation bands per grid: 1 +Minimum cutoff percentage (elevation bands): 0.05 +Maximum number of slope bands per grid: 1 +Minimum cutoff percentage (slope bands): 0.05 +Maximum number of aspect bands per grid: 1 +Minimum cutoff percentage (aspect bands): 0.05 + +#Processor Layout +#Should match the total number of processors used + +Number of processors along x: 18 +Number of processors along y: 16 +Decompose by processes: .true. +Halo size along x: 0 +Halo size along y: 0 + +#------------------------ ROUTING ------------------------------------- + +Routing model: "none" + +#------------------------RADIATIVE TRANSFER MODELS-------------------------- + +Radiative transfer model: none + +#------------------------APPLICATION MODELS--------------------------------- + +Number of application models: 0 + +#---------------------DATA ASSIMILATION ---------------------------------- +#Data Assimilation Options + +Number of data assimilation instances: 0 +Data assimilation algorithm: "none" +Data assimilation set: "none" +# Number of state variables: 2 +Data assimilation exclude analysis increments: 0 +Data assimilation output interval for diagnostics: "1da" +Data assimilation number of observation types: 0 +Data assimilation output ensemble members: 0 +Data assimilation output processed observations: 0 +Data assimilation output innovations: 0 + +#Bias estimation options +Bias estimation algorithm: none +Bias estimation attributes file: none +Bias estimation restart output frequency: 1da +Bias estimation start mode: none +Bias estimation restart file: none + +#Perturbation options +Perturbations start mode: coldstart +Perturbations restart output interval: 1da +Perturbations restart filename: none +Forcing perturbation algorithm: none +Forcing perturbation frequency: 1hr +Forcing attributes file: none +Forcing perturbation attributes file: none +State perturbation algorithm: none +State perturbation frequency: 1hr +State attributes file: none +State perturbation attributes file: none +Observation perturbation algorithm: none +Observation perturbation frequency: 1hr +Observation attributes file: none +Observation perturbation attributes file: none + + +#------------------------DOMAIN SPECIFICATION-------------------------- +#Definition of Running Domain +#Specify the domain extremes in latitude and longitude +#Run domain lower left lat: 25.0625 +#Run domain lower left lon: -124.9375 +#Run domain upper right lat: 52.9375 +#Run domain upper right lon: -67.0625 +#Run domain resolution (dx): 0.125 +#Run domain resolution (dy): 0.125 + +#The following options list the choice of parameter maps to be +#used + +LIS domain and parameter data file: ./input/lis_input.d01.nc +Landmask data source: "LDT" +Landcover data source: "LDT" +Soil texture data source: "LDT" +Soil fraction data source: "none" +Soil color data source: "none" +Elevation data source: "LDT" +Slope data source: "none" +Aspect data source: "none" +Curvature data source: "none" +LAI data source: "none" +SAI data source: "none" +Albedo data source: "LDT" +Max snow albedo data source: "LDT" +Greenness data source: "LDT" +Roughness data source: "none" +Porosity data source: "none" +Ksat data source: "none" +B parameter data source: "none" +Quartz data source: "none" +Emissivity data source: "none" +TBOT lag skin temperature update option: 0 +TBOT skin temperature lag days: 0 + +#--------------------------------FORCINGS---------------------------------- +NLDAS2 forcing directory: ./input/forc/ +NLDAS2 data center source: "GES-DISC" +NLDAS2 domain x-dimension size: 464 +NLDAS2 domain y-dimension size: 224 +NLDAS2 use model level data: 0 +NLDAS2 use model based swdown: 0 +NLDAS2 use model based precip: 0 +NLDAS2 use model based pressure: 0 + +#-----------------------LAND SURFACE MODELS-------------------------- +Noah-MP.5.0 model timestep: 30mn +Noah-MP.5.0 soil timestep: 30mn +Noah-MP.5.0 restart output interval: 1da +Noah-MP.5.0 restart file: none #./OUTPUT/SURFACEMODEL/201001/LIS_RST_NOAHMPnew_201001100000.d01.nc +Noah-MP.5.0 restart file format: netcdf +Noah-MP.5.0 parameter table: ./input/NoahmpTable.TBL # this file is stored at: noahmp.5.0/phys/noahmp/parameters/NoahmpTable.TBL +Noah-MP.5.0 number of soil layers: 4 +Noah-MP.5.0 thickness of soil layers: 0.1 0.3 0.6 1.0 +Noah-MP.5.0 domain resolution dx: 13897.18 # unit of meter (=0.125deg for NLDAS2) +Noah-MP.5.0 domain resolution dy: 13897.18 # unit of meter (=0.125deg for NLDAS2) +Noah-MP.5.0 dynamic vegetation option: 4 # Up to 9 different options +Noah-MP.5.0 canopy stomatal resistance option: 1 # 1=Ball-Berry; 2=Jarvis +Noah-MP.5.0 soil moisture factor for stomatal resistance: 1 # 1=Noah; 2=CLM; 3=SSiB +Noah-MP.5.0 surface runoff option: 3 # 1=SIMGM; 2=SIMTOP; 3=Schaake96; 4=BATS; 5=Miguez-Macho&Fan; 6=VIC; 7=XinAnJiang; 8=Dynamic VIC +Noah-MP.5.0 subsurface runoff and groundwater option: 3 # 1=SIMGM; 2=SIMTOP; 3=Schaake96; 4=BATS; 5=Miguez-Macho&Fan; 6=VIC; 7=XinAnJiang; 8=Dynamic VIC +Noah-MP.5.0 dynamic VIC infiltration option: 1 # 1=Philip; 2=Green-Ampt; 3=Smith-Parlange (only works with surface runoff=8) +Noah-MP.5.0 surface layer drag coefficient option: 1 # 1=M-O; 2=Chen97 +Noah-MP.5.0 supercooled liquid water option: 1 # 1=NY06; 2=Koren99 +Noah-MP.5.0 frozen soil permeability option: 1 # 1=NY06; 2=Koren99 +Noah-MP.5.0 canopy radiative transfer option: 3 # 1=gap=F(3D;cosz); 2=gap=0; 3=gap=1-Fveg +Noah-MP.5.0 snow surface albedo option: 1 # 1=BATS; 2=CLASS +Noah-MP.5.0 rain-snow partition option: 1 # 1=Jordan91; 2=BATS; 3=Noah; 4=WRF couple; 5=Wet-Bulb +Noah-MP.5.0 snow thermal conductivity option: 1 # 1=Yen1965; 2=Anderson1976; 3=constant; 4=Verseghy1991; 5=Yen1981 +Noah-MP.5.0 lower boundary of soil temperature option: 2 # 1=zero-flux; 2=Noah +Noah-MP.5.0 snow&soil temperature time scheme option: 1 # 1=semi-implicit; 2=fully implicit; 3=FSNO for TS +Noah-MP.5.0 glacier ice option: 1 # 1=include phase change; 2=slab ice (Noah) +Noah-MP.5.0 surface resistance option: 1 # 1=Sakaguchi and Zeng 2009; 2=Sellers (1992); 3=adjusted Sellers; 4=option1 for non-snow and rsurf_snow for snow +Noah-MP.5.0 soil configuration option: 1 # 1=input dominant soil texture; 2=input soil texture varies that varies with depth; 3=soil composition and pedotransfer; 4=input soil properties +Noah-MP.5.0 soil pedotransfer function option: 1 # 1=Saxton and Rawls (2006) (used when soil_opt=3) +Noah-MP.5.0 crop model option: 0 # 0=No crop model; 1=Liu et al. 2016; +Noah-MP.5.0 irrigation trigger option: 0 # 0=No irrigation; 1=Irrigation ON; 2=Trigger by plant/harvest date; 3=Trigger by LAI +Noah-MP.5.0 irrigation method option: 0 # 0=method based on input map; 1=sprinkler; 2=micro/drip; 3=flooding +Noah-MP.5.0 tile drainage option: 0 # 0=No tile drainage; 1=Simple drainage; 2=Hooghoudt's scheme +Noah-MP.5.0 urban physics option: 0 # 0=No; 1=Single-layer; 2=Multi-layer BEP scheme; 3=Multi-layer BEM scheme +Noah-MP.5.0 reference height of temperature and humidity: 10.0 +Noah-MP.5.0 initial surface skin temperature: 273.15 +Noah-MP.5.0 initial snow water equivalent: 0.0 +Noah-MP.5.0 initial snow depth: 0.0 +Noah-MP.5.0 initial total canopy surface water: 0.0 +Noah-MP.5.0 initial soil temperatures: 280.0 280.0 280.0 280.0 +#Noah-MP.5.0 initial soil temperatures: 274.0 274.0 274.0 274.0 #TML: start with low soil temp to permit snow DA +Noah-MP.5.0 initial total soil moistures: 0.20 0.20 0.20 0.20 +Noah-MP.5.0 initial leaf area index: 0.5 +Noah-MP.5.0 initial water table depth: 2.5 +Noah-MP.5.0 initial water in the aquifer: 4900.0 +Noah-MP.5.0 initial water in aquifer and saturated soil: 4900.0 + +Template open water timestep: 30mn + + +#---------------------------MODEL OUTPUT CONFIGURATION----------------------- +#Specify the list of ALMA variables that need to be featured in the +#LSM model output + +Model output attributes file: './MODEL_OUTPUT_LIST_noahmp5.TBL' diff --git a/lis/configs/Noah-MPv5.0/lis.config_noahmp5_USAF_global b/lis/configs/Noah-MPv5.0/lis.config_noahmp5_USAF_global new file mode 100644 index 000000000..d1671f8af --- /dev/null +++ b/lis/configs/Noah-MPv5.0/lis.config_noahmp5_USAF_global @@ -0,0 +1,427 @@ +#Overall driver options +Running mode: "retrospective" +Map projection of the LIS domain: latlon +Number of nests: 1 +Number of surface model types: 2 +Surface model types: "LSM" "Openwater" +Surface model output interval: 3hr +Land surface model: "Noah-MP.5.0" +Open water model: "template open water" +Number of met forcing sources: 1 +Blending method for forcings: overlay +Met forcing sources: "AGRMET" +Met forcing chosen ensemble member: 1 +Topographic correction method (met forcing): "none" +Enable spatial downscaling of precipitation: 0 +Spatial upscaling method (met forcing): average +Spatial interpolation method (met forcing): bilinear +Temporal interpolation method (met forcing): linear + +#Runtime options +Forcing variables list file: ./lis.config.global/forcing_variables.txt +Output methodology: "2d gridspace" +Output model restart files: 1 +Output data format: netcdf +Output naming style: "3 level hierarchy" +Enable output statistics: .false. +Start mode: coldstart #coldstart, restart +Starting year: 2023 +Starting month: 7 +Starting day: 1 +Starting hour: 0 +Starting minute: 0 +Starting second: 0 +Ending year: 2023 +Ending month: 8 +Ending day: 1 +Ending hour: 0 +Ending minute: 0 +Ending second: 0 +Undefined value: -9999 +Output directory: './OUTPUT' +Diagnostic output file: './logfiles/lislog' +Number of ensembles per tile: 1 + +#The following options are used for subgrid tiling based on vegetation +Maximum number of surface type tiles per grid: 1 +Minimum cutoff percentage (surface type tiles): 0.05 +Maximum number of soil texture tiles per grid: 1 +Minimum cutoff percentage (soil texture tiles): 0.05 +Maximum number of soil fraction tiles per grid: 1 +Minimum cutoff percentage (soil fraction tiles): 0.05 +Maximum number of elevation bands per grid: 1 +Minimum cutoff percentage (elevation bands): 0.05 +Maximum number of slope bands per grid: 1 +Minimum cutoff percentage (slope bands): 0.05 +Maximum number of aspect bands per grid: 1 +Minimum cutoff percentage (aspect bands): 0.05 + +#Processor layout +#Should match the total number of processors used +Number of processors along x: 560 +Number of processors along y: 1 +Decompose by processes: .true. +Halo size along x: 0 +Halo size along y: 0 + +#Sub-models +Routing model: none +Radiative transfer model: none +Number of application models: 0 + +#---------------------DATA ASSIMILATION ---------------------------------- +#Data assimilation options +Number of data assimilation instances: 0 +Data assimilation algorithm: none none none +Data assimilation set: "SNODEP" "SMOPS-ASCAT soil moisture" "SMAP(NASA) soil moisture" +Data assimilation exclude analysis increments: 0 0 0 +Data assimilation number of observation types: 1 1 1 +Data assimilation output interval for diagnostics: 1mo 1mo 1mo +Data assimilation output processed observations: 0 0 0 +Data assimilation output innovations: 0 0 0 +Data assimilation output ensemble spread: 0 0 0 + +Data assimilation observation domain file: ./lis_input.global.noahmp5.merit.nc ./lis_input.global.noahmp5.merit.nc ./lis_input.global.noahmp5.merit.nc +Data assimilation scaling strategy: "none" "CDF matching" "CDF matching" + +Data assimilation use a trained forward model: 0 0 0 +Data assimilation trained forward model output file: none none none + +#Bias estimation options +Bias estimation algorithm: none none none +Bias estimation attributes file: none none none +Bias estimation restart output frequency: 1da 1da 1da +Bias estimation start mode: none none none +Bias estimation restart file: none none none + +#Perturbation options +Perturbations start mode: coldstart coldstart coldstart +Perturbations restart output interval: 1mo 1mo 1mo +Perturbations restart filename: none none none +Apply perturbation bias correction: 1 1 1 + +Forcing perturbation algorithm: none none none +Forcing perturbation frequency: 1hr 1hr 1hr +Forcing attributes file: ./attribs/forcing_attribs.txt ./attribs/forcing_attribs.txt ./attribs/forcing_attribs.txt +Forcing perturbation attributes file: ./attribs/forcing_pertattribs.txt ./attribs/forcing_pertattribs.txt ./attribs/forcing_pertattribs.txt + +State perturbation algorithm: none none none +State perturbation frequency: 6hr 6hr 6hr +State attributes file: ./attribs/noahmp_snow_attribs.txt ./attribs/noahmp_sm_attribs.txt ./attribs/noahmp_sm_attribs.txt +State perturbation attributes file: ./attribs/noahmp_snow_pertattribs.txt ./attribs/noahmp_sm_pertattribs.txt ./attribs/noahmp_sm_pertattribs.txt + +Observation perturbation algorithm: none none none +Observation perturbation frequency: 6hr 6hr 6hr +Observation attributes file: ./attribs/snodep_attribs.txt ./attribs/smops_attribs.txt ./attribs/smap_attribs.txt +Observation perturbation attributes file: ./attribs/snodep_pertattribs.txt ./attribs/smops_pertattribs.txt ./attribs/smap_pertattribs.txt + +SNODEP data directory: ./usaf_lis/MET_FORCING/SNODEP +SNODEP mesh resolution: 16 +SNODEP naming convention: LIS + +SMOPS ASCAT soil moisture data directory: ./usaf_lis/MET_FORCING/SMOPS +SMOPS ASCAT naming convention: "AGRMET ops" +SMOPS ASCAT version: "date-based" +SMOPS ASCAT model CDF file: ./cdf/noahmp401_cdf_200obs.nc +SMOPS ASCAT observation CDF file: ./cdf/ASCAT_cdf_10km_100obs.nc +SMOPS ASCAT soil moisture number of bins in the CDF: 100 +SMOPS ASCAT use realtime data: 1 +SMOPS ASCAT soil moisture use scaled standard deviation model: 0 +SMOPS ASCAT CDF read option: 1 + +SMAP(NASA) soil moisture data directory: ./input/RS_DATA/SMAP/SPL3SMP.007 +SMAP(NASA) soil moisture data designation: SPL3SMP +SMAP(NASA) soil moisture Composite Release ID: R17 +SMAP(NASA) model CDF file: ./cdf/noahmp401_cdf_200obs.nc +SMAP(NASA) observation CDF file: ./cdf/SMAP_cdf_10km_30obs.nc +SMAP(NASA) soil moisture number of bins in the CDF: 100 +SMAP(NASA) soil moisture use scaled standard deviation model: 0 +SMAP(NASA) CDF read option: 1 + +#------------------------DOMAIN SPECIFICATION-------------------------- +#The following options list the choice of parameter maps to be used +LIS domain and parameter data file: ./lis.config.global/lis_input.global.noahmp5.merit.nc # can also use noahmp401 file +Landmask data source: LDT +Landcover data source: LDT +Soil texture data source: LDT +Soil fraction data source: none +Soil color data source: none +Elevation data source: LDT +Slope data source: LDT +Aspect data source: LDT +Curvature data source: none +LAI data source: none +SAI data source: none +Albedo data source: LDT +Max snow albedo data source: LDT +Greenness data source: LDT +Roughness data source: none +Porosity data source: none +Ksat data source: none +B parameter data source: none +Quartz data source: none +Emissivity data source: none + +TBOT lag skin temperature update option: 0 +TBOT skin temperature lag days: 0 + +#--------------------------------FORCINGS---------------------------------- +# 10-km global domain +AGRMET forcing map projection: latlon +AGRMET forcing domain lower left lat: -89.9531250 +AGRMET forcing domain lower left lon: -179.9296875 +AGRMET forcing domain upper right lat: 89.9531250 +AGRMET forcing domain upper right lon: 179.9296875 +AGRMET forcing domain resolution (dx): 0.1406250 +AGRMET forcing domain resolution (dy): 0.0937500 + +# Input settings +AGRMET forcing directory: ./lis.forcing.global.202307/usaf_lis/MET_FORCING/usaf_lis75s2s_gfs2galwem +AGRMET retrospective root filename: "/PS.AFWA_SC.U_DI.C_DC.ANLYS_GP.LIS_GR.C0P09DEG_AR.GLOBAL_PA.03-HR-SUM_DD." +AGRMET precip obs file format: 1 +AGRMET sfc obs file format: 1 + +# Output settings +AGRMET analysis directory: Analysis_UMFG_1 # Change as appropriate +AGRMET surface fields directory: SFCALC # Legacy, will eventually remove +AGRMET merged precip directory: PRECIP # Legacy, will eventually remove +AGRMET security classification: U +AGRMET distribution classification: C +AGRMET data category: ANLYS +AGRMET area of data: GLOBAL + +# NWP data. Use GFS until 2017100100, then switch to GALWEM. +# (GFS will still be used as on-the-fly emergency backup, +# if GALWEM files are missing.) +AGRMET first guess source: GALWEM # GALWEM or GFS, but not both +AGRMET use GFS precip: 0 # Set to 1 if *not* using GALWEM as primary +AGRMET GFS data directory: GFS # Always GFS +AGRMET GFS filename version: 1 # 1 for legacy, 2 for new 557WW filename convention +AGRMET use timestamp on gfs: 1 # Always 1 +AGRMET use GALWEM precip: 1 # Set to 1 if using GALWEM as primary +AGRMET GALWEM data directory: GALWEM # Always GALWEM +AGRMET GALWEM nominal resolution (km): 17 # 17 or 10 +AGRMET nogaps wind weight: 1.0 # Applied for all NWP sources, keep at 1.0 + +# Rain gauge data. Use JMOBS until 2012032700, use NONE from +# 2012032700 until 2012040912, use CDMS beginning 2012040912. +AGRMET use precip observations: 1 # Always set to 1 +AGRMET JMOBS data directory: CDMS # JMOBS, NONE, or CDMS +AGRMET use timestamp on directories: 1 + +# Do not use SSMI rainfall data -- use IMERG instead. +AGRMET use SSMI data: 0 # 0 = Do not use +AGRMET SSMI zero use switch: 0 # 0 = do not use SSMI zeros +AGRMET SSMI data directory: SSMI # SSMI_LE, NONE, or SSMI +AGRMET SSMI imax: 1024 # For 16th mesh polar stereographic +AGRMET SSMI jmax: 1024 # For 16th mesh polar stereographic + +# Do not use GEOPRECIP rainfall data -- use IMERG instead. +AGRMET use GEOPRECIP estimate: 0 # 0 = Do not use +AGRMET GEOPRECIP data directory: GEO # GEO_LE, NONE, or GEO +AGRMET GEOPRECIP imax: 1024 # For 16th mesh polar stereographic +AGRMET GEOPRECIP jmax: 1024 # For 16th mesh polar stereographic +AGRMET GEO_PRECIP maximum temperature threshold: 278 +AGRMET GEO_PRECIP minimum temperature threshold: 273 + +# Do not use CMORPH rainfall data -- use IMERG instead. +AGRMET use CMORPH data: 0 # 0 = Do not use +AGRMET CMORPH data directory: CMORPH # Always CMORPH +AGRMET CMORPH imax: 4948 +AGRMET CMORPH jmax: 1649 +AGRMET CMORPH min lat: -59.963614 +AGRMET CMORPH max lat: 59.963614 +AGRMET CMORPH min lon: -179.963622 +AGRMET CMORPH max lon: 179.963622 +AGRMET CMORPH dx: 0.072771377 +AGRMET CMORPH dy: 0.072756669 +AGRMET CMORPH maximum temperature threshold: 278 +AGRMET CMORPH minimum temperature threshold: 273 + +# Use IMERG rainfall data +AGRMET use IMERG data: 1 # 1 = Use +AGRMET IMERG temperature threshold: 278 +AGRMET IMERG data directory: ./IMERG/Early_V06B +AGRMET IMERG product: 3B-HHR-E # Early Run +AGRMET IMERG version: V06B # V06B released in 2019 +AGRMET IMERG Probability Liquid Precip Threshold: 100 + +# Bratseth runtime settings +AGRMET maximum precip obs: 2000000 # Max observations to store in memory +AGRMET minimum wind speed: 0.25 # Sanity minimum value for winds +AGRMET output OBA data: 0 # 0 = do not output diagnostic data from Bratseth +AGRMET skip backQC: 0 # 0 = do not skip backQC check in Bratseth +AGRMET skip superstatQC: 0 # 0 = do not skip superstatQC check in Bratseth +AGRMET 3hr maximum precip ceiling: 200.0 +AGRMET PPT Background bias correction option: 0 # 0 = turn off (not ready yet) + +# EMK...New recommended settings based on sample NWP and observations +# for 2 Feb - 7 Mar 2020 and no Box-Cox transformation. + +# Bratseth error covariance settings for GALWEM-17km background field. +# Replace with commented entries below when GALWEM switches to 10-km. +AGRMET GALWEM Precip background error scale length (m): 102000. +AGRMET GALWEM Precip background error variance: 0.83 +AGRMET GALWEM Precip Gauge observation error variance: 0.86 +AGRMET GALWEM Precip GEOPRECIP observation error scale length (m): 132000. +AGRMET GALWEM Precip GEOPRECIP observation error variance: 1.24 +AGRMET GALWEM Precip SSMI observation error scale length (m): 133000. +AGRMET GALWEM Precip SSMI observation error variance: 2.58 +AGRMET GALWEM Precip CMORPH observation error scale length (m): 89000. +AGRMET GALWEM Precip CMORPH observation error variance: 1.15 +AGRMET GALWEM Precip IMERG observation error scale length (m): 101000. +AGRMET GALWEM Precip IMERG observation error variance: 1.93 +AGRMET GALWEM T2M background error scale length (m): 110000. +AGRMET GALWEM T2M background error variance: 1.48 +AGRMET GALWEM T2M station observation error variance: 2.30 +AGRMET GALWEM RH2M background error scale length (m): 119000. +AGRMET GALWEM RH2M background error variance: 30.7 +AGRMET GALWEM RH2M station observation error variance: 65.8 +AGRMET GALWEM SPD10M background error scale length (m): 53000. +AGRMET GALWEM SPD10M background error variance: 0.62 +AGRMET GALWEM SPD10M station observation error variance: 2.37 + +# Bratseth error covariance settings for GALWEM-10km background field. +# AGRMET GALWEM Precip background error scale length (m): 110000. +# AGRMET GALWEM Precip background error variance: 0.81 +# AGRMET GALWEM Precip Gauge observation error variance: 1.22 +# AGRMET GALWEM Precip GEOPRECIP observation error scale length (m): 139000. +# AGRMET GALWEM Precip GEOPRECIP observation error variance: 1.45 +# AGRMET GALWEM Precip SSMI observation error scale length (m): 135000. +# AGRMET GALWEM Precip SSMI observation error variance: 2.68 +# AGRMET GALWEM Precip CMORPH observation error scale length (m): 88000. +# AGRMET GALWEM Precip CMORPH observation error variance: 1.38 +# AGRMET GALWEM Precip IMERG observation error scale length (m): 102000. +# AGRMET GALWEM Precip IMERG observation error variance: 2.52 +# AGRMET GALWEM T2M background error scale length (m): 115000. +# AGRMET GALWEM T2M background error variance: 1.29 +# AGRMET GALWEM T2M station observation error variance: 2.42 +# AGRMET GALWEM RH2M background error scale length (m): 129000. +# AGRMET GALWEM RH2M background error variance: 27.2 +# AGRMET GALWEM RH2M station observation error variance: 68.6 +# AGRMET GALWEM SPD10M background error scale length (m): 56000. +# AGRMET GALWEM SPD10M background error variance: 0.48 +# AGRMET GALWEM SPD10M station observation error variance: 2.43 + +# GFSFV3 Bratseth error covariance settings. Used if GALWEM is unavailable. +AGRMET GFS Precip background error scale length (m): 93000. +AGRMET GFS Precip background error variance: 0.47 +AGRMET GFS Precip Gauge observation error variance: 0.70 +AGRMET GFS Precip GEOPRECIP observation error scale length (m): 131000. +AGRMET GFS Precip GEOPRECIP observation error variance: 1.06 +AGRMET GFS Precip SSMI observation error scale length (m): 131000. +AGRMET GFS Precip SSMI observation error variance: 2.10 +AGRMET GFS Precip CMORPH observation error scale length (m): 91000. +AGRMET GFS Precip CMORPH observation error variance: 0.92 +AGRMET GFS Precip IMERG observation error scale length (m): 100000. +AGRMET GFS Precip IMERG observation error variance: 1.62 +AGRMET GFS T2M background error scale length (m): 125000. +AGRMET GFS T2M background error variance: 1.36 +AGRMET GFS T2M station observation error variance: 2.38 +AGRMET GFS RH2M background error scale length (m): 197000. +AGRMET GFS RH2M background error variance: 51.3 +AGRMET GFS RH2M station observation error variance: 66.8 +AGRMET GFS SPD10M background error scale length (m): 86000. +AGRMET GFS SPD10M background error variance: 0.57 +AGRMET GFS SPD10M station observation error variance: 2.48 + +# Radiation settings. Uses WWMCA cloud data. Use WWMCA_LE from +# 20071101 to 2012032700, use NONE from 2012032700 to 2012040912, +# use WWMCA beginning 2012040912. Use WWMCA_GRIB for operations. +AGRMET cloud data directory: WWMCA # WWMCA_LE, NONE, WWMCA, or WWMCA_GRIB +# Use WWMCA GRIB1 files beginning 12Z 4 Jul 2020 +AGRMET WWMCA GRIB1 read option: 1 +AGRMET snow distribution shape parameter: 2.6 + +# Legacy AGRMET settings. Eventually these will be removed, +# but for now keep these settings. +AGRMET latlon mask file: legacy/global_0p25/mask_25KM.1gd4r +AGRMET mask file: legacy/all_16/point_switches +AGRMET terrain file: legacy/pst_16/terrain +# EMK...8th polar files are missing, but are not read anyway. +# Just leave these settings here. +AGRMET 8th polar mask file: legacy/all_8/point_switches +AGRMET 8th polar terrain file: legacy/pst_8/terrain +AGRMET 16th polar mask file: legacy/all_16/point_switches +AGRMET 16th polar terrain file: legacy/pst_16/terrain +AGRMET 64th polar mask file: legacy/pst_16/point_switches +AGRMET 64th polar terrain file: legacy/pst_16/terrain +AGRMET native imax: 1024 # 16th polar stereographic +AGRMET native jmax: 1024 # 16th polar stereographic +AGRMET sfcalc cntm file: legacy/global_0p25/spread_radii.1gd4r +AGRMET precip climatology: legacy/global_0p25/ +AGRMET use present/past weather estimate: 0 # 0 = do not use BOGUS data +AGRMET use CDFSII-based estimate: 0 # 0 = do not use CDFSII estimates +AGRMET CDFSII time interval: 6 +AGRMET use precip climatology: 0 # 0 = do not use climatology +AGRMET alternate monthly weighting factor: 1.0 +AGRMET minimum 3hr climo value: 0.025 +AGRMET maximum 3hr climo value: 0.375 +AGRMET minimum precip-per-precip day multiplier: 0.0 +AGRMET maximum precip-per-precip day multiplier: 1.1 +AGRMET cloud threshold to generate CDFSII estimate: 85.0 +AGRMET median cloud cover percentage1: 15.0 +AGRMET median cloud cover percentage2: 0.60 +AGRMET overcast percentage: 0.30 + +#-----------------------LAND SURFACE MODELS-------------------------- +Noah-MP.5.0 model timestep: 30mn +Noah-MP.5.0 soil timestep: 30mn +Noah-MP.5.0 restart output interval: 1mo +Noah-MP.5.0 restart file: none +Noah-MP.5.0 restart file format: netcdf +Noah-MP.5.0 parameter table: ./NoahmpTable.TBL # this file is stored at: noahmp.5.0/phys/noahmp/parameters/NoahmpTable.TBL +Noah-MP.5.0 number of soil layers: 4 +Noah-MP.5.0 thickness of soil layers: 0.1 0.3 0.6 1.0 +Noah-MP.5.0 domain resolution dx: 15634.3275 # unit of meter (=0.1406250deg for AGRMET) +Noah-MP.5.0 domain resolution dy: 10422.885 # unit of meter (=0.0937500deg for AGRMET) +Noah-MP.5.0 dynamic vegetation option: 4 # 9 options available +Noah-MP.5.0 canopy stomatal resistance option: 1 # 1=Ball-Berry; 2=Jarvis +Noah-MP.5.0 soil moisture factor for stomatal resistance: 1 # 1=Noah; 2=CLM; 3=SSiB +Noah-MP.5.0 surface runoff option: 3 # 1=SIMGM; 2=SIMTOP; 3=Schaake96; 4=BATS; 5=Miguez-Macho&Fan; 6=VIC; 7=XinAnJiang; 8=Dynamic VIC +Noah-MP.5.0 subsurface runoff and groundwater option: 3 # 1=SIMGM; 2=SIMTOP; 3=Schaake96; 4=BATS; 5=Miguez-Macho&Fan; 6=VIC; 7=XinAnJiang; 8=Dynamic VIC +Noah-MP.5.0 dynamic VIC infiltration option: 1 # 1=Philip; 2=Green-Ampt; 3=Smith-Parlange (only works with surface runoff=8) +Noah-MP.5.0 surface layer drag coefficient option: 1 # 1=M-O; 2=Chen97 +Noah-MP.5.0 supercooled liquid water option: 1 # 1=NY06; 2=Koren99 +Noah-MP.5.0 frozen soil permeability option: 1 # 1=NY06; 2=Koren99 +Noah-MP.5.0 canopy radiative transfer option: 3 # 1=gap=F(3D;cosz); 2=gap=0; 3=gap=1-Fveg +Noah-MP.5.0 snow surface albedo option: 1 # 1=BATS; 2=CLASS +Noah-MP.5.0 rain-snow partition option: 1 # 1=Jordan91; 2=BATS; 3=Noah +Noah-MP.5.0 snow thermal conductivity option: 1 # 1=Yen1965; 2=Anderson1976; 3=constant; 4=Verseghy1991; 5=Yen1981 +Noah-MP.5.0 lower boundary of soil temperature option: 2 # 1=zero-flux; 2=Noah +Noah-MP.5.0 snow&soil temperature time scheme option: 1 # 1=semi-implicit; 2=fully implicit +Noah-MP.5.0 glacier ice option: 1 # 1=include phase change; 2=slab ice (Noah) +Noah-MP.5.0 surface resistance option: 1 # 1=Sakaguchi and Zeng 2009; 2=Sellers (1992); 3=adjusted Sellers; 4=option1 for non-snow and rsurf_snow for snow +Noah-MP.5.0 soil configuration option: 1 # 1=input dominant soil texture; 2=input soil texture varies that varies with depth; 3=soil composition and pedotransfer functions +Noah-MP.5.0 soil pedotransfer function option: 1 # 1=Saxton and Rawls (2006) (used when soil_opt=3) +Noah-MP.5.0 crop model option: 0 # 0=No crop model; 1=Liu et al. 2016; 2=Gecros +Noah-MP.5.0 irrigation trigger option: 0 # 0=No irrigation; 1=Irrigation ON; 2=Trigger by plant/harvest date; 3=Trigger by LAI +Noah-MP.5.0 irrigation method option: 0 # 0=method based on input map; 1=sprinkler; 2=micro/drip; 3=flooding +Noah-MP.5.0 tile drainage option: 0 # 0=No tile drainage; 1=Simple drainage; 2=Hooghoudt's scheme +Noah-MP.5.0 urban physics option: 0 # 0=No; 1=Single-layer; 2=Multi-layer BEP scheme; 3=Multi-layer BEM scheme +Noah-MP.5.0 initial surface skin temperature: 288.0 +Noah-MP.5.0 initial soil temperatures: 288.0 288.0 288.0 288.0 +Noah-MP.5.0 initial total soil moistures: 0.20 0.20 0.20 0.20 +Noah-MP.5.0 initial snow water equivalent: 0.0 +Noah-MP.5.0 initial snow depth: 0.0 +Noah-MP.5.0 initial total canopy surface water: 0.0 +Noah-MP.5.0 initial leaf area index: 0.5 +Noah-MP.5.0 initial water table depth: 2.5 +Noah-MP.5.0 initial water in the aquifer: 4900.0 +Noah-MP.5.0 initial water in aquifer and saturated soil: 4900.0 +Noah-MP.5.0 reference height of temperature and humidity: 10.0 + +Template open water timestep: 30mn + +#---------------------------MODEL OUTPUT CONFIGURATION----------------------- +#Specify the list of ALMA variables that need to be featured in the +#LSM model output +Output start year: +Output start month: +Output start day: +Output start hour: +Output start minutes: +Output start seconds: + +Model output attributes file: ./MODEL_OUTPUT_LIST_noahmp5.TBL + diff --git a/lis/configs/lis.config.adoc b/lis/configs/lis.config.adoc index 271accd18..211090973 100644 --- a/lis/configs/lis.config.adoc +++ b/lis/configs/lis.config.adoc @@ -166,6 +166,7 @@ Acceptable values are: |Noah.3.9 | Noah version 3.9 |Noah-MP.3.6 | Noah-MP version 3.6 |Noah-MP.4.0.1 | Noah-MP version 4.0.1 +|Noah-MP.5.0 | Noah-MP version 5.0 |RUC.3.7 | RUC version 3.7 |CLM.2 | CLM version 2.0 |VIC.4.1.1 | VIC version 4.1.1 @@ -8386,6 +8387,546 @@ Noah-MP.4.0.1 snow depth glacier model option: 2000 .... +[[sssec_lsm_noahmp50,Noah-MP-5.0]] +==== Noah-MP-5.0 + +`Noah-MP.5.0 model timestep:` specifies the main model (except soil process) +timestep for the Noah-MP.5.0 LSM. + +See Section <> for a description +of how to specify a time interval. + +`Noah-MP.5.0 soil timestep:` specifies the soil process (heat and water) +timestep for the Noah-MP.5.0 LSM. + +See Section <> for a description +of how to specify a time interval. + +`Noah-MP.5.0 restart output interval:` specifies the restart output +interval for the Noah-MP.5.0 LSM. + +See Section <> for a description +of how to specify a time interval. + +`Noah-MP.5.0 restart file:` specifies the Noah-MP.5.0 LSM restart file. + +`Noah-MP.5.0 restart file format:` specifies the Noah-MP.5.0 restart +file format (default = netcdf). + +`Noah-MP.5.0 parameter table:` specifies the filename of the +Noah-MP.5.0 parameter table (all parameters in one new table file) + +`Noah-MP.5.0 number of soil layers:` specifies the number of soil layers +for Noah-MP.5.0 soil moisture/temperature. + +`Noah-MP.5.0 thickness of soil layers:` specifies the thicknesses of the +individual Noah-MP.5.0 LSM layers. The first number is the thickness +of the top soil layer, and the following numbers are the thicknesses of +each soil layer going down. If the number of soil layers and thicknesses +change from the typical 4 layers with thicknesses of 0.1, 0.3, 0.6, and +1.0 meters, users should change the values of NROOT for each vegetation +type to map the number of layers with roots for transpiration in their +own custom MPTABLE.TBL parameter file. + +`Noah-MP.5.0 domain resolution dx:` specifies the length (unit: meter) of +the longitude-direction of spatial resolution. + +`Noah-MP.5.0 domain resolution dy:` specifies the length (unit: meter) of +the latitude-direction of spatial resolution. + +`Noah-MP.5.0 dynamic vegetation option:` specifies the dynamic vegetation +model option for Noah-MP.5.0 LSM. Options generally recommended for use +by the model developers are indicated with [**]. See Sect.3.3 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). +Options not yet supported in the LIS implementation are indicated with [NS]. +Acceptable values are: + +|==== +|Value | Note | Description + +| 1 | | off (use table LAI/SAI; use input GVF) +| 2 | | on (dynamic vegetation; GVF is a function of LAI/SAI) +| 3 | | off (use table LAI/SAI; GVF is a function of LAI/SAI) +| 4 | ** | off (use table LAI/SAI; GVF is the maximum value) +| 5 | ** | on (dynamic vegetation; GVF is the maximum value) +| 6 | | on (dynamic vegetation; use input GVF) +| 7 | | off (use input LAI/SAI; use input GVF) +| 8 | | off (use input LAI/SAI; GVF is a function of LAI/SAI) +| 9 | | off (use input LAI/SAI; GVF is the maximum value) +|==== + +When using options 1 through 6, users should set `LAI data source:` to +"`none`". For options 1, 3, or 4, the LAI value will be read from the +`Noah-MP.5.0 MP parameter table:` file (typically, "`NoahmpTable.TBL`") +based on the vegetation class of the tile and the current month. For +options 2, 5, or 6, the LAI is a prognostic variable as a function of +the LeafMass calculated from the dynamic vegetation scheme. When using +options 7 through 9, users should set `LAI data source:` to "`LDT`", +after running LDT to include an LAI dataset as one of the parameters +in the `LIS domain and parameter data file:`. + +When using options 1 through 6, users should set `SAI data source:` to +"`none`". For options 1, 3, or 4, the SAI value will be read from the +`Noah-MP.5.0 MP parameter table:` file (typically, "`NoahmpTable.TBL`") +based on the vegetation class of the tile and the current month. For +options 2, 5, or 6, the SAI is a prognostic variable as a function of +the StemMass calculated from the dynamic vegetation scheme. When using +options 7 through 9, users can set `SAI data source:` to "`LDT`", after +running LDT to include an SAI dataset as one of the parameters in the +`LIS domain and parameter data file:`. Alternatively, for these options +(7, 8, or 9), users can choose to not use an input SAI dataset by setting +`SAI data source:` to "`none`", in which case the SAI value will be set +from the `Noah-MP.5.0 parameter table:` file. + +When using options 1, 4, 5, 6, 7, or 9, users should set `Greenness data +source:` to "`LDT`", after running LDT to include a greenness dataset as +one of the parameters in the `LIS domain and parameter data file:`. The +greenness parameter variable name can be referred to as GVF (greenness +vegetation fraction), FVEG, or SHDFAC in the Noah-MP.5.0 physics code. +When using options 1, 6, or 7, the greenness value is set to the monthly +climatology value for each tile (unless "`CONSTANT`" was chosen when LDT +was run for the `Greenness data source:`). When using options 4, 5, or 9, +the greenness value for each tile is set to the maximum value of all months +from the monthly climatology at that tile. When using options 2, 3, or 8, +the greenness is a function of LAI and SAI at each tile for each timestep. + +Note that when using dynamic vegetation option 2, 5, or 6, the Ball-Berry +canopy stomatal resistance option must be selected for the following config. + +`Noah-MP.5.0 canopy stomatal resistance option:` specifies the canopy +stomatal resistance option for Noah-MP.5.0 LSM. See Sect.3.6.11 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). Options generally +recommended for use by the model developers are indicated with [**]. +Acceptable values are: + +|==== +|Value | Note | Description + +| 1 | ** | Ball-Berry +| 2 | | Jarvis +|==== + +`Noah-MP.5.0 soil moisture factor for stomatal resistance:` +specifies the soil moisture factor for stomatal resistance option +for Noah-MP.5.0 LSM. See Sect.3.6.8 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). +Options generally recommended for use by the +model developers are indicated with [**]. Acceptable values are: + +|==== +|Value | Note | Description + +| 1 | ** | Noah (soil moisture) +| 2 | | CLM (matric potential) +| 3 | | SSiB (matric potential) +|==== + +`Noah-MP.5.0 surface runoff option:` specifies the surface runoff +option for Noah-MP.5.0 LSM. See Sect.3.7.8 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). + Options generally recommended +for use by the model developers are indicated with [**]. Options not yet +supported in the LIS implementation are indicated with [NS]. Acceptable +values are: + +|==== +|Value | Note | Description + +| 1 | | SIMGM: TOPMODEL with groundwater (Niu et al. 2007 JGR) +| 2 | | SIMTOP: TOPMODEL with an equilibrium water table (Niu et al. 2005 JGR) +| 3 | ** | Noah original surface and subsurface runoff (free drainage) (Schaake 1996) +| 4 | | BATS surface and subsurface runoff (free drainage) +| 5 | NS | Miguez-Macho&Fan groundwater scheme (Miguez-Macho et al. 2007 JGR; Fan et al. 2007 JGR) +| 6 | | Variable Infiltration Capacity (VIC) Model surface runoff scheme (Wood et al., 1992, JGR) +| 7 | | Xinanjiang Infiltration and surface runoff scheme (Jayawardena and Zhou, 2000) +| 8 | | Dynamic Variable Infiltration Capacity (VIC) surface runoff scheme (Liang and Xie, 2001) +|==== + +`Noah-MP.5.0 subsurface runoff and groundwater option:` specifies the subsurface runoff +and groundwater option for Noah-MP.5.0 LSM. Currently only the same surface and subsurface +runoff options are well tested and recommended. See Sect.3.7.8 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). Options generally recommended +for use by the model developers are indicated with [**]. Options not yet +supported in the LIS implementation are indicated with [NS]. Acceptable +values are: + +|==== +|Value | Note | Description + +| 1 | | SIMGM: TOPMODEL with groundwater (Niu et al. 2007 JGR) +| 2 | | SIMTOP: TOPMODEL with an equilibrium water table (Niu et al. 2005 JGR) +| 3 | ** | Noah original surface and subsurface runoff (free drainage) (Schaake 1996) +| 4 | | BATS surface and subsurface runoff (free drainage) +| 5 | NS | Miguez-Macho&Fan groundwater scheme (Miguez-Macho et al. 2007 JGR; Fan et al. 2007 JGR) +| 6 | | Variable Infiltration Capacity (VIC) Model surface runoff scheme (Wood et al., 1992, JGR) +| 7 | | Xinanjiang Infiltration and surface runoff scheme (Jayawardena and Zhou, 2000) +| 8 | | Dynamic Variable Infiltration Capacity (VIC) surface runoff scheme (Liang and Xie, 2001) +|==== + +`Noah-MP.5.0 dynamic VIC infiltration option:` specifies the dynamic +Variable Infiltration Capacity (VIC) infiltration option for Noah-MP.5.0 LSM. +Currently only works when surface and subsurface runoff option=8. See Sect.3.7.8 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). +Options generally recommended for use by the model developers are indicated with [**]. +Acceptable values are: + +|==== +|Value | Note | Description + +| 1 | ** | Philip scheme +| 2 | | Green-Ampt scheme +| 3 | | Smith-Parlange scheme +|==== + +`Noah-MP.5.0 surface layer drag coefficient option:` specifies the +surface layer drag coefficient option for Noah-MP.5.0 LSM. See Sect.3.6.13 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). Options +generally recommended for use by the model developers are indicated +with [**]. Acceptable values are: + +|==== +|Value | Note | Description + +| 1 | ** | Monin-Obukhov +| 2 | | original Noah (Chen 1997) +|==== + +`Noah-MP.5.0 supercooled liquid water option:` specifies the supercooled +liquid water option for Noah-MP.5.0 LSM. See Sect.3.6.19 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). +Options generally recommended for use by the model developers are +indicated with [**]. Acceptable values are: + +|==== +|Value | Note | Description + +| 1 | ** | no iteration (Niu and Yang, 2006 JHM) +| 2 | | Koren`'s iteration (1999) +|==== + +`Noah-MP.5.0 frozen soil permeability option:` specifies the frozen soil +permeability option for Noah-MP.5.0 LSM. See Sect.3.7.4 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). Options generally recommended +for use by the model developers are indicated with [**]. Acceptable values +are: + +|==== +|Value | Note | Description + +| 1 | ** | linear effects, more permeable (Niu and Yang, 2006, JHM) +| 2 | | nonlinear effects, less permeable (Koren 1999) +|==== + +`Noah-MP.5.0 canopy radiation transfer option:` specifies the canopy radiation +transfer option for Noah-MP.5.0 LSM. See 3.6.5 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). Options generally recommended +for use by the model developers are indicated with [**]. Acceptable +values are: + +|==== +|Value | Note | Description + +| 1 | | modified two-stream (gap = F(solar angle, 3D structure ...)<1-FVEG) +| 2 | | two-stream applied to grid-cell (gap = 0) +| 3 | ** | two-stream applied to vegetated fraction (gap=1-FVEG) +|==== + +`Noah-MP.5.0 snow surface albedo option:` specifies the snow surface +albedo option for Noah-MP.5.0 LSM. See Sect.3.6.5 in Noah-MPv5 +technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). Options generally recommended +for use by the model developers are indicated with [**]. Acceptable +values are: + +|==== +|Value | Note | Description + +| 1 | ** | BATS +| 2 | | CLASS +|==== + +`Noah-MP.5.0 rainfall & snowfall option:` specifies the option for +partitioning precipitation into rainfall and snowfall for Noah-MP.5.0 +LSM. See Sect.3.1 in Noah-MPv5 technote (He et al. 2023: http://dx.doi.org/10.5065/ew8g-yr95). + Options generally recommended for use by the model developers are +indicated with [**]. Options not yet supported in the LIS implementation +are indicated with [NS]. Acceptable values are: + +|==== +|Value | Note | Description + +| 1 | ** | Jordan (1991) +| 2 | | BATS: when SFCTMPoff; 2->on); with opt\_crs=1 +! \item[crs\_opt] +! canopt stomatal resistance (1->Ball-Berry; 2->Jarvis) +! \item[btr\_opt] +! soil moisture factor for stomatal resistance(1->Noah;2->CLM;3->SSiB) +! \item[runsfc\_opt] +! surface runoff (1->SIMGM; 2->SIMTOP; 3->Schaake96; 4->BATS; 5->MMF; 6->VIC; 7->XinAnJiang; 8->DynamicVIC) +! \item[runsub\_opt] +! subsurface runoff (1->SIMGM; 2->SIMTOP; 3->Schaake96; 4->BATS; 5->MMF; 6->VIC; 7->XinAnJiang; 8->DynamicVIC) +! \item[sfc\_opt] +! surface layer drag coeff (CH \& CM) (1->M-O; 2->Chen97) +! \item[frz\_opt] +! supercooled liquid water (1->NY06; 2->Koren99) +! \item[tksno\_opt] +! snow thermal conductivity (1->Yen1965; 2->Anderson1976; 3->constant; 4->Verseghy1991; 5->Yen1981) +! \item[inf\_opt] +! frozen soil permeability (1->NY06; 2->Koren99) +! \item[rad\_opt] +! radiation transfer (1->gap=F(3D,cosz); 2->gap=0; 3->gap=1-Fveg) +! \item[alb\_opt] +! snow surface albedo (1->BATS; 2->CLASS) +! \item[snf\_opt] +! rainfall \& snowfall (1->Jordan91; 2->BATS; 3->Noah) +! \item[tbot\_opt] +! lower boundary of soil temperature +! \item[stc\_opt] +! snow/soil temperature time scheme +! \item[gla\_opt] +! glacier option (1->phase change; 2->simple) +! \item[rsf\_opt] +! surface resistance(1->Sakaguchi/Zeng;2->Seller;3->mod Sellers;4->1+snow) +! \item[soil\_opt] +! soil configuration option +! \item[pedo\_opt] +! soil pedotransfer function option +! \item[crop\_opt] +! crop model option (0->none; 1->Liu2016) +! \item[irr\_opt] +! irrigation scheme option (0->none; 1->always on; 2->trigger by planting/harvest dates; 3->trigger by LAI) +! \item[irrm\_opt] +! irrigation method option (0->fraction from input; 1->sprinkler; 2->micro/drip; 3->flood) +! \item[tdrn\_opt] +! tile drainage option (0->none; 1->simple drainage; 2->Hooghoudt's scheme) +! \item[urban\_opt] +! urban physics option (0->none; 1->SLUCM; 2->BEP; 3->BEP_BEM) +! \end{description} +! +! !REVISION HISTORY: +! This module is generated with the Model Implementation Toolkit developed +! by Shugong Wang for the NASA Land Information System Version 7. The initial +! specification of the module is defined by Sujay Kumar. +! 10/25/18: Shugong Wang, Zhuo Wang Initial implementation for LIS 7 and NoahMP401 +! 05/01/23: Cenlin He, update to work with refactored Noah-MP (v5.0 and later) + +! !USES: + use NoahMP50_module + use LIS_constantsMod, only : LIS_CONST_PATH_LEN + + implicit none + + PRIVATE + !------------------------------------------------------------------------- + ! PUBLIC MEMBER FUNCTIONS + !------------------------------------------------------------------------- + public :: NoahMP50_ini + !------------------------------------------------------------------------- + ! PUBLIC TYPES + !------------------------------------------------------------------------- + public :: Noahmp50_struc +!EOP + type, public :: NoahMP50_type_dec + character(len=LIS_CONST_PATH_LEN) :: rfile + character*256 :: rformat + !------------------------------------------------------------------------- + ! Parameter file names + !------------------------------------------------------------------------- + character*128 :: LDT_ncvar_vegetype + character*128 :: LDT_ncvar_soiltype + character*128 :: LDT_ncvar_shdfac_monthly + character*128 :: LDT_ncvar_tbot + character*128 :: LDT_ncvar_planting + character*128 :: LDT_ncvar_harvest + character*128 :: LDT_ncvar_season_gdd + character*128 :: LDT_ncvar_soilcomp + character*128 :: LDT_ncvar_soilcL1 + character*128 :: LDT_ncvar_soilcL2 + character*128 :: LDT_ncvar_soilcL3 + character*128 :: LDT_ncvar_soilcL4 + character*128 :: LDT_ncvar_irfract + character*128 :: LDT_ncvar_sifract + character*128 :: LDT_ncvar_mifract + character*128 :: LDT_ncvar_fifract + character*128 :: LDT_ncvar_tdfract + character*128 :: LDT_ncvar_fdepth + character*128 :: LDT_ncvar_eqzwt + character*128 :: LDT_ncvar_rechclim + character*128 :: LDT_ncvar_riverbed + + !------------------------------------------------------------------------- + ! ts, Count, rstInterval, outInterval + !------------------------------------------------------------------------- + real :: ts + real :: ts_soil + integer :: count + real :: rstInterval + integer :: outInterval + integer :: forc_count + !------------------------------------------------------------------------- + ! Initial Model State for cold start + !------------------------------------------------------------------------- + real :: init_tskin + real :: init_sneqv + real :: init_snowh + real :: init_canwat + real, pointer :: init_tslb(:) + real, pointer :: init_smc(:) + real :: init_zwt + real :: init_wa + real :: init_wt + real :: init_lai + !------------------------------------------------------------------------- + ! Constant Parameter + !------------------------------------------------------------------------- + real :: dz8w + real :: dt + real :: dt_soil + real :: dx + real :: dy + real, pointer :: sldpth(:) + integer :: nsoil + integer :: nsnow + character(len=256) :: noahmp_tbl_name + character(len=256) :: landuse_scheme_name + integer :: dveg_opt + integer :: crs_opt + integer :: btr_opt + integer :: runsfc_opt + integer :: runsub_opt + integer :: sfc_opt + integer :: frz_opt + integer :: inf_opt + integer :: rad_opt + integer :: alb_opt + integer :: snf_opt + integer :: tksno_opt + integer :: tbot_opt + integer :: stc_opt + integer :: gla_opt + integer :: rsf_opt + integer :: soil_opt + integer :: pedo_opt + integer :: crop_opt + integer :: irr_opt + integer :: irrm_opt + integer :: tdrn_opt + integer :: infdv_opt + integer :: urban_opt + !integer :: sndpth_gla_opt + type(NoahMP50dec), pointer :: noahmp50(:) + end type NoahMP50_type_dec + + type(NoahMP50_type_dec), pointer :: Noahmp50_struc(:) + +contains + +!BOP +! +! !ROUTINE: NoahMP50_ini +! \label{NoahMP50_ini} +! +! !INTERFACE: + subroutine NoahMP50_ini() +! !USES: + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify, LIS_logunit + use LIS_timeMgrMod, only : LIS_clock, LIS_calendar, & + LIS_update_timestep, LIS_registerAlarm + use LIS_surfaceModelDataMod, only : LIS_sfmodel_struc +! !DESCRIPTION: +! +! This routine creates the datatypes and allocates memory for NoahMP50-specific +! variables. It also invokes the routine to read the runtime specific options +! for NoahMP50 from the configuration file. +! +! The routines invoked are: +! \begin{description} +! \item[NoahMP50\_readcrd](\ref{NoahMP50_readcrd})\\ +! reads the runtime options for NoahMP50 model +! \end{description} +!EOP + implicit none + integer :: n, t + integer :: status + character*3 :: fnest ! EMK for RHMin + + ! allocate memory for nest + allocate(Noahmp50_struc(LIS_rc%nnest)) + + ! read configuation information from lis.config file + call NoahMP50_readcrd() + + do n=1, LIS_rc%nnest + ! allocate memory for all tiles in current nest + allocate(Noahmp50_struc(n)%noahmp50(LIS_rc%npatch(n, LIS_rc%lsm_index))) + !------------------------------------------------------------------------ + ! allocate memory for vector variables passed to model interfaces + ! TODO: check the following allocation statements carefully! + !------------------------------------------------------------------------ + ! allocate memory for multilevel spatial parameter + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + allocate(Noahmp50_struc(n)%noahmp50(t)%shdfac_monthly(12)) + allocate(Noahmp50_struc(n)%noahmp50(t)%soilcomp(8)) + enddo + + ! allocate memory for state variables + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + allocate(Noahmp50_struc(n)%noahmp50(t)%smc(Noahmp50_struc(n)%nsoil)) + allocate(Noahmp50_struc(n)%noahmp50(t)%sh2o(Noahmp50_struc(n)%nsoil)) + allocate(Noahmp50_struc(n)%noahmp50(t)%tslb(Noahmp50_struc(n)%nsoil)) + allocate(Noahmp50_struc(n)%noahmp50(t)%tsno(Noahmp50_struc(n)%nsnow)) + allocate(Noahmp50_struc(n)%noahmp50(t)%zss(Noahmp50_struc(n)%nsnow + Noahmp50_struc(n)%nsoil)) + allocate(Noahmp50_struc(n)%noahmp50(t)%snowice(Noahmp50_struc(n)%nsnow)) + allocate(Noahmp50_struc(n)%noahmp50(t)%snowliq(Noahmp50_struc(n)%nsnow)) + allocate(Noahmp50_struc(n)%noahmp50(t)%smoiseq(Noahmp50_struc(n)%nsoil)) + allocate(Noahmp50_struc(n)%noahmp50(t)%accetrani(Noahmp50_struc(n)%nsoil)) + enddo + + ! initialize forcing variables to zeros + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + Noahmp50_struc(n)%noahmp50(t)%lwdown = 0.0 + Noahmp50_struc(n)%noahmp50(t)%swdown = 0.0 + Noahmp50_struc(n)%noahmp50(t)%psurf = 0.0 + Noahmp50_struc(n)%noahmp50(t)%prcp = 0.0 + Noahmp50_struc(n)%noahmp50(t)%tair = 0.0 + Noahmp50_struc(n)%noahmp50(t)%qair = 0.0 + Noahmp50_struc(n)%noahmp50(t)%wind_e = 0.0 + Noahmp50_struc(n)%noahmp50(t)%wind_n = 0.0 + Noahmp50_struc(n)%noahmp50(t)%sfcheadrt = 0.0 + Noahmp50_struc(n)%noahmp50(t)%irnumsi = 0 + Noahmp50_struc(n)%noahmp50(t)%irnummi = 0 + Noahmp50_struc(n)%noahmp50(t)%irnumfi = 0 + Noahmp50_struc(n)%noahmp50(t)%irwatsi = 0.0 + Noahmp50_struc(n)%noahmp50(t)%irwatmi = 0.0 + Noahmp50_struc(n)%noahmp50(t)%irwatfi = 0.0 + Noahmp50_struc(n)%noahmp50(t)%irsivol = 0.0 + Noahmp50_struc(n)%noahmp50(t)%irmivol = 0.0 + Noahmp50_struc(n)%noahmp50(t)%irfivol = 0.0 + Noahmp50_struc(n)%noahmp50(t)%ireloss = 0.0 + Noahmp50_struc(n)%noahmp50(t)%irrsplh = 0.0 + Noahmp50_struc(n)%noahmp50(t)%qtdrain = 0.0 + Noahmp50_struc(n)%noahmp50(t)%accssoil = 0.0 + Noahmp50_struc(n)%noahmp50(t)%accqinsur = 0.0 + Noahmp50_struc(n)%noahmp50(t)%accqseva = 0.0 + Noahmp50_struc(n)%noahmp50(t)%accetrani = 0.0 + Noahmp50_struc(n)%noahmp50(t)%accdwater = 0.0 + Noahmp50_struc(n)%noahmp50(t)%accprcp = 0.0 + Noahmp50_struc(n)%noahmp50(t)%accecan = 0.0 + Noahmp50_struc(n)%noahmp50(t)%accetran = 0.0 + Noahmp50_struc(n)%noahmp50(t)%accedir = 0.0 + Noahmp50_struc(n)%noahmp50(t)%sfcrunoff = 0.0 + Noahmp50_struc(n)%noahmp50(t)%udrrunoff = 0.0 + Noahmp50_struc(n)%noahmp50(t)%deeprech = 0.0 + Noahmp50_struc(n)%noahmp50(t)%rech = 0.0 + Noahmp50_struc(n)%noahmp50(t)%acsnom = 0.0 + Noahmp50_struc(n)%noahmp50(t)%acsnow = 0.0 + Noahmp50_struc(n)%noahmp50(t)%irfract = 0.0 + Noahmp50_struc(n)%noahmp50(t)%sifract = 0.0 + Noahmp50_struc(n)%noahmp50(t)%mifract = 0.0 + Noahmp50_struc(n)%noahmp50(t)%fifract = 0.0 + !ag(05Jan2021) + Noahmp50_struc(n)%noahmp50(t)%rivsto = 0.0 + Noahmp50_struc(n)%noahmp50(t)%fldsto = 0.0 + Noahmp50_struc(n)%noahmp50(t)%fldfrc = 0.0 + enddo ! end of tile (t) loop + + !------------------------------------------------------------------------ + ! Model timestep Alarm + !------------------------------------------------------------------------ + Noahmp50_struc(n)%forc_count = 0 + + call LIS_update_timestep(LIS_rc, n, Noahmp50_struc(n)%ts) + + write(fnest,'(i3.3)') n + call LIS_registerAlarm("NoahMP50 model alarm "//trim(fnest),& + Noahmp50_struc(n)%ts, & + Noahmp50_struc(n)%ts) + + ! CH2023: add soil timestep that is allowed to be different from main timestep + call LIS_registerAlarm("NoahMP50 model alarm "//trim(fnest),& + Noahmp50_struc(n)%ts, & + Noahmp50_struc(n)%ts_soil) + + call LIS_registerAlarm("NoahMP50 restart alarm "//trim(fnest),& + Noahmp50_struc(n)%ts,& + Noahmp50_struc(n)%rstInterval) + + ! EMK Add alarm to reset tair_agl_min for RHMin. This should + ! match the output interval, since that is used for calculating + ! Tair_F_min. + call LIS_registerAlarm("NoahMP50 RHMin alarm "//trim(fnest),& + Noahmp50_struc(n)%ts,& + LIS_sfmodel_struc(n)%outInterval) + if (LIS_sfmodel_struc(n)%outInterval .gt. 86400 .or. & + trim(LIS_sfmodel_struc(n)%outIntervalType) .eq. "dekad") then + write(LIS_logunit,*) & + '[WARN] If RHMin is selected for output, please reset ', & + 'surface model output interval to no more than 24 hours.' + end if + + ! Initialize min/max values to implausible values. + Noahmp50_struc(n)%noahmp50(:)%tair_agl_min = 999.0 + Noahmp50_struc(n)%noahmp50(:)%rhmin = 999.0 + + !------------------------------------------------------------------------ + ! TODO: setup number of soil moisture/temperature layers and depth here + !------------------------------------------------------------------------ + ! TODO: set number of soil moisture layers in surface model + LIS_sfmodel_struc(n)%nsm_layers = Noahmp50_struc(n)%nsoil + ! TODO: set number of soil temperature layers in surface model + LIS_sfmodel_struc(n)%nst_layers = Noahmp50_struc(n)%nsoil + allocate(LIS_sfmodel_struc(n)%lyrthk(Noahmp50_struc(n)%nsoil)) + !LIS_sfmodel_struc(n)%lyrthk(:) = Noahmp50_struc(n)%sldpth(:) + !EMK...Output soil layer thicknesses in centimeters for + !consistency with other LSMs. + LIS_sfmodel_struc(n)%lyrthk(:) = & + 100*Noahmp50_struc(n)%sldpth(:) + LIS_sfmodel_struc(n)%ts = Noahmp50_struc(n)%ts + enddo + end subroutine NoahMP50_ini +end module NoahMP50_lsmMod diff --git a/lis/surfacemodels/land/noahmp.5.0/NoahMP50_main.F90 b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_main.F90 new file mode 100644 index 000000000..fe8a00ac8 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_main.F90 @@ -0,0 +1,1158 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- + +#include "LIS_misc.h" +!BOP +! +! !ROUTINE: NoahMP50_main +! \label{NoahMP50_main} +! +! !REVISION HISTORY: +! This subroutine is generated with the Model Implementation Toolkit +! developed by Shugong Wang for the NASA Land Information System V7. +! The initial specification of the subroutine is by Sujay Kumar. +! +! 10/25/18: Shugong Wang, Zhuo Wang; initial implementation for NoahMP50 with LIS-7 +! 05/15/19: Yeosang Yoon; code added for snow DA to work +! 10/29/19: David Mocko; Added RELSMC to output, and an option +! for different units for Qs/Qsb/Albedo +! 03/09/22: David Mocko: Fixed "input LAI" for dynamic vegetation options 7/8/9 +! 05/23/23: Cenlin He: modified for refactored NoahMP v5 and later + +! !INTERFACE: +subroutine NoahMP50_main(n) +! !USES: + use LIS_coreMod + use LIS_histDataMod + use LIS_timeMgrMod, only : LIS_isAlarmRinging + use LIS_constantsMod, only : LIS_CONST_RHOFW !New + use LIS_vegDataMod, only : LIS_lai, LIS_sai + use LIS_logMod, only : LIS_logunit, LIS_endrun + use LIS_FORC_AttributesMod + use NoahMP50_lsmMod + use NoahmpIOVarType + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer :: t + integer :: i + real :: dt + real :: lat, lon + real :: tempval + integer :: row, col, tid + integer :: year, month, day, hour, minute, second + logical :: alarmCheck + +! +! !DESCRIPTION: +! This is the entry point for calling the NoahMP50 physics. +! This routine calls the {\tt noahmp_driver_50} routine that performs +! the land surface computations, to solve water and energy equations. + +! The arguments are: +! \begin{description} +! \item[n] +! index of the nest +! \end{description} +!EOP + +! define variables for NoahMP50 + + ! Code added by Zhuo Wang 02/28/2019 + real :: AvgSurfT_out ! average surface temperature [K] + real :: TWS_out ! terrestrial water storage [mm] + ! Code added by David Mocko 04/25/2019 + real :: startsm, startswe, startint, startgw, endsm + + ! EMK for 557WW + real :: tmp_q2sat, tmp_es + character*3 :: fnest + REAL, PARAMETER:: LVH2O = 2.501000E+6 ! Latent heat for evapo for water + + ! -------------------------------- + + ! check NoahMP50 alarm. If alarm is ring, run model. + + write(fnest,'(i3.3)') n + alarmCheck = LIS_isAlarmRinging(LIS_rc, "NoahMP50 model alarm "//trim(fnest)) + + if (alarmCheck) Then + do t = 1, LIS_rc%npatch(n, LIS_rc%lsm_index) + dt = LIS_rc%ts + row = LIS_surface(n, LIS_rc%lsm_index)%tile(t)%row + col = LIS_surface(n, LIS_rc%lsm_index)%tile(t)%col + lat = LIS_domain(n)%grid(LIS_domain(n)%gindex(col, row))%lat + lon = LIS_domain(n)%grid(LIS_domain(n)%gindex(col, row))%lon + + ! retrieve forcing data from NoahMP50_struc(n)%noahmp50(t) and assign to 1-D NoahmpIO variables + ! T_PHY: air temperature + NoahmpIO%T_PHY(1,1,1) = NoahMP50_struc(n)%noahmp50(t)%tair / NoahMP50_struc(n)%forc_count + ! Yeosang Yoon, for snow DA + NoahMP50_struc(n)%noahmp50(t)%sfctmp = NoahmpIO%T_PHY(1,1,1) + + ! P8W: air pressure + NoahmpIO%P8W(1,1,1) = NoahMP50_struc(n)%noahmp50(t)%psurf / NoahMP50_struc(n)%forc_count + + ! U_PHY: U wind component + NoahmpIO%U_PHY(1,1,1) = NoahMP50_struc(n)%noahmp50(t)%wind_e / NoahMP50_struc(n)%forc_count + + ! V_PHY: V wind component + NoahmpIO%V_PHY(1,1,1) = NoahMP50_struc(n)%noahmp50(t)%wind_n / NoahMP50_struc(n)%forc_count + + ! QV_CURR: specific humidity + NoahmpIO%QV_CURR(1,1,1) = NoahMP50_struc(n)%noahmp50(t)%qair / NoahMP50_struc(n)%forc_count + + ! SWDOWN: downward solar radiation + NoahmpIO%SWDOWN(1,1) = NoahMP50_struc(n)%noahmp50(t)%swdown / NoahMP50_struc(n)%forc_count + + ! GLW: downward longwave radiation + NoahmpIO%GLW(1,1) = NoahMP50_struc(n)%noahmp50(t)%lwdown / NoahMP50_struc(n)%forc_count + + ! prcp: total precipitation (rainfall+snowfall) + ! Noah-MP require total precipitation as forcing input. [mm per model timestep] + ! T. Lahmers: Correct total precip for cases when model time step > forcing timestep. + ! Edit suggested by D. Mocko and K. Arsenault + !if (NoahMP50_struc(n)%ts > LIS_rc%ts) then + NoahmpIO%RAINBL(1,1) = NoahMP50_struc(n)%ts * & + (NoahMP50_struc(n)%noahmp50(t)%prcp / NoahMP50_struc(n)%forc_count) + !else + ! NoahmpIO%RAINBL(1,1) = dt * (NoahMP50_struc(n)%noahmp50(t)%prcp / NoahMP50_struc(n)%forc_count) + !endif + + !ag(05Jan2021) + ! rivsto/fldsto: River storage and flood storage + ! NoahMP50_struc(n)%noahmp50(t)%rivsto and NoahMP50_struc(n)%noahmp50(t)%fldsto + ! are updated in noahmp50_getsws_hymap2.F90 + NoahmpIO%rivsto(1,1) = NoahMP50_struc(n)%noahmp50(t)%rivsto + NoahmpIO%fldsto(1,1) = NoahMP50_struc(n)%noahmp50(t)%fldsto + NoahmpIO%fldfrc(1,1) = NoahMP50_struc(n)%noahmp50(t)%fldfrc + + ! check validity of tair + if(NoahmpIO%T_PHY(1,1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable tair in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + ! check validity of psurf + if(NoahmpIO%P8W(1,1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable psurf in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + ! check validity of wind_e + if(NoahmpIO%U_PHY(1,1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable wind_e in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + ! check validity of wind_n + if(NoahmpIO%V_PHY(1,1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable wind_n in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + ! check validity of qair + if(NoahmpIO%QV_CURR(1,1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable qair in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + ! check validity of swdown + if(NoahmpIO%SWDOWN(1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable swdown in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + ! check validity of lwdown + if(NoahmpIO%GLW(1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable lwdown in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + ! check validity of prcp + if(NoahmpIO%RAINBL(1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable prcp in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + ! + + !ag (05Jan2021) + ! check validity of rivsto + if(NoahmpIO%rivsto(1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable rivsto in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + ! check validity of fldsto + if(NoahmpIO%fldsto(1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable fldsto in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + ! check validity of fldfrc + if(NoahmpIO%fldfrc(1,1) .eq. LIS_rc%udef) then + write(LIS_logunit, *) "[ERR] undefined value found for forcing variable fldfrc in Noah-MP.5.0" + write(LIS_logunit, *) "for tile ", t, "latitude = ", lat, "longitude = ", lon + call LIS_endrun() + endif + + ! get parameters + NoahmpIO%xlat(1,1) = lat + NoahmpIO%xlon(1,1) = lon + NoahmpIO%msftx(1,1) = 1.0 + NoahmpIO%msfty(1,1) = 1.0 + NoahmpIO%year = LIS_rc%yr + NoahmpIO%month = LIS_rc%mo + NoahmpIO%day = LIS_rc%da + NoahmpIO%hour = LIS_rc%hr + NoahmpIO%minute = LIS_rc%mn + NoahmpIO%ttile = t + NoahmpIO%itimestep = LIS_rc%tscount(n) + NoahmpIO%dtbl = NoahMP50_struc(n)%ts + NoahmpIO%soiltstep = NoahMP50_struc(n)%ts_soil + NoahmpIO%dzs(:) = NoahMP50_struc(n)%sldpth(:) + NoahmpIO%nsoil = NoahMP50_struc(n)%nsoil + NoahmpIO%nsnow = NoahMP50_struc(n)%nsnow + NoahmpIO%dx = NoahMP50_struc(n)%dx + NoahmpIO%dy = NoahMP50_struc(n)%dy + NoahmpIO%ivgtyp(1,1) = NoahMP50_struc(n)%noahmp50(t)%vegetype + NoahmpIO%isltyp(1,1) = NoahMP50_struc(n)%noahmp50(t)%soiltype + ! Multiply shdfac by 100.0 because noahmpdrv.f90, expects it in units of percentage, not fraction. + NoahmpIO%shdfac_monthly(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%shdfac_monthly(:) * 100.0 + NoahmpIO%tmn(1,1) = NoahMP50_struc(n)%noahmp50(t)%tbot + NoahmpIO%urban_vegtype(1,1) = LIS_rc%urbanclass + NoahmpIO%cropcat(1,1) = LIS_rc%cropclass + NoahmpIO%IOPT_DVEG = NoahMP50_struc(n)%dveg_opt + NoahmpIO%IOPT_CRS = NoahMP50_struc(n)%crs_opt + NoahmpIO%IOPT_BTR = NoahMP50_struc(n)%btr_opt + NoahmpIO%IOPT_RUNSRF = NoahMP50_struc(n)%runsfc_opt + NoahmpIO%IOPT_RUNSUB = NoahMP50_struc(n)%runsub_opt + NoahmpIO%IOPT_SFC = NoahMP50_struc(n)%sfc_opt + NoahmpIO%IOPT_FRZ = NoahMP50_struc(n)%frz_opt + NoahmpIO%IOPT_INF = NoahMP50_struc(n)%inf_opt + NoahmpIO%IOPT_RAD = NoahMP50_struc(n)%rad_opt + NoahmpIO%IOPT_ALB = NoahMP50_struc(n)%alb_opt + NoahmpIO%IOPT_SNF = NoahMP50_struc(n)%snf_opt + NoahmpIO%IOPT_TKSNO = NoahMP50_struc(n)%tksno_opt + NoahmpIO%IOPT_TBOT = NoahMP50_struc(n)%tbot_opt + NoahmpIO%IOPT_STC = NoahMP50_struc(n)%stc_opt + NoahmpIO%IOPT_GLA = NoahMP50_struc(n)%gla_opt + NoahmpIO%IOPT_RSF = NoahMP50_struc(n)%rsf_opt + NoahmpIO%IOPT_SOIL = NoahMP50_struc(n)%soil_opt + NoahmpIO%IOPT_PEDO = NoahMP50_struc(n)%pedo_opt + NoahmpIO%IOPT_CROP = NoahMP50_struc(n)%crop_opt + NoahmpIO%IOPT_IRR = NoahMP50_struc(n)%irr_opt + NoahmpIO%IOPT_IRRM = NoahMP50_struc(n)%irrm_opt + NoahmpIO%IOPT_INFDV = NoahMP50_struc(n)%infdv_opt + NoahmpIO%IOPT_TDRN = NoahMP50_struc(n)%tdrn_opt + NoahmpIO%iz0tlnd = 0 + NoahmpIO%sf_urban_physics = NoahMP50_struc(n)%urban_opt +! Multiply reference height by 2.0 because module_sf_noahmpdrv +! expects this variable to be in terms of a thickness of the +! atmospheric layers, and it later divides this value by 2.0. +! Thus, the LIS user should specify the exact height of the +! reference in lis.config, and module_sf_noahmpdrv will then +! correctly use this actual value. This code is confirmed in +! the HRLDAS driver, which also multiplies this value by 2.0. +! 11/30/2018 - dmm + NoahmpIO%dz8w(1,1,1) = NoahMP50_struc(n)%dz8w * 2.0 + + if (NoahmpIO%IOPT_CROP > 0) then + NoahmpIO%planting(1,1) = NoahMP50_struc(n)%noahmp50(t)%planting + NoahmpIO%harvest(1,1) = NoahMP50_struc(n)%noahmp50(t)%harvest + NoahmpIO%season_gdd(1,1) = NoahMP50_struc(n)%noahmp50(t)%season_gdd + else + NoahmpIO%planting(1,1) = 0.0 + NoahmpIO%harvest(1,1) = 0.0 + NoahmpIO%season_gdd(1,1) = 0.0 + endif + +! Zhuo Wang tested on 11/15/2018, not read from LDT-generated netcdf input file + if (NoahmpIO%IOPT_SOIL .eq. 2) then + NoahmpIO%soilcL1(1,1) = NoahMP50_struc(n)%noahmp50(t)%soilcL1 + NoahmpIO%soilcL2(1,1) = NoahMP50_struc(n)%noahmp50(t)%soilcL2 + NoahmpIO%soilcL3(1,1) = NoahMP50_struc(n)%noahmp50(t)%soilcL3 + NoahmpIO%soilcL4(1,1) = NoahMP50_struc(n)%noahmp50(t)%soilcL4 + endif + if (NoahmpIO%IOPT_SOIL .eq. 3) then + NoahmpIO%soilcomp(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%soilcomp(:) + endif + + ! for irrigation + if (NoahmpIO%IOPT_IRR > 0) then + NoahmpIO%irnumsi(1,1) = NoahMP50_struc(n)%noahmp50(t)%irnumsi + NoahmpIO%irnummi(1,1) = NoahMP50_struc(n)%noahmp50(t)%irnummi + NoahmpIO%irnumfi(1,1) = NoahMP50_struc(n)%noahmp50(t)%irnumfi + NoahmpIO%irfract(1,1) = NoahMP50_struc(n)%noahmp50(t)%irfract + NoahmpIO%sifract(1,1) = NoahMP50_struc(n)%noahmp50(t)%sifract + NoahmpIO%mifract(1,1) = NoahMP50_struc(n)%noahmp50(t)%mifract + NoahmpIO%fifract(1,1) = NoahMP50_struc(n)%noahmp50(t)%fifract + NoahmpIO%irwatsi(1,1) = NoahMP50_struc(n)%noahmp50(t)%irwatsi + NoahmpIO%irwatmi(1,1) = NoahMP50_struc(n)%noahmp50(t)%irwatmi + NoahmpIO%irwatfi(1,1) = NoahMP50_struc(n)%noahmp50(t)%irwatfi + NoahmpIO%ireloss(1,1) = NoahMP50_struc(n)%noahmp50(t)%ireloss + NoahmpIO%irrsplh(1,1) = NoahMP50_struc(n)%noahmp50(t)%irrsplh + NoahmpIO%irsivol(1,1) = NoahMP50_struc(n)%noahmp50(t)%irsivol + NoahmpIO%irmivol(1,1) = NoahMP50_struc(n)%noahmp50(t)%irmivol + NoahmpIO%irfivol(1,1) = NoahMP50_struc(n)%noahmp50(t)%irfivol + endif + + ! for tile drainage + if (NoahmpIO%IOPT_TDRN > 0) then + NoahmpIO%TD_FRACTION(1,1)= NoahMP50_struc(n)%noahmp50(t)%tdfract + NoahmpIO%qtdrain(1,1) = NoahMP50_struc(n)%noahmp50(t)%qtdrain + NoahmpIO%qtiledrain(1,1) = NoahMP50_struc(n)%noahmp50(t)%qtdrainflx + endif + + ! for MMF groundwater + if (NoahmpIO%IOPT_RUNSUB == 5) then + NoahmpIO%fdepthxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%fdepth + NoahmpIO%eqzwt(1,1) = NoahMP50_struc(n)%noahmp50(t)%eqzwt + NoahmpIO%riverbedxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%riverbed + NoahmpIO%rivercondxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%rivercond + NoahmpIO%pexpxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%pexp + NoahmpIO%areaxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%area + NoahmpIO%qrfsxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%qrfs + NoahmpIO%qspringxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%qspring + NoahmpIO%qrfxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%qrf + NoahmpIO%qspringsxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%qsprings + NoahmpIO%qslatxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%qslat + NoahmpIO%rechclim(1,1) = NoahMP50_struc(n)%noahmp50(t)%rechclim + NoahmpIO%rivermask(1,1) = NoahMP50_struc(n)%noahmp50(t)%rivermask + NoahmpIO%nonriverxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%nonriver + endif + + ! get state variables + NoahmpIO%sfcrunoff(1,1) = NoahMP50_struc(n)%noahmp50(t)%sfcrunoff + NoahmpIO%udrunoff(1,1) = NoahMP50_struc(n)%noahmp50(t)%udrrunoff + NoahmpIO%smois(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%smc(:) + NoahmpIO%sh2o(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%sh2o(:) + NoahmpIO%tslb(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%tslb(:) + NoahmpIO%snow(1,1) = NoahMP50_struc(n)%noahmp50(t)%sneqv + NoahmpIO%snowh(1,1) = NoahMP50_struc(n)%noahmp50(t)%snowh + NoahmpIO%canwat(1,1) = NoahMP50_struc(n)%noahmp50(t)%canwat + NoahmpIO%acsnom(1,1) = NoahMP50_struc(n)%noahmp50(t)%acsnom + NoahmpIO%acsnow(1,1) = NoahMP50_struc(n)%noahmp50(t)%acsnow + NoahmpIO%isnowxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%isnow + NoahmpIO%tvxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%tv + NoahmpIO%tgxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%tg + NoahmpIO%canicexy(1,1) = NoahMP50_struc(n)%noahmp50(t)%canice + NoahmpIO%canliqxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%canliq + NoahmpIO%eahxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%eah + NoahmpIO%tahxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%tah + NoahmpIO%cmxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%cm + NoahmpIO%chxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%ch + NoahmpIO%fwetxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%fwet + NoahmpIO%sneqvoxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%sneqvo + NoahmpIO%alboldxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%albold + NoahmpIO%qsnowxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%qsnow + NoahmpIO%wslakexy(1,1) = NoahMP50_struc(n)%noahmp50(t)%wslake + NoahmpIO%zwtxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%zwt + NoahmpIO%waxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%wa + NoahmpIO%wtxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%wt + NoahmpIO%tsnoxy(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%tsno(:) + NoahmpIO%zsnsoxy(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%zss(:) + NoahmpIO%snicexy(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%snowice(:) + NoahmpIO%snliqxy(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%snowliq(:) + NoahmpIO%lfmassxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%lfmass + NoahmpIO%rtmassxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%rtmass + NoahmpIO%stmassxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%stmass + NoahmpIO%woodxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%wood + NoahmpIO%stblcpxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%stblcp + NoahmpIO%fastcpxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%fastcp + + ! additional accumulated variables + NoahmpIO%ACC_SSOILXY(1,1) = NoahMP50_struc(n)%noahmp50(t)%accssoil + NoahmpIO%ACC_QINSURXY(1,1) = NoahMP50_struc(n)%noahmp50(t)%accqinsur + NoahmpIO%ACC_QSEVAXY(1,1) = NoahMP50_struc(n)%noahmp50(t)%accqseva + NoahmpIO%ACC_ETRANIXY(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%accetrani(:) + NoahmpIO%ACC_DWATERXY(1,1) = NoahMP50_struc(n)%noahmp50(t)%accdwater + NoahmpIO%ACC_PRCPXY(1,1) = NoahMP50_struc(n)%noahmp50(t)%accprcp + NoahmpIO%ACC_ECANXY(1,1) = NoahMP50_struc(n)%noahmp50(t)%accecan + NoahmpIO%ACC_ETRANXY(1,1) = NoahMP50_struc(n)%noahmp50(t)%accetran + NoahmpIO%ACC_EDIRXY (1,1) = NoahMP50_struc(n)%noahmp50(t)%accedir + +! DMM - If dynamic vegetation option DVEG = 7, 8, or 9 for "input LAI", +! then send LAI/SAI from input to the Noah-MP physics. If any +! tile has an undefined LAI/SAI value, instead use the value from the +! MPTABLE file for that vegetation class and for the month. + if ((NoahmpIO%IOPT_DVEG .ge. 7).and.(NoahmpIO%IOPT_DVEG .le. 9)) then + tid = LIS_surface(n,LIS_rc%lsm_index)%tile(t)%tile_id +! If "LAI data source:" is set to "none" for these three Noah-MP +! input LAI vegetation options, stop the run. + if (LIS_rc%useLAImap(n).ne."none") then + NoahmpIO%lai(1,1) = LIS_lai(n)%tlai(tid) + else + write(LIS_logunit,*) & + '[ERR] Attempting to use input LAI, however' + write(LIS_logunit,*) & + '[ERR] "LAI data source:" is set to "none".' + call LIS_endrun() + endif +! If "SAI data source:" is set to "none" for these three Noah-MP-4.0.1 +! input LAI vegetation options, fill in the SAI values from MPTABLE. + if (LIS_rc%useSAImap(n).ne."none") then + NoahmpIO%xsaixy(1,1) = LIS_sai(n)%tsai(tid) + endif +! If any LAI or SAI values are undefined at a tile, +! fill in the LAI or SAI values from MPTABLE. + if (NoahmpIO%lai(1,1) .eq. LIS_rc%udef) then + NoahmpIO%lai(1,1) = NoahMP50_struc(n)%noahmp50(t)%lai + endif + if (NoahmpIO%xsaixy(1,1) .eq. LIS_rc%udef) then + NoahmpIO%xsaixy(1,1) = NoahMP50_struc(n)%noahmp50(t)%sai + endif + else + NoahmpIO%lai(1,1) = NoahMP50_struc(n)%noahmp50(t)%lai + NoahmpIO%xsaixy(1,1) = NoahMP50_struc(n)%noahmp50(t)%sai + endif + NoahmpIO%taussxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%tauss + NoahmpIO%smoiseq(1,:,1) = NoahMP50_struc(n)%noahmp50(t)%smoiseq(:) + NoahmpIO%smcwtdxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%smcwtd + NoahmpIO%deeprechxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%deeprech + NoahmpIO%rechxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%rech + NoahmpIO%grainxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%grain + NoahmpIO%gddxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%gdd + NoahmpIO%pgsxy(1,1) = NoahMP50_struc(n)%noahmp50(t)%pgs + NoahmpIO%sfcheadrt(1,1) = NoahMP50_struc(n)%noahmp50(t)%sfcheadrt + +! Calculate water storages at start of timestep + startsm = 0.0 + do i = 1,NoahmpIO%nsoil + startsm = startsm + & + (NoahmpIO%smois(1,i,1) * NoahmpIO%dzs(i) * LIS_CONST_RHOFW) + enddo + startswe = NoahmpIO%snow(1,1) + startint = NoahmpIO%canliqxy(1,1) + NoahmpIO%canicexy(1,1) + startgw = NoahmpIO%waxy(1,1) + + ! call model physics + call noahmp_driver_50(n, NoahMP50_struc(n)%noahmp50(t)%param) + + ! save state variables from NoahmpIO 1-D variables to global variables + NoahMP50_struc(n)%noahmp50(t)%sfcrunoff = NoahmpIO%sfcrunoff(1,1) + NoahMP50_struc(n)%noahmp50(t)%udrrunoff = NoahmpIO%udrunoff(1,1) + NoahMP50_struc(n)%noahmp50(t)%smc(:) = NoahmpIO%smois(1,:,1) + NoahMP50_struc(n)%noahmp50(t)%sh2o(:) = NoahmpIO%sh2o(1,:,1) + NoahMP50_struc(n)%noahmp50(t)%tslb(:) = NoahmpIO%tslb(1,:,1) + NoahMP50_struc(n)%noahmp50(t)%sneqv = NoahmpIO%snow(1,1) + NoahMP50_struc(n)%noahmp50(t)%snowh = NoahmpIO%snowh(1,1) + NoahMP50_struc(n)%noahmp50(t)%canwat = NoahmpIO%canwat(1,1) + NoahMP50_struc(n)%noahmp50(t)%acsnom = NoahmpIO%acsnom(1,1) + NoahMP50_struc(n)%noahmp50(t)%acsnow = NoahmpIO%acsnow(1,1) + NoahMP50_struc(n)%noahmp50(t)%isnow = NoahmpIO%isnowxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%tv = NoahmpIO%tvxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%tg = NoahmpIO%tgxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%canice = NoahmpIO%canicexy(1,1) + NoahMP50_struc(n)%noahmp50(t)%canliq = NoahmpIO%canliqxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%eah = NoahmpIO%eahxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%tah = NoahmpIO%tahxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%cm = NoahmpIO%cmxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%ch = NoahmpIO%chxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%fwet = NoahmpIO%fwetxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%sneqvo = NoahmpIO%sneqvoxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%albold = NoahmpIO%alboldxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%qsnow = NoahmpIO%qsnowxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%wslake = NoahmpIO%wslakexy(1,1) + NoahMP50_struc(n)%noahmp50(t)%zwt = NoahmpIO%zwtxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%wa = NoahmpIO%waxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%wt = NoahmpIO%wtxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%tsno(:) = NoahmpIO%tsnoxy(1,:,1) + NoahMP50_struc(n)%noahmp50(t)%zss(:) = NoahmpIO%zsnsoxy(1,:,1) + NoahMP50_struc(n)%noahmp50(t)%snowice(:) = NoahmpIO%snicexy(1,:,1) + NoahMP50_struc(n)%noahmp50(t)%snowliq(:) = NoahmpIO%snliqxy(1,:,1) + NoahMP50_struc(n)%noahmp50(t)%lfmass = NoahmpIO%lfmassxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%rtmass = NoahmpIO%rtmassxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%stmass = NoahmpIO%stmassxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%wood = NoahmpIO%woodxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%stblcp = NoahmpIO%stblcpxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%fastcp = NoahmpIO%fastcpxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%lai = NoahmpIO%lai(1,1) + NoahMP50_struc(n)%noahmp50(t)%sai = NoahmpIO%xsaixy(1,1) + NoahMP50_struc(n)%noahmp50(t)%tauss = NoahmpIO%taussxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%smoiseq(:) = NoahmpIO%smoiseq(1,:,1) + NoahMP50_struc(n)%noahmp50(t)%smcwtd = NoahmpIO%smcwtdxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%deeprech = NoahmpIO%deeprechxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%rech = NoahmpIO%rechxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%grain = NoahmpIO%grainxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%gdd = NoahmpIO%gddxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%pgs = NoahmpIO%pgsxy(1,1) + + ! save output variables from NoahmpIO variables to global variables + NoahMP50_struc(n)%noahmp50(t)%tsk = NoahmpIO%tsk(1,1) + NoahMP50_struc(n)%noahmp50(t)%hfx = NoahmpIO%hfx(1,1) + NoahMP50_struc(n)%noahmp50(t)%qfx = NoahmpIO%qfx(1,1) + NoahMP50_struc(n)%noahmp50(t)%lh = NoahmpIO%lh(1,1) + NoahMP50_struc(n)%noahmp50(t)%grdflx = NoahmpIO%grdflx(1,1) + NoahMP50_struc(n)%noahmp50(t)%albedo = NoahmpIO%albedo(1,1) + NoahMP50_struc(n)%noahmp50(t)%snowc = NoahmpIO%snowc(1,1) + NoahMP50_struc(n)%noahmp50(t)%emiss = NoahmpIO%emiss(1,1) + NoahMP50_struc(n)%noahmp50(t)%rs = NoahmpIO%rs(1,1) + NoahMP50_struc(n)%noahmp50(t)%t2mv = NoahmpIO%t2mvxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%t2mb = NoahmpIO%t2mbxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%q2mv = NoahmpIO%q2mvxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%q2mb = NoahmpIO%q2mbxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%trad = NoahmpIO%tradxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%nee = NoahmpIO%neexy(1,1) + NoahMP50_struc(n)%noahmp50(t)%gpp = NoahmpIO%gppxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%npp = NoahmpIO%nppxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%fveg = NoahmpIO%fvegxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%runsf = NoahmpIO%runsfxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%runsb = NoahmpIO%runsbxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%ecan = NoahmpIO%ecanxy(1,1) +! Direct soil evaporation does not include sublimation of the snowpack +! on the soil (by the strict ALMA definition of ESoil). - David Mocko + NoahMP50_struc(n)%noahmp50(t)%edir = NoahmpIO%edirxy(1,1) - NoahmpIO%qsnsubxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%etran = NoahmpIO%etranxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%rainf = NoahmpIO%rainlsm(1,1) + NoahMP50_struc(n)%noahmp50(t)%snowf = NoahmpIO%snowlsm(1,1) + NoahMP50_struc(n)%noahmp50(t)%fsa = NoahmpIO%fsaxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%fira = NoahmpIO%firaxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%apar = NoahmpIO%aparxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%psn = NoahmpIO%psnxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%sav = NoahmpIO%savxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%sag = NoahmpIO%sagxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%rssun = NoahmpIO%rssunxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%rssha = NoahmpIO%rsshaxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%bgap = NoahmpIO%bgapxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%wgap = NoahmpIO%wgapxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%tgb = NoahmpIO%tgbxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%tgv = NoahmpIO%tgvxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%chv = NoahmpIO%chvxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%chb = NoahmpIO%chbxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%shg = NoahmpIO%shgxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%shc = NoahmpIO%shcxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%shb = NoahmpIO%shbxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%evg = NoahmpIO%evgxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%evb = NoahmpIO%evbxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%ghv = NoahmpIO%ghvxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%ghb = NoahmpIO%ghbxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%irg = NoahmpIO%irgxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%irc = NoahmpIO%ircxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%irb = NoahmpIO%irbxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%tr = NoahmpIO%trxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%evc = NoahmpIO%evcxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%chleaf = NoahmpIO%chleafxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%chuc = NoahmpIO%chucxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%chv2 = NoahmpIO%chv2xy(1,1) + NoahMP50_struc(n)%noahmp50(t)%chb2 = NoahmpIO%chb2xy(1,1) + NoahMP50_struc(n)%noahmp50(t)%infxs1rt = NoahmpIO%infxsrt(1,1) + NoahMP50_struc(n)%noahmp50(t)%soldrain1rt = NoahmpIO%soldrain(1,1) + NoahMP50_struc(n)%noahmp50(t)%sfcheadrt = NoahmpIO%sfcheadrt(1,1) + + ! additional accumulated variables + NoahMP50_struc(n)%noahmp50(t)%accssoil = NoahmpIO%ACC_SSOILXY(1,1) + NoahMP50_struc(n)%noahmp50(t)%accqinsur = NoahmpIO%ACC_QINSURXY(1,1) + NoahMP50_struc(n)%noahmp50(t)%accqseva = NoahmpIO%ACC_QSEVAXY(1,1) + NoahMP50_struc(n)%noahmp50(t)%accetrani(:) = NoahmpIO%ACC_ETRANIXY(1,:,1) + NoahMP50_struc(n)%noahmp50(t)%accdwater = NoahmpIO%ACC_DWATERXY(1,1) + NoahMP50_struc(n)%noahmp50(t)%accprcp = NoahmpIO%ACC_PRCPXY(1,1) + NoahMP50_struc(n)%noahmp50(t)%accecan = NoahmpIO%ACC_ECANXY(1,1) + NoahMP50_struc(n)%noahmp50(t)%accetran = NoahmpIO%ACC_ETRANXY(1,1) + NoahMP50_struc(n)%noahmp50(t)%accedir = NoahmpIO%ACC_EDIRXY (1,1) + + ! for irrigation + if (NoahmpIO%IOPT_IRR > 0) then + NoahMP50_struc(n)%noahmp50(t)%irnumsi = NoahmpIO%irnumsi(1,1) + NoahMP50_struc(n)%noahmp50(t)%irnummi = NoahmpIO%irnummi(1,1) + NoahMP50_struc(n)%noahmp50(t)%irnumfi = NoahmpIO%irnumfi(1,1) + NoahMP50_struc(n)%noahmp50(t)%irwatsi = NoahmpIO%irwatsi(1,1) + NoahMP50_struc(n)%noahmp50(t)%irwatmi = NoahmpIO%irwatmi(1,1) + NoahMP50_struc(n)%noahmp50(t)%irwatfi = NoahmpIO%irwatfi(1,1) + NoahMP50_struc(n)%noahmp50(t)%ireloss = NoahmpIO%ireloss(1,1) + NoahMP50_struc(n)%noahmp50(t)%irrsplh = NoahmpIO%irrsplh(1,1) + NoahMP50_struc(n)%noahmp50(t)%irsivol = NoahmpIO%irsivol(1,1) + NoahMP50_struc(n)%noahmp50(t)%irmivol = NoahmpIO%irmivol(1,1) + NoahMP50_struc(n)%noahmp50(t)%irfivol = NoahmpIO%irfivol(1,1) + endif + + ! for tile drainage + if (NoahmpIO%IOPT_TDRN > 0) then + NoahMP50_struc(n)%noahmp50(t)%qtdrain = NoahmpIO%qtdrain(1,1) + NoahMP50_struc(n)%noahmp50(t)%qtdrainflx = NoahmpIO%qtiledrain(1,1) + endif + + ! for MMF groundwater + if (NoahmpIO%IOPT_RUNSUB == 5) then + NoahMP50_struc(n)%noahmp50(t)%fdepth = NoahmpIO%fdepthxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%eqzwt = NoahmpIO%eqzwt(1,1) + NoahMP50_struc(n)%noahmp50(t)%riverbed = NoahmpIO%riverbedxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%rivercond = NoahmpIO%rivercondxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%pexp = NoahmpIO%pexpxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%area = NoahmpIO%areaxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%qrfs = NoahmpIO%qrfsxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%qspring = NoahmpIO%qspringxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%qrf = NoahmpIO%qrfxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%qsprings = NoahmpIO%qspringsxy(1,1) + NoahMP50_struc(n)%noahmp50(t)%qslat = NoahmpIO%qslatxy(1,1) + endif + + ! EMK Update RHMin for 557WW + if (NoahmpIO%T_PHY(1,1,1) .lt. & + noahmp50_struc(n)%noahmp50(t)%tair_agl_min) then + noahmp50_struc(n)%noahmp50(t)%tair_agl_min = NoahmpIO%T_PHY(1,1,1) + ! Use formulation based on Noah.3.6 code, which treats + ! q2sat as saturated specific humidity + tmp_es = 611.0*exp(2.501E6/461.0*(1./273.15 - 1./NoahmpIO%T_PHY(1,1,1))) + tmp_q2sat = 0.622*tmp_es/(NoahmpIO%P8W(1,1,1)-(1.-0.622)*tmp_es) + noahmp50_struc(n)%noahmp50(t)%rhmin = NoahmpIO%QV_CURR(1,1,1) / tmp_q2sat + endif + + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_RHMIN, & + value=noahmp50_struc(n)%noahmp50(t)%rhmin, & + vlevel=1, unit="-", direction="-",& + surface_type=LIS_rc%lsm_index) + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_RHMIN, & + value=(100.*noahmp50_struc(n)%noahmp50(t)%rhmin), & + vlevel=1, unit="%", direction="-",& + surface_type=LIS_rc%lsm_index) + + ![ 1] output variable: tsk (unit=K ). *** surface radiative temperature + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_RADT, value = NoahMP50_struc(n)%noahmp50(t)%tsk, & + vlevel=1, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 2] output variable: fsh (unit=W/m2). *** sensible heat flux to atmosphere + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QH, value = NoahMP50_struc(n)%noahmp50(t)%hfx, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 3] output variable: lh (unit=W/m2). *** latent heat flux + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QLE, value = NoahMP50_struc(n)%noahmp50(t)%lh, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 4] output variable: grdflx (unit=W/m2). *** ground/snow heat flux to soil + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QG, value = NoahMP50_struc(n)%noahmp50(t)%grdflx, & + vlevel=1, unit="W m-2", direction="DN", surface_type = LIS_rc%lsm_index) + + ![ 5] output variable: albedo (unit=- ). *** total grid albedo + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_ALBEDO, value = NoahMP50_struc(n)%noahmp50(t)%albedo, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + !if (NoahMP50_struc(n)%noahmp50(t)%albedo .ne. LIS_rc%udef) & + ! NoahMP50_struc(n)%noahmp50(t)%albedo = NoahMP50_struc(n)%noahmp50(t)%albedo * 100.0 + + !call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_ALBEDO, value = NoahMP50_struc(n)%noahmp50(t)%albedo, & + ! vlevel=1, unit="%", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 6] output variable: snowc (unit=-). *** snow cover fraction + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWCOVER, value = NoahMP50_struc(n)%noahmp50(t)%snowc, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWCOVER, value = (NoahMP50_struc(n)%noahmp50(t)%snowc*100.0), & + vlevel=1, unit="%", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 7] output variable: smc (unit=m3/m3). *** volumetric soil moisture + do i=1, NoahMP50_struc(n)%nsoil + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SOILMOIST, value = NoahMP50_struc(n)%noahmp50(t)%smc(i), & + vlevel=i, unit="m^3 m-3", direction="-", surface_type = LIS_rc%lsm_index) + end do + + ![ 8] output variable: sh2o (unit=m3/m3). *** equilibrium volumetric liquid soil moisture content + do i=1, NoahMP50_struc(n)%nsoil + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SMLIQFRAC, value = NoahMP50_struc(n)%noahmp50(t)%sh2o(i), & + vlevel=i, unit="m^3 m-3", direction="-", surface_type = LIS_rc%lsm_index) + end do + + ![ 9] output variable: tslb (unit=K). *** soil temperature + do i=1, NoahMP50_struc(n)%nsoil + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SOILTEMP, value = NoahMP50_struc(n)%noahmp50(t)%tslb(i), & + vlevel=i, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + end do + + ![ 10] output variable: sneqv (unit=mm ). *** snow water equivalent + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SWE, value = NoahMP50_struc(n)%noahmp50(t)%sneqv, & + vlevel=1, unit="kg m-2", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 11] output variable: snowh (unit=m ). *** physical snow depth + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWDEPTH, value = NoahMP50_struc(n)%noahmp50(t)%snowh, & + vlevel=1, unit="m ", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 12] output variable: canwat (unit=kg/m2). *** total canopy water storage + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CANOPINT, value = NoahMP50_struc(n)%noahmp50(t)%canwat, & + vlevel=1, unit="kg m-2", direction="- ", surface_type = LIS_rc%lsm_index) + + ![ 13] output variable: emiss (unit=- ). *** surface bulk emissivity + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_EMISSFORC, value = NoahMP50_struc(n)%noahmp50(t)%emiss, & + vlevel=1, unit="- ", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 14] output variable: rs (unit=s/m). *** total stomatal resistance + ! call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_RS, value = NoahMP50_struc(n)%noahmp50(t)%rs, & + ! vlevel=1, unit="s/m", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 15] output variable: isnow (unit=-). *** actual number of snow layers + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SOWN_NLAYER, value = -1.0*NoahMP50_struc(n)%noahmp50(t)%isnow, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 16] output variable: tv (unit=K ). *** vegetation leaf temperature + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_VEGT, value = NoahMP50_struc(n)%noahmp50(t)%tv, & + vlevel=1, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 17] output variable: tg (unit=K). *** averaged ground surface temperature + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_GROUNDAVGT, value = NoahMP50_struc(n)%noahmp50(t)%tg, & + vlevel=1, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 18] output variable: canice (unit=mm). *** canopy intercepted ice + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SWEVEG, value = NoahMP50_struc(n)%noahmp50(t)%canice, & + vlevel=1, unit="kg m-2", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 19] output variable: canliq (unit=mm). *** canopy intercepted liquid water + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CANOPY_INTL, value = NoahMP50_struc(n)%noahmp50(t)%canliq, & + vlevel=1, unit="mm", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 20] output variable: eah (unit=Pa ). *** canopy air vapor pressure + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CANOPY_VP, value = NoahMP50_struc(n)%noahmp50(t)%eah, & + vlevel=1, unit="Pa", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 21] output variable: tah (unit=K ). *** canopy air temperature + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CANOPY_TEMP, value = NoahMP50_struc(n)%noahmp50(t)%tah, & + vlevel=1, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 22] output variable: cm (unit=s/m ). *** bulk momentum drag coefficient + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CM, value = NoahMP50_struc(n)%noahmp50(t)%cm, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 23] output variable: ch (unit=s/m ). *** bulk sensible heat exchange coefficient + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CH, value = NoahMP50_struc(n)%noahmp50(t)%ch, & + vlevel=1, unit="m", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 24] output variable: fwet (unit=- ). *** wetted or snowed fraction of canopy + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CANOPY_WF, value = NoahMP50_struc(n)%noahmp50(t)%fwet, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 25] output variable: wslake (unit=mm). *** lake water storage + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_LAKEWATER, value = NoahMP50_struc(n)%noahmp50(t)%wslake, & + vlevel=1, unit="mm", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 26] output variable: zwt (unit=m). *** water table depth + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_WATERTABLED, value = NoahMP50_struc(n)%noahmp50(t)%zwt, & + vlevel=1, unit="m", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 27] output variable: wa (unit=mm). *** water storage in the "aquifer" + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_GWS, value = NoahMP50_struc(n)%noahmp50(t)%wa, & + vlevel=1, unit="mm", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 28] output variable: wt (unit=mm). *** water in aquifer and saturated soil + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_WT_AQUI_SATSOIL, value = NoahMP50_struc(n)%noahmp50(t)%wt, & + vlevel=1, unit="mm", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 29] output variable: tsno (unit=K). *** snow layer temperature + do i=1, NoahMP50_struc(n)%nsnow + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWTPROF, value = NoahMP50_struc(n)%noahmp50(t)%tsno(i), & + vlevel=i, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + end do + + ![ 30] output variable: snowice (unit=mm ). *** snow layer ice + do i=1, NoahMP50_struc(n)%nsnow + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWICE, value = NoahMP50_struc(n)%noahmp50(t)%snowice(i), & + vlevel=i, unit="mm", direction="-", surface_type = LIS_rc%lsm_index) + end do + + ![ 31] output variable: snowliq (unit=mm ). *** snow layer liquid water + do i=1, NoahMP50_struc(n)%nsnow + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWLIQ, value = NoahMP50_struc(n)%noahmp50(t)%snowliq(i), & + vlevel=i, unit="mm", direction="-", surface_type = LIS_rc%lsm_index) + end do + + ! Yeosang Yoon, for snow DA + ! output variable: z_snow (unit=m). *** snow layer-bottom depth from snow surface + do i=1, NoahMP50_struc(n)%nsnow + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOW_LBDFSS, value = NoahMP50_struc(n)%noahmp50(t)%zss(i), & + vlevel=i, unit="m", direction="-", surface_type = LIS_rc%lsm_index) + end do + + ![ 32] output variable: lfmass (unit=g/m2). *** leaf mass + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_LEAFMASS, value = NoahMP50_struc(n)%noahmp50(t)%lfmass, & + vlevel=1, unit="g m-2", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 33] output variable: rtmass (unit=g/m2 ). *** mass of fine roots + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_ROOTMASS, value = NoahMP50_struc(n)%noahmp50(t)%rtmass, & + vlevel=1, unit="g m-2 ", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 34] output variable: stmass (unit=g/m2 ). *** stem mass + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_STEMMASS, value = NoahMP50_struc(n)%noahmp50(t)%stmass, & + vlevel=1, unit="g m-2", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 35] output variable: wood (unit=g/m2). *** mass of wood including woody roots + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_WOODMASS, value = NoahMP50_struc(n)%noahmp50(t)%wood, & + vlevel=1, unit="g m-2", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 36] output variable: stblcp (unit=g/m2). *** stable carbon in deep soil + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CARBON_DEEPSOIL, value = NoahMP50_struc(n)%noahmp50(t)%stblcp, & + vlevel=1, unit="g m-2", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 37] output variable: fastcp (unit=g/m2 ). *** short-lived carbon in shallow soil + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CARBON_SHALLOWSOIL, value = NoahMP50_struc(n)%noahmp50(t)%fastcp, & + vlevel=1, unit="g m-2", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 38] output variable: lai (unit=-). *** leave area index + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_LAI, value = NoahMP50_struc(n)%noahmp50(t)%lai, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 39] output variable: sai (unit=- ). *** stem area index + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SAI, value = NoahMP50_struc(n)%noahmp50(t)%sai, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 40] output variable: tauss (unit=- ). *** snow aging factor + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWAGE, value = NoahMP50_struc(n)%noahmp50(t)%tauss, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 41] output variable: smcwtd (unit=m3/m3). *** soil moisture content in the layer to the water table when deep + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_BETWEENWATER, value = NoahMP50_struc(n)%noahmp50(t)%smcwtd, & + vlevel=1, unit="m^3 m-3", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 42] output variable: deeprech (unit=m). *** recharge to the water table when groundwater is deep + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QRECTOGW, value = NoahMP50_struc(n)%noahmp50(t)%deeprech, & + vlevel=1, unit="m", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 43] output variable: rech (unit=m). *** recharge from the water table when groundwater is shallow + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QRECFROMGW, value = NoahMP50_struc(n)%noahmp50(t)%rech, & + vlevel=1, unit="m", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 44] output variable: t2mv (unit=K). *** 2-m air temperature over vegetated part + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_VEGE2MT, value = NoahMP50_struc(n)%noahmp50(t)%t2mv, & + vlevel=1, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 45] output variable: t2mb (unit=K ). *** 2-m height air temperature + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_BARE2MT, value = NoahMP50_struc(n)%noahmp50(t)%t2mb, & + vlevel=1, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 46] output variable: q2mv (unit=kg/kg). *** 2-m mixing ratio of vegetation part + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_VEGE2MQ2, value = NoahMP50_struc(n)%noahmp50(t)%q2mv, & + vlevel=1, unit="kg kg-1", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 47] output variable: q2mb (unit=kg/kg). *** 2-m mixing ratio of bare ground part + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_BARE2MQ2, value = NoahMP50_struc(n)%noahmp50(t)%q2mb, & + vlevel=1, unit="kg kg-1", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 48] output variable: trad (unit=K). *** surface radiative temperature + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_RADT, value = NoahMP50_struc(n)%noahmp50(t)%trad, & + vlevel=1, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 49] output variable: nee (unit=g/m2/s ). *** net ecosystem exchange of CO2 + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_NEE, value = NoahMP50_struc(n)%noahmp50(t)%nee, & + vlevel=1, unit="g m-2 s-1", direction="OUT", surface_type = LIS_rc%lsm_index) + + ![ 50] output variable: gpp (unit=g/m2/s ). *** gross primary assimilation of carbon + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_GPP, value = NoahMP50_struc(n)%noahmp50(t)%gpp, & + vlevel=1, unit="g m-2 s-1", direction="IN", surface_type = LIS_rc%lsm_index) + + ![ 51] output variable: npp (unit=g/m2/s). *** net primary productivity of carbon + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_NPP, value = NoahMP50_struc(n)%noahmp50(t)%npp, & + vlevel=1, unit="g m-2 s-1", direction="OUT", surface_type = LIS_rc%lsm_index) + + ![ 52] output variable: fveg (unit=-). *** Noah-MP green vegetation fraction + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_GREENNESS, value = NoahMP50_struc(n)%noahmp50(t)%fveg, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 53] output variable: runsf (unit=mm/s). *** surface runoff + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QS, value = NoahMP50_struc(n)%noahmp50(t)%runsf/NoahMP50_struc(n)%ts,& + vlevel=1, unit="kg m-2 s-1", direction="OUT", surface_type = LIS_rc%lsm_index) + + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QS, value = NoahMP50_struc(n)%noahmp50(t)%runsf, & + vlevel=1, unit="kg m-2", direction="OUT", surface_type = LIS_rc%lsm_index) + + ![ 54] output variable: runsb (unit=mm/s ). *** baseflow (saturation excess) + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QSB, value = NoahMP50_struc(n)%noahmp50(t)%runsb/NoahMP50_struc(n)%ts,& + vlevel=1, unit="kg m-2 s-1", direction="OUT", surface_type = LIS_rc%lsm_index) + + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QSB, value = NoahMP50_struc(n)%noahmp50(t)%runsb, & + vlevel=1, unit="kg m-2", direction="OUT", surface_type = LIS_rc%lsm_index) + + ! Combined output variable: qtot (unit=mm | mm/s). *** total runoff + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QTOT, & + value = NoahMP50_struc(n)%noahmp50(t)%runsf/NoahMP50_struc(n)%ts + & + NoahMP50_struc(n)%noahmp50(t)%runsb/NoahMP50_struc(n)%ts, & + vlevel=1, unit="kg m-2 s-1", direction="OUT", surface_type = LIS_rc%lsm_index) + + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QTOT, & + value = NoahMP50_struc(n)%noahmp50(t)%runsf + NoahMP50_struc(n)%noahmp50(t)%runsb, & + vlevel=1, unit="kg m-2", direction="OUT", surface_type = LIS_rc%lsm_index) + + ![ 55] output variable: ecan (unit=mm/s ). *** evaporation of intercepted water + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_ECANOP, value = NoahMP50_struc(n)%noahmp50(t)%ecan, & + vlevel=1, unit="kg m-2 s-1", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 56] output variable: edir (unit=mm/s ). *** soil surface evaporation rate + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_ESOIL, value = NoahMP50_struc(n)%noahmp50(t)%edir, & + vlevel=1, unit="kg m-2 s-1", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 57] output variable: etran (unit=mm/s ). *** transpiration rate + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_TVEG, value = NoahMP50_struc(n)%noahmp50(t)%etran, & + vlevel=1, unit="kg m-2 s-1", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 58] output variable: fsa (unit=W/m2). *** total absorbed solar radiation + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SWNET, value = NoahMP50_struc(n)%noahmp50(t)%fsa, & + vlevel=1, unit="W m-2", direction="DN", surface_type = LIS_rc%lsm_index) + + ![ 59] output variable: fira (unit=W/m2 ). *** total net longwave radiation [+ to atm] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_LWUP, value = NoahMP50_struc(n)%noahmp50(t)%fira, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 60] output variable: apar (unit=W/m2). *** photosynthesis active energy by canopy + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_APAR, value = NoahMP50_struc(n)%noahmp50(t)%apar, & + vlevel=1, unit="W m-2", direction="IN", surface_type = LIS_rc%lsm_index) + + ![ 61] output variable: psn (unit=umol/m2/s ). *** total photosynthesis of CO2 [+] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_PSCO2, value = NoahMP50_struc(n)%noahmp50(t)%psn, & + vlevel=1, unit="umol m-2 s-1", direction="IN", surface_type = LIS_rc%lsm_index) + + ![ 62] output variable: sav (unit=W/m2 ). *** solar radiation absorbed by vegetation + !call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SAV, value = NoahMP50_struc(n)%noahmp50(t)%sav, & + ! vlevel=1, unit="W/m2 ", direction="IN", surface_type = LIS_rc%lsm_index) + + ![ 63] output variable: sag (unit=W/m2 ). *** solar radiation absorbed by ground + !call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SAG, value = NoahMP50_struc(n)%noahmp50(t)%sag, & + ! vlevel=1, unit="W/m2 ", direction="IN", surface_type = LIS_rc%lsm_index) + + ![ 64] output variable: rssun (unit=s/m). *** sunlit leaf stomatal resistance + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_RSSUN, value = NoahMP50_struc(n)%noahmp50(t)%rssun, & + vlevel=1, unit="s m-1", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 65] output variable: rssha (unit=s/m). *** shaded leaf stomatal resistance + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_RSSHA, value = NoahMP50_struc(n)%noahmp50(t)%rssha, & + vlevel=1, unit="s m-1", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 66] output variable: bgap (unit=-). *** between gap fraction + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_BGAP, value = NoahMP50_struc(n)%noahmp50(t)%bgap, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 67] output variable: wgap (unit=- ). *** within gap fraction + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_WGAP, value = NoahMP50_struc(n)%noahmp50(t)%wgap, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 68] output variable: tgb (unit=K). *** bare ground temperature + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_BARESOILT, value = NoahMP50_struc(n)%noahmp50(t)%tgb, & + vlevel=1, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 69] output variable: tgv (unit=K). *** vegetated ground surface temperature + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_GROUNDVEGT, value = NoahMP50_struc(n)%noahmp50(t)%tgv, & + vlevel=1, unit="K", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 70] output variable: chv (unit=s/m). *** sensible heat exchange coefficient over vegetated fraction + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CHV, value = NoahMP50_struc(n)%noahmp50(t)%chv, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 71] output variable: chb (unit=s/m). *** sensible heat exchange coefficient over bare-ground fraction + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CHB, value = NoahMP50_struc(n)%noahmp50(t)%chb, & + vlevel=1, unit="-", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 72] output variable: shg (unit=W/m2 ). *** get ground sensible heat [+ to atm] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SHG, value = NoahMP50_struc(n)%noahmp50(t)%shg, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 73] output variable: shc (unit=W/m2 ). *** canopy sensible heat [+ to atm] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SHC, value = NoahMP50_struc(n)%noahmp50(t)%shc, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 74] output variable: shb (unit=W/m2 ). *** bare ground sensible heat [+ to atm] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SHB, value = NoahMP50_struc(n)%noahmp50(t)%shb, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 75] output variable: evg (unit=W/m2 ). *** veg ground evaporation [+ to atm] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_EVG, value = NoahMP50_struc(n)%noahmp50(t)%evg, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 76] output variable: evb (unit=W/m2 ). *** bare soil evaporation [+ to atm] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_EVB, value = NoahMP50_struc(n)%noahmp50(t)%evb, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 77] output variable: ghv (unit=W/m2 ). *** vegetated ground heat flux [+ to soil] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_GHV, value = NoahMP50_struc(n)%noahmp50(t)%ghv, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 78] output variable: ghb (unit=W/m2 ). *** bare ground heat flux [+ to soil] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_GHB, value = NoahMP50_struc(n)%noahmp50(t)%ghb, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 79] output variable: irg (unit=W/m2 ). *** veg ground net long wave radiation [+ to atm] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_IRV, value = NoahMP50_struc(n)%noahmp50(t)%irg, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 80] output variable: irc (unit=W/m2 ). *** canopy net long wave radiation [+ to atm] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_IRC, value = NoahMP50_struc(n)%noahmp50(t)%irc, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 81] output variable: irb (unit=W/m2 ). *** bare net long wave radiation [+ to atm] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_IRB, value = NoahMP50_struc(n)%noahmp50(t)%irb, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 82] output variable: tr (unit=W/m2 ). *** transpiration heat [to atm] + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_HTR, value = NoahMP50_struc(n)%noahmp50(t)%tr, & + vlevel=1, unit="W m-2", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 83] output variable: evc (unit=W/m2 ). *** canopy evaporation heat [to atm] + !call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_EVC, value = NoahMP50_struc(n)%noahmp50(t)%evc, & + ! vlevel=1, unit="W/m2 ", direction="UP", surface_type = LIS_rc%lsm_index) + + ![ 84] output variable: chleaf (unit=m/s). *** leaf exchange coefficient + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CHLEAF, value = NoahMP50_struc(n)%noahmp50(t)%chleaf, & + vlevel=1, unit="m s-1", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 85] output variable: chuc (unit=m/s). *** under canopy exchange coefficient + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CHUC, value = NoahMP50_struc(n)%noahmp50(t)%chuc, & + vlevel=1, unit="m s-1", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 86] output variable: chv2 (unit=m/s). *** veg 2m exchange coefficient + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CHV2, value = NoahMP50_struc(n)%noahmp50(t)%chv2, & + vlevel=1, unit="m s-1", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 87] output variable: chb2 (unit=m/s). *** bare 2m exchange coefficient + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_CHB2, value = NoahMP50_struc(n)%noahmp50(t)%chb2, & + vlevel=1, unit="m s-1", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 88] output variable: evap (unit=kg/m2/s). *** total evapotranspiration + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_EVAP, value = NoahMP50_struc(n)%noahmp50(t)%qfx, & + vlevel=1, unit="kg m-2 s-1", direction="UP", surface_type = LIS_rc%lsm_index) + !PET + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_POTEVAP, & + value=(NoahmpIO%fgev_pet(1,1)+NoahmpIO%fcev_pet(1,1)+NoahmpIO%fctr_pet(1,1)), vlevel=1,unit="W m-2",& + direction="UP",surface_type=LIS_rc%lsm_index) + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_POTEVAP, & + value=(NoahmpIO%fgev_pet(1,1)+NoahmpIO%fcev_pet(1,1)+NoahmpIO%fctr_pet(1,1))/LVH2O, & + vlevel=1,unit="kg m-2 s-1", direction="UP",surface_type=LIS_rc%lsm_index) + + ![ 89] output variable: rainf (unit=kg/m2). *** precipitation rate + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_RAINF, value = NoahMP50_struc(n)%noahmp50(t)%rainf, & + vlevel=1, unit="kg m-2 s-1", direction="DN", surface_type = LIS_rc%lsm_index) + + ![ 90] output variable: snowf (unit=kg/m2). *** snowfall rate + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SNOWF, value = NoahMP50_struc(n)%noahmp50(t)%snowf, & + vlevel=1, unit="kg m-2 s-1", direction="DN", surface_type = LIS_rc%lsm_index) + + ![ 91] LWnet + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_LWNET,vlevel=1, & + value=(-1.0 * NoahMP50_struc(n)%noahmp50(t)%fira), & + unit="W m-2", direction="DN", surface_type=LIS_rc%lsm_index) + + ! Code added by Zhuo Wang on 02/28/2019 + ![ 92] output variable: qsnbot (unit=kg m-2 s-1). *** melting water out of snow bottom + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QSM, value = NoahmpIO%qsnbotxy(1,1), & + vlevel=1, unit="kg m-2 s-1", direction="S2L", surface_type = LIS_rc%lsm_index) + + ![ 93] output variable: subsnow (unit=kg m-2 s-1). *** snow sublimation + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_SUBSNOW, value = NoahmpIO%qsnsubxy(1,1), & + vlevel=1, unit="kg m-2 s-1", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 94] output variable: AvgSurfT (unit=K). *** average surface temperature + AvgSurfT_out = NoahMP50_struc(n)%noahmp50(t)%fveg * NoahMP50_struc(n)%noahmp50(t)%tv + & + (1.0-NoahMP50_struc(n)%noahmp50(t)%fveg) * NoahMP50_struc(n)%noahmp50(t)%tgb + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_AVGSURFT, value = AvgSurfT_out, & + vlevel=1, unit="K", direction="-",surface_type = LIS_rc%lsm_index) + + ![ 95] TWS should be SWE + CanopInt + Soil moisture + WA - David Mocko + TWS_out = NoahMP50_struc(n)%noahmp50(t)%sneqv + if ((NoahMP50_struc(n)%noahmp50(t)%canliq.ge.0.0).and. & + (NoahMP50_struc(n)%noahmp50(t)%canice.ge.0.0)) then + TWS_out = TWS_out + & + (NoahMP50_struc(n)%noahmp50(t)%canliq + & + NoahMP50_struc(n)%noahmp50(t)%canice) + endif + do i = 1,NoahMP50_struc(n)%nsoil + TWS_out = TWS_out + & + (NoahMP50_struc(n)%noahmp50(t)%smc(i) * & + NoahmpIO%dzs(i)*LIS_CONST_RHOFW) + enddo + if (NoahMP50_struc(n)%noahmp50(t)%wa.ge.0.0) then + TWS_out = TWS_out + NoahMP50_struc(n)%noahmp50(t)%wa + endif + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_TWS, value = TWS_out, & + vlevel=1, unit="mm", direction="-", surface_type = LIS_rc%lsm_index) + + ![ 96] Qa - Advective energy - Heat transferred to a snow cover by rain + ! - (unit=W m-2) - added by David Mocko + call LIS_diagnoseSurfaceOutputVar(n, t, LIS_MOC_QA, value = NoahmpIO%pahxy(1,1), & + vlevel=1, unit="W m-2",direction="DN",surface_type=LIS_rc%lsm_index) + +! Added water balance change terms - David Mocko + endsm = 0.0 + do i = 1,NoahmpIO%nsoil + endsm = endsm + & + (NoahmpIO%smois(1,i,1) * NoahmpIO%dzs(i) * LIS_CONST_RHOFW) + enddo + call LIS_diagnoseSurfaceOutputVar(n,t,LIS_MOC_DELSOILMOIST,& + value=(endsm - startsm),vlevel=1,unit="kg m-2", & + direction="INC",surface_type=LIS_rc%lsm_index) + call LIS_diagnoseSurfaceOutputVar(n,t,LIS_MOC_DELSWE, & + value=(NoahMP50_struc(n)%noahmp50(t)%sneqv - & + startswe), & + vlevel=1,unit="kg m-2",direction="INC", & + surface_type=LIS_rc%lsm_index) + call LIS_diagnoseSurfaceOutputVar(n,t,LIS_MOC_DELINTERCEPT,& + value=((NoahMP50_struc(n)%noahmp50(t)%canliq + & + NoahMP50_struc(n)%noahmp50(t)%canice) - & + startint), & + vlevel=1,unit="kg m-2",direction="INC", & + surface_type=LIS_rc%lsm_index) +! For now, the ALMA standard does not provide a variable for the +! change in groundwater storage. Instead, temporarily writing it +! to the DELSURFSTOR (which is the change in surface water storage). +! This is only a temporary fix, until LIS_MOC_DELGROUNDWATER or +! a similarly-named variable is added into LIS_histDataMod.F90. + call LIS_diagnoseSurfaceOutputVar(n,t,LIS_MOC_DELSURFSTOR, & + value=(NoahMP50_struc(n)%noahmp50(t)%wa - & + startgw), & + vlevel=1,unit="kg m-2",direction="INC", & + surface_type=LIS_rc%lsm_index) + +! David Mocko (10/29/2019) - Copy RELSMC calculation from Noah-3.X + do i = 1,NoahmpIO%nsoil + if (NoahmpIO%relsmc(1,i,1).gt.1.0) then + NoahmpIO%relsmc(1,i,1) = 1.0 + endif + if (NoahmpIO%relsmc(1,i,1).lt.0.01) then + NoahmpIO%relsmc(1,i,1) = 0.01 + endif + +! J.Case (9/11/2014) -- Set relative soil moisture to missing (LIS_rc%udef) +! if the vegetation type is urban class. + if (NoahmpIO%ivgtyp(1,1) .eq. NoahmpIO%urban_vegtype(1,1)) then + NoahmpIO%relsmc(1,i,1) = LIS_rc%udef + endif + call LIS_diagnoseSurfaceOutputVar(n,t,LIS_MOC_RELSMC,vlevel=i, & + value=NoahmpIO%relsmc(1,i,1),unit='-',direction="-",surface_type=LIS_rc%lsm_index) + if (NoahmpIO%relsmc(1,i,1) .eq. LIS_rc%udef) then + tempval = NoahmpIO%relsmc(1,i,1) + else + tempval = NoahmpIO%relsmc(1,i,1)*100.0 + endif + call LIS_diagnoseSurfaceOutputVar(n,t,LIS_MOC_RELSMC,vlevel=i, & + value=tempval,unit='%',direction="-",surface_type=LIS_rc%lsm_index) + enddo + + ! reset forcing variables to zeros + NoahMP50_struc(n)%noahmp50(t)%tair = 0.0 + NoahMP50_struc(n)%noahmp50(t)%psurf = 0.0 + NoahMP50_struc(n)%noahmp50(t)%wind_e = 0.0 + NoahMP50_struc(n)%noahmp50(t)%wind_n = 0.0 + NoahMP50_struc(n)%noahmp50(t)%qair = 0.0 + NoahMP50_struc(n)%noahmp50(t)%swdown = 0.0 + NoahMP50_struc(n)%noahmp50(t)%lwdown = 0.0 + NoahMP50_struc(n)%noahmp50(t)%prcp = 0.0 + + enddo ! end of tile (t) loop + ! reset forcing counter to be zero + NoahMP50_struc(n)%forc_count = 0 + + endif ! end of alarmCheck loop + + ! EMK...See if noahmp50_struc(n)%noahmp50(t)%tair_agl_min needs to be + ! reset for calculating RHMin. + alarmCheck = LIS_isAlarmRinging(LIS_rc, & + "NoahMP50 RHMin alarm "//trim(fnest)) + if (alarmCheck) then + write(LIS_logunit,*) & + '[INFO] Resetting tair_agl_min for RHMin calculation' + do t = 1,LIS_rc%npatch(n,LIS_rc%lsm_index) + noahmp50_struc(n)%noahmp50(t)%tair_agl_min = 999. + end do + end if + +end subroutine NoahMP50_main diff --git a/lis/surfacemodels/land/noahmp.5.0/NoahMP50_module.F90 b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_module.F90 new file mode 100644 index 000000000..4b585f116 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_module.F90 @@ -0,0 +1,577 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- + +module NoahMP50_module +!BOP +! +! !MODULE: NoahMP50_module +! +! !DESCRIPTION: +! The code in this file provides a description of the +! data structure containing the NoahMP 1-d variables (for v5.0 and later). +! The variables specified in the data structure include: +! +! \begin{description} +! \item[n] +! nest id. unit: - +! \item[latitude] +! latitude in decimal degree. unit: rad +! \item[logitude] +! longitude in decimal year. unit: rad +! \item[year] +! year of the current time step. unit: - +! \item[month] +! month of the current time step. unit: - +! \item[day] +! day of the current time step. unit: - +! \item[hour] +! hour of the current time step. unit: - +! \item[minute] +! minute of the current time step. unit: - +! \item[dz8w] +! thickness of atmospheric layers. unit: m +! \item[dt] +! timestep. unit: s +! \item[sldpth] +! thickness of soil layers. unit: m +! \item[nsoil] +! number of soil layers. unit: - +! \item[nsnow] +! maximum number of snow layers (e.g. 3). unit: - +! \item[vegetype] +! vegetation type. unit: - +! \item[soiltype] +! soil type. unit: - +! \item[shdfac\_monthly] +! monthly values for green vegetation fraction. unit: +! \item[tbot] +! deep soil temperature. unit: K +! \item[urban\_vegetype] +! urban land cover type index. unit: - +! \item[cropcat] +! crop category. unit: - +! \item[planting] +! planting date. unit: - +! \item[harvest] +! harvest date. unit: - +! \item[season\_gdd] +! growing season GDD. unit: - +! \item[landuse\_tbl\_name] +! Noah model landuse parameter table. unit: - +! \item[soil\_tbl\_name] +! Noah model soil parameter table. unit: - +! \item[gen\_tbl\_name] +! Noah model general parameter table. unit: - +! \item[noahmp\_tbl\_name] +! NoahMP parameter table. unit: - +! \item[landuse\_scheme\_name] +! Landuse classification scheme. unit: - +! \item[soil\_scheme\_name] +! Soil classification scheme. unit: - +! \item[dveg\_opt] +! dynamic vegetation, (1-$>$off; 2-$>$on); with opt\_crs=1. unit: - +! \item[crs\_opt] +! canopt stomatal resistance (1-$>$Ball-Berry; 2-$>$Jarvis). unit: - +! \item[btr\_opt] +! soil moisture factor for stomatal resistance (1-$>$Noah;2-$>$CLM;3-$>$SSiB). unit: - +! \item[runsfc\_opt] +! surface runoff (1->SIMGM; 2->SIMTOP; 3->Schaake96; 4->BATS; 5->MMF; 6->VIC; 7->XinAnJiang; 8->DynamicVIC) +! \item[runsub\_opt] +! subsurface runoff (1->SIMGM; 2->SIMTOP; 3->Schaake96; 4->BATS; 5->MMF; 6->VIC; 7->XinAnJiang; 8->DynamicVIC) +! \item[sfc\_opt] +! surface layer drag coeff (CH \& CM) (1-$>$M-O; 2-$>$Chen97). unit: - +! \item[frz\_opt] +! supercooled liquid water (1-$>$NY06; 2-$>$Koren99). unit: - +! \item[tksno\_opt] +! snow thermal conductivity (1->Yen1965; 2->Anderson1976; 3->constant; 4->Verseghy1991; 5->Yen1981). unit: - +! \item[inf\_opt] +! frozen soil permeability (1-$>$NY06; 2-$>$Koren99). unit: - +! \item[rad\_opt] +! radiation transfer (1-$>$gap=F(3D,cosz); 2-$>$gap=0; 3-$>$gap=1-Fveg). unit: - +! \item[alb\_opt] +! snow surface albedo (1-$>$BATS; 2-$>$CLASS). unit: - +! \item[snf\_opt] +! rainfall \& snowfall (1-$>$Jordan91; 2-$>$BATS; 3-$>$Noah). unit: - +! \item[tbot\_opt] +! lower boundary of soil temperature. unit: - +! \item[stc\_opt] +! snow/soil temperature time scheme. unit: - +! \item[gla\_opt] +! glacier option (1-$>$phase change; 2-$>$simple). unit: - +! \item[rsf\_opt] +! surface resistance (1-$>$Sakaguchi/Zeng;2-$>$Seller;3-$>$mod Sellers;4-$>$1+snow). unit: - +! \item[soil\_opt] +! soil configuration option. unit: - +! \item[pedo\_opt] +! soil pedotransfer function option. unit: - +! \item[crop\_opt] +! crop model option (0-$>$none; 1-$>$Liu et al.2016). unit: - +! \item[irr\_opt] +! irrigation scheme option (0->none; 1->always on; 2->trigger by planting/harvest dates; 3->trigger by LAI) +! \item[irrm\_opt] +! irrigation method option (0->fraction from input; 1->sprinkler; 2->micro/drip; 3->flood) +! \item[tdrn\_opt] +! tile drainage option (0->none; 1->simple drainage; 2->Hooghoudt's scheme) +! \item[urban\_opt] +! urban physics option. unit: - +! \item[soilcomp] +! soil sand and clay percentage. unit: - +! \item[soilcL1] +! soil texture in layer 1. unit: - +! \item[soilcL2] +! soil texture in layer 2. unit: - +! \item[soilcL3] +! soil texture in layer 3. unit: - +! \item[soilcL4] +! soil texture in layer 4. unit: - +! \item[tair] +! air temperature. unit: K +! \item[psurf] +! air pressure. unit: Pa +! \item[wind\_e] +! U wind component. unit: m/s +! \item[wind\_n] +! V wind component. unit: m/s +! \item[qair] +! specific humidity. unit: kg/kg +! \item[swdown] +! downward solar radiation. unit: W m-2 +! \item[lwdown] +! downward longwave radiation. unit: W m-2 +! \item[prcp] +! total precipitation (rainfall+snowfall). unit: mm +! \item[tsk] +! surface radiative temperature. unit: K +! \item[hfx] +! sensible heat flux. unit: W m-2 +! \item[qfx] +! latent heat flux. unit: kg s-1 m-2 +! \item[lh] +! latent heat flux. unit: W m-2 +! \item[grdflx] +! ground/snow heat flux. unit: W m-2 +! \item[sfcrunoff] +! accumulated surface runoff. unit: m +! \item[udrrunoff] +! accumulated sub-surface runoff. unit: m +! \item[albedo] +! total grid albedo. unit: - +! \item[snowc] +! snow cover fraction. unit: - +! \item[smc] +! volumtric soil moisture. unit: m3/m3 +! \item[sh2o] +! volumtric liquid soil moisture. unit: m3/m3 +! \item[tslb] +! soil temperature. unit: K +! \item[sneqv] +! snow water equivalent. unit: mm +! \item[snowh] +! physical snow depth. unit: m +! \item[canwat] +! total canopy water + ice. unit: mm +! \item[acsnom] +! accumulated snow melt leaving pack. unit: - +! \item[acsnow] +! accumulated snow on grid. unit: mm +! \item[emiss] +! surface bulk emissivity. unit: - +! \item[rs] +! total stomatal resistance. unit: s/m +! \item[isnow] +! actual no. of snow layers. unit: - +! \item[tv] +! vegetation leaf temperature. unit: K +! \item[tg] +! bulk ground surface temperature. unit: K +! \item[canice] +! canopy-intercepted ice. unit: mm +! \item[canliq] +! canopy-intercepted liquid water. unit: mm +! \item[eah] +! canopy air vapor pressure. unit: Pa +! \item[tah] +! canopy air temperature. unit: K +! \item[cm] +! bulk momentum drag coefficient. unit: - +! \item[ch] +! bulk sensible heat exchange coefficient. unit: - +! \item[fwet] +! wetted or snowed fraction of canopy. unit: - +! \item[sneqvo] +! snow mass at last time step. unit: mm h2o +! \item[albold] +! snow albedo at last time step. unit: - +! \item[qsnow] +! snowfall on the ground. unit: mm/s +! \item[wslake] +! lake water storage. unit: mm +! \item[zwt] +! water table depth. unit: m +! \item[wa] +! water in the "aquifer". unit: mm +! \item[wt] +! water in aquifer and saturated soil. unit: mm +! \item[tsno] +! snow layer temperature. unit: K +! \item[zss] +! snow/soil layer depth from snow surface. unit: m +! \item[snowice] +! snow layer ice. unit: mm +! \item[snowliq] +! snow layer liquid water. unit: mm +! \item[lfmass] +! leaf mass. unit: g/m2 +! \item[rtmass] +! mass of fine roots. unit: g/m2 +! \item[stmass] +! stem mass. unit: g/m2 +! \item[wood] +! mass of wood (including woody roots). unit: g/m2 +! \item[stblcp] +! stable carbon in deep soil. unit: g/m2 +! \item[fastcp] +! short-lived carbon in shallow soil. unit: g/m2 +! \item[lai] +! leaf area index. unit: - +! \item[sai] +! stem area index. unit: - +! \item[tauss] +! snow age factor. unit: - +! \item[smoiseq] +! equilibrium volumetric soil moisture content. unit: m3/m3 +! \item[smcwtd] +! soil moisture content in the layer to the water table when deep. unit: - +! \item[deeprech] +! recharge to the water table when deep. unit: - +! \item[rech] +! recharge to the water table (diagnostic). unit: - +! \item[grain] +! mass of grain XING. unit: g/m2 +! \item[gdd] +! growing degree days XING (based on 10C). unit: - +! \item[pgs] +! growing degree days XING. unit: - +! \item[t2mv] +! 2m temperature of vegetation part. unit: K +! \item[t2mb] +! 2m temperature of bare ground part. unit: K +! \item[q2mv] +! 2m mixing ratio of vegetation part. unit: - +! \item[q2mb] +! 2m mixing ratio of bare ground part. unit: - +! \item[trad] +! surface radiative temperature. unit: K +! \item[nee] +! net ecosys exchange of CO2. unit: g/m2/s CO2 +! \item[gpp] +! gross primary assimilation of carbon. unit: g/m2/s C +! \item[npp] +! net primary productivity of carbon. unit: g/m2/s C +! \item[fveg] +! Noah-MP green vegetation fraction. unit: - +! \item[runsf] +! surface runoff. unit: mm/s +! \item[runsb] +! subsurface runoff. unit: mm/s +! \item[ecan] +! evaporation of intercepted water. unit: mm/s +! \item[edir] +! soil surface evaporation rate. unit: mm/s +! \item[etran] +! transpiration rate. unit: mm/s +! \item[rainf] +! raifall. unit: km s-1 +! \item[snowf] +! snow fall. unit: kg s-1 +! \item[fsa] +! total absorbed solar radiation. unit: W/m2 +! \item[fira] +! total net longwave radiation [+ to atm]. unit: W/m2 +! \item[apar] +! photosyn active energy by canopy. unit: W/m2 +! \item[psn] +! total photosynthesis [+]. unit: umol co2/m2/s +! \item[sav] +! solar radiation absorbed by vegetation. unit: W/m2 +! \item[sag] +! solar radiation absorbed by ground. unit: W/m2 +! \item[rssun] +! sunlit leaf stomatal resistance. unit: s/m +! \item[rssha] +! shaded leaf stomatal resistance. unit: s/m +! \item[bgap] +! between gap fraction. unit: - +! \item[wgap] +! within gap fraction. unit: - +! \item[tgb] +! bare ground temperature. unit: K +! \item[tgv] +! under canopy ground temperature. unit: K +! \item[chv] +! sensible heat exchange coefficient vegetated. unit: - +! \item[chb] +! sensible heat exchange coefficient bare-ground. unit: - +! \item[shg] +! veg ground sensible heat [+ to atm]. unit: W/m2 +! \item[shc] +! canopy sensible heat [+ to atm]. unit: W/m2 +! \item[shb] +! bare sensible heat [+ to atm]. unit: W/m2 +! \item[evg] +! veg ground evaporation [+ to atm]. unit: W/m2 +! \item[evb] +! bare soil evaporation [+ to atm]. unit: W/m2 +! \item[ghv] +! veg ground heat flux [+ to soil]. unit: W/m2 +! \item[ghb] +! bare ground heat flux [+ to soil]. unit: W/m2 +! \item[irg] +! veg ground net LW radiation [+ to atm]. unit: W/m2 +! \item[irc] +! canopy net LW radiation [+ to atm]. unit: W/m2 +! \item[irb] +! bare net LW radiation [+ to atm]. unit: W/m2 +! \item[tr] +! transpiration [ to atm]. unit: W/m2 +! \item[evc] +! canopy evaporation heat [to atm]. unit: W/m2 +! \item[chleaf] +! leaf exchange coefficient. unit: - +! \item[chuc] +! under canopy exchange coefficient. unit: - +! \item[chv2] +! veg 2m exchange coefficient. unit: - +! \item[chb2] +! bare 2m exchange coefficient. unit: - +! \end{description} +! +! !REVISION HISTORY: +! This module is generated with the Model Implementation Toolkit developed +! by Shugong Wang for the NASA Land Information System Version 7. The initial +! specification of the module is defined by Sujay Kumar. +! 10/25/18: Shugong Wang, Zhuo Wang Initial implementation for LIS 7 and NoahMP401 +! 05/01/23: Cenlin He, update to work with refactored Noah-MP (v5.0 and later) + +!EOP + USE LisNoahmpParamType + + implicit none + + INTEGER, PRIVATE, PARAMETER :: MBAND = 2 + INTEGER, PRIVATE, PARAMETER :: NSOIL = 4 + INTEGER, PRIVATE, PARAMETER :: NSTAGE = 8 + + type, public :: noahmp50dec + !------------------------------------------------------ + ! forcing + !------------------------------------------------------ + real :: tair + real :: sfctmp ! Yeosang Yoon for snow DA + real :: psurf + real :: wind_e + real :: wind_n + real :: qair + real :: swdown + real :: lwdown + real :: prcp + !-------------------------------------------------------- + ! spatial parameter + !-------------------------------------------------------- + integer :: vegetype + integer :: soiltype + real :: tbot + real :: planting + real :: harvest + real :: season_gdd + real :: soilcL1 + real :: soilcL2 + real :: soilcL3 + real :: soilcL4 + !---------------------------------------------------------- + ! multilevel spatial parameter + !---------------------------------------------------------- + real, pointer :: shdfac_monthly(:) + real, pointer :: soilcomp(:) + !---------------------------------------------------------- + ! state + !---------------------------------------------------------- + real :: sfcrunoff + real :: udrrunoff + real, pointer :: smc(:) + real, pointer :: sh2o(:) + real, pointer :: tslb(:) + real :: sneqv + real :: snowh + real :: canwat + real :: acsnom + real :: acsnow + integer :: isnow + real :: tv + real :: tg + real :: canice + real :: canliq + real :: eah + real :: tah + real :: cm + real :: ch + real :: fwet + real :: sneqvo + real :: albold + real :: qsnow + real :: wslake + real :: zwt + real :: wa + real :: wt + real, pointer :: tsno(:) + real, pointer :: zss(:) + real, pointer :: snowice(:) + real, pointer :: snowliq(:) + real :: lfmass + real :: rtmass + real :: stmass + real :: wood + real :: stblcp + real :: fastcp + real :: lai + real :: sai + real :: tauss + real :: grain + real :: gdd + integer :: pgs + ! for mmf groundwater + real, pointer :: smoiseq(:) + real :: smcwtd + real :: deeprech + real :: rech + real :: pexp + real :: area + real :: qrf + real :: qspring + real :: qslat + real :: qrfs + real :: qsprings + real :: fdepth + real :: rivercond + real :: riverbed + real :: eqzwt + real :: rechclim + real :: rivermask + real :: nonriver + ! for irrigation + integer :: irnumsi + integer :: irnummi + integer :: irnumfi + real :: irfract + real :: sifract + real :: mifract + real :: fifract + real :: irwatsi + real :: irwatmi + real :: irwatfi + real :: ireloss + real :: irrsplh + real :: irsivol + real :: irmivol + real :: irfivol + ! for tile drainage + real :: tdfract + real :: qtdrain + real :: qtdrainflx + ! for water budget with different soil time step + real :: accssoil + real :: accqinsur + real :: accqseva + real, pointer :: accetrani(:) + real :: accdwater + real :: accprcp + real :: accecan + real :: accetran + real :: accedir + !ag (05Jan2021) + ! 2-way coupling parameters + real :: rivsto + real :: fldsto + real :: fldfrc + + !------------------------------------------------------- + ! output + !------------------------------------------------------- + real :: tsk +! real :: fsh + real :: hfx + real :: qfx + real :: lh + real :: grdflx + real :: albedo + real :: snowc + real :: emiss + real :: rs + real :: t2mv + real :: t2mb + real :: q2mv + real :: q2mb + real :: trad + real :: nee + real :: gpp + real :: npp + real :: fveg + real :: runsf + real :: runsb + real :: ecan + real :: edir + real :: etran + real :: rainf + real :: snowf + real :: fsa + real :: fira + real :: apar + real :: psn + real :: sav + real :: sag + real :: rssun + real :: rssha + real :: bgap + real :: wgap + real :: tgb + real :: tgv + real :: chv + real :: chb + real :: shg + real :: shc + real :: shb + real :: evg + real :: evb + real :: ghv + real :: ghb + real :: irg + real :: irc + real :: irb + real :: tr + real :: evc + real :: chleaf + real :: chuc + real :: chv2 + real :: chb2 + + !EMK for 557WW + real :: tair_agl_min + real :: rhmin + + type(LisNoahmpParam_type) :: param + + ! For WRF-HYDRO + real :: sfcheadrt + real :: infxs1rt + real :: soldrain1rt + + end type noahmp50dec + +end module NoahMP50_module diff --git a/lis/surfacemodels/land/noahmp.5.0/NoahMP50_read_OPT_parameters.F90 b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_read_OPT_parameters.F90 new file mode 100644 index 000000000..4076619de --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_read_OPT_parameters.F90 @@ -0,0 +1,445 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +!BOP +! +! !ROUTINE: NoahMP50_read_OPT_parameters +! \label{NoahMP50_read_OPT_parameters} +! +! !REVISION HISTORY: +! +! This subroutine reads the optimized parameters generated typically +! from the LIS OPT/UE system. In general, this routine can be used +! to overwrite the default lookup table values that the model uses. +! +! 5 May 2020: Sujay Kumar; Initial specification +! May 2023: Cenlin He, modified for refactored NoahMP v5 and later + +! !INTERFACE: +! +subroutine NoahMP50_read_OPT_parameters() +! !USES: + use LIS_coreMod + use NoahMP50_lsmMod + + implicit none + + integer :: mtype + logical :: var_found + integer :: t, k, n + integer :: col, row + real, allocatable :: placeholder(:,:) + + mtype = LIS_rc%lsm_index + + do n=1,LIS_rc%nnest + allocate(placeholder(LIS_rc%lnc(n), LIS_rc%lnr(n))) + + call NoahMP50_read_OPT_param(n, "ALBDRY1", placeholder, var_found) + + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%albdry(1) =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "ALBDRY2", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%albdry(2) =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "ALBICE1", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%albice(1) =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "ALBICE2", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%albice(2) =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "ALBSAT1", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%albsat(1) =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "ALBSAT2", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%albsat(2) =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "BETADS", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%betads =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "BETAIS", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%betais =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "EG1", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%eg(1) =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "EG2", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%eg(2) =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "MFSNO", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%mfsno =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "OMEGAS1", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%omegas(1) =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "OMGEAS2", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%omegas(2) =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "RSURF_SNOW", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%rsurf_snow =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "SSI", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%ssi =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "Z0SNO", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%z0sno =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "MXSNALB", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%mxsnalb =& + placeholder(col, row) + endif + enddo + endif + + + call NoahMP50_read_OPT_param(n, "MNSNALB", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%mnsnalb =& + placeholder(col, row) + endif + enddo + endif + + + call NoahMP50_read_OPT_param(n, "SNDECAYEXP", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%sndecayexp =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "T_ULIMIT", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%t_ulimit =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "T_MLIMIT", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%t_mlimit =& + placeholder(col, row) + endif + enddo + endif + + + call NoahMP50_read_OPT_param(n, "T_LLIMIT", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%t_llimit =& + placeholder(col, row) + endif + enddo + endif + + call NoahMP50_read_OPT_param(n, "SNOWF_SCALEF", placeholder, var_found) + if(var_found) then + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + if(placeholder(col,row).ne.LIS_rc%udef) then + NoahMP50_struc(n)%noahmp50(t)%param%snowf_scalef =& + placeholder(col, row) + endif + enddo + endif + + deallocate(placeholder) + + end do +end subroutine NoahMP50_read_OPT_parameters + +!BOP +! +! !ROUTINE: NoahMP50_read_OPT_param +! \label{NoahMP50_read_OPT_param} +! +! !REVISION HISTORY: +! 03 Sept 2004: Sujay Kumar; Initial Specification for read_laiclimo +! 30 Oct 2013: Shugong Wang; Generalization for reading OPT spatial parameter +! +! !INTERFACE: +subroutine NoahMP50_read_OPT_param(n, ncvar_name, placeholder,var_found) +! !USES: + use netcdf + use LIS_coreMod, only : LIS_rc, LIS_domain, LIS_localPet, & + LIS_ews_halo_ind, LIS_ewe_halo_ind, & + LIS_nss_halo_ind, LIS_nse_halo_ind + use LIS_logMod, only : LIS_logunit, LIS_verify, LIS_endrun + use LIS_fileIOMod, only: LIS_read_param + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + character(len=*), intent(in) :: ncvar_name + real, intent(out) :: placeholder(LIS_rc%lnc(n), LIS_rc%lnr(n)) + logical :: var_found +! !DESCRIPTION: +! This subroutine reads OPT parameters from the LIS +! NetCDF parameter data file +! +! The arguments are: +! \begin{description} +! \item[n] +! index of n +! \item[array] +! array containing returned values +! \end{description} +! +!EOP + + integer :: ios1 + integer :: ios, nid, param_ID, nc_ID, nr_ID, dimids(3) + integer :: nc, nr, t, k + real, pointer :: level_data(:, :) + logical :: file_exists + + placeholder = LIS_rc%udef + var_found = .false. + + inquire(file=LIS_rc%paramfile(n), exist=file_exists) + if(file_exists) then + write(LIS_logunit, *) '[INFO] Reading '//trim(ncvar_name)//& + ' map ' + + ! open NetCDF parameter file + ios = nf90_open(path=trim(LIS_rc%paramfile(n)), & + mode=NF90_NOWRITE, ncid=nid) + call LIS_verify(ios, 'Error in nf90_open in NoahMP50_read_OPT_param') + + ! inquire the ID of east-west dimension + ios = nf90_inq_dimid(nid, 'east_west', nc_ID) + call LIS_verify(ios, & + 'Error in nf90_inq_dimid in NoahMP50_read_OPT_param') + + ! inquire the ID of north-south dimension + ios = nf90_inq_dimid(nid, 'north_south', nr_ID) + call LIS_verify(ios, & + 'Error in nf90_inq_dimid in NoahMP50_read_OPT_param') + + ! inquire the length of east-west dimension + ios = nf90_inquire_dimension(nid, nc_ID, len=nc) + call LIS_verify(ios, & + 'Error in nf90_inquire_dimension in NoahMP50_read_OPT_param') + + ! inquire the length of north-south dimension + ios = nf90_inquire_dimension(nid, nr_ID, len=nr) + call LIS_verify(ios, & + 'Error in nf90_inquire_dimension in NoahMP50_read_OPT_param') + + ! inquire the ID of parameter. + ios = nf90_inq_varid(nid, Trim(ncvar_name), param_ID) + if(ios.eq.0) then + ! inquire the IDs of all dimensions. The third dimension is the level dimension + ios = nf90_inquire_variable(nid, param_ID, dimids = dimids) + call LIS_verify(ios, trim(ncvar_name)//' failed to inquire dimensions') + + ! allocate memory + allocate(level_data (LIS_rc%gnc(n), LIS_rc%gnr(n))) + + ! inquire the variable ID of parameter + ios = nf90_inq_varid(nid, trim(ncvar_name), param_ID) + call LIS_verify(ios, trim(ncvar_name)//& + ' field not found in the LIS param file') + + ! read parameter + ios = nf90_get_var(nid, param_ID, level_data) + call LIS_verify(ios, 'Error in nf90_get_var in NoahMP50_read_OPT_param') + + ! grab parameter at specific level + placeholder(:, :) = & + level_data(LIS_ews_halo_ind(n, LIS_localPet+1):LIS_ewe_halo_ind(n, LIS_localPet+1), & + LIS_nss_halo_ind(n, LIS_localPet+1):LIS_nse_halo_ind(n, LIS_localPet+1)) + + deallocate(level_data) + + var_found = .true. + else + write(LIS_logunit,*) '[WARN] ', trim(ncvar_name)//& + ' field not found in the LIS param file' + endif + + ! close netcdf file + ios = nf90_close(nid) + call LIS_verify(ios, 'Error in nf90_close in NoahMP50_read_OPT_param') + + endif + +end subroutine NoahMP50_read_OPT_param diff --git a/lis/surfacemodels/land/noahmp.5.0/NoahMP50_readcrd.F90 b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_readcrd.F90 new file mode 100644 index 000000000..4df48d44f --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_readcrd.F90 @@ -0,0 +1,640 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- + +!BOP +! +! !ROUTINE: NoahMP50_readcrd +! \label{NoahMP50\_readcrd} +! +! !REVISION HISTORY: +! This subroutine is generated with the Model Implementation Toolkit developed +! by Shugong Wang for the NASA Land Information System Version 7. The initial +! specification of the subroutine is defined by Sujay Kumar. +! 10/25/18 : Shugong Wang, Zhuo Wang, initial implementation for LIS 7 and NoahMP401 +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !INTERFACE: + +subroutine NoahMP50_readcrd() +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc , LIS_config + use LIS_timeMgrMod, only : LIS_parseTimeString + use LIS_logMod, only : LIS_logunit, LIS_verify, LIS_endrun + use NoahMP50_lsmMod, only : Noahmp50_struc + use netcdf +! +! !DESCRIPTION: +! +! This routine reads the options specific to NoahMP50 model from +! the LIS configuration file. +! +!EOP + implicit none + + integer :: rc + integer :: n, i + character*10 :: time + character*6 :: str_i + integer :: ios + integer, allocatable :: nids(:) + character*32 :: soil_scheme_name, landuse_scheme_name + + allocate(nids(LIS_rc%nnest)) + + write(LIS_logunit,*) & + "[INFO] Start reading LIS configuration file for Noah-MP.5.0 (v5.0 or newer)" + + ! open NetCDF parameter file for reading global attributes + do n=1,LIS_rc%nnest + ios = nf90_open(path=trim(LIS_rc%paramfile(n)), mode=NF90_NOWRITE,ncid=nids(n)) + call LIS_verify(ios,'Error in nf90_open in '//trim(LIS_rc%paramfile(n))//' in NoahMP50_readcrd') + enddo + + ! main Noah-MP model timestep + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 model timestep:", rc = rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Time, rc = rc) + call LIS_verify(rc, "Noah-MP.5.0 model timestep: not defined") + call LIS_parseTimeString(time, Noahmp50_struc(n)%ts) + enddo + + ! Noah-MP soil process timestep + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 soil timestep:", rc = rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Time, rc = rc) + call LIS_verify(rc, "Noah-MP.5.0 soil timestep: not defined") + call LIS_parseTimeString(time, Noahmp50_struc(n)%ts_soil) + enddo + + ! restart timestep + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 restart output interval:", rc = rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Time, rc = rc) + call LIS_verify(rc, & + "Noah-MP.5.0 restart output interval: not defined") + call LIS_parseTimeString(time, Noahmp50_struc(n)%rstInterval) + enddo + + ! model domain size dx (meter) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 domain resolution dx:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%dx, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 domain resolution dx: not defined") + enddo + + ! model domain size dy (meter) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 domain resolution dy:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%dy, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 domain resolution dy: not defined") + enddo + + !---------------------------! + ! Constant Parameters ! + !---------------------------! + ! number of soil layers + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 number of soil layers:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%nsoil, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 number of soil layers: not defined") + enddo + + ! allocate memory for sldpth using nsoil as dimension + do n=1, LIS_rc%nnest + allocate(Noahmp50_struc(n)%sldpth(Noahmp50_struc(n)%nsoil)) + enddo + ! allocate memory for init_smc using nsoil as dimension + do n=1, LIS_rc%nnest + allocate(Noahmp50_struc(n)%init_smc(Noahmp50_struc(n)%nsoil)) + enddo + ! allocate memory for init_tslb using nsoil as dimension + do n=1, LIS_rc%nnest + allocate(Noahmp50_struc(n)%init_tslb(Noahmp50_struc(n)%nsoil)) + enddo + + ! maximum number of snow layers (e.g., 3) + do n=1, LIS_rc%nnest + Noahmp50_struc(n)%nsnow = 3 + enddo + + ! thickness of atmospheric layers + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 reference height of temperature and humidity:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%dz8w, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 reference height of temperature and "//& + "humidity: not defined") + enddo + + ! thickness of soil layers + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 thickness of soil layers:", rc = rc) + do n=1, LIS_rc%nnest + do i = 1, Noahmp50_struc(n)%nsoil + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%sldpth(i), rc=rc) + call LIS_verify(rc, & + 'Noah-MP.5.0 thickness of soil layers: not defined') + enddo + enddo + + ! Landuse classification scheme + do n=1, LIS_rc%nnest + ios = nf90_get_att(nids(n), NF90_GLOBAL, 'LANDCOVER_SCHEME', landuse_scheme_name) + call LIS_verify(ios, 'Error in nf90_get_att: LANDCOVER_SCHEME') + if (trim(landuse_scheme_name) .eq. "USGS") then + Noahmp50_struc(n)%landuse_scheme_name = "USGS" + elseif (trim(landuse_scheme_name) .eq. "IGBPNCEP") then + Noahmp50_struc(n)%landuse_scheme_name = & + "MODIFIED_IGBP_MODIS_NOAH" + elseif (trim(landuse_scheme_name) .eq. "NALCMS_SM_IGBPNCEP" ) then + Noahmp50_struc(n)%landuse_scheme_name = & + "MODIFIED_IGBP_MODIS_NOAH" + elseif (trim(landuse_scheme_name) .eq. "UMD") then + Noahmp50_struc(n)%landuse_scheme_name = "UMD" + else + write(LIS_logunit,*) & + "[ERR] Currently, only USGS, IGBPNCEP, and UMD" + write(LIS_logunit,*) "[ERR] are supported by Noah-MP.5.0 LSM" + write(LIS_logunit,*) "[ERR] program stopping ..." + call LIS_endrun() + endif + enddo + + ! Noah-MP.5.0 parameter table (merged SOILPARM.TBL,GENPARM.TBL,MPTABLE.TBL) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 parameter table:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%noahmp_tbl_name, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 parameter table: not defined") + enddo + + write(LIS_logunit,*) & + "[INFO] Setting Noah-MP.5.0 physics options:" + + ! dynamic vegetation + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 dynamic vegetation option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%dveg_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 dynamic vegetation option: not defined") + write(LIS_logunit,33) "dynamic vegetation:", & + Noahmp50_struc(n)%dveg_opt + enddo + + ! canopy stomatal resistance (1->Ball-Berry; 2->Jarvis) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 canopy stomatal resistance option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%crs_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 canopy stomatal resistance option: not defined") + write(LIS_logunit,33) "canopy stomatal resistance:", & + Noahmp50_struc(n)%crs_opt + enddo + + ! soil moisture factor for stomatal resistance(1->Noah;2->CLM;3->SSiB) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 soil moisture factor for stomatal resistance:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%btr_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 soil moisture factor for stomatal resistance:"//& + " not defined") + write(LIS_logunit,33) "soil moisture factor for stomatal "//& + "resistance:",Noahmp50_struc(n)%btr_opt + enddo + + ! surface runoff (1->SIMGM; 2->SIMTOP; 3->Schaake96; 4->BATS; 5->MMF; 6->VIC; 7->XAJ; 8->DynVIC) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 surface runoff option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%runsfc_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 surface runoff option: not defined") + write(LIS_logunit,33) "surface runoff:", & + Noahmp50_struc(n)%runsfc_opt + enddo + + ! subsurface runoff and groundwater (1->SIMGM; 2->SIMTOP; 3->Schaake96; 4->BATS; 5->MMF; 6->VIC; 7->XAJ; 8->DynVIC) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 subsurface runoff and groundwater option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%runsub_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 subsurface runoff and groundwater option: not defined") + write(LIS_logunit,33) "subsurface runoff and groundwater:", & + Noahmp50_struc(n)%runsub_opt + enddo + + ! infiltration options for dynamic VIC (1->Philip; 2-> Green-Ampt;3->Smith-Parlange) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 dynamic VIC infiltration option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%infdv_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 dynamic VIC infiltration option: not defined") + write(LIS_logunit,33) "dynamic VIC infiltration:", & + Noahmp50_struc(n)%infdv_opt + enddo + + ! surface layer drag coeff (CH & CM) (1->M-O; 2->Chen97) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 surface layer drag coefficient option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%sfc_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 surface layer drag coefficient option:"//& + " not defined") + write(LIS_logunit,33) "surface layer drag coefficient:", & + Noahmp50_struc(n)%sfc_opt + enddo + + ! supercooled liquid water (1->NY06; 2->Koren99) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 supercooled liquid water option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%frz_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 supercooled liquid water option: not defined") + write(LIS_logunit,33) "supercooled liquid water:", & + Noahmp50_struc(n)%frz_opt + enddo + + ! frozen soil permeability (1->NY06; 2->Koren99) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 frozen soil permeability option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%inf_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 frozen soil permeability option: not defined") + write(LIS_logunit,33) "frozen soil permeability:", & + Noahmp50_struc(n)%inf_opt + enddo + + ! radiation transfer (1->gap=F(3D,cosz); 2->gap=0; 3->gap=1-Fveg) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 canopy radiative transfer option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%rad_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 canopy radiative transfer option: not defined") + write(LIS_logunit,33) "canopy radiative transfer:", & + Noahmp50_struc(n)%rad_opt + enddo + + ! snow surface albedo (1->BATS; 2->CLASS) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 snow surface albedo option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%alb_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 snow surface albedo option: not defined") + write(LIS_logunit,33) "snow surface albedo:", & + Noahmp50_struc(n)%alb_opt + enddo + + ! rainfall & snowfall (1->Jordan91; 2->BATS; 3->Noah; 4->WRF; 5->Wet-bulb) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 rain-snow partition option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%snf_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 rain-snow partition option: not defined") + write(LIS_logunit,33) "rain-snow partition:", & + Noahmp50_struc(n)%snf_opt + enddo + + ! lower boundary of soil temperature + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 lower boundary of soil temperature option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%tbot_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 lower boundary of soil temperature option:"//& + " not defined") + write(LIS_logunit,33) "lower boundary of soil temperature:", & + Noahmp50_struc(n)%tbot_opt + enddo + + ! snow/soil temperature time scheme + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 snow&soil temperature time scheme option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%stc_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 snow&soil temperature time scheme option:"//& + " not defined") + write(LIS_logunit,33) "snow&soil temperature time scheme:", & + Noahmp50_struc(n)%stc_opt + enddo + + ! glacier option (1->phase change; 2->simple) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 glacier ice option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%gla_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 glacier ice option: not defined") + write(LIS_logunit,33) "glacier ice:",Noahmp50_struc(n)%gla_opt + enddo + + ! Custom snowpack depth for glacier model (in mm) + !=== Now this parameter is set in the NoahmpTable.TBL ("SWEMAXGLA", default=5000mm) + !call ESMF_ConfigFindLabel(LIS_config, & + ! "Noah-MP.5.0 snow depth glacier model option:", rc = rc) + !if(rc /= 0) then + ! write(LIS_logunit,33) "[WARN] Max snow depth not defined." + ! write(LIS_logunit,33) "[WARN] Setting to default value of 5000." + ! do n=1, LIS_rc%nnest + ! Noahmp50_struc(n)%sndpth_gla_opt = 5000 + ! write(LIS_logunit,33) "snow depth for glacier model: ",Noahmp50_struc(n)%sndpth_gla_opt + ! enddo + !else + ! do n=1, LIS_rc%nnest + ! call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%sndpth_gla_opt, rc=rc) + ! write(LIS_logunit,33) "snow depth for glacier model: ",Noahmp50_struc(n)%sndpth_gla_opt + ! enddo + !endif + + ! surface resistance (1->Sakaguchi/Zeng;2->Seller;3->mod Sellers;4->1+snow) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 surface resistance option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%rsf_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 surface resistance option: not defined") + write(LIS_logunit,33) "surface resistance:", & + Noahmp50_struc(n)%rsf_opt + enddo + + ! soil configuration option + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 soil configuration option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%soil_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 soil configuration option: not defined") + write(LIS_logunit,33) "soil configuration:", & + Noahmp50_struc(n)%soil_opt + enddo + + ! soil pedotransfer function option + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 soil pedotransfer function option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%pedo_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 soil pedotransfer function option: not defined") + write(LIS_logunit,33) "soil pedotransfer function:", & + Noahmp50_struc(n)%pedo_opt + enddo + + ! crop model option (0->none; 1->Liu2016) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 crop model option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%crop_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 crop model option: not defined") + write(LIS_logunit,33) "crop model:", & + Noahmp50_struc(n)%crop_opt + enddo + + ! urban physics option + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 urban physics option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%urban_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 urban physics option: not defined") + write(LIS_logunit,33) "urban physics:", & + Noahmp50_struc(n)%urban_opt + enddo + + ! snow thermal conductivity option (1->Yen1965; 2->Anderson1976; 3->Constant; 4->Verseghy1991; 5->Yen1981) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 snow thermal conductivity option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%tksno_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 snow thermal conductivity option: not defined") + write(LIS_logunit,33) "snow thermal conductivity:",Noahmp50_struc(n)%tksno_opt + enddo + + ! irrigation option (0->none; 1->always on; 2->trigger by planting/harvest dates; 3->trigger by LAI) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 irrigation trigger option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%irr_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 irrigation trigger option: not defined") + write(LIS_logunit,33) "irrigation trigger:",Noahmp50_struc(n)%irr_opt + enddo + + ! irrigation method option (0->fraction from input; 1->sprinkler; 2->micro/drip; 3->flood) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 irrigation method option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%irrm_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 irrigation method option: not defined") + write(LIS_logunit,33) "irrigation method:",Noahmp50_struc(n)%irrm_opt + enddo + + ! tile drainage option (0->none; 1->simple drainage; 2->Hooghoudt's scheme) + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 tile drainage option:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%tdrn_opt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 tile drainage option: not defined") + write(LIS_logunit,33) "tile drainage:",Noahmp50_struc(n)%tdrn_opt + enddo + + + ! The following lines hard code the LDT NetCDF variable names. + ! Modified by Zhuo Wang on 11/08/2018 + ! Setting some values to PLANTING, HARVEST, SEASON_GDD, SOILCOMP, SOILCL1-->SOILCL4 in NoahMP50_main.F90 + do n=1, LIS_rc%nnest + ! Noahmp50_struc(n)%LDT_ncvar_vegetype = ' ! Edit here if hard code name + ! Noahmp50_struc(n)%LDT_ncvar_soiltype = ' ! Edit here if hard code name + Noahmp50_struc(n)%LDT_ncvar_tbot = 'TBOT' !'NoahMP50_TBOT' + Noahmp50_struc(n)%LDT_ncvar_shdfac_monthly = 'GREENNESS' !'NoahMP50_SHDFAC_MONTHLY' + Noahmp50_struc(n)%LDT_ncvar_planting = 'PLANTING' !'NoahMP50_PLANTING' + Noahmp50_struc(n)%LDT_ncvar_harvest = 'HARVEST' !'NoahMP50_HARVEST' + Noahmp50_struc(n)%LDT_ncvar_season_gdd = 'SEASON_GDD' !'NoahMP50_SEASON_GDD' + Noahmp50_struc(n)%LDT_ncvar_soilcomp = 'SOILCOMP' !'NoahMP50_SOILCOMP' + Noahmp50_struc(n)%LDT_ncvar_soilcL1 = 'SOILCL1' !'NoahMP50_SOILCL1' + Noahmp50_struc(n)%LDT_ncvar_soilcL2 = 'SOILCL2' !'NoahMP50_SOILCL2' + Noahmp50_struc(n)%LDT_ncvar_soilcL3 = 'SOILCL3' !'NoahMP50_SOILCL3' + Noahmp50_struc(n)%LDT_ncvar_soilcL4 = 'SOILCL4' !'NoahMP50_SOILCL4' + Noahmp50_struc(n)%LDT_ncvar_irfract = 'IRFRACT' + Noahmp50_struc(n)%LDT_ncvar_sifract = 'SIFRACT' + Noahmp50_struc(n)%LDT_ncvar_mifract = 'MIFRACT' + Noahmp50_struc(n)%LDT_ncvar_fifract = 'FIFRACT' + Noahmp50_struc(n)%LDT_ncvar_tdfract = 'TD_FRACTION' + Noahmp50_struc(n)%LDT_ncvar_fdepth = 'FDEPTH' + Noahmp50_struc(n)%LDT_ncvar_eqzwt = 'EQZWT' + Noahmp50_struc(n)%LDT_ncvar_rechclim = 'RECHCLIM' + Noahmp50_struc(n)%LDT_ncvar_riverbed = 'RIVERBED' + enddo + +!------------------------------------------------------------------------------------------ + ! set default restart format to netcdf + do n=1,LIS_rc%nnest + Noahmp50_struc(n)%rformat = "netcdf" + enddo + ! restart run, read restart file + if (trim(LIS_rc%startcode) == "restart") then + Call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 restart file:", rc=rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%rfile, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 restart file: not defined") + enddo + + Call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 restart file format:", rc=rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%rformat, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 restart file format: not defined") + enddo + + ! coldstart run, read initial state variables + else + ! skin temperature + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 initial surface skin temperature:", rc = rc) + do n=1, LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%init_tskin, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 initial surface skin temperature:"//& + " not defined") + enddo + + ! snow water equivalent + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 initial snow water equivalent:", rc = rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%init_sneqv, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 initial snow water equivalent:"//& + " not defined") + enddo + + ! physical snow depth + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 initial snow depth:", rc = rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%init_snowh, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 initial snow depth:"//& + " not defined") + enddo + + ! total canopy water + ice + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 initial total canopy surface water:", rc = rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%init_canwat, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 initial total canopy surface water:"//& + " not defined") + enddo + + ! soil temperature + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 initial soil temperatures:", rc = rc) + do n=1,LIS_rc%nnest + do i=1, Noahmp50_struc(n)%nsoil + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%init_tslb(i), rc=rc) + end do + call LIS_verify(rc, & + "Noah-MP.5.0 initial soil temperatures:"//& + " not defined") + enddo + + ! volumetric soil moisture + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 initial total soil moistures:", rc = rc) + do n=1,LIS_rc%nnest + do i=1, Noahmp50_struc(n)%nsoil + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%init_smc(i), rc=rc) + end do + call LIS_verify(rc, & + "Noah-MP.5.0 initial total soil moistures:"//& + " not defined") + enddo + + ! water table depth + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 initial water table depth:", rc = rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%init_zwt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 initial water table depth:"//& + " not defined") + enddo + + ! water in the "aquifer" + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 initial water in the aquifer:", rc = rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%init_wa, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 initial water in the aquifer:"//& + " not defined") + enddo + + ! water in aquifer and saturated soil + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 initial water in aquifer and saturated soil:", rc = rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%init_wt, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 initial water in aquifer and saturated soil:"//& + " not defined") + enddo + + ! leaf area index + call ESMF_ConfigFindLabel(LIS_config, & + "Noah-MP.5.0 initial leaf area index:", rc = rc) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config, Noahmp50_struc(n)%init_lai, rc=rc) + call LIS_verify(rc, & + "Noah-MP.5.0 initial leaf area index:"//& + " not defined") + enddo + + endif + + deallocate(nids) + + 33 format(a47,i4) + + write(LIS_logunit, *) & + "[INFO] Finish reading LIS configuration file for Noah-MP.5.0" + +end subroutine NoahMP50_readcrd diff --git a/lis/surfacemodels/land/noahmp.5.0/NoahMP50_readrst.F90 b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_readrst.F90 new file mode 100644 index 000000000..bcc48af5a --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_readrst.F90 @@ -0,0 +1,554 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- + +#include "LIS_misc.h" +!BOP +! +! !ROUTINE: NoahMP50_readrst +! \label{NoahMP50_readrst} +! +! !REVISION HISTORY: +! This subroutine is generated with the Model Implementation Toolkit developed +! by Shugong Wang for the NASA Land Information System Version 7. The initial +! specification of the subroutine is defined by Sujay Kumar. +! 10/25/18: Shugong Wang, Zhuo Wang; initial implementation for LIS 7 and Noah-MP-4.0.1 +! 01/08/2021 Bailing Li; implemented code for reading GRACE DA restart file +! May 2023: Cenlin He, modified for refactored NoahMP v5 and later + +! !INTERFACE: +subroutine NoahMP50_readrst() +! !USES: + use LIS_coreMod, only : LIS_rc, LIS_masterproc + use LIS_historyMod, only : LIS_readvar_restart + use LIS_logMod, only : LIS_logunit, LIS_endrun, & + LIS_getNextUnitNumber, & + LIS_releaseUnitNumber, & + LIS_verify + use LIS_constantsMod, only : LIS_CONST_PATH_LEN + use NoahMP50_lsmMod + use ESMF + use LIS_fileIOMod + use LIS_timeMgrMod + +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + use netcdf +#endif + +! +! !DESCRIPTION: +! This program reads restart files for Noah-MP-4.0.1 LSM. +! This includes all relevant water/energy storages and tile information. +! The following is the list of variables specified in the Noah-MP-4.0.1 +! restart file: +! \begin{verbatim} +! nc, nr, ntiles - grid and tile space dimensions +! sfcrunoff - NoahMP accumulated surface runoff [m] +! udrrunoff - NoahMP accumulated sub-surface runoff [m] +! smc - NoahMP volumtric soil moisture [m3/m3] +! sh2o - NoahMP volumtric liquid soil moisture [m3/m3] +! tslb - NoahMP soil temperature [K] +! sneqv - NoahMP snow water equivalent [mm] +! snowh - NoahMP physical snow depth [m] +! canwat - NoahMP total canopy water + ice [mm] +! acsnom - NoahMP accumulated snow melt leaving pack [-] +! acsnow - NoahMP accumulated snow on grid [mm] +! isnow - NoahMP actual no. of snow layers [-] +! tv - NoahMP vegetation leaf temperature [K] +! tg - NoahMP bulk ground surface temperature [K] +! canice - NoahMP canopy-intercepted ice [mm] +! canliq - NoahMP canopy-intercepted liquid water [mm] +! eah - NoahMP canopy air vapor pressure [Pa] +! tah - NoahMP canopy air temperature [K] +! cm - NoahMP bulk momentum drag coefficient [-] +! ch - NoahMP bulk sensible heat exchange coefficient [-] +! fwet - NoahMP wetted or snowed fraction of canopy [-] +! sneqvo - NoahMP snow mass at last time step [mm h2o] +! albold - NoahMP snow albedo at last time step [-] +! qsnow - NoahMP snowfall on the ground [mm/s] +! wslake - NoahMP lake water storage [mm] +! zwt - NoahMP water table depth [m] +! wa - NoahMP water in the "aquifer" [mm] +! wt - NoahMP water in aquifer and saturated soil [mm] +! tsno - NoahMP snow layer temperature [K] +! zss - NoahMP snow/soil layer depth from snow surface [m] +! snowice - NoahMP snow layer ice [mm] +! snowliq - NoahMP snow layer liquid water [mm] +! lfmass - NoahMP leaf mass [g/m2] +! rtmass - NoahMP mass of fine roots [g/m2] +! stmass - NoahMP stem mass [g/m2] +! wood - NoahMP mass of wood (including woody roots) [g/m2] +! stblcp - NoahMP stable carbon in deep soil [g/m2] +! fastcp - NoahMP short-lived carbon in shallow soil [g/m2] +! lai - NoahMP leaf area index [-] +! sai - NoahMP stem area index [-] +! tauss - NoahMP snow age factor [-] +! smoiseq - NoahMP equilibrium volumetric soil moisture content [m3/m3] +! smcwtd - NoahMP soil moisture content in the layer to the water table when deep [-] +! deeprech - NoahMP recharge to the water table when deep [-] +! rech - NoahMP recharge to the water table (diagnostic) [-] +! grain - NoahMP mass of grain XING [g/m2] +! gdd - NoahMP growing degree days XING (based on 10C) [-] +! pgs - NoahMP growing degree days XING [-] +! \end{verbatim} +! +! The routines invoked are: +! \begin{description} +! \item[LIS\_readvar\_restart](\ref{LIS_readvar_restart})\\ +! reads a variable from the restart file +! \item[NoahMP50\_coldstart](\ref{NoahMP50_coldstart})\\ +! initializes the NoahMP state variables +! \end{description} +!EOP + + implicit none + + integer :: t, l + integer :: nc, nr, npatch + integer :: n + integer :: ftn + integer :: status + real, allocatable :: tmptilen(:) + logical :: file_exists + character*20 :: wformat + character(len=LIS_CONST_PATH_LEN) :: filen + integer :: yr,mo,da,hr,mn,ss,doy + real*8 :: time + real :: gmt + real :: ts + + + do n=1, LIS_rc%nnest + wformat = trim(NoahMP50_struc(n)%rformat) + ! coldstart + if(LIS_rc%startcode .eq. "coldstart") then + call NoahMP50_coldstart(LIS_rc%lsm_index) + ! restart + elseif(LIS_rc%startcode .eq. "restart") then + !---create restart filename based on timewindow for EnKS + if(LIS_rc%runmode.eq."ensemble smoother") then + if(LIS_rc%iterationId(n).gt.1) then + if(NoahMP50_struc(n)%rstInterval.eq.2592000) then + !create the restart filename based on the timewindow start time + call ESMF_TimeGet(LIS_twStartTime,yy=yr,mm=mo,& + dd=da,calendar=LIS_calendar,rc=status) + hr = 0 + mn = 0 + ss = 0 + call LIS_tick(time,doy,gmt,yr,mo,da,hr,mn,ss,(-1)*LIS_rc%ts) + else + call ESMF_TimeGet(LIS_twStartTime,yy=yr,mm=mo,& + dd=da,calendar=LIS_calendar,rc=status) + hr = 0 + mn = 0 + ss = 0 + endif + + call LIS_create_restart_filename(n,filen,'SURFACEMODEL','NoahMP50', & + yr,mo,da,hr,mn,ss, wformat=wformat) + NoahMP50_struc(n)%rfile = filen + endif + endif + + + allocate(tmptilen(LIS_rc%npatch(n, LIS_rc%lsm_index))) + ! check the existance of restart file + inquire(file=NoahMP50_struc(n)%rfile, exist=file_exists) + If (.not. file_exists) then + write(LIS_logunit,*) "[ERR] Noah-MP.5.0 restart file: ", & + trim(NoahMP50_struc(n)%rfile) + write(LIS_logunit,*) "[ERR] does not exist." + write(LIS_logunit,*) "[ERR] Program stopping ..." + call LIS_endrun + endif + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 restart file used: ",trim(NoahMP50_struc(n)%rfile) + + ! open restart file + if(wformat .eq. "binary") then + ftn = LIS_getNextUnitNumber() + open(ftn, file=NoahMP50_struc(n)%rfile, & + form="unformatted") + read(ftn) nc, nr, npatch !time, veg class, no. tiles + + ! check for grid space conflict + if((nc .ne. LIS_rc%gnc(n)) .or. (nr .ne. LIS_rc%gnr(n))) then + write(LIS_logunit,*) "[ERR]",trim(NoahMP50_struc(n)%rfile) + write(LIS_logunit,*) "[ERR] grid space mismatch" + write(LIS_logunit,*) "[ERR] Program stopping..." + call LIS_endrun + endif + + if(npatch .ne. LIS_rc%glbnpatch_red(n, LIS_rc%lsm_index)) then + write(LIS_logunit,*) "[ERR]",trim(NoahMP50_struc(n)%rfile) + write(LIS_logunit,*) "[ERR] tile space mismatch" + write(LIS_logunit,*) "[ERR] Program stopping..." + call LIS_endrun + endif + elseif(wformat .eq. "netcdf") then +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + status = nf90_open(path=NoahMP50_struc(n)%rfile, & + mode=NF90_NOWRITE, ncid=ftn) + call LIS_verify(status, "Error opening file "//NoahMP50_struc(n)%rfile) +#endif + endif + + ! read: accumulated surface runoff + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%sfcrunoff, & + varname="SFCRUNOFF", wformat=wformat) + + ! read: accumulated sub-surface runoff + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%udrrunoff, & + varname="UDRRUNOFF", wformat=wformat) + + ! read: volumtric soil moisture + do l=1, NoahMP50_struc(n)%nsoil ! TODO: check loop + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, varname="SMC", & + dim=l, vlevels = NoahMP50_struc(n)%nsoil, wformat=wformat) + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + NoahMP50_struc(n)%noahmp50(t)%smc(l) = tmptilen(t) + enddo + enddo + + ! read: volumtric liquid soil moisture + do l=1, NoahMP50_struc(n)%nsoil ! TODO: check loop + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, varname="SH2O", & + dim=l, vlevels = NoahMP50_struc(n)%nsoil, wformat=wformat) + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + NoahMP50_struc(n)%noahmp50(t)%sh2o(l) = tmptilen(t) + enddo + enddo + + ! read: soil temperature + do l=1, NoahMP50_struc(n)%nsoil ! TODO: check loop + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, varname="TSLB", & + dim=l, vlevels = NoahMP50_struc(n)%nsoil, wformat=wformat) + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + NoahMP50_struc(n)%noahmp50(t)%tslb(l) = tmptilen(t) + enddo + enddo + + ! read: snow water equivalent + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%sneqv, & + varname="SNEQV", wformat=wformat) + + ! read: physical snow depth + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%snowh, & + varname="SNOWH", wformat=wformat) + + ! read: total canopy water + ice + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%canwat, & + varname="CANWAT", wformat=wformat) + + ! read: accumulated snow melt leaving pack + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%acsnom, & + varname="ACSNOM", wformat=wformat) + + ! read: accumulated snow on grid + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%acsnow, & + varname="ACSNOW", wformat=wformat) + + ! read: actual no. of snow layers + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%isnow, & + varname="ISNOW", wformat=wformat) + + ! read: vegetation leaf temperature + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%tv, & + varname="TV", wformat=wformat) + + ! read: bulk ground surface temperature + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%tg, & + varname="TG", wformat=wformat) + + ! read: canopy-intercepted ice + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%canice, & + varname="CANICE", wformat=wformat) + + ! read: canopy-intercepted liquid water + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%canliq, & + varname="CANLIQ", wformat=wformat) + + ! read: canopy air vapor pressure + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%eah, & + varname="EAH", wformat=wformat) + + ! read: canopy air temperature + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%tah, & + varname="TAH", wformat=wformat) + + ! read: bulk momentum drag coefficient + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%cm, & + varname="CM", wformat=wformat) + + ! read: bulk sensible heat exchange coefficient + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%ch, & + varname="CH", wformat=wformat) + + ! read: wetted or snowed fraction of canopy + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%fwet, & + varname="FWET", wformat=wformat) + + ! read: snow mass at last time step + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%sneqvo, & + varname="SNEQVO", wformat=wformat) + + ! read: snow albedo at last time step + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%albold, & + varname="ALBOLD", wformat=wformat) + + ! read: snowfall on the ground + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qsnow, & + varname="QSNOW", wformat=wformat) + + ! read: lake water storage + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%wslake, & + varname="WSLAKE", wformat=wformat) + + ! read: water table depth + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%zwt, & + varname="ZWT", wformat=wformat) + + ! read: water in the "aquifer" + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%wa, & + varname="WA", wformat=wformat) + + ! read: water in aquifer and saturated soil + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%wt, & + varname="WT", wformat=wformat) + + ! read: snow layer temperature + do l=1, NoahMP50_struc(n)%nsnow ! TODO: check loop + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, varname="TSNO", & + dim=l, vlevels = NoahMP50_struc(n)%nsnow, wformat=wformat) + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + NoahMP50_struc(n)%noahmp50(t)%tsno(l) = tmptilen(t) + enddo + enddo + + ! read: snow/soil layer depth from snow surface + do l=1, NoahMP50_struc(n)%nsnow + NoahMP50_struc(n)%nsoil + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, varname="ZSS", & + dim=l, vlevels = NoahMP50_struc(n)%nsnow + NoahMP50_struc(n)%nsoil, wformat=wformat) + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + NoahMP50_struc(n)%noahmp50(t)%zss(l) = tmptilen(t) + enddo + enddo + + ! read: snow layer ice + do l=1, NoahMP50_struc(n)%nsnow ! TODO: check loop + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, varname="SNOWICE", & + dim=l, vlevels = NoahMP50_struc(n)%nsnow, wformat=wformat) + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + NoahMP50_struc(n)%noahmp50(t)%snowice(l) = tmptilen(t) + enddo + enddo + + ! read: snow layer liquid water + do l=1, NoahMP50_struc(n)%nsnow ! TODO: check loop + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, varname="SNOWLIQ", & + dim=l, vlevels = NoahMP50_struc(n)%nsnow, wformat=wformat) + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + NoahMP50_struc(n)%noahmp50(t)%snowliq(l) = tmptilen(t) + enddo + enddo + + ! read: leaf mass + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%lfmass, & + varname="LFMASS", wformat=wformat) + + ! read: mass of fine roots + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%rtmass, & + varname="RTMASS", wformat=wformat) + + ! read: stem mass + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%stmass, & + varname="STMASS", wformat=wformat) + + ! read: mass of wood (including woody roots) + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%wood, & + varname="WOOD", wformat=wformat) + + ! read: stable carbon in deep soil + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%stblcp, & + varname="STBLCP", wformat=wformat) + + ! read: short-lived carbon in shallow soil + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%fastcp, & + varname="FASTCP", wformat=wformat) + + ! read: leaf area index + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%lai, & + varname="LAI", wformat=wformat) + + ! read: stem area index + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%sai, & + varname="SAI", wformat=wformat) + + ! read: snow age factor + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%tauss, & + varname="TAUSS", wformat=wformat) + + if (NoahMP50_struc(n)%runsub_opt == 5) then + ! read: equilibrium volumetric soil moisture content + do l=1, NoahMP50_struc(n)%nsoil ! TODO: check loop + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, varname="SMOISEQ", & + dim=l, vlevels = NoahMP50_struc(n)%nsoil, wformat=wformat) + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + NoahMP50_struc(n)%noahmp50(t)%smoiseq(l) = tmptilen(t) + enddo + enddo + + ! read: soil moisture content in the layer to the water table when deep + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%smcwtd, & + varname="SMCWTD", wformat=wformat) + + ! read: recharge to the water table when deep + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%deeprech, & + varname="DEEPRECH", wformat=wformat) + + ! read: recharge to the water table (diagnostic) + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%rech, & + varname="RECH", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%pexp, & + varname="PEXP", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%area, & + varname="AREA", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qrf, & + varname="QRF", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qspring, & + varname="QSPRING", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qslat, & + varname="QSLAT", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qrfs, & + varname="QRFS", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qsprings, & + varname="QSPRINGS", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%fdepth, & + varname="FDEPTH", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%rivercond, & + varname="RIVERCOND", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%riverbed, & + varname="RIVERBED", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%eqzwt, & + varname="EQZWT", wformat=wformat) + endif ! MMF groundwater + + ! for irrigation + if (NoahMP50_struc(n)%irr_opt >0) then + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irnumsi, & + varname="IRNUMSI", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irnummi, & + varname="IRNUMMI", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irnumfi, & + varname="IRNUMFI", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irwatsi, & + varname="IRWATSI", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irwatmi, & + varname="IRWATMI", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irwatfi, & + varname="IRWATFI", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irsivol, & + varname="IRSIVOL", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irmivol, & + varname="IRMIVOL", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irfivol, & + varname="IRFIVOL", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%ireloss, & + varname="IRELOSS", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irrsplh, & + varname="IRRSPLH", wformat=wformat) + endif ! irrigation + + ! for tile drainage + if (NoahMP50_struc(n)%tdrn_opt >0) then + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qtdrain, & + varname="QTDRAIN", wformat=wformat) + endif + + ! for crop + ! read: mass of grain XING + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%grain, & + varname="GRAIN", wformat=wformat) + + ! read: growing degree days XING (based on 10C) + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%gdd, & + varname="GDD", wformat=wformat) + + ! read: growing degree days XING + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%pgs, & + varname="PGS", wformat=wformat) + + ! for additional restart variables + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accssoil, & + varname="ACC_SSOIL", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accqinsur, & + varname="ACC_QINSUR", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accqseva, & + varname="ACC_QSEVA", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accdwater, & + varname="ACC_DWATER", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accprcp, & + varname="ACC_PRCP", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accecan, & + varname="ACC_ECAN", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accetran, & + varname="ACC_ETRAN", wformat=wformat) + + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accedir, & + varname="ACC_EDIR", wformat=wformat) + + do l=1, NoahMP50_struc(n)%nsoil ! TODO: check loop + call LIS_readvar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, varname="ACC_ETRANI", & + dim=l, vlevels = NoahMP50_struc(n)%nsoil, wformat=wformat) + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + NoahMP50_struc(n)%noahmp50(t)%accetrani(l) = tmptilen(t) + enddo + enddo + + ! close restart file + if(wformat .eq. "binary") then + call LIS_releaseUnitNumber(ftn) + elseif(wformat .eq. "netcdf") then +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + status = nf90_close(ftn) + call LIS_verify(status, & + "Error in nf90_close in NoahMP50_readrst") +#endif + endif + deallocate(tmptilen) + endif + enddo +end subroutine NoahMP50_readrst diff --git a/lis/surfacemodels/land/noahmp.5.0/NoahMP50_reset.F90 b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_reset.F90 new file mode 100644 index 000000000..f701ecd26 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_reset.F90 @@ -0,0 +1,57 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! +! !ROUTINE: NoahMP50_reset +! \label{NoahMP50_reset} +! +! !REVISION HISTORY: +! Modified by Shugong Wang for Noah-MP.4.0.1 +! modified by Cenlin He for refactored Noah-MP v5 and later + +! !INTERFACE: +subroutine NoahMP50_reset() +! !USES: + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_logunit + use NoahMP50_lsmMod + +! +! !DESCRIPTION: +! +! This routine is the entry point to set up the parameters +! required for Noah-MP LSM. These include the soils, greenness, +! albedo, bottom temperature and the initialization of state +! variables in Noah-MP. +! +!EOP + implicit none + integer :: t,n + integer :: status + + + do n=1,LIS_rc%nnest + write(LIS_logunit,*) "Noah-MP.5.0 resetting" + + ! initialize forcing variables to zeros + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + NoahMP50_struc(n)%noahmp50(t)%lwdown = 0.0 + NoahMP50_struc(n)%noahmp50(t)%swdown = 0.0 + NoahMP50_struc(n)%noahmp50(t)%psurf = 0.0 + NoahMP50_struc(n)%noahmp50(t)%prcp = 0.0 + NoahMP50_struc(n)%noahmp50(t)%tair = 0.0 + NoahMP50_struc(n)%noahmp50(t)%qair = 0.0 + NoahMP50_struc(n)%noahmp50(t)%wind_e = 0.0 + NoahMP50_struc(n)%noahmp50(t)%wind_n = 0.0 + enddo ! end of tile (t) loop + NoahMP50_struc(n)%forc_count = 0 + + enddo ! do n=1,LIS_rc%nnest +end subroutine NoahMP50_reset diff --git a/lis/surfacemodels/land/noahmp.5.0/NoahMP50_setup.F90 b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_setup.F90 new file mode 100644 index 000000000..106a5be9a --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_setup.F90 @@ -0,0 +1,810 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- + +#include "LIS_misc.h" +!BOP +! +! !ROUTINE: NoahMP50_setup +! \label{NoahMP50_setup} +! +! !REVISION HISTORY: +! This subroutine is generated with the Model Implementation Toolkit developed +! by Shugong Wang for the NASA Land Information System Version 7. The initial +! specification of the subroutine is defined by Sujay Kumar. +! 10/25/18: Shugong Wang, Zhuo Wang; initial implementation for LIS 7 and NoahMP50 +! 05/01/23: Cenlin He, update to work with refactored Noah-MP (v5.0 and later) +! !INTERFACE: + +subroutine NoahMP50_setup() + +! !USES: + use NoahMP50_lsmMod + use NoahmpIOVarType + use LIS_logMod, only: LIS_logunit, LIS_verify, LIS_endrun + use LIS_fileIOMod, only: LIS_read_param!, LIS_convertParamDataToLocalDomain + use LIS_coreMod, only: LIS_rc, LIS_surface + use NoahmpReadTableMod, only : NoahmpReadTable + use NoahmpIOVarInitMod, only : NoahmpIOVarInitDefault + +! +! !DESCRIPTION: +! +! This routine is the entry point to set up the parameters +! required for NoahMP50. These include: +! vegetype - vegetation type [-] +! soiltype - soil type [-] +! tbot - deep soil temperature [K] +! planting - planting date [-] +! harvest - harvest date [-] +! season_gdd - growing season GDD [-] +! soilcL1 - soil texture in layer 1 [-] +! soilcL2 - soil texture in layer 2 [-] +! soilcL3 - soil texture in layer 3 [-] +! soilcL4 - soil texture in layer 4 [-] +! irfract - total irrigation fraction [-] +! sifract - sprinker irrigation fraction [-] +! mifract - micro irrigation fraction [-] +! fifract - flood irrigation fraction [-] +! tdfract - tile drainage fraction [-] +! The routines invoked are: +! \begin{description} +! \item[LIS\_read\_param](\ref{LIS_read_param}) \\ +! retrieves LIS parameter data from NetCDF file +! \item[NoahMP50\_read\_MULTILEVEL\_param](\ref{NoahMP50_read_MULTILEVEL_param}) \\ +! retrieves MULTILEVEL spatial parameter from NetCDF file +! \end{description} +!EOP + + implicit none + integer :: mtype + integer :: t, k, n + integer :: col, row + real, allocatable :: placeholder(:,:) + integer :: soilcolor, vegtyp, soiltyp(4), slopetyp, croptype + mtype = LIS_rc%lsm_index + + do n=1, LIS_rc%nnest + ! allocate memory for place holder for #n nest + allocate(placeholder(LIS_rc%lnc(n), LIS_rc%lnr(n))) + + !----------------------------! + ! reading spatial parameters ! + !----------------------------! + ! vegetype takes value from the LIS built-in parameter vegt + !TODO: convert vegetation data source into vegetation types + if(LIS_rc%uselcmap(n) .ne. 'none') then + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 retrieve parameter VEGETYPE from LIS" + do t=1, LIS_rc%npatch(n, mtype) + NoahMP50_struc(n)%noahmp50(t)%vegetype= LIS_surface(n, mtype)%tile(t)%vegt + enddo + else + ! read: vegetype + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter VEGETYPE from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_vegetype), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%vegetype = placeholder(col, row) + enddo + endif + ! soiltype takes value from the LIS built-in parameter soilt + !TODO: convert soil texture into soil types according to scheme + if(LIS_rc%usetexturemap(n) .ne. 'none') then + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 retrieve parameter SOILTYPE from LIS" + do t=1, LIS_rc%npatch(n, mtype) + NoahMP50_struc(n)%noahmp50(t)%soiltype= LIS_surface(n, mtype)%tile(t)%soilt + enddo + else + ! read: soiltype + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter SOILTYPE from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_soiltype), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%soiltype = placeholder(col, row) + enddo + endif + ! read: tbot + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter TBOT from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_tbot), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%tbot = placeholder(col, row) + enddo + + !!! SW 11/06/2018 + if(NoahMP50_struc(n)%crop_opt > 0) then + ! read: planting + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter PLANTING from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_planting), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%planting = placeholder(col, row) + enddo + + ! read: harvest + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 reading parameter HARVEST from ",& + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_harvest), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%harvest = placeholder(col, row) + enddo + + ! read: season_gdd + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 reading parameter SEASON_GDD from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_season_gdd), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%season_gdd = placeholder(col, row) + enddo + endif + + ! CH 05/01/2023: for irrigation + if(NoahMP50_struc(n)%irr_opt > 0) then + ! read: total irrigation fraction + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter IRFRACT from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_irfract), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%irfract = placeholder(col, row) + enddo + + ! read: sprinkler irrigation fraction + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter SIFRACT from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_sifract), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%sifract = placeholder(col, row) + enddo + + ! read: micro/drip irrigation fraction + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter MIFRACT from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_mifract), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%mifract = placeholder(col, row) + enddo + + ! read: flood irrigation fraction + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter FIFRACT from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_fifract), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%fifract = placeholder(col, row) + enddo + endif + + ! CH 05/01/2023: for tile drainage + if(NoahMP50_struc(n)%tdrn_opt > 0) then + ! read: tile drainage fraction + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter TDFRACT from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_tdfract), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%tdfract = placeholder(col, row) + enddo + endif + + !!! SW 11/06/2018 + if(NoahMP50_struc(n)%soil_opt .eq. 2) then + ! read: soilcL1 + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 reading parameter SOILCL1 from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_soilcL1), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%soilcl1 = placeholder(col, row) + enddo + + ! read: soilcL2 + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 reading parameter SOILCL2 from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_soilcL2), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%soilcl2 = placeholder(col, row) + enddo + + ! read: soilcL3 + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 reading parameter SOILCL3 from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_soilcL3), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%soilcl3 = placeholder(col, row) + enddo + + ! read: soilcL4 + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 reading parameter SOILCL4 from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_soilcL4), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%soilcl4 = placeholder(col, row) + enddo + endif + + ! CH 05/01/2023: for MMF groundwater + if(NoahMP50_struc(n)%runsub_opt == 5) then + ! read: efolding depth for transmissivity (m) + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter FDEPTH from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_fdepth), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%fdepth = placeholder(col, row) + enddo + + ! read: equilibrium water table depth (m) + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter EQZWT from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_eqzwt), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%eqzwt = placeholder(col, row) + enddo + + ! read: riverbed depth (m) + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter RIVERBED from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_riverbed), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%riverbed = placeholder(col, row) + enddo + + ! read: climatology recharge + write(LIS_logunit,*) & + "[INFO] Noah-MP.5.0 reading parameter RECHCLIM from ", & + trim(LIS_rc%paramfile(n)) + call LIS_read_param(n, trim(NoahMP50_struc(n)%LDT_ncvar_rechclim), placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%rechclim = placeholder(col, row) + enddo + endif + + !----------------------------------------------! + ! MULTILEVEL reading spatial spatial parameters ! + !----------------------------------------------! + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 reading parameter SHDFAC_MONTHLY from ",& + trim(LIS_rc%paramfile(n)) + do k = 1, 12 + call NoahMP50_read_MULTILEVEL_param(n, NoahMP50_struc(n)%LDT_ncvar_shdfac_monthly, k, placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%shdfac_monthly(k) = placeholder(col, row) + enddo + enddo + + if(NoahMP50_struc(n)%soil_opt .eq. 3) then + ! read: soilcomp + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 reading parameter SOILCOMP from ", & + trim(LIS_rc%paramfile(n)) + do k = 1, 8 + call NoahMP50_read_MULTILEVEL_param(n, NoahMP50_struc(n)%LDT_ncvar_soilcomp, k, placeholder) + do t = 1, LIS_rc%npatch(n, mtype) + col = LIS_surface(n, mtype)%tile(t)%col + row = LIS_surface(n, mtype)%tile(t)%row + NoahMP50_struc(n)%noahmp50(t)%soilcomp(k) = placeholder(col, row) + enddo + enddo + endif + deallocate(placeholder) + + !!!! read Noah-MP parameter tables + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 parameter table (veg, soil, general): ", & + trim(NoahMP50_struc(n)%noahmp_tbl_name) + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 Landuse classification scheme: ", & + trim(NoahMP50_struc(n)%landuse_scheme_name) + write(LIS_logunit,*) "[INFO] Noah-MP.5.0 Soil classification scheme: ", & + "STAS (default, cannot change)" + call NoahmpReadTable(trim(NoahMP50_struc(n)%landuse_scheme_name), & + trim(NoahMP50_struc(n)%noahmp_tbl_name)) + + do t=1,LIS_rc%npatch(n,mtype) + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + VEGTYP = NoahMP50_struc(n)%noahmp50(t)%vegetype + SLOPETYP = 1 ! set underground runoff slope term + SOILCOLOR = 4 ! soil color: assuming a middle color category ????????? + CROPTYPE = 0 + if (NoahMP50_struc(n)%crop_opt > 0 .and. VEGTYP == NoahmpIO%ISCROP_TABLE) & + CROPTYPE = NoahmpIO%DEFAULT_CROP_TABLE + call TRANSFER_MP_PARAMETERS_NEW(VEGTYP,SOILTYP,SLOPETYP,SOILCOLOR,CROPTYPE,& + NoahMP50_struc(n)%noahmp50(t)%param) + enddo + + ! optional read of Optimized parameters + call NoahMP50_read_OPT_parameters() + + !-------- initialize NoahmpIO 1-D interface variables + NoahmpIO%xstart = 1 + NoahmpIO%xend = 1 + NoahmpIO%ystart = 1 + NoahmpIO%yend = 1 + NoahmpIO%ids = NoahmpIO%xstart + NoahmpIO%ide = NoahmpIO%xend + NoahmpIO%jds = NoahmpIO%ystart + NoahmpIO%jde = NoahmpIO%yend + NoahmpIO%kds = 1 + NoahmpIO%kde = 2 + NoahmpIO%its = NoahmpIO%xstart + NoahmpIO%ite = NoahmpIO%xend + NoahmpIO%jts = NoahmpIO%ystart + NoahmpIO%jte = NoahmpIO%yend + NoahmpIO%kts = 1 + NoahmpIO%kte = 2 + NoahmpIO%ims = NoahmpIO%xstart + NoahmpIO%ime = NoahmpIO%xend + NoahmpIO%jms = NoahmpIO%ystart + NoahmpIO%jme = NoahmpIO%yend + NoahmpIO%kms = 1 + NoahmpIO%kme = 2 + NoahmpIO%nsoil = NoahMP50_struc(n)%nsoil + NoahmpIO%nsnow = NoahMP50_struc(n)%nsnow + + call NoahmpIOVarInitDefault(NoahmpIO) ! initialize NoahmpIO to undefined/default value + !-------- NoahmpIO init complete + + enddo + +end subroutine NoahMP50_setup + +!BOP +! +! !ROUTINE: NoahMP50_read_MULTILEVEL_param +! \label{read_MULTILEVEL_param} +! +! !REVISION HISTORY: +! 03 Sept 2004: Sujay Kumar; Initial Specification for read_laiclimo +! 30 Oct 2013: Shugong Wang; Generalization for reading MULTILEVEL spatial parameter +! +! !INTERFACE: +subroutine NoahMP50_read_MULTILEVEL_param(n, ncvar_name, level, placeholder) +! !USES: + use netcdf + use LIS_coreMod, only : LIS_rc, LIS_domain, LIS_localPet, & + LIS_ews_halo_ind, LIS_ewe_halo_ind, & + LIS_nss_halo_ind, LIS_nse_halo_ind + use LIS_logMod, only : LIS_logunit, LIS_verify, LIS_endrun + use LIS_fileIOMod, only: LIS_read_param + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: level + character(len=*), intent(in) :: ncvar_name + real, intent(out) :: placeholder(LIS_rc%lnc(n), LIS_rc%lnr(n)) +! !DESCRIPTION: +! This subroutine reads MULTILEVEL parameters from the LIS +! NetCDF parameter data file +! +! The arguments are: +! \begin{description} +! \item[n] +! index of n +! \item[level] +! level index (month, quarter, soil layer, snow layer) of the data to be read +! \item[array] +! array containing returned values +! \end{description} +! +!EOP + + integer :: ios1 + integer :: ios, nid, param_ID, nc_ID, nr_ID, dimids(3) + integer :: nc, nr, t, nlevel, k + real, pointer :: level_data(:, :, :) + logical :: file_exists + + inquire(file=LIS_rc%paramfile(n), exist=file_exists) + if(file_exists) then + write(LIS_logunit, *) '[INFO] Reading '//trim(ncvar_name)//' map for level ', level + + ! open NetCDF parameter file + ios = nf90_open(path=trim(LIS_rc%paramfile(n)), mode=NF90_NOWRITE, ncid=nid) + call LIS_verify(ios, 'Error in nf90_open in NoahMP50_read_MULTILEVEL_param') + + ! inquire the ID of east-west dimension + ios = nf90_inq_dimid(nid, 'east_west', nc_ID) + call LIS_verify(ios, 'Error in nf90_inq_dimid in NoahMP50_read_MULTILEVEL_param') + + ! inquire the ID of north-south dimension + ios = nf90_inq_dimid(nid, 'north_south', nr_ID) + call LIS_verify(ios, 'Error in nf90_inq_dimid in NoahMP50_read_MULTILEVEL_param') + + ! inquire the length of east-west dimension + ios = nf90_inquire_dimension(nid, nc_ID, len=nc) + call LIS_verify(ios, 'Error in nf90_inquire_dimension in NoahMP50_read_MULTILEVEL_param') + + ! inquire the length of north-south dimension + ios = nf90_inquire_dimension(nid, nr_ID, len=nr) + call LIS_verify(ios, 'Error in nf90_inquire_dimension in NoahMP50_read_MULTILEVEL_param') + + ! inquire the ID of parameter. + ios = nf90_inq_varid(nid, Trim(ncvar_name), param_ID) + call LIS_verify(ios, trim(ncvar_name)//' field not found in the LIS param file') + + ! inquire the IDs of all dimensions. The third dimension is the level dimension + ios = nf90_inquire_variable(nid, param_ID, dimids = dimids) + call LIS_verify(ios, trim(ncvar_name)//' failed to inquire dimensions') + + ! inquire the length of the level dimension + ios = nf90_inquire_dimension(nid, dimids(3), len=nlevel) + call LIS_verify(ios, trim(ncvar_name)//' failed to inquire the length of the 3rd dimension') + + ! allocate memory + allocate(level_data (LIS_rc%gnc(n), LIS_rc%gnr(n), nlevel)) + + ! inquire the variable ID of parameter + ios = nf90_inq_varid(nid, trim(ncvar_name), param_ID) + call LIS_verify(ios, trim(ncvar_name)//' field not found in the LIS param file') + + ! read parameter + ios = nf90_get_var(nid, param_ID, level_data) + call LIS_verify(ios, 'Error in nf90_get_var in NoahMP50_read_MULTILEVEL_param') + + ! close netcdf file + ios = nf90_close(nid) + call LIS_verify(ios, 'Error in nf90_close in NoahMP50_read_MULTILEVEL_param') + + ! grab parameter at specific level + placeholder(:, :) = & + level_data(LIS_ews_halo_ind(n, LIS_localPet+1):LIS_ewe_halo_ind(n, LIS_localPet+1), & + LIS_nss_halo_ind(n, LIS_localPet+1):LIS_nse_halo_ind(n, LIS_localPet+1), level) + + ! free memory + deallocate(level_data) + + else + write(LIS_logunit, *) '[ERR] MULTILEVEL parameter data file: ', & + trim(LIS_rc%paramfile(n)) + write(LIS_logunit, *) '[ERR] does not exist.' + write(LIS_logunit, *) '[ERR] program stopping ...' + call LIS_endrun + endif + + end subroutine NoahMP50_read_MULTILEVEL_param + +SUBROUTINE TRANSFER_MP_PARAMETERS_NEW(VEGTYPE,SOILTYPE,SLOPETYPE,SOILCOLOR,CROPTYPE,parameters) + + use NoahmpIOVarType + use LisNoahmpParamType + + implicit none + + INTEGER, INTENT(IN) :: VEGTYPE + INTEGER, INTENT(IN) :: SOILTYPE(4) + INTEGER, INTENT(IN) :: SLOPETYPE + INTEGER, INTENT(IN) :: SOILCOLOR + INTEGER, INTENT(IN) :: CROPTYPE + + type(LisNoahmpParam_type), intent(inout) :: parameters + + REAL :: FRZFACT + INTEGER :: ISOIL + + parameters%ISWATER = NoahmpIO%ISWATER_TABLE + parameters%ISBARREN = NoahmpIO%ISBARREN_TABLE + parameters%ISICE = NoahmpIO%ISICE_TABLE + parameters%ISCROP = NoahmpIO%ISCROP_TABLE + parameters%EBLFOREST = NoahmpIO%EBLFOREST_TABLE + + parameters%URBAN_FLAG = .FALSE. + IF( VEGTYPE == NoahmpIO%ISURBAN_TABLE .or. VEGTYPE >= NoahmpIO%URBTYPE_beg ) THEN + parameters%URBAN_FLAG = .TRUE. + ENDIF + +!------------------------------------------------------------------------------------------! +! Transfer veg parameters +!------------------------------------------------------------------------------------------! + + parameters%CH2OP = NoahmpIO%CH2OP_TABLE(VEGTYPE) !maximum intercepted h2o per unit lai+sai (mm) + parameters%DLEAF = NoahmpIO%DLEAF_TABLE(VEGTYPE) !characteristic leaf dimension (m) + parameters%Z0MVT = NoahmpIO%Z0MVT_TABLE(VEGTYPE) !momentum roughness length (m) + parameters%HVT = NoahmpIO%HVT_TABLE(VEGTYPE) !top of canopy (m) + parameters%HVB = NoahmpIO%HVB_TABLE(VEGTYPE) !bottom of canopy (m) + parameters%DEN = NoahmpIO%DEN_TABLE(VEGTYPE) !tree density (no. of trunks per m2) + parameters%RC = NoahmpIO%RC_TABLE(VEGTYPE) !tree crown radius (m) + parameters%MFSNO = NoahmpIO%MFSNO_TABLE(VEGTYPE) !snowmelt m parameter () + parameters%SCFFAC = NoahmpIO%SCFFAC_TABLE(VEGTYPE) !snow cover factor (m) (replace original hard-coded 2.5*z0 in SCF formulation) + parameters%CBIOM = NoahmpIO%CBIOM_TABLE(VEGTYPE) !canopy biomass heat capacity parameter (m) + parameters%SAIM = NoahmpIO%SAIM_TABLE(VEGTYPE,:) !monthly stem area index, one-sided + parameters%LAIM = NoahmpIO%LAIM_TABLE(VEGTYPE,:) !monthly leaf area index, one-sided + parameters%SLA = NoahmpIO%SLA_TABLE(VEGTYPE) !single-side leaf area per Kg [m2/kg] + parameters%DILEFC = NoahmpIO%DILEFC_TABLE(VEGTYPE) !coeficient for leaf stress death [1/s] + parameters%DILEFW = NoahmpIO%DILEFW_TABLE(VEGTYPE) !coeficient for leaf stress death [1/s] + parameters%FRAGR = NoahmpIO%FRAGR_TABLE(VEGTYPE) !fraction of growth respiration !original was 0.3 + parameters%LTOVRC = NoahmpIO%LTOVRC_TABLE(VEGTYPE) !leaf turnover [1/s] + parameters%C3PSN = NoahmpIO%C3PSN_TABLE(VEGTYPE) !photosynthetic pathway: 0. = c4, 1. = c3 + parameters%KC25 = NoahmpIO%KC25_TABLE(VEGTYPE) !co2 michaelis-menten constant at 25c (pa) + parameters%AKC = NoahmpIO%AKC_TABLE(VEGTYPE) !q10 for kc25 + parameters%KO25 = NoahmpIO%KO25_TABLE(VEGTYPE) !o2 michaelis-menten constant at 25c (pa) + parameters%AKO = NoahmpIO%AKO_TABLE(VEGTYPE) !q10 for ko25 + parameters%VCMX25 = NoahmpIO%VCMX25_TABLE(VEGTYPE) !maximum rate of carboxylation at 25c (umol co2/m**2/s) + parameters%AVCMX = NoahmpIO%AVCMX_TABLE(VEGTYPE) !q10 for vcmx25 + parameters%BP = NoahmpIO%BP_TABLE(VEGTYPE) !minimum leaf conductance (umol/m**2/s) + parameters%MP = NoahmpIO%MP_TABLE(VEGTYPE) !slope of conductance-to-photosynthesis relationship + parameters%QE25 = NoahmpIO%QE25_TABLE(VEGTYPE) !quantum efficiency at 25c (umol co2 / umol photon) + parameters%AQE = NoahmpIO%AQE_TABLE(VEGTYPE) !q10 for qe25 + parameters%RMF25 = NoahmpIO%RMF25_TABLE(VEGTYPE) !leaf maintenance respiration at 25c (umol co2/m**2/s) + parameters%RMS25 = NoahmpIO%RMS25_TABLE(VEGTYPE) !stem maintenance respiration at 25c (umol co2/kg bio/s) + parameters%RMR25 = NoahmpIO%RMR25_TABLE(VEGTYPE) !root maintenance respiration at 25c (umol co2/kg bio/s) + parameters%ARM = NoahmpIO%ARM_TABLE(VEGTYPE) !q10 for maintenance respiration + parameters%FOLNMX = NoahmpIO%FOLNMX_TABLE(VEGTYPE) !foliage nitrogen concentration when f(n)=1 (%) + parameters%TMIN = NoahmpIO%TMIN_TABLE(VEGTYPE) !minimum temperature for photosynthesis (k) + parameters%XL = NoahmpIO%XL_TABLE(VEGTYPE) !leaf/stem orientation index + parameters%RHOL = NoahmpIO%RHOL_TABLE(VEGTYPE,:) !leaf reflectance: 1=vis, 2=nir + parameters%RHOS = NoahmpIO%RHOS_TABLE(VEGTYPE,:) !stem reflectance: 1=vis, 2=nir + parameters%TAUL = NoahmpIO%TAUL_TABLE(VEGTYPE,:) !leaf transmittance: 1=vis, 2=nir + parameters%TAUS = NoahmpIO%TAUS_TABLE(VEGTYPE,:) !stem transmittance: 1=vis, 2=nir + parameters%MRP = NoahmpIO%MRP_TABLE(VEGTYPE) !microbial respiration parameter (umol co2 /kg c/ s) + parameters%CWPVT = NoahmpIO%CWPVT_TABLE(VEGTYPE) !empirical canopy wind parameter + parameters%WRRAT = NoahmpIO%WRRAT_TABLE(VEGTYPE) !wood to non-wood ratio + parameters%WDPOOL = NoahmpIO%WDPOOL_TABLE(VEGTYPE) !wood pool (switch 1 or 0) depending on woody or not [-] + parameters%TDLEF = NoahmpIO%TDLEF_TABLE(VEGTYPE) !characteristic T for leaf freezing [K] + parameters%NROOT = NoahmpIO%NROOT_TABLE(VEGTYPE) !number of soil layers with root present + parameters%RGL = NoahmpIO%RGL_TABLE(VEGTYPE) !Parameter used in radiation stress function + parameters%RSMIN = NoahmpIO%RS_TABLE(VEGTYPE) !Minimum stomatal resistance [s m-1] + parameters%HS = NoahmpIO%HS_TABLE(VEGTYPE) !Parameter used in vapor pressure deficit function + parameters%TOPT = NoahmpIO%TOPT_TABLE(VEGTYPE) !Optimum transpiration air temperature [K] + parameters%RSMAX = NoahmpIO%RSMAX_TABLE(VEGTYPE) !Maximal stomatal resistance [s m-1] + parameters%RTOVRC = NoahmpIO%RTOVRC_TABLE(VEGTYPE) !root turnover coefficient [1/s] + parameters%RSWOODC = NoahmpIO%RSWOODC_TABLE(VEGTYPE) !wood respiration coeficient [1/s] + parameters%BF = NoahmpIO%BF_TABLE(VEGTYPE) !parameter for present wood allocation [-] + parameters%WSTRC = NoahmpIO%WSTRC_TABLE(VEGTYPE) !water stress coeficient [-] + parameters%LAIMIN = NoahmpIO%LAIMIN_TABLE(VEGTYPE) !minimum leaf area index [m2/m2] + parameters%XSAMIN = NoahmpIO%XSAMIN_TABLE(VEGTYPE) !minimum stem area index [m2/m2] + +!------------------------------------------------------------------------------------------! +! Transfer rad parameters +!------------------------------------------------------------------------------------------! + + parameters%ALBSAT = NoahmpIO%ALBSAT_TABLE(SOILCOLOR,:) + parameters%ALBDRY = NoahmpIO%ALBDRY_TABLE(SOILCOLOR,:) + parameters%ALBICE = NoahmpIO%ALBICE_TABLE + parameters%ALBLAK = NoahmpIO%ALBLAK_TABLE + parameters%OMEGAS = NoahmpIO%OMEGAS_TABLE + parameters%BETADS = NoahmpIO%BETADS_TABLE + parameters%BETAIS = NoahmpIO%BETAIS_TABLE + parameters%EG = NoahmpIO%EG_TABLE + parameters%EICE = NoahmpIO%EICE_TABLE + +!------------------------------------------------------------------------------------------! +! Transfer crop parameters +!------------------------------------------------------------------------------------------! + + IF(CROPTYPE > 0) THEN + parameters%PLTDAY = NoahmpIO%PLTDAY_TABLE(CROPTYPE) ! Planting date + parameters%HSDAY = NoahmpIO%HSDAY_TABLE(CROPTYPE) ! Harvest date + parameters%PLANTPOP = NoahmpIO%PLANTPOP_TABLE(CROPTYPE) ! Plant density [per ha] - used? + parameters%IRRI = NoahmpIO%IRRI_TABLE(CROPTYPE) ! Irrigation strategy 0= non-irrigation 1=irrigation (no water-stress) + parameters%GDDTBASE = NoahmpIO%GDDTBASE_TABLE(CROPTYPE) ! Base temperature for GDD accumulation [C] + parameters%GDDTCUT = NoahmpIO%GDDTCUT_TABLE(CROPTYPE) ! Upper temperature for GDD accumulation [C] + parameters%GDDS1 = NoahmpIO%GDDS1_TABLE(CROPTYPE) ! GDD from seeding to emergence + parameters%GDDS2 = NoahmpIO%GDDS2_TABLE(CROPTYPE) ! GDD from seeding to initial vegetative + parameters%GDDS3 = NoahmpIO%GDDS3_TABLE(CROPTYPE) ! GDD from seeding to post vegetative + parameters%GDDS4 = NoahmpIO%GDDS4_TABLE(CROPTYPE) ! GDD from seeding to intial reproductive + parameters%GDDS5 = NoahmpIO%GDDS5_TABLE(CROPTYPE) ! GDD from seeding to pysical maturity + parameters%C3PSN = NoahmpIO%C3PSNI_TABLE(CROPTYPE) + parameters%KC25 = NoahmpIO%KC25I_TABLE(CROPTYPE) + parameters%AKC = NoahmpIO%AKCI_TABLE(CROPTYPE) + parameters%KO25 = NoahmpIO%KO25I_TABLE(CROPTYPE) + parameters%AKO = NoahmpIO%AKOI_TABLE(CROPTYPE) + parameters%AVCMX = NoahmpIO%AVCMXI_TABLE(CROPTYPE) + parameters%VCMX25 = NoahmpIO%VCMX25I_TABLE(CROPTYPE) + parameters%BP = NoahmpIO%BPI_TABLE(CROPTYPE) + parameters%MP = NoahmpIO%MPI_TABLE(CROPTYPE) + parameters%FOLNMX = NoahmpIO%FOLNMXI_TABLE(CROPTYPE) + parameters%QE25 = NoahmpIO%QE25I_TABLE(CROPTYPE) + parameters%AREF = NoahmpIO%AREF_TABLE(CROPTYPE) ! reference maximum CO2 assimulation rate + parameters%PSNRF = NoahmpIO%PSNRF_TABLE(CROPTYPE) ! CO2 assimulation reduction factor(0-1) (caused by non-modeling part,e.g.pest,weeds) + parameters%I2PAR = NoahmpIO%I2PAR_TABLE(CROPTYPE) ! Fraction of incoming solar radiation to photosynthetically active radiation + parameters%TASSIM0 = NoahmpIO%TASSIM0_TABLE(CROPTYPE) ! Minimum temperature for CO2 assimulation [C] + parameters%TASSIM1 = NoahmpIO%TASSIM1_TABLE(CROPTYPE) ! CO2 assimulation linearly increasing until temperature reaches T1 [C] + parameters%TASSIM2 = NoahmpIO%TASSIM2_TABLE(CROPTYPE) ! CO2 assmilation rate remain at Aref until temperature reaches T2 [C] + parameters%K = NoahmpIO%K_TABLE(CROPTYPE) ! light extinction coefficient + parameters%EPSI = NoahmpIO%EPSI_TABLE(CROPTYPE) ! initial light use efficiency + parameters%Q10MR = NoahmpIO%Q10MR_TABLE(CROPTYPE) ! q10 for maintainance respiration + parameters%LEFREEZ = NoahmpIO%LEFREEZ_TABLE(CROPTYPE) ! characteristic T for leaf freezing [K] + parameters%DILE_FC = NoahmpIO%DILE_FC_TABLE(CROPTYPE,:) ! coeficient for temperature leaf stress death [1/s] + parameters%DILE_FW = NoahmpIO%DILE_FW_TABLE(CROPTYPE,:) ! coeficient for water leaf stress death [1/s] + parameters%FRA_GR = NoahmpIO%FRA_GR_TABLE(CROPTYPE) ! fraction of growth respiration + parameters%LF_OVRC = NoahmpIO%LF_OVRC_TABLE(CROPTYPE,:) ! fraction of leaf turnover [1/s] + parameters%ST_OVRC = NoahmpIO%ST_OVRC_TABLE(CROPTYPE,:) ! fraction of stem turnover [1/s] + parameters%RT_OVRC = NoahmpIO%RT_OVRC_TABLE(CROPTYPE,:) ! fraction of root tunrover [1/s] + parameters%LFMR25 = NoahmpIO%LFMR25_TABLE(CROPTYPE) ! leaf maintenance respiration at 25C [umol CO2/m**2 /s] + parameters%STMR25 = NoahmpIO%STMR25_TABLE(CROPTYPE) ! stem maintenance respiration at 25C [umol CO2/kg bio/s] + parameters%RTMR25 = NoahmpIO%RTMR25_TABLE(CROPTYPE) ! root maintenance respiration at 25C [umol CO2/kg bio/s] + parameters%GRAINMR25 = NoahmpIO%GRAINMR25_TABLE(CROPTYPE) ! grain maintenance respiration at 25C [umol CO2/kg bio/s] + parameters%LFPT = NoahmpIO%LFPT_TABLE(CROPTYPE,:) ! fraction of carbohydrate flux to leaf + parameters%STPT = NoahmpIO%STPT_TABLE(CROPTYPE,:) ! fraction of carbohydrate flux to stem + parameters%RTPT = NoahmpIO%RTPT_TABLE(CROPTYPE,:) ! fraction of carbohydrate flux to root + parameters%GRAINPT = NoahmpIO%GRAINPT_TABLE(CROPTYPE,:) ! fraction of carbohydrate flux to grain + parameters%LFCT = NoahmpIO%LFCT_TABLE(CROPTYPE,:) ! fraction of carbohydrate translocation from leaf to grain + parameters%STCT = NoahmpIO%STCT_TABLE(CROPTYPE,:) ! fraction of carbohydrate translocation from stem to grain + parameters%RTCT = NoahmpIO%RTCT_TABLE(CROPTYPE,:) ! fraction of carbohydrate translocation from root to grain + parameters%BIO2LAI = NoahmpIO%BIO2LAI_TABLE(CROPTYPE) ! leaf are per living leaf biomass [m^2/kg] + END IF + +!------------------------------------------------------------------------------------------! +! Transfer global parameters +!------------------------------------------------------------------------------------------! + + parameters%CO2 = NoahmpIO%CO2_TABLE + parameters%O2 = NoahmpIO%O2_TABLE + parameters%TIMEAN = NoahmpIO%TIMEAN_TABLE + parameters%FSATMX = NoahmpIO%FSATMX_TABLE + parameters%Z0SNO = NoahmpIO%Z0SNO_TABLE + parameters%SSI = NoahmpIO%SSI_TABLE + parameters%SNOW_RET_FAC = NoahmpIO%SNOW_RET_FAC_TABLE + parameters%SNOW_EMIS = NoahmpIO%SNOW_EMIS_TABLE + parameters%SWEMX = NoahmpIO%SWEMX_TABLE + parameters%RSURF_SNOW = NoahmpIO%RSURF_SNOW_TABLE + parameters%TAU0 = NoahmpIO%TAU0_TABLE + parameters%GRAIN_GROWTH = NoahmpIO%GRAIN_GROWTH_TABLE + parameters%EXTRA_GROWTH = NoahmpIO%EXTRA_GROWTH_TABLE + parameters%DIRT_SOOT = NoahmpIO%DIRT_SOOT_TABLE + parameters%BATS_COSZ = NoahmpIO%BATS_COSZ_TABLE + parameters%BATS_VIS_NEW = NoahmpIO%BATS_VIS_NEW_TABLE + parameters%BATS_NIR_NEW = NoahmpIO%BATS_NIR_NEW_TABLE + parameters%BATS_VIS_AGE = NoahmpIO%BATS_VIS_AGE_TABLE + parameters%BATS_NIR_AGE = NoahmpIO%BATS_NIR_AGE_TABLE + parameters%BATS_VIS_DIR = NoahmpIO%BATS_VIS_DIR_TABLE + parameters%BATS_NIR_DIR = NoahmpIO%BATS_NIR_DIR_TABLE + parameters%RSURF_EXP = NoahmpIO%RSURF_EXP_TABLE + parameters%C2_SNOWCOMPACT = NoahmpIO%C2_SNOWCOMPACT_TABLE + parameters%C3_SNOWCOMPACT = NoahmpIO%C3_SNOWCOMPACT_TABLE + parameters%C4_SNOWCOMPACT = NoahmpIO%C4_SNOWCOMPACT_TABLE + parameters%C5_SNOWCOMPACT = NoahmpIO%C5_SNOWCOMPACT_TABLE + parameters%DM_SNOWCOMPACT = NoahmpIO%DM_SNOWCOMPACT_TABLE + parameters%ETA0_SNOWCOMPACT = NoahmpIO%ETA0_SNOWCOMPACT_TABLE + parameters%SNLIQMAXFRAC = NoahmpIO%SNLIQMAXFRAC_TABLE + parameters%SWEMAXGLA = NoahmpIO%SWEMAXGLA_TABLE + parameters%WSLMAX = NoahmpIO%WSLMAX_TABLE + parameters%ROUS = NoahmpIO%ROUS_TABLE + parameters%CMIC = NoahmpIO%CMIC_TABLE + parameters%SNOWDEN_MAX = NoahmpIO%SNOWDEN_MAX_TABLE + parameters%CLASS_ALB_REF = NoahmpIO%CLASS_ALB_REF_TABLE + parameters%CLASS_SNO_AGE = NoahmpIO%CLASS_SNO_AGE_TABLE + parameters%CLASS_ALB_NEW = NoahmpIO%CLASS_ALB_NEW_TABLE + parameters%PSIWLT = NoahmpIO%PSIWLT_TABLE + parameters%Z0SOIL = NoahmpIO%Z0SOIL_TABLE + parameters%Z0LAKE = NoahmpIO%Z0LAKE_TABLE + +! ---------------------------------------------------------------------- +! Transfer irrigation parameters +! ---------------------------------------------------------------------- + parameters%IRR_HAR = NoahmpIO%IRR_HAR_TABLE + parameters%IRR_FRAC = NoahmpIO%IRR_FRAC_TABLE + parameters%IRR_LAI = NoahmpIO%IRR_LAI_TABLE + parameters%IRR_MAD = NoahmpIO%IRR_MAD_TABLE + parameters%FILOSS = NoahmpIO%FILOSS_TABLE + parameters%SPRIR_RATE = NoahmpIO%SPRIR_RATE_TABLE + parameters%MICIR_RATE = NoahmpIO%MICIR_RATE_TABLE + parameters%FIRTFAC = NoahmpIO%FIRTFAC_TABLE + parameters%IR_RAIN = NoahmpIO%IR_RAIN_TABLE + +! ---------------------------------------------------------------------- +! Transfer tile drainage parameters +! ---------------------------------------------------------------------- + parameters%DRAIN_LAYER_OPT = NoahmpIO%DRAIN_LAYER_OPT_TABLE + parameters%TD_DEPTH = NoahmpIO%TD_DEPTH_TABLE(SOILTYPE(1)) + parameters%TDSMC_FAC = NoahmpIO%TDSMC_FAC_TABLE(SOILTYPE(1)) + parameters%TD_DC = NoahmpIO%TD_DC_TABLE(SOILTYPE(1)) + parameters%TD_DCOEF = NoahmpIO%TD_DCOEF_TABLE(SOILTYPE(1)) + parameters%TD_D = NoahmpIO%TD_D_TABLE(SOILTYPE(1)) + parameters%TD_ADEPTH = NoahmpIO%TD_ADEPTH_TABLE(SOILTYPE(1)) + parameters%TD_RADI = NoahmpIO%TD_RADI_TABLE(SOILTYPE(1)) + parameters%TD_SPAC = NoahmpIO%TD_SPAC_TABLE(SOILTYPE(1)) + parameters%TD_DDRAIN = NoahmpIO%TD_DDRAIN_TABLE(SOILTYPE(1)) + parameters%KLAT_FAC = NoahmpIO%KLAT_FAC_TABLE(SOILTYPE(1)) + +! ---------------------------------------------------------------------- +! Transfer soil parameters +! ---------------------------------------------------------------------- + + do isoil = 1, size(soiltype) + parameters%BEXP(isoil) = NoahmpIO%BEXP_TABLE (SOILTYPE(isoil)) + parameters%DKSAT(isoil) = NoahmpIO%DKSAT_TABLE (SOILTYPE(isoil)) + parameters%DWSAT(isoil) = NoahmpIO%DWSAT_TABLE (SOILTYPE(isoil)) + parameters%PSISAT(isoil) = NoahmpIO%PSISAT_TABLE (SOILTYPE(isoil)) + parameters%QUARTZ(isoil) = NoahmpIO%QUARTZ_TABLE (SOILTYPE(isoil)) + parameters%SMCDRY(isoil) = NoahmpIO%SMCDRY_TABLE (SOILTYPE(isoil)) + parameters%SMCMAX(isoil) = NoahmpIO%SMCMAX_TABLE (SOILTYPE(isoil)) + parameters%SMCREF(isoil) = NoahmpIO%SMCREF_TABLE (SOILTYPE(isoil)) + parameters%SMCWLT(isoil) = NoahmpIO%SMCWLT_TABLE (SOILTYPE(isoil)) + end do + + parameters%BVIC = NoahmpIO%BVIC_TABLE(SOILTYPE(1)) + parameters%AXAJ = NoahmpIO%AXAJ_TABLE(SOILTYPE(1)) + parameters%BXAJ = NoahmpIO%BXAJ_TABLE(SOILTYPE(1)) + parameters%XXAJ = NoahmpIO%XXAJ_TABLE(SOILTYPE(1)) + parameters%BDVIC = NoahmpIO%BDVIC_TABLE(SOILTYPE(1)) + parameters%GDVIC = NoahmpIO%GDVIC_TABLE(SOILTYPE(1)) + parameters%BBVIC = NoahmpIO%BBVIC_TABLE(SOILTYPE(1)) + +! ---------------------------------------------------------------------- +! Transfer GENPARM parameters +! ---------------------------------------------------------------------- + parameters%CSOIL = NoahmpIO%CSOIL_TABLE + parameters%ZBOT = NoahmpIO%ZBOT_TABLE + parameters%CZIL = NoahmpIO%CZIL_TABLE + parameters%REFDK = NoahmpIO%REFDK_TABLE + parameters%REFKDT = NoahmpIO%REFKDT_TABLE + parameters%FRZK = NoahmpIO%FRZK_TABLE + parameters%KDT = parameters%REFKDT * parameters%DKSAT(1) / parameters%REFDK + parameters%SLOPE = NoahmpIO%SLOPE_TABLE(SLOPETYPE) + + IF(parameters%URBAN_FLAG)THEN ! Hardcoding some urban parameters for soil + parameters%SMCMAX = 0.45 + parameters%SMCREF = 0.42 + parameters%SMCWLT = 0.40 + parameters%SMCDRY = 0.40 + parameters%CSOIL = 3.E6 + ENDIF + +! adjust FRZK parameter to actual soil type: FRZK * FRZFACT + IF(SOILTYPE(1) /= 14) then + FRZFACT = (parameters%SMCMAX(1) / parameters%SMCREF(1)) * (0.412 / 0.468) + parameters%FRZX = parameters%FRZK * FRZFACT + END IF + + parameters%mxsnalb = 0.84 + parameters%mnsnalb = 0.55 + parameters%sndecayexp = 0.01 + parameters%t_ulimit = 2.5 + parameters%t_mlimit = 2.0 + parameters%t_llimit = 0.5 + parameters%snowf_scalef = 1.0 + + END SUBROUTINE TRANSFER_MP_PARAMETERS_NEW diff --git a/lis/surfacemodels/land/noahmp.5.0/NoahMP50_snowphys_updateMod.F90 b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_snowphys_updateMod.F90 new file mode 100755 index 000000000..0ffcbb07e --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_snowphys_updateMod.F90 @@ -0,0 +1,497 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !Module: NoahMP50_snowphys_updateMod +! \label{NoahMP50_snowphys_updateMod} +! +! !REVISION HISTORY: +! May 2023: Cenlin He; copied from NoahMP v4.5 (same physics as NoahMP v5.0) +! +! TODO: This is only for snow DA use. May need a better integration with NoahMP +! refactored source code directly. + +Module NoahMP50_snowphys_updateMod + + use LisNoahmpParamType + + implicit none + +contains + +! ------ snow compaction subroutine copied from NoahMP v4.5 (same physics as v5.0) + subroutine Compact (parameters,NSNOW ,NSOIL ,DT ,STC ,SNICE , & !in + SNLIQ ,ZSOIL ,IMELT ,FICEOLD,ILOC , JLOC , & !in + ISNOW ,DZSNSO ,ZSNSO ) !inout +! ---------------------------------------------------------------------- + IMPLICIT NONE +! ---------------------------------------------------------------------- +! input + type (LisNoahmpParam_type), INTENT(IN) :: parameters + INTEGER, INTENT(IN) :: ILOC !grid index + INTEGER, INTENT(IN) :: JLOC !grid index + INTEGER, INTENT(IN) :: NSOIL !no. of soil layers [ =4] + INTEGER, INTENT(IN) :: NSNOW !maximum no. of snow layers [ =3] + INTEGER, DIMENSION(-NSNOW+1:0) , INTENT(IN) :: IMELT !melting state index [0-no melt;1-melt] + REAL, INTENT(IN) :: DT !time step (sec) + REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(IN) :: STC !snow layer temperature [k] + REAL, DIMENSION(-NSNOW+1: 0), INTENT(IN) :: SNICE !snow layer ice [mm] + REAL, DIMENSION(-NSNOW+1: 0), INTENT(IN) :: SNLIQ !snow layer liquid water [mm] + REAL, DIMENSION( 1:NSOIL), INTENT(IN) :: ZSOIL !depth of layer-bottom from soil srf + REAL, DIMENSION(-NSNOW+1: 0), INTENT(IN) :: FICEOLD!ice fraction at last timestep + +! input and output + INTEGER, INTENT(INOUT) :: ISNOW ! actual no. of snow layers + REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: DZSNSO ! snow layer thickness [m] + REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: ZSNSO ! depth of snow/soil layer-bottom + +! local + real, parameter :: TFRZ = 273.16 !freezing/melting point (k) + real, parameter :: DENH2O = 1000.0 !density of water (kg/m3) + REAL, PARAMETER :: DENICE = 917.0 !density of ice (kg/m3) + REAL, PARAMETER :: C2 = 21.0e-3 ![m3/kg] ! default 21.e-3 + REAL, PARAMETER :: C3 = 2.5e-6 ![1/s] + REAL, PARAMETER :: C4 = 0.04 ![1/k] + REAL, PARAMETER :: C5 = 2.0 ! + REAL, PARAMETER :: DM = 100.0 !upper Limit on destructive metamorphism compaction [kg/m3] +! REAL, PARAMETER :: ETA0 = 0.8e+6 !viscosity coefficient [kg-s/m2] + !according to Anderson, it is between 0.52e6~1.38e6 + REAL, PARAMETER :: ETA0 = 1.33e+6 ! C.He: optimized based on SNOTEL obs (He et al. 2021 JGR) + REAL :: BURDEN !pressure of overlying snow [kg/m2] + REAL :: DDZ1 !rate of settling of snow pack due to destructive metamorphism. + REAL :: DDZ2 !rate of compaction of snow pack due to overburden. + REAL :: DDZ3 !rate of compaction of snow pack due to melt [1/s] + REAL :: DEXPF !EXPF=exp(-c4*(273.15-STC)). + REAL :: TD !STC - TFRZ [K] + REAL :: PDZDTC !nodal rate of change in fractional-thickness due to compaction [fraction/s] + REAL :: VOID !void (1 - SNICE - SNLIQ) + REAL :: WX !water mass (ice + liquid) [kg/m2] + REAL :: BI !partial density of ice [kg/m3] + REAL, DIMENSION(-NSNOW+1:0) :: FICE !fraction of ice at current time step + + INTEGER :: J + +! ---------------------------------------------------------------------- + BURDEN = 0.0 + + DO J = ISNOW+1, 0 + + WX = SNICE(J) + SNLIQ(J) + FICE(J) = SNICE(J) / WX + VOID = 1.0 - (SNICE(J)/DENICE + SNLIQ(J)/DENH2O) / DZSNSO(J) + + ! Allow compaction only for non-saturated node and higher ice lens node. + IF (VOID > 0.001 .AND. SNICE(J) > 0.1) THEN + BI = SNICE(J) / DZSNSO(J) + TD = MAX(0.0,TFRZ-STC(J)) + DEXPF = EXP(-C4*TD) + + ! Settling as a result of destructive metamorphism + + DDZ1 = -C3*DEXPF + + IF (BI > DM) DDZ1 = DDZ1*EXP(-46.0E-3*(BI-DM)) + + ! Liquid water term + + IF (SNLIQ(J) > 0.01*DZSNSO(J)) DDZ1=DDZ1*C5 + + ! Compaction due to overburden + + DDZ2 = -(BURDEN+0.5*WX)*EXP(-0.08*TD-C2*BI)/ETA0 ! 0.5*WX -> self-burden + + ! Compaction occurring during melt + + IF (IMELT(J) == 1) THEN + DDZ3 = MAX(0.0,(FICEOLD(J) - FICE(J))/MAX(1.0E-6,FICEOLD(J))) + DDZ3 = - DDZ3/DT ! sometimes too large + ELSE + DDZ3 = 0.0 + END IF + + ! Time rate of fractional change in DZ (units of s-1) + + PDZDTC = (DDZ1 + DDZ2 + DDZ3)*DT + PDZDTC = MAX(-0.5,PDZDTC) + + ! The change in DZ due to compaction + + DZSNSO(J) = DZSNSO(J)*(1.0+PDZDTC) + DZSNSO(J) = max(DZSNSO(J),SNICE(J)/DENICE + SNLIQ(J)/DENH2O) + + ! C.He: constrain snow density to a reasonable range (50~500 kg/m3) + DZSNSO(J) = MIN(MAX(DZSNSO(J),(SNICE(J)+SNLIQ(J))/500.0),(SNICE(J)+SNLIQ(J))/50.0) + + END IF + + ! Pressure of overlying snow + + BURDEN = BURDEN + WX + + END DO + + end subroutine Compact + + +! ------ snow layer combination subroutine copied from NoahMP v4.5 (same physics as v5.0) + subroutine Combine (parameters,NSNOW ,NSOIL ,ILOC ,JLOC , & !in + ISNOW ,SH2O ,STC ,SNICE ,SNLIQ , & !inout + DZSNSO ,SICE ,SNOWH ,SNEQV , & !inout + PONDING1 ,PONDING2) !out +! ---------------------------------------------------------------------- + IMPLICIT NONE +! ---------------------------------------------------------------------- +! input + type (LisNoahmpParam_type), INTENT(IN) :: parameters + INTEGER, INTENT(IN) :: ILOC + INTEGER, INTENT(IN) :: JLOC + INTEGER, INTENT(IN) :: NSNOW !maximum no. of snow layers + INTEGER, INTENT(IN) :: NSOIL !no. of soil layers +! input and output + INTEGER, INTENT(INOUT) :: ISNOW !actual no. of snow layers + REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: SH2O !soil liquid moisture (m3/m3) + REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: SICE !soil ice moisture (m3/m3) + REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: STC !snow layer temperature [k] + REAL, DIMENSION(-NSNOW+1: 0), INTENT(INOUT) :: SNICE !snow layer ice [mm] + REAL, DIMENSION(-NSNOW+1: 0), INTENT(INOUT) :: SNLIQ !snow layer liquid water [mm] + REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: DZSNSO!snow layer depth [m] + REAL, INTENT(INOUT) :: sneqv !snow water equivalent [m] + REAL, INTENT(INOUT) :: snowh !snow depth [m] + REAL, INTENT(OUT) :: PONDING1 + REAL, INTENT(OUT) :: PONDING2 + +! local variables: + INTEGER :: I,J,K,L ! node indices + INTEGER :: ISNOW_OLD ! number of top snow layer + INTEGER :: MSSI ! node index + INTEGER :: NEIBOR ! adjacent node selected for combination + REAL :: ZWICE ! total ice mass in snow + REAL :: ZWLIQ ! total liquid water in snow + + REAL :: DZMIN(3) ! minimum of top snow layer +! DATA DZMIN /0.045, 0.05, 0.2/ + DATA DZMIN /0.025, 0.025, 0.1/ ! MB: change limit +!----------------------------------------------------------------------- + + ISNOW_OLD = ISNOW + + DO J = ISNOW_OLD+1,0 + IF (SNICE(J) <= 0.1) THEN + IF(J /= 0) THEN + SNLIQ(J+1) = SNLIQ(J+1) + SNLIQ(J) + SNICE(J+1) = SNICE(J+1) + SNICE(J) + DZSNSO(J+1) = DZSNSO(J+1) + DZSNSO(J) + ELSE + IF (ISNOW_OLD < -1) THEN ! MB/KM: change to ISNOW + SNLIQ(J-1) = SNLIQ(J-1) + SNLIQ(J) + SNICE(J-1) = SNICE(J-1) + SNICE(J) + DZSNSO(J-1) = DZSNSO(J-1) + DZSNSO(J) + ELSE + IF(SNICE(J) >= 0.0) THEN + PONDING1 = SNLIQ(J) ! ISNOW WILL GET SET TO ZERO BELOW; PONDING1 WILL GET + SNEQV = SNICE(J) ! ADDED TO PONDING FROM PHASECHANGE PONDING SHOULD BE + SNOWH = DZSNSO(J) ! ZERO HERE BECAUSE IT WAS CALCULATED FOR THIN SNOW + ELSE ! SNICE OVER-SUBLIMATED EARLIER + PONDING1 = SNLIQ(J) + SNICE(J) + IF(PONDING1 < 0.0) THEN ! IF SNICE AND SNLIQ SUBLIMATES REMOVE FROM SOIL + SICE(1) = SICE(1)+PONDING1/(DZSNSO(1)*1000.0) ! negative SICE due to oversublimation is adjusted below + PONDING1 = 0.0 + END IF + SNEQV = 0.0 + SNOWH = 0.0 + END IF + SNLIQ(J) = 0.0 + SNICE(J) = 0.0 + DZSNSO(J) = 0.0 + ENDIF +! SH2O(1) = SH2O(1)+SNLIQ(J)/(DZSNSO(1)*1000.0) +! SICE(1) = SICE(1)+SNICE(J)/(DZSNSO(1)*1000.0) + ENDIF + + ! shift all elements above this down by one. + IF (J > ISNOW+1 .AND. ISNOW < -1) THEN + DO I = J, ISNOW+2, -1 + STC(I) = STC(I-1) + SNLIQ(I) = SNLIQ(I-1) + SNICE(I) = SNICE(I-1) + DZSNSO(I)= DZSNSO(I-1) + END DO + END IF + ISNOW = ISNOW + 1 + END IF + END DO + +! to conserve water in case of too large surface sublimation + + IF(SICE(1) < 0.0) THEN + SH2O(1) = SH2O(1) + SICE(1) + SICE(1) = 0.0 + END IF + + IF(ISNOW ==0) RETURN ! MB: get out if no longer multi-layer + + SNEQV = 0.0 + SNOWH = 0.0 + ZWICE = 0.0 + ZWLIQ = 0.0 + + DO J = ISNOW+1,0 + SNEQV = SNEQV + SNICE(J) + SNLIQ(J) + SNOWH = SNOWH + DZSNSO(J) + ZWICE = ZWICE + SNICE(J) + ZWLIQ = ZWLIQ + SNLIQ(J) + END DO + +! check the snow depth - all snow gone +! the liquid water assumes ponding on soil surface. + + IF (SNOWH < 0.025 .AND. ISNOW < 0 ) THEN ! MB: change limit +! IF (SNOWH < 0.05 .AND. ISNOW < 0 ) THEN + ISNOW = 0 + SNEQV = ZWICE + PONDING2 = ZWLIQ ! LIMIT OF ISNOW < 0 MEANS INPUT PONDING + IF(SNEQV <= 0.0) SNOWH = 0.0 ! SHOULD BE ZERO; SEE ABOVE + END IF + + +! check the snow depth - snow layers combined + + IF (ISNOW < -1) THEN + + ISNOW_OLD = ISNOW + MSSI = 1 + + DO I = ISNOW_OLD+1,0 + IF (DZSNSO(I) < DZMIN(MSSI)) THEN + + IF (I == ISNOW+1) THEN + NEIBOR = I + 1 + ELSE IF (I == 0) THEN + NEIBOR = I - 1 + ELSE + NEIBOR = I + 1 + IF ((DZSNSO(I-1)+DZSNSO(I)) < (DZSNSO(I+1)+DZSNSO(I))) NEIBOR = I-1 + END IF + + ! Node l and j are combined and stored as node j. + IF (NEIBOR > I) THEN + J = NEIBOR + L = I + ELSE + J = I + L = NEIBOR + END IF + + CALL COMBO (parameters,DZSNSO(J), SNLIQ(J), SNICE(J), & + STC(J), DZSNSO(L), SNLIQ(L), SNICE(L), STC(L) ) + + ! Now shift all elements above this down one. + IF (J-1 > ISNOW+1) THEN + DO K = J-1, ISNOW+2, -1 + STC(K) = STC(K-1) + SNICE(K) = SNICE(K-1) + SNLIQ(K) = SNLIQ(K-1) + DZSNSO(K) = DZSNSO(K-1) + END DO + END IF + + ! Decrease the number of snow layers + ISNOW = ISNOW + 1 + IF (ISNOW >= -1) EXIT + ELSE + + ! The layer thickness is greater than the prescribed minimum value + MSSI = MSSI + 1 + + END IF + END DO + + END IF + + end subroutine Combine + + +! ------ snow layer division subroutine copied from NoahMP v4.5 (same physics as v5.0) + subroutine Divide (parameters,NSNOW ,NSOIL , & !in + ISNOW ,STC ,SNICE ,SNLIQ ,DZSNSO ) !inout +! ---------------------------------------------------------------------- + IMPLICIT NONE +! ---------------------------------------------------------------------- +! input + type (LisNoahmpParam_type), INTENT(IN) :: parameters + INTEGER, INTENT(IN) :: NSNOW !maximum no. of snow layers [ =3] + INTEGER, INTENT(IN) :: NSOIL !no. of soil layers [ =4] + +! input and output + INTEGER , INTENT(INOUT) :: ISNOW !actual no. of snow layers + REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: STC !snow layer temperature [k] + REAL, DIMENSION(-NSNOW+1: 0), INTENT(INOUT) :: SNICE !snow layer ice [mm] + REAL, DIMENSION(-NSNOW+1: 0), INTENT(INOUT) :: SNLIQ !snow layer liquid water [mm] + REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: DZSNSO!snow layer depth [m] + +! local variables: + INTEGER :: J !indices + INTEGER :: MSNO !number of layer (top) to MSNO (bot) + REAL :: DRR !thickness of the combined [m] + real, parameter :: TFRZ = 273.16 !freezing/melting point (k) + REAL, DIMENSION( 1:NSNOW) :: DZ !snow layer thickness [m] + REAL, DIMENSION( 1:NSNOW) :: SWICE !partial volume of ice [m3/m3] + REAL, DIMENSION( 1:NSNOW) :: SWLIQ !partial volume of liquid water [m3/m3] + REAL, DIMENSION( 1:NSNOW) :: TSNO !node temperature [k] + REAL :: ZWICE !temporary + REAL :: ZWLIQ !temporary + REAL :: PROPOR!temporary + REAL :: DTDZ !temporary +! ---------------------------------------------------------------------- + + DO J = 1,NSNOW + IF (J <= ABS(ISNOW)) THEN + DZ(J) = DZSNSO(J+ISNOW) + SWICE(J) = SNICE(J+ISNOW) + SWLIQ(J) = SNLIQ(J+ISNOW) + TSNO(J) = STC(J+ISNOW) + END IF + END DO + + MSNO = ABS(ISNOW) + + IF (MSNO == 1) THEN + ! Specify a new snow layer + IF (DZ(1) > 0.05) THEN + MSNO = 2 + DZ(1) = DZ(1)/2.0 + SWICE(1) = SWICE(1)/2.0 + SWLIQ(1) = SWLIQ(1)/2.0 + DZ(2) = DZ(1) + SWICE(2) = SWICE(1) + SWLIQ(2) = SWLIQ(1) + TSNO(2) = TSNO(1) + END IF + END IF + + IF (MSNO > 1) THEN + IF (DZ(1) > 0.05) THEN + DRR = DZ(1) - 0.05 + PROPOR = DRR/DZ(1) + ZWICE = PROPOR*SWICE(1) + ZWLIQ = PROPOR*SWLIQ(1) + PROPOR = 0.05/DZ(1) + SWICE(1) = PROPOR*SWICE(1) + SWLIQ(1) = PROPOR*SWLIQ(1) + DZ(1) = 0.05 + + CALL COMBO (parameters,DZ(2), SWLIQ(2), SWICE(2), TSNO(2), DRR, & + ZWLIQ, ZWICE, TSNO(1)) + + ! subdivide a new layer + IF (MSNO <= 2 .AND. DZ(2) > 0.20) THEN ! MB: change limit +! IF (MSNO <= 2 .AND. DZ(2) > 0.10) THEN + MSNO = 3 + DTDZ = (TSNO(1) - TSNO(2))/((DZ(1)+DZ(2))/2.0) + DZ(2) = DZ(2)/2.0 + SWICE(2) = SWICE(2)/2.0 + SWLIQ(2) = SWLIQ(2)/2.0 + DZ(3) = DZ(2) + SWICE(3) = SWICE(2) + SWLIQ(3) = SWLIQ(2) + TSNO(3) = TSNO(2) - DTDZ*DZ(2)/2.0 + IF (TSNO(3) >= TFRZ) THEN + TSNO(3) = TSNO(2) + ELSE + TSNO(2) = TSNO(2) + DTDZ*DZ(2)/2.0 + ENDIF + + END IF + END IF + END IF + + IF (MSNO > 2) THEN + IF (DZ(2) > 0.2) THEN + DRR = DZ(2) - 0.2 + PROPOR = DRR/DZ(2) + ZWICE = PROPOR*SWICE(2) + ZWLIQ = PROPOR*SWLIQ(2) + PROPOR = 0.2/DZ(2) + SWICE(2) = PROPOR*SWICE(2) + SWLIQ(2) = PROPOR*SWLIQ(2) + DZ(2) = 0.2 + CALL COMBO (parameters,DZ(3), SWLIQ(3), SWICE(3), TSNO(3), DRR, & + ZWLIQ, ZWICE, TSNO(2)) + END IF + END IF + + ISNOW = -MSNO + + DO J = ISNOW+1,0 + DZSNSO(J) = DZ(J-ISNOW) + SNICE(J) = SWICE(J-ISNOW) + SNLIQ(J) = SWLIQ(J-ISNOW) + STC(J) = TSNO(J-ISNOW) + END DO + + end subroutine Divide + + +! ------ snow layer combo subroutine copied from NoahMP v4.5 (same physics as v5.0) + subroutine Combo(parameters,DZ, WLIQ, WICE, T, DZ2, WLIQ2, WICE2, T2) + +! ---------------------------------------------------------------------- + IMPLICIT NONE +! ---------------------------------------------------------------------- +! input + type (LisNoahmpParam_type), INTENT(IN) :: parameters + + REAL, INTENT(IN) :: DZ2 !nodal thickness of 2 elements being combined [m] + REAL, INTENT(IN) :: WLIQ2 !liquid water of element 2 [kg/m2] + REAL, INTENT(IN) :: WICE2 !ice of element 2 [kg/m2] + REAL, INTENT(IN) :: T2 !nodal temperature of element 2 [k] + REAL, INTENT(INOUT) :: DZ !nodal thickness of 1 elements being combined [m] + REAL, INTENT(INOUT) :: WLIQ !liquid water of element 1 + REAL, INTENT(INOUT) :: WICE !ice of element 1 [kg/m2] + REAL, INTENT(INOUT) :: T !node temperature of element 1 [k] + + real, parameter :: CICE = 2.094E06 !specific heat capacity of ice (j/m3/k) + real, parameter :: CWAT = 4.188E06 !specific heat capacity of water (j/m3/k) + real, parameter :: TFRZ = 273.16 !freezing/melting point (k) + real, parameter :: HFUS = 0.3336E06 !latent heat of fusion (j/kg) + +! local + REAL :: DZC !total thickness of nodes 1 and 2 (DZC=DZ+DZ2). + REAL :: WLIQC !combined liquid water [kg/m2] + REAL :: WICEC !combined ice [kg/m2] + REAL :: TC !combined node temperature [k] + REAL :: H !enthalpy of element 1 [J/m2] + REAL :: H2 !enthalpy of element 2 [J/m2] + REAL :: HC !temporary + +!----------------------------------------------------------------------- + + DZC = DZ+DZ2 + WICEC = (WICE+WICE2) + WLIQC = (WLIQ+WLIQ2) + H = (CICE*WICE+CWAT*WLIQ) * (T-TFRZ)+HFUS*WLIQ + H2= (CICE*WICE2+CWAT*WLIQ2) * (T2-TFRZ)+HFUS*WLIQ2 + + HC = H + H2 + IF(HC < 0.0)THEN + TC = TFRZ + HC/(CICE*WICEC + CWAT*WLIQC) + ELSE IF (HC.LE.HFUS*WLIQC) THEN + TC = TFRZ + ELSE + TC = TFRZ + (HC - HFUS*WLIQC) / (CICE*WICEC + CWAT*WLIQC) + END IF + + DZ = DZC + WICE = WICEC + WLIQ = WLIQC + T = TC + + end subroutine Combo + +end module NoahMP50_snowphys_updateMod diff --git a/lis/surfacemodels/land/noahmp.5.0/NoahMP50_writerst.F90 b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_writerst.F90 new file mode 100644 index 000000000..1d8289326 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/NoahMP50_writerst.F90 @@ -0,0 +1,1132 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- + +#include "LIS_misc.h" +!BOP +! +! !ROUTINE: NoahMP50_writerst +! \label{NoahMP50_writerst} +! +! !REVISION HISTORY: +! This subroutine is generated with the Model Implementation Toolkit developed +! by Shugong Wang for the NASA Land Information System Version 7. The initial +! specification of the subroutine is defined by Sujay Kumar. +! 10/25/18: Shugong Wang, Zhuo Wang; initial implementation for LIS 7 and NoahMP401 +! May 2023: Cenlin He, modified for refactored NoahMP v5 and later + +! !INTERFACE: +subroutine NoahMP50_writerst(n) +! !USES: + use LIS_coreMod, only : LIS_rc, LIS_masterproc + use LIS_timeMgrMod, only : LIS_isAlarmRinging + use LIS_logMod, only : LIS_logunit, LIS_getNextUnitNumber, & + LIS_releaseUnitNumber , LIS_verify + use LIS_fileIOMod, only : LIS_create_output_directory, & + LIS_create_restart_filename + use LIS_constantsMod, only : LIS_CONST_PATH_LEN + use NoahMP50_lsmMod + +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + use netcdf +#endif + + implicit none + ! !ARGUMENTS: + integer, intent(in) :: n +! +! !DESCRIPTION: +! This program writes restart files for Noah-MP-4.0.1 LSM. +! This includes all relevant water/energy storage and tile information. +! +! The routines invoked are: +! \begin{description} +! \item[LIS\_create\_output\_directory](\ref{LIS_create_output_directory})\\ +! creates a timestamped directory for the restart files +! \item[LIS\_create\_restart\_filename](\ref{LIS_create_restart_filename})\\ +! generates a timestamped restart filename +! \item[NoahMP50\_dump\_restart](\ref{NoahMP50_dump_restart})\\ +! writes the NoahMP50 variables into the restart file +! \end{description} +!EOP + + character(len=LIS_CONST_PATH_LEN) :: filen + character*20 :: wformat + logical :: alarmCheck + integer :: ftn + integer :: status + character*3 :: fnest + + ! set restart alarm + write(fnest,'(i3.3)') n + alarmCheck = LIS_isAlarmRinging(LIS_rc, "NoahMP50 restart alarm "//trim(fnest)) + + ! set restart file format (read from LIS configration file_ + wformat = trim(NoahMP50_struc(n)%rformat) + + if(alarmCheck .or. (LIS_rc%endtime ==1)) then + If (LIS_masterproc) Then + call LIS_create_output_directory("SURFACEMODEL") + call LIS_create_restart_filename(n, filen, "SURFACEMODEL", & + "NoahMP50",wformat=wformat) + if(wformat .eq. "binary") then + ftn = LIS_getNextUnitNumber() + open(ftn,file=filen,status="unknown", form="unformatted") + elseif(wformat .eq. "netcdf") then +#if (defined USE_NETCDF4) + status = nf90_create(path=filen, cmode=nf90_hdf5, ncid = ftn) + call LIS_verify(status, & + "Error in nf90_open in NoahMP50_writerst") +#endif +#if (defined USE_NETCDF3) + status = nf90_create(Path = filen, cmode = nf90_clobber, ncid = ftn) + call LIS_verify(status, & + "Error in nf90_open in NoahMP50_writerst") +#endif + endif + endif + + call NoahMP50_dump_restart(n, ftn, wformat) + + if (LIS_masterproc) then + if(wformat .eq. "binary") then + call LIS_releaseUnitNumber(ftn) + elseif(wformat .eq. "netcdf") then +#if (defined USE_NETCDF3 || defined USE_NETCDF4) + status = nf90_close(ftn) + call LIS_verify(status, & + "Error in nf90_close in NoahMP50_writerst") +#endif + endif + write(LIS_logunit, *)& + "[INFO] Noah-MP.5.0 archive restart written: ",trim(filen) + endif + endif +end subroutine NoahMP50_writerst + +!BOP +! +! !ROUTINE: NoahMP50_dump_restart +! \label{NoahMP50_dump_restart} +! +! !REVISION HISTORY: +! This subroutine is generated with the Model Implementation Toolkit developed +! by Shugong Wang for the NASA Land Information System Version 7. The initial +! specification of the subroutine is defined by Sujay Kumar. +! 10/25/18: Shugong Wang, Zhuo Wang, initial implementation for LIS 7 and NoahMP401 +! May 2023: Cenlin He, modified for refactored NoahMP v5 and later +! !INTERFACE: +subroutine NoahMP50_dump_restart(n, ftn, wformat) + +! !USES: + use LIS_coreMod, only : LIS_rc, LIS_masterproc + use LIS_logMod, only : LIS_logunit + use LIS_historyMod + use NoahMP50_lsmMod + + implicit none + + integer, intent(in) :: ftn + integer, intent(in) :: n + character(len=*), intent(in) :: wformat +! +! !DESCRIPTION: +! This routine gathers the necessary restart variables and performs +! the actual write statements to create the restart files. +! +! The arguments are: +! \begin{description} +! \item[n] +! index of the nest +! \item[ftn] +! unit number for the restart file +! \item[wformat] +! restart file format (binary/netcdf) +! \end{description} +! +! +! The following is the list of variables written in the NoahMP401 +! restart file: +! \begin{verbatim} +! nc, nr, ntiles - grid and tile space dimensions +! sfcrunoff - NoahMP accumulated surface runoff [m] +! udrrunoff - NoahMP accumulated sub-surface runoff [m] +! smc - NoahMP volumtric soil moisture [m3/m3] +! sh2o - NoahMP volumtric liquid soil moisture [m3/m3] +! tslb - NoahMP soil temperature [K] +! sneqv - NoahMP snow water equivalent [mm] +! snowh - NoahMP physical snow depth [m] +! canwat - NoahMP total canopy water + ice [mm] +! acsnom - NoahMP accumulated snow melt leaving pack [-] +! acsnow - NoahMP accumulated snow on grid [mm] +! isnow - NoahMP actual no. of snow layers [-] +! tv - NoahMP vegetation leaf temperature [K] +! tg - NoahMP bulk ground surface temperature [K] +! canice - NoahMP canopy-intercepted ice [mm] +! canliq - NoahMP canopy-intercepted liquid water [mm] +! eah - NoahMP canopy air vapor pressure [Pa] +! tah - NoahMP canopy air temperature [K] +! cm - NoahMP bulk momentum drag coefficient [-] +! ch - NoahMP bulk sensible heat exchange coefficient [-] +! fwet - NoahMP wetted or snowed fraction of canopy [-] +! sneqvo - NoahMP snow mass at last time step [mm h2o] +! albold - NoahMP snow albedo at last time step [-] +! qsnow - NoahMP snowfall on the ground [mm/s] +! wslake - NoahMP lake water storage [mm] +! zwt - NoahMP water table depth [m] +! wa - NoahMP water in the "aquifer" [mm] +! wt - NoahMP water in aquifer and saturated soil [mm] +! tsno - NoahMP snow layer temperature [K] +! zss - NoahMP snow/soil layer depth from snow surface [m] +! snowice - NoahMP snow layer ice [mm] +! snowliq - NoahMP snow layer liquid water [mm] +! lfmass - NoahMP leaf mass [g/m2] +! rtmass - NoahMP mass of fine roots [g/m2] +! stmass - NoahMP stem mass [g/m2] +! wood - NoahMP mass of wood (including woody roots) [g/m2] +! stblcp - NoahMP stable carbon in deep soil [g/m2] +! fastcp - NoahMP short-lived carbon in shallow soil [g/m2] +! lai - NoahMP leaf area index [-] +! sai - NoahMP stem area index [-] +! tauss - NoahMP snow age factor [-] +! smoiseq - NoahMP equilibrium volumetric soil moisture content [m3/m3] +! smcwtd - NoahMP soil moisture content in the layer to the water table when deep [-] +! deeprech - NoahMP recharge to the water table when deep [-] +! rech - NoahMP recharge to the water table (diagnostic) [-] +! grain - NoahMP mass of grain XING [g/m2] +! gdd - NoahMP growing degree days XING (based on 10C) [-] +! pgs - NoahMP growing degree days XING [-] +! \end{verbatim} +! +! The routines invoked are: +! \begin{description} +! \item[LIS\_writeGlobalHeader\_restart](\ref{LIS_writeGlobalHeader_restart})\\ +! writes the global header information +! \item[LIS\_writeHeader\_restart](\ref{LIS_writeHeader_restart})\\ +! writes the header information for a variable +! \item[LIS\_closeHeader\_restart](\ref{LIS_closeHeader_restart})\\ +! close the header +! \item[LIS\_writevar\_restart](\ref{LIS_writevar_restart})\\ +! writes a variable to the restart file +! \end{description} +! +!EOP + + integer :: l, t + real :: tmptilen(LIS_rc%npatch(n, LIS_rc%lsm_index)) + integer :: dimID(11) + integer :: sfcrunoff_ID + integer :: udrrunoff_ID + integer :: smc_ID + integer :: sh2o_ID + integer :: tslb_ID + integer :: sneqv_ID + integer :: snowh_ID + integer :: canwat_ID + integer :: acsnom_ID + integer :: acsnow_ID + integer :: isnow_ID + integer :: tv_ID + integer :: tg_ID + integer :: canice_ID + integer :: canliq_ID + integer :: eah_ID + integer :: tah_ID + integer :: cm_ID + integer :: ch_ID + integer :: fwet_ID + integer :: sneqvo_ID + integer :: albold_ID + integer :: qsnow_ID + integer :: wslake_ID + integer :: zwt_ID + integer :: wa_ID + integer :: wt_ID + integer :: tsno_ID + integer :: zss_ID + integer :: snowice_ID + integer :: snowliq_ID + integer :: lfmass_ID + integer :: rtmass_ID + integer :: stmass_ID + integer :: wood_ID + integer :: stblcp_ID + integer :: fastcp_ID + integer :: lai_ID + integer :: sai_ID + integer :: tauss_ID + integer :: smoiseq_ID + integer :: smcwtd_ID + integer :: deeprech_ID + integer :: rech_ID + integer :: grain_ID + integer :: gdd_ID + integer :: pgs_ID + integer :: pexp_ID + integer :: area_ID + integer :: qrf_ID + integer :: qspring_ID + integer :: qslat_ID + integer :: qrfs_ID + integer :: qsprings_ID + integer :: fdepth_ID + integer :: rivercond_ID + integer :: riverbed_ID + integer :: eqzwt_ID + integer :: irnumsi_ID + integer :: irnummi_ID + integer :: irnumfi_ID + integer :: irwatsi_ID + integer :: irwatmi_ID + integer :: irwatfi_ID + integer :: irsivol_ID + integer :: irmivol_ID + integer :: irfivol_ID + integer :: ireloss_ID + integer :: irrsplh_ID + integer :: qtdrain_ID + integer :: accssoil_ID + integer :: accqinsur_ID + integer :: accqseva_ID + integer :: accetrani_ID + integer :: accdwater_ID + integer :: accprcp_ID + integer :: accecan_ID + integer :: accetran_ID + integer :: accedir_ID + + ! write the header of the restart file + call LIS_writeGlobalHeader_restart(ftn, n, LIS_rc%lsm_index, & + "NoahMP50", & + dim1=NoahMP50_struc(n)%nsoil+NoahMP50_struc(n)%nsnow, & + dim2=NoahMP50_struc(n)%nsoil, & + dim3=NoahMP50_struc(n)%nsnow, & + dim4=1, & + dimID=dimID, & + output_format = trim(wformat)) + + ! write the header for state variable sfcrunoff + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, sfcrunoff_ID, "SFCRUNOFF", & + "accumulated surface runoff", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable udrrunoff + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, udrrunoff_ID, "UDRRUNOFF", & + "accumulated sub-surface runoff", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable smc + !TODO: check dimension of the state variable following "vlevels=" + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, smc_ID, "SMC", & + "volumtric soil moisture", & + "m3/m3", vlevels=NoahMP50_struc(n)%nsoil , valid_min=-99999.0, valid_max=99999.0, & + var_flag = "dim2") + + ! write the header for state variable sh2o + !TODO: check dimension of the state variable following "vlevels=" + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, sh2o_ID, "SH2O", & + "volumtric liquid soil moisture", & + "m3/m3", vlevels=NoahMP50_struc(n)%nsoil , valid_min=-99999.0, valid_max=99999.0, & + var_flag = "dim2") + + ! write the header for state variable tslb + !TODO: check dimension of the state variable following "vlevels=" + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, tslb_ID, "TSLB", & + "soil temperature", & + "K", vlevels=NoahMP50_struc(n)%nsoil , valid_min=-99999.0, valid_max=99999.0, & + var_flag = "dim2") + + ! write the header for state variable sneqv + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, sneqv_ID, "SNEQV", & + "snow water equivalent", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable snowh + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, snowh_ID, "SNOWH", & + "physical snow depth", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable canwat + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, canwat_ID, "CANWAT", & + "total canopy water + ice", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable acsnom + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, acsnom_ID, "ACSNOM", & + "accumulated snow melt leaving pack", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable acsnow + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, acsnow_ID, "ACSNOW", & + "accumulated snow on grid", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable isnow + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, isnow_ID, "ISNOW", & + "actual no. of snow layers", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable tv + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, tv_ID, "TV", & + "vegetation leaf temperature", & + "K", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable tg + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, tg_ID, "TG", & + "bulk ground surface temperature", & + "K", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable canice + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, canice_ID, "CANICE", & + "canopy-intercepted ice", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable canliq + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, canliq_ID, "CANLIQ", & + "canopy-intercepted liquid water", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable eah + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, eah_ID, "EAH", & + "canopy air vapor pressure", & + "Pa", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable tah + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, tah_ID, "TAH", & + "canopy air temperature", & + "K", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable cm + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, cm_ID, "CM", & + "bulk momentum drag coefficient", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable ch + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, ch_ID, "CH", & + "bulk sensible heat exchange coefficient", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable fwet + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, fwet_ID, "FWET", & + "wetted or snowed fraction of canopy", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable sneqvo + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, sneqvo_ID, "SNEQVO", & + "snow mass at last time step", & + "mm h2o", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable albold + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, albold_ID, "ALBOLD", & + "snow albedo at last time step", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable qsnow + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, qsnow_ID, "QSNOW", & + "snowfall on the ground", & + "mm/s", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable wslake + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, wslake_ID, "WSLAKE", & + "lake water storage", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable zwt + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, zwt_ID, "ZWT", & + "water table depth", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable wa + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, wa_ID, "WA", & + "water in aquifer", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable wt + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, wt_ID, "WT", & + "water in aquifer and saturated soil", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable tsno + !TODO: check dimension of the state variable following "vlevels=" + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, tsno_ID, "TSNO", & + "snow layer temperature", & + "K", vlevels=NoahMP50_struc(n)%nsnow , valid_min=-99999.0, valid_max=99999.0, & + var_flag = "dim3") + + ! write the header for state variable zss + !TODO: check dimension of the state variable following "vlevels=" + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, zss_ID, "ZSS", & + "snow/soil layer depth from snow surface", & + "m", vlevels=NoahMP50_struc(n)%nsnow+NoahMP50_struc(n)%nsoil , valid_min=-99999.0, valid_max=99999.0, & + var_flag = "dim1") + + ! write the header for state variable snowice + !TODO: check dimension of the state variable following "vlevels=" + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, snowice_ID, "SNOWICE", & + "snow layer ice", & + "mm", vlevels=NoahMP50_struc(n)%nsnow , valid_min=-99999.0, valid_max=99999.0, & + var_flag = "dim3") + + ! write the header for state variable snowliq + !TODO: check dimension of the state variable following "vlevels=" + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, snowliq_ID, "SNOWLIQ", & + "snow layer liquid water", & + "mm", vlevels=NoahMP50_struc(n)%nsnow , valid_min=-99999.0, valid_max=99999.0, & + var_flag = "dim3") + + ! write the header for state variable lfmass + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, lfmass_ID, "LFMASS", & + "leaf mass", & + "g/m2", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable rtmass + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, rtmass_ID, "RTMASS", & + "mass of fine roots", & + "g/m2", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable stmass + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, stmass_ID, "STMASS", & + "stem mass", & + "g/m2", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable wood + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, wood_ID, "WOOD", & + "mass of wood (including woody roots)", & + "g/m2", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable stblcp + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, stblcp_ID, "STBLCP", & + "stable carbon in deep soil", & + "g/m2", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable fastcp + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, fastcp_ID, "FASTCP", & + "short-lived carbon in shallow soil", & + "g/m2", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable lai + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, lai_ID, "LAI", & + "leaf area index", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable sai + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, sai_ID, "SAI", & + "stem area index", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable tauss + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, tauss_ID, "TAUSS", & + "snow age factor", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + + ! for MMF groundwater + if (NoahMP50_struc(n)%runsub_opt == 5) then + ! write the header for state variable smoiseq + !TODO: check dimension of the state variable following "vlevels=" + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, smoiseq_ID, "SMOISEQ", & + "equilibrium volumetric soil moisture content", & + "m3/m3", vlevels=NoahMP50_struc(n)%nsoil , valid_min=-99999.0, valid_max=99999.0, & + var_flag = "dim2") + + ! write the header for state variable smcwtd + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, smcwtd_ID, "SMCWTD", & + "soil moisture content in the layer to the water table when deep", & + "m3/m3", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable deeprech + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, deeprech_ID, "DEEPRECH", & + "recharge to the water table when deep", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable rech + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, rech_ID, "RECH", & + "recharge to the water table (diagnostic)", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable pexp + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, pexp_ID, "PEXP", & + "groundwater expotential parameter", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable area + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, area_ID, "AREA", & + "river area", & + "m2", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable qrf + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, qrf_ID, "QRF", & + "groundwater baseflow", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable qspring + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, qspring_ID, "QSPRING", & + "seeping water", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable qslat + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, qslat_ID, "QSLAT", & + "accumulated lateral flow", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable qrfs + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, qrfs_ID, "QRFS", & + "accumulated GW baseflow", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable qsprings + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, qsprings_ID, "QSPRINGS", & + "accumulated seeping water", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable fdepth + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, fdepth_ID, "FDEPTH", & + "depth", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable rivercond + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, rivercond_ID, "RIVERCOND", & + "river conductivity", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable riverbed + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, riverbed_ID, "RIVERBED", & + "riverbed depth", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable eqzwt + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, eqzwt_ID, "EQZWT", & + "equilibrium water table depth", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + endif + + ! for irrigation + if (NoahMP50_struc(n)%irr_opt >0) then + ! write the header for state variable irnumsi + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, irnumsi_ID, "IRNUMSI", & + "sprinkler irrigation count", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable irnummi + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, irnummi_ID, "IRNUMMI", & + "micro irrigation count", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable irnumfi + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, irnumfi_ID, "IRNUMFI", & + "flood irrigation count", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable irwatsi + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, irwatsi_ID, "IRWATSI", & + "sprinkler irrigation water amount", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable irwatmi + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, irwatmi_ID, "IRWATMI", & + "micro irrigation water amount", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable irwatfi + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, irwatfi_ID, "IRWATFI", & + "flood irrigation water amount", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable irsivol + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, irsivol_ID, "IRSIVOL", & + "sprinkler irrigation water volume", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable irmivol + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, irmivol_ID, "IRMIVOL", & + "micro irrigation water volume", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable irfivol + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, irfivol_ID, "IRFIVOL", & + "flood irrigation water volume", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable ireloss + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, ireloss_ID, "IRELOSS", & + "loss of irrigation water to evaporation", & + "m", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable irrsplh + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, irrsplh_ID, "IRRSPLH", & + "latent heating from sprinkler evaporation", & + "W/m2", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + endif + + ! for tile drainage + if (NoahMP50_struc(n)%tdrn_opt >0) then + ! write the header for state variable qtdrain + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, qtdrain_ID, "QTDRAIN", & + "accumulated tile drainage discharge", & + "mm", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + endif + + ! write the header for state variable grain + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, grain_ID, "GRAIN", & + "mass of grain XING", & + "g/m2", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable gdd + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, gdd_ID, "GDD", & + "growing degree days XING (based on 10C)", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable pgs + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, pgs_ID, "PGS", & + "growing degree days XING", & + "-", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! for additional restart variables + ! write the header for state variable accssoil + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, accssoil_ID, "ACC_SSOIL", & + "accumulated ground heat flux", & + "W/m2", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable accqinsur + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, accqinsur_ID, "ACC_QINSUR", & + "accumulated soil surface water flux", & + "m/s", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable accqseva + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, accqseva_ID, "ACC_QSEVA", & + "accumulated soil surface evaporation", & + "m/s", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable accetrani + call LIS_writeHeader_restart(ftn, n, dimID, accetrani_ID, "ACC_ETRANI", & + "accumulated plant transpiration each layer", & + "m/s", vlevels=NoahMP50_struc(n)%nsoil , valid_min=-99999.0, valid_max=99999.0, & + var_flag = "dim2") + ! write the header for state variable accdwater + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, accdwater_ID, "ACC_DWATER", & + "accumulated water storage change", & + "m/s", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable accprcp + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, accprcp_ID, "ACC_PRCP", & + "accumulated precipitation", & + "m/s", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable accecan + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, accecan_ID, "ACC_ECAN", & + "accumulated canopy evaporation", & + "m/s", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable accetran + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, accetran_ID, "ACC_ETRAN", & + "accumulated transpiration", & + "m/s", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + ! write the header for state variable accedir + !TODO: replace -99999 and 99999 with correct values for valid_min and valid_max + call LIS_writeHeader_restart(ftn, n, dimID, accedir_ID, "ACC_EDIR", & + "accumulated net soil evaporation", & + "m/s", vlevels=1, valid_min=-99999.0, valid_max=99999.0) + + ! close header of restart file + call LIS_closeHeader_restart(ftn, n, LIS_rc%lsm_index, dimID, NoahMP50_struc(n)%rstInterval) + + + ! write state variables into restart file + ! accumulated surface runoff + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%sfcrunoff, & + varid=sfcrunoff_ID, dim=1, wformat=wformat) + + ! accumulated sub-surface runoff + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%udrrunoff, & + varid=udrrunoff_ID, dim=1, wformat=wformat) + + ! volumtric soil moisture + do l=1, NoahMP50_struc(n)%nsoil ! TODO: check loop + tmptilen = 0 + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tmptilen(t) = NoahMP50_struc(n)%noahmp50(t)%smc(l) + enddo + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, & + varid=smc_ID, dim=l, wformat=wformat) + enddo + ! volumtric liquid soil moisture + do l=1, NoahMP50_struc(n)%nsoil ! TODO: check loop + tmptilen = 0 + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tmptilen(t) = NoahMP50_struc(n)%noahmp50(t)%sh2o(l) + enddo + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, & + varid=sh2o_ID, dim=l, wformat=wformat) + enddo + ! soil temperature + do l=1, NoahMP50_struc(n)%nsoil ! TODO: check loop + tmptilen = 0 + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tmptilen(t) = NoahMP50_struc(n)%noahmp50(t)%tslb(l) + enddo + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, & + varid=tslb_ID, dim=l, wformat=wformat) + enddo + ! snow water equivalent + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%sneqv, & + varid=sneqv_ID, dim=1, wformat=wformat) + + ! physical snow depth + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%snowh, & + varid=snowh_ID, dim=1, wformat=wformat) + + ! total canopy water + ice + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%canwat, & + varid=canwat_ID, dim=1, wformat=wformat) + + ! accumulated snow melt leaving pack + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%acsnom, & + varid=acsnom_ID, dim=1, wformat=wformat) + + ! accumulated snow on grid + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%acsnow, & + varid=acsnow_ID, dim=1, wformat=wformat) + + ! actual no. of snow layers + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%isnow, & + varid=isnow_ID, dim=1, wformat=wformat) + + ! vegetation leaf temperature + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%tv, & + varid=tv_ID, dim=1, wformat=wformat) + + ! bulk ground surface temperature + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%tg, & + varid=tg_ID, dim=1, wformat=wformat) + + ! canopy-intercepted ice + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%canice, & + varid=canice_ID, dim=1, wformat=wformat) + + ! canopy-intercepted liquid water + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%canliq, & + varid=canliq_ID, dim=1, wformat=wformat) + + ! canopy air vapor pressure + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%eah, & + varid=eah_ID, dim=1, wformat=wformat) + + ! canopy air temperature + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%tah, & + varid=tah_ID, dim=1, wformat=wformat) + + ! bulk momentum drag coefficient + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%cm, & + varid=cm_ID, dim=1, wformat=wformat) + + ! bulk sensible heat exchange coefficient + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%ch, & + varid=ch_ID, dim=1, wformat=wformat) + + ! wetted or snowed fraction of canopy + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%fwet, & + varid=fwet_ID, dim=1, wformat=wformat) + + ! snow mass at last time step + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%sneqvo, & + varid=sneqvo_ID, dim=1, wformat=wformat) + + ! snow albedo at last time step + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%albold, & + varid=albold_ID, dim=1, wformat=wformat) + + ! snowfall on the ground + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qsnow, & + varid=qsnow_ID, dim=1, wformat=wformat) + + ! lake water storage + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%wslake, & + varid=wslake_ID, dim=1, wformat=wformat) + + ! water table depth + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%zwt, & + varid=zwt_ID, dim=1, wformat=wformat) + + ! water in the "aquifer" + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%wa, & + varid=wa_ID, dim=1, wformat=wformat) + + ! water in aquifer and saturated soil + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%wt, & + varid=wt_ID, dim=1, wformat=wformat) + + ! snow layer temperature + do l=1, NoahMP50_struc(n)%nsnow ! TODO: check loop + tmptilen = 0 + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tmptilen(t) = NoahMP50_struc(n)%noahmp50(t)%tsno(l) + enddo + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, & + varid=tsno_ID, dim=l, wformat=wformat) + enddo + ! snow/soil layer depth from snow surface + do l=1, NoahMP50_struc(n)%nsnow+NoahMP50_struc(n)%nsoil ! TODO: check loop + tmptilen = 0 + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tmptilen(t) = NoahMP50_struc(n)%noahmp50(t)%zss(l) + enddo + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, & + varid=zss_ID, dim=l, wformat=wformat) + enddo + ! snow layer ice + do l=1, NoahMP50_struc(n)%nsnow ! TODO: check loop + tmptilen = 0 + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tmptilen(t) = NoahMP50_struc(n)%noahmp50(t)%snowice(l) + enddo + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, & + varid=snowice_ID, dim=l, wformat=wformat) + enddo + ! snow layer liquid water + do l=1, NoahMP50_struc(n)%nsnow ! TODO: check loop + tmptilen = 0 + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tmptilen(t) = NoahMP50_struc(n)%noahmp50(t)%snowliq(l) + enddo + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, & + varid=snowliq_ID, dim=l, wformat=wformat) + enddo + ! leaf mass + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%lfmass, & + varid=lfmass_ID, dim=1, wformat=wformat) + + ! mass of fine roots + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%rtmass, & + varid=rtmass_ID, dim=1, wformat=wformat) + + ! stem mass + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%stmass, & + varid=stmass_ID, dim=1, wformat=wformat) + + ! mass of wood (including woody roots) + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%wood, & + varid=wood_ID, dim=1, wformat=wformat) + + ! stable carbon in deep soil + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%stblcp, & + varid=stblcp_ID, dim=1, wformat=wformat) + + ! short-lived carbon in shallow soil + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%fastcp, & + varid=fastcp_ID, dim=1, wformat=wformat) + + ! leaf area index + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%lai, & + varid=lai_ID, dim=1, wformat=wformat) + + ! stem area index + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%sai, & + varid=sai_ID, dim=1, wformat=wformat) + + ! snow age factor + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%tauss, & + varid=tauss_ID, dim=1, wformat=wformat) + + ! for MMF groundwater + if (NoahMP50_struc(n)%runsub_opt == 5) then + + ! equilibrium volumetric soil moisture content + do l=1, NoahMP50_struc(n)%nsoil ! TODO: check loop + tmptilen = 0 + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tmptilen(t) = NoahMP50_struc(n)%noahmp50(t)%smoiseq(l) + enddo + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, & + varid=smoiseq_ID, dim=l, wformat=wformat) + enddo + + ! soil moisture content in the layer to the water table when deep + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%smcwtd, & + varid=smcwtd_ID, dim=1, wformat=wformat) + + ! recharge to the water table when deep + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%deeprech, & + varid=deeprech_ID, dim=1, wformat=wformat) + + ! recharge to the water table (diagnostic) + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%rech, & + varid=rech_ID, dim=1, wformat=wformat) + + ! groundwater expotential parameter + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%pexp, & + varid=pexp_ID, dim=1, wformat=wformat) + + ! river area + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%area, & + varid=area_ID, dim=1, wformat=wformat) + + ! groundwater baseflow + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qrf, & + varid=qrf_ID, dim=1, wformat=wformat) + + ! seeping water + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qspring, & + varid=qspring_ID, dim=1, wformat=wformat) + + ! accumulated lateral flow + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qslat, & + varid=qslat_ID, dim=1, wformat=wformat) + + ! accumulated GW baseflow + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qrfs, & + varid=qrfs_ID, dim=1, wformat=wformat) + + ! accumulated seeping water + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qsprings, & + varid=qsprings_ID, dim=1, wformat=wformat) + + ! depth + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%fdepth, & + varid=fdepth_ID, dim=1, wformat=wformat) + + ! river conductivity + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%rivercond, & + varid=rivercond_ID, dim=1, wformat=wformat) + + ! riverbed depth + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%riverbed, & + varid=riverbed_ID, dim=1, wformat=wformat) + + ! equilibrium water table depth + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%eqzwt, & + varid=eqzwt_ID, dim=1, wformat=wformat) + + endif + + ! for irrigation + if (NoahMP50_struc(n)%irr_opt >0) then + ! sprinkler irrigation count + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irnumsi, & + varid=irnumsi_ID, dim=1, wformat=wformat) + + ! micro irrigation count + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irnummi, & + varid=irnummi_ID, dim=1, wformat=wformat) + + ! flood irrigation count + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irnumfi, & + varid=irnumfi_ID, dim=1, wformat=wformat) + + ! sprinkler irrigation water amount + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irwatsi, & + varid=irwatsi_ID, dim=1, wformat=wformat) + + ! micro irrigation water amount + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irwatmi, & + varid=irwatmi_ID, dim=1, wformat=wformat) + + ! flood irrigation water amount + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irwatfi, & + varid=irwatfi_ID, dim=1, wformat=wformat) + + ! sprinkler irrigation water volume + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irsivol, & + varid=irsivol_ID, dim=1, wformat=wformat) + + ! micro irrigation water volume + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irmivol, & + varid=irmivol_ID, dim=1, wformat=wformat) + + ! flood irrigation water volume + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irfivol, & + varid=irfivol_ID, dim=1, wformat=wformat) + + ! loss of irrigation water to evaporation + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%ireloss, & + varid=ireloss_ID, dim=1, wformat=wformat) + + ! latent heating from sprinkler evaporation + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%irrsplh, & + varid=irrsplh_ID, dim=1, wformat=wformat) + + endif + + ! for tile drainage + if (NoahMP50_struc(n)%tdrn_opt >0) then + ! accumulated tile drainage discharge + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%qtdrain, & + varid=qtdrain_ID, dim=1, wformat=wformat) + endif + + ! mass of grain XING + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%grain, & + varid=grain_ID, dim=1, wformat=wformat) + + ! growing degree days XING (based on 10C) + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%gdd, & + varid=gdd_ID, dim=1, wformat=wformat) + + ! growing degree days XING + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%pgs, & + varid=pgs_ID, dim=1, wformat=wformat) + + ! for additional variables + ! accumulated ground heat flux + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accssoil, & + varid=accssoil_ID, dim=1, wformat=wformat) + + ! accumulated soil surface water flux + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accqinsur, & + varid=accqinsur_ID, dim=1, wformat=wformat) + + ! accumulated soil surface evaporation + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accqseva, & + varid=accqseva_ID, dim=1, wformat=wformat) + + ! accumulated plant transpiration each layer + do l=1, NoahMP50_struc(n)%nsoil ! TODO: check loop + tmptilen = 0 + do t=1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tmptilen(t) = NoahMP50_struc(n)%noahmp50(t)%accetrani(l) + enddo + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, tmptilen, & + varid=accetrani_ID, dim=l, wformat=wformat) + enddo + + ! accumulated water storage change + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accdwater, & + varid=accdwater_ID, dim=1, wformat=wformat) + + ! accumulated precipitation + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accprcp, & + varid=accprcp_ID, dim=1, wformat=wformat) + + ! accumulated canopy evaporation + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accecan, & + varid=accecan_ID, dim=1, wformat=wformat) + + ! accumulated transpiration + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accetran, & + varid=accetran_ID, dim=1, wformat=wformat) + + ! accumulated net soil evaporation + call LIS_writevar_restart(ftn, n, LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50%accedir, & + varid=accedir_ID, dim=1, wformat=wformat) + + + !!! END OF writing state variables + +end subroutine NoahMP50_dump_restart diff --git a/lis/surfacemodels/land/noahmp.5.0/cpl_wrf_noesmf/noahMP50_setwrfexport.F90 b/lis/surfacemodels/land/noahmp.5.0/cpl_wrf_noesmf/noahMP50_setwrfexport.F90 new file mode 100755 index 000000000..4b4ca5434 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/cpl_wrf_noesmf/noahMP50_setwrfexport.F90 @@ -0,0 +1,125 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! +! !ROUTINE: NoahMP50_setwrfexport.F90 +! +! !DESCRIPTION: +! Defines the export states from NoahMP to WRF in coupled mode +! surface albedo (albedo) +! soil moisture content (smc 1:4) +! soil temperature (stc 1:4) +! snow water equivalent (snow) +! snow height (snowh) +! volumetric liquid soil moisture (sh2o 1:4) +! if WRF_HYDRO +! infiltration excess (infxsrt) +! soil drainage (soldrain) +! +! !REVISION HISTORY: +! 02 Dec 2003; Sujay Kumar, Initial Version +! 17 Nov 2008; Sujay Kumar, Modified for the ESMF coupled version +! 28 Jun 2018; Chandana Gangodagamage Modified for the NoahMP.3.6 +! May 2023: Cenlin He, modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine NoahMP50_setwrfexport(n) +! !USES: + use ESMF + use LIS_coreMod + use LIS_historyMod, only : LIS_patch2tile + use LIS_logMod + use LISWRFGridCompMod, only : LISWRF_export + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n +!EOP + integer :: i,j,k,t + real, allocatable :: temp(:) + + allocate(temp(LIS_rc%npatch(n,LIS_rc%lsm_index))) + ! surface albedo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%albedo_t,& + NoahMP50_struc(n)%noahmp50%albedo) +#ifdef WRF_HYDRO + ! infiltration excess + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%infxsrt_t,& + NoahMP50_struc(n)%noahmp50%infxs1rt) + ! soil drainage + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%soldrain_t,& + NoahMP50_struc(n)%noahmp50%soldrain1rt) +#endif + ! soil moisture content layers 1:4 + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%smc(1) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%smc1_t,& + temp) + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%smc(2) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%smc2_t,& + temp) + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%smc(3) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%smc3_t,& + temp) + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%smc(4) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%smc4_t,& + temp) + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%tslb(1) + enddo + ! soil temperature layers 1:4 + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%stc1_t,temp) + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%tslb(2) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%stc2_t,temp) + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%tslb(3) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%stc3_t,temp) + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%tslb(4) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%stc4_t,temp) + ! snow water equivalent + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%snow_t,& + NoahMP50_struc(n)%noahmp50%sneqv*1000.0) + ! snow height NUWRF EMK + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%snowh_t,& + NoahMP50_struc(n)%noahmp50%snowh) + ! volumetric liquid soil moisture layers 1:4 + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%sh2o(1) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%sh2o1_t,temp) + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%sh2o(2) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%sh2o2_t,temp) + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%sh2o(3) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%sh2o3_t,temp) + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + temp(i) = NoahMP50_struc(n)%noahmp50(i)%sh2o(4) + enddo + call LIS_patch2tile(n,LIS_rc%lsm_index,LISWRF_export(n)%sh2o4_t,temp) + deallocate(temp) + +end subroutine NoahMP50_setwrfexport + diff --git a/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_getCROCUSexport.F90 b/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_getCROCUSexport.F90 new file mode 100644 index 000000000..f5048c9ee --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_getCROCUSexport.F90 @@ -0,0 +1,73 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getCROCUSexport +! \label{noahmp50_getCROCUSexport} +! +! !REVISION HISTORY: +! 19 Sep 2020: Sujay Kumar; Initial Specification +! 17 Nov 2020: Mahdi Navari; In analogous to ISBA-Crocus %tgb replaced with %tslb +! 2 Dec 2020: Mahdi Navari; Edited to add soil volumetric liquid and frozen water content +! May 2023: Cenlin He; modified to work with refactored Noah-MP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getCROCUSexport(n, LSM2SUBLSM_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM2SUBLSM_State +! +! !DESCRIPTION: +! +! +!EOP + + + + type(ESMF_Field) :: gtField + type(ESMF_Field) :: XWGIField + type(ESMF_Field) :: XWGField + real, pointer :: gt(:) + real, pointer :: XWGI(:) + real, pointer :: XWG(:) + integer :: t + integer :: status + + call ESMF_StateGet(LSM2SUBLSM_State,"Ground temperature",gtField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM2SUBLSM_State,"soil volumetric liquid water content",XWGField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM2SUBLSM_State,"soil volumetric frozen water content",XWGIField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(gtField,localDE=0,farrayPtr=gt,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(XWGField,localDE=0,farrayPtr=XWG,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(XWGIField,localDE=0,farrayPtr=XWGI,rc=status) + call LIS_verify(status) + + + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + gt(t) = NoahMP50_struc(n)%noahmp50(t)%tslb(1) + !gt(t) = NoahMP50_struc(n)%noahmp50(t)%tgb + XWGI(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) - NoahMP50_struc(n)%noahmp50(t)%sh2o(1) ! volumetric frozen soil moisture [m3/m3] + XWG(t) = NoahMP50_struc(n)%noahmp50(t)%sh2o(1) ! volumetric liquid soil moisture [m3/m3] + enddo + + +end subroutine noahmp50_getCROCUSexport diff --git a/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_getSnowModelexport.F90 b/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_getSnowModelexport.F90 new file mode 100644 index 000000000..b32188543 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_getSnowModelexport.F90 @@ -0,0 +1,74 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getSnowModelexport +! \label{noahmp50_getSnowModelexport} +! +! !REVISION HISTORY: +! 19 Sep 2020: Sujay Kumar; Initial Specification +! 17 Nov 2020: Mahdi Navari; In analogous to ISBA-Crocus %tgb replaced with %tslb +! 2 Dec 2020: Mahdi Navari; Edited to add soil volumetric liquid and frozen water content +! 12 Aug 2021: Kristi Arsenault; Added SnowModel connections +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getSnowModelexport(n, LSM2SUBLSM_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM2SUBLSM_State +! +! !DESCRIPTION: +! +! +!EOP + +#if 0 + type(ESMF_Field) :: gtField + type(ESMF_Field) :: XWGIField + type(ESMF_Field) :: XWGField + real, pointer :: gt(:) + real, pointer :: XWGI(:) + real, pointer :: XWG(:) + integer :: t + integer :: status + + call ESMF_StateGet(LSM2SUBLSM_State,"Ground temperature",gtField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM2SUBLSM_State,"soil volumetric liquid water content",XWGField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM2SUBLSM_State,"soil volumetric frozen water content",XWGIField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(gtField,localDE=0,farrayPtr=gt,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(XWGField,localDE=0,farrayPtr=XWG,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(XWGIField,localDE=0,farrayPtr=XWGI,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + gt(t) = NoahMP50_struc(n)%noahmp50(t)%tslb(1) + !gt(t) = NoahMP50_struc(n)%noahmp50(t)%tgb + XWGI(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) - NoahMP50_struc(n)%noahmp50(t)%sh2o(1) ! volumetric frozen soil moisture [m3/m3] + XWG(t) = NoahMP50_struc(n)%noahmp50(t)%sh2o(1) ! volumetric liquid soil moisture [m3/m3] + enddo + +#endif + +end subroutine noahmp50_getSnowModelexport + + diff --git a/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_setCROCUSimport.F90 b/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_setCROCUSimport.F90 new file mode 100755 index 000000000..ef3946479 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_setCROCUSimport.F90 @@ -0,0 +1,62 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_setCROCUSimport +! \label{noahmp50_setCROCUSimport} +! +! !REVISION HISTORY: +! 19 Sep 2020: Sujay Kumar; Initial Specification +! May 2023: Cenlin He; Modified to work with refactored Noah-MP v5 and later +! +! !INTERFACE: +subroutine noahmp50_setCROCUSimport(n, SubLSM2LSM_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: SubLSM2LSM_State +! +! !DESCRIPTION: +! +! +!EOP + type(ESMF_Field) :: snwdField, sweField + real, pointer :: swe(:), snwd(:) + real :: dsneqv,dsnowh + integer :: t + integer :: status + + call ESMF_StateGet(SubLSM2LSM_State,"Total SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(SubLSM2LSM_State,"Total snowdepth",snwdField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snwdField,localDE=0,farrayPtr=snwd,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + dsneqv = swe(t) - NoahMP50_struc(n)%noahmp50(t)%sneqv !in mm + dsnowh = snwd(t) - NoahMP50_struc(n)%noahmp50(t)%snowh !in m + + ! update + call noahmp50_snow_update(n, t, dsneqv, dsnowh) + + enddo + +end subroutine noahmp50_setCROCUSimport + + diff --git a/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_setSnowModelimport.F90 b/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_setSnowModelimport.F90 new file mode 100755 index 000000000..64b74e60d --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/cplsubLSM/noahmp50_setSnowModelimport.F90 @@ -0,0 +1,69 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_setSnowModelimport +! \label{noahmp50_setSnowModelimport} +! +! !REVISION HISTORY: +! 19 Sep 2020: Sujay Kumar; Initial Specification +! 12 Aug 2021: Kristi Arsenault; Added SnowModel +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_setSnowModelimport(n, SubLSM2LSM_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: SubLSM2LSM_State +! +! !DESCRIPTION: +! +! +!EOP + type(ESMF_Field) :: snwdField, sweField + real, pointer :: swe(:), snwd(:) + real :: dsneqv,dsnowh + integer :: t + integer :: status + + call ESMF_StateGet(SubLSM2LSM_State,"Total SWE",sweField,rc=status) + call LIS_verify(status,"noahmp50_setSnowModelimport: error in swe state get from SnowModel") + call ESMF_StateGet(SubLSM2LSM_State,"Total snowdepth",snwdField,rc=status) + call LIS_verify(status,"noahmp50_setSnowModelimport: error in snwd state get from SnowModel") + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status,"noahmp50_setSnowModelimport: error in swe data values") + call ESMF_FieldGet(snwdField,localDE=0,farrayPtr=snwd,rc=status) + call LIS_verify(status,"noahmp50_setSnowModelimport: error in snwd data values") + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + ! SnowModel has its SWE in meters -- conversion here to mm: + dsneqv = (swe(t)*1000.) - NoahMP50_struc(n)%noahmp50(t)%sneqv !in mm + dsnowh = snwd(t) - NoahMP50_struc(n)%noahmp50(t)%snowh !in m + +! if( dsneqv > 0. .or. dsnowh > 0. ) then +! write(501,*) t, swe(t), noahmp50_struc(n)%noahmp50(t)%sneqv, & +! snwd(t), noahmp50_struc(n)%noahmp50(t)%snowh +! endif + + ! Update NoahMP's Snow states: + call noahmp50_snow_update(n, t, dsneqv, dsnowh) + + enddo + +end subroutine noahmp50_setSnowModelimport + + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_daveg_Mod.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_daveg_Mod.F90 new file mode 100755 index 000000000..e89f7009f --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_daveg_Mod.F90 @@ -0,0 +1,53 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +module noahmp50_daveg_Mod +!BOP +! +! !MODULE: noahmp50_daveg_Mod +! +! !DESCRIPTION: +! +! !REVISION HISTORY: +! 13 Feb 2020: Sujay Kumar; Initial Specification +! +! !USES: + use ESMF + use LIS_coreMod + use LIS_dataAssimMod + use LIS_logMod + + implicit none + + PRIVATE +!----------------------------------------------------------------------------- +! !PUBLIC MEMBER FUNCTIONS: +!----------------------------------------------------------------------------- + public :: noahmp50_daveg_init +!EOP + +contains +!BOP +! +! !ROUTINE: noahmp50_daveg_init +! \label{noahmp50_daveg_init} +! +! !INTERFACE: + subroutine noahmp50_daveg_init(k) +! !USES: +! !DESCRIPTION: +! +!EOP + + implicit none + integer, intent(in) :: k + + end subroutine noahmp50_daveg_init +end module noahmp50_daveg_Mod diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_descale_veg.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_descale_veg.F90 new file mode 100755 index 000000000..97b64b50a --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_descale_veg.F90 @@ -0,0 +1,46 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_descale_veg +! \label{noahmp50_descale_veg} +! +! !REVISION HISTORY: +! 13 Feb 2020: Sujay Kumar; Initial Specification +! +! !INTERFACE: +subroutine noahmp50_descale_veg(n, LSM_State, LSM_Incr_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! Descales ESI related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + + +end subroutine noahmp50_descale_veg + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_getLAIpred.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_getLAIpred.F90 new file mode 100755 index 000000000..6ceca1900 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_getLAIpred.F90 @@ -0,0 +1,62 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getLAIpred +! \label{noahmp50_getLAIpred} +! +! !REVISION HISTORY: +! 13 Feb 2020: Sujay Kumar; Initial Specification +! +! !INTERFACE: +subroutine noahmp50_getLAIpred(n, k,obs_pred) +! !USES: + use ESMF + use LIS_constantsMod + use LIS_coreMod + use LIS_dataAssimMod + use LIS_DAobservationsMod + use noahmp50_lsmMod + use noahmp50_dasoilm_Mod +!EOP + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + real :: obs_pred(LIS_rc%obs_ngrid(k),LIS_rc%nensem(n)) +! +! !DESCRIPTION: +! +! Returns the Soil moisture obs pred (model's estimate of +! observations) for data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[obs\_pred] model's estimate of observations \newline +! \end{description} +!EOP + real :: obs_tmp + integer :: i,t,m,gid,kk + real :: inputs_tp(6) + character*50 :: units_tp(6) + real :: lai(LIS_rc%npatch(n,LIS_rc%lsm_index)) + + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + lai(t) = NoahMP50_struc(n)%noahmp50(t)%lai + enddo + call LIS_convertPatchSpaceToObsEnsSpace(n,k,& + LIS_rc%lsm_index, & + lai,& + obs_pred) + +end subroutine noahmp50_getLAIpred + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_getvegvars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_getvegvars.F90 new file mode 100755 index 000000000..d37f19f3a --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_getvegvars.F90 @@ -0,0 +1,63 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getvegvars +! \label{noahmp50_getvegvars} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 1 Aug 2016: Mahdi Navari; Modified for Noahmp401 +! To do: makes it general for x layers (currently hard coded for 4 layers) +! !INTERFACE: +subroutine noahmp50_getvegvars(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the soilmoisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} + !EOP + + + type(ESMF_Field) :: laiField + + integer :: t + integer :: status + real, pointer :: lai(:) + + call ESMF_StateGet(LSM_State,"LAI",laiField,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(laiField,localDE=0,farrayPtr=lai,rc=status) + call LIS_verify(status) + + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + lai(t) = NoahMP50_struc(n)%noahmp50(t)%lai + enddo + +end subroutine noahmp50_getvegvars + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_qc_LAIobs.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_qc_LAIobs.F90 new file mode 100755 index 000000000..c14e44ff5 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_qc_LAIobs.F90 @@ -0,0 +1,53 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_qc_LAIobs +! \label{noahmp50_qc_LAIobs} +! +! !REVISION HISTORY: +! 25Feb2008: Sujay Kumar: Initial Specification +! 1 Aug 2016: Mahdi Navari; Modified for Noahmp401 +! +! !INTERFACE: +subroutine noahmp50_qc_LAIobs(n,k,OBS_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod, only : LIS_verify + use LIS_constantsMod, only : LIS_CONST_TKFRZ + use LIS_DAobservationsMod + use noahmp50_lsmMod + + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + type(ESMF_State) :: OBS_State +! +! !DESCRIPTION: +! +! This subroutine performs any model-based QC of the observation +! prior to data assimilation. Here the soil moisture observations +! are flagged when LSM indicates that (1) rain is falling (2) +! soil is frozen or (3) ground is fully or partially covered +! with snow MN:(4) ground is covered with vegatation (more than 50%). +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[OBS\_State] ESMF state container for observations \newline +! \end{description} +! +!EOP + + +end subroutine noahmp50_qc_LAIobs + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_qcveg.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_qcveg.F90 new file mode 100755 index 000000000..46743e6ae --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_qcveg.F90 @@ -0,0 +1,169 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_qcveg +! \label{noahmp50_qcveg} +! +! !REVISION HISTORY: +! 13 Feb 2020: Sujay Kumar; Initial Specification +! +! !INTERFACE: +subroutine noahmp50_qcveg(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod, only : LIS_verify + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the soilmoisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} + !EOP + type(ESMF_Field) :: laiField + integer :: t + integer :: status + real, pointer :: lai(:) + + real :: laimax + real :: laimin + + integer :: gid + real :: laitmp + + logical :: update_flag(LIS_rc%ngrid(n)) + real :: perc_violation(LIS_rc%ngrid(n)) + + real :: laimean(LIS_rc%ngrid(n)) + integer :: nlaimean(LIS_rc%ngrid(n)) + + integer :: N_ens + real :: state_tmp(LIS_rc%nensem(n)),state_mean + + call ESMF_StateGet(LSM_State,"LAI",laiField,rc=status) + call LIS_verify(status) + + + call ESMF_FieldGet(laiField,localDE=0,farrayPtr=lai,rc=status) + call LIS_verify(status) + + + call ESMF_AttributeGet(laiField,"Max Value",laimax,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(laiField,"Min Value",laimin,rc=status) + call LIS_verify(status) + + + + update_flag = .true. + perc_violation = 0.0 + laimean = 0.0 + nlaimean = 0 + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + laitmp = lai(t) + + if(laitmp.lt.laimin.or.laitmp.gt.laimax) then + update_flag(gid) = .false. + perc_violation(gid) = perc_violation(gid) +1 + endif + + enddo + + do gid=1,LIS_rc%ngrid(n) + perc_violation(gid) = perc_violation(gid)/LIS_rc%nensem(n) + enddo + +! For ensembles that are unphysical, compute the +! ensemble average after excluding them. This +! is done only if the majority of the ensemble +! members are good (>60%) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + if(.not.update_flag(gid)) then + if(perc_violation(gid).lt.0.8) then + if((lai(t).gt.laimin).and.& + (lai(t).lt.laimax)) then + laimean(gid) = laimean(gid) + & + lai(t) + nlaimean(gid) = nlaimean(gid) + 1 + endif + endif + endif + enddo + + do gid=1,LIS_rc%ngrid(n) + if(nlaimean(gid).gt.0) then + laimean(gid) = laimean(gid)/nlaimean(gid) + endif + enddo + + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + laitmp = lai(t) + +! If the update is unphysical, simply set to the average of +! the good ensemble members. If all else fails, do not +! update. + + if(update_flag(gid)) then + lai(t) = laitmp + elseif(perc_violation(gid).lt.0.8) then + if(laitmp.lt.laimin.or.laitmp.gt.laimax) then + lai(t) = laimean(gid) + else + lai(t) = lai(t) + endif + endif + enddo + +#if 0 + N_ens = LIS_rc%nensem(n) + do t=1,N_ens + state_tmp(t) = lai(t) + enddo + state_mean =sum(state_tmp)/N_ens + + write(113,fmt='(i4.4,i2.2,i2.2,i2.2,i2.2,i2.2,21F8.3)') & + LIS_rc%yr, LIS_rc%mo, LIS_rc%da, LIS_rc%hr, & + LIS_rc%mn, LIS_rc%ss, & + state_mean, & + state_tmp + +#endif + + +end subroutine noahmp50_qcveg + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_scale_veg.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_scale_veg.F90 new file mode 100755 index 000000000..6beff2750 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_scale_veg.F90 @@ -0,0 +1,45 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_scale_veg +! \label{noahmp50_scale_veg} +! +! !REVISION HISTORY: +! 13 Feb 2020: Sujay Kumar; Initial Specification +! +! !INTERFACE: +subroutine noahmp50_scale_veg(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Scales esioisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + + +end subroutine noahmp50_scale_veg + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_setvegvars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_setvegvars.F90 new file mode 100755 index 000000000..0d240773d --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_setvegvars.F90 @@ -0,0 +1,89 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_setvegvars +! \label{noahmp50_setvegvars} +! +! !REVISION HISTORY: +! 13 Feb 2020: Sujay Kumar; Initial Specification +! +! Apply the update if it met the update conditions +! Update conditions: +! 1- Prior SM(sh2o) + increment > MIN_THRESHOLD +! 2- Prior SM(sh2o) + increment < sm_threshold +! There are 3 cases +! 1- If all the ensemble members met the update conditions --> apply the update +! 2- If more than 50% of the ensemble members met the update condition --> +! apply the update for that members and set the other member to the mean +! value of the ensemble (i.e. mean of the members that met the conditions) +! 3- If less then 50% of the ensemble members met the update conditions --> +! adjust the states + + +! !INTERFACE: +subroutine noahmp50_setvegvars(n, LSM_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! This routine assigns the soil moisture prognostic variables to noah's +! model space. +! +!EOP + real, parameter :: MIN_THRESHOLD = 0.02 + type(ESMF_Field) :: laiField,sm1Field + real :: MAX_threshold + real :: sm_threshold + real :: delta1 + integer :: SOILTYP ! soil type index [-] + integer :: t,i,gid,m,t_unpert + integer :: status + real, pointer :: lai(:),soilm1(:) + real :: lfmass + logical :: flag_tmp(LIS_rc%nensem(n)) + logical :: update_flag(LIS_rc%ngrid(n)) + logical :: ens_flag(LIS_rc%nensem(n)) + logical :: update_flag_tile(LIS_rc%npatch(n,LIS_rc%lsm_index)) + logical :: update_flag_ens(LIS_rc%ngrid(n)) + logical :: update_flag_new(LIS_rc%ngrid(n)) + real :: tmp1(LIS_rc%nensem(n)) + integer :: pcount + logical :: bounds_violation + real :: MinEnsSM1 ,MaxEnsSM1 + real :: tmpval + integer :: nIter + real :: smc_tmp + + call ESMF_StateGet(LSM_State,"LAI",laiField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(laiField,localDE=0,farrayPtr=lai,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + if(NoahMP50_struc(n)%noahmp50(t)%param%sla.ne.0) then + NoahMP50_struc(n)%noahmp50(t)%lai = lai(t) + lfmass = lai(t)*1000.0/(NoahMP50_struc(n)%noahmp50(t)%param%sla) + NoahMP50_struc(n)%noahmp50(t)%lfmass = lfmass + endif + enddo + +end subroutine noahmp50_setvegvars + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_updatevegvars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_updatevegvars.F90 new file mode 100755 index 000000000..88308161a --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_updatevegvars.F90 @@ -0,0 +1,148 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_updatevegvars +! \label{noahmp50_updatevegvars} +! +! !REVISION HISTORY: +! 13 Feb 2020: Sujay Kumar; Initial Specification +! +! !INTERFACE: +subroutine noahmp50_updatevegvars(n, LSM_State, LSM_Incr_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! This routine assigns the soil moisture prognostic variables to noah's +! model space. +! +!EOP + type(ESMF_Field) :: laiField, laiIncrField + + integer :: t,gid + integer :: status + real, pointer :: lai(:), laiincr(:) + real :: laitmp,laimax,laimin + + logical :: update_flag(LIS_rc%ngrid(n)) + real :: perc_violation(LIS_rc%ngrid(n)) + + real :: laimean(LIS_rc%ngrid(n)) + integer :: nlaimean(LIS_rc%ngrid(n)) + + + call ESMF_StateGet(LSM_State,"LAI",laiField,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(LSM_Incr_State,"LAI",laiIncrField,rc=status) + call LIS_verify(status) + + + call ESMF_FieldGet(laiField,localDE=0,farrayPtr=lai,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(laiIncrField,localDE=0,farrayPtr=laiincr,rc=status) + call LIS_verify(status) + + + call ESMF_AttributeGet(laiField,"Max Value",laimax,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(laiField,"Min Value",laimin,rc=status) + call LIS_verify(status) + + + update_flag = .true. + perc_violation = 0.0 + laimean = 0.0 + nlaimean = 0 + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + laitmp = lai(t) + laiincr(t) + + + if(laitmp.lt.laimin.or.laitmp.gt.laimax) then + update_flag(gid) = .false. + perc_violation(gid) = perc_violation(gid) +1 + endif + + enddo + + do gid=1,LIS_rc%ngrid(n) + perc_violation(gid) = perc_violation(gid)/LIS_rc%nensem(n) + enddo + +! For ensembles that are unphysical, compute the +! ensemble average after excluding them. This +! is done only if the majority of the ensemble +! members are good (>60%) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + if(.not.update_flag(gid)) then + if(perc_violation(gid).lt.0.8) then + if((lai(t)+laiincr(t).gt.laimin).and.& + (lai(t)+laiincr(t).lt.laimax)) then + laimean(gid) = laimean(gid) + & + lai(t) + laiincr(t) + nlaimean(gid) = nlaimean(gid) + 1 + endif + endif + endif + enddo + + do gid=1,LIS_rc%ngrid(n) + if(nlaimean(gid).gt.0) then + laimean(gid) = laimean(gid)/nlaimean(gid) + endif + enddo + + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + laitmp = lai(t) + laiincr(t) + +! If the update is unphysical, simply set to the average of +! the good ensemble members. If all else fails, do not +! update. + + if(update_flag(gid)) then + lai(t) = laitmp + elseif(perc_violation(gid).lt.0.8) then + if(laitmp.lt.laimin.or.laitmp.gt.laimax) then + lai(t) = laimean(gid) + else + lai(t) = lai(t) + laiincr(t) + endif + endif + enddo + +end subroutine noahmp50_updatevegvars + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_veg_DAlog.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_veg_DAlog.F90 new file mode 100755 index 000000000..0a4fb4fec --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_veg_DAlog.F90 @@ -0,0 +1,25 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +! +! 15 Apr 2021: Wanshu Nie; created for Noah-MP4.0.1 +! + +subroutine noahmp50_veg_DAlog(n) + + ! USES: + + ! ARGUMENTS: + integer, intent(in) :: n + + ! DESCRIPTION: + + +end subroutine noahmp50_veg_DAlog + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_write_veg.F90 b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_write_veg.F90 new file mode 100755 index 000000000..e05dafb70 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_LAI/noahmp50_write_veg.F90 @@ -0,0 +1,70 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_write_veg +! \label{noahmp50_write_veg} +! +! !REVISION HISTORY: +! 13 Feb 2020: Sujay Kumar; Initial Specification +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_write_veg(ftn,n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use noahmp50_lsmMod + use LIS_historyMod, only : LIS_writevar_restart + implicit none +! !ARGUMENTS: + integer, intent(in) :: ftn + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the soil moisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + integer :: t + real, allocatable :: tmp(:) + + allocate(tmp(LIS_rc%npatch(n,LIS_rc%lsm_index))) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(2) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(3) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(4) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + deallocate(tmp) + +end subroutine noahmp50_write_veg + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_dasnodep_Mod.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_dasnodep_Mod.F90 new file mode 100755 index 000000000..3ac493dd2 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_dasnodep_Mod.F90 @@ -0,0 +1,49 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +module noahmp50_dasnodep_Mod +!BOP +! +! !MODULE: noahmp50_dasnodep_Mod +! +! !DESCRIPTION: +! +! !REVISION HISTORY: +! +! !USES: + + implicit none + + PRIVATE +!----------------------------------------------------------------------------- +! !PUBLIC MEMBER FUNCTIONS: +!----------------------------------------------------------------------------- + public :: noahmp50_dasnodep_init +!----------------------------------------------------------------------------- +! !PUBLIC TYPES: +!----------------------------------------------------------------------------- +!EOP + + SAVE +contains +!BOP +! +! !ROUTINE: noahmp50_dasnodep_init +! \label{noahmp50_dasnodep_init} +! +! !INTERFACE: + subroutine noahmp50_dasnodep_init() +! !USES: +! !DESCRIPTION: +! +!EOP + implicit none + end subroutine noahmp50_dasnodep_init +end module noahmp50_dasnodep_Mod diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_descale_snodep.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_descale_snodep.F90 new file mode 100644 index 000000000..ee3758ea3 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_descale_snodep.F90 @@ -0,0 +1,72 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_descale_snodep +! \label{noahmp50_descale_snodep} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! +! !INTERFACE: +subroutine noahmp50_descale_snodep(n, LSM_State, LSM_Incr_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use noahmp50_lsmMod + use LIS_logMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + + integer :: t + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + +#if 0 + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + swe(t) = swe(t)*1000.0 + enddo +#endif + +end subroutine noahmp50_descale_snodep + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_getsnodeppred.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_getsnodeppred.F90 new file mode 100644 index 000000000..8a2055bc9 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_getsnodeppred.F90 @@ -0,0 +1,59 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getsnodeppred +! \label{noahmp50_getsnodeppred} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 01 May 2014: Yuqiong Liu; modifed to include mesh8, mesh16, and 0p25 SNODEP data +! 24 May 2017: Yeosang Yoon: updated the file to work with the DA observation +! space updates. +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getsnodeppred(n, k, obs_pred) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc,LIS_surface + use noahmp50_lsmMod + use SNODEPobs_Mod, only: SNODEP_obs_obj + use LIS_DAobservationsMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + real :: obs_pred(LIS_rc%ngrid(n),LIS_rc%nensem(n)) + real :: snwd(LIS_rc%npatch(n,LIS_rc%lsm_index)) +!EOP + + integer :: t + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if (SNODEP_obs_obj(n)%mesh .eq. 8) then + snwd(t) = NoahMP50_struc(n)%noahmp50(t)%snowh*39.37 !convert from meter to inch + elseif (SNODEP_obs_obj(n)%mesh .eq. 16 .or. SNODEP_obs_obj(n)%mesh .eq. 25) then + snwd(t) = NoahMP50_struc(n)%noahmp50(t)%snowh + endif + enddo + + call LIS_convertPatchSpaceToObsEnsSpace(n,k,& + LIS_rc%lsm_index, & + snwd,& + obs_pred) + +end subroutine noahmp50_getsnodeppred + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_getsnodepvars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_getsnodepvars.F90 new file mode 100644 index 000000000..b51d5fc3e --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_getsnodepvars.F90 @@ -0,0 +1,70 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getsnodepvars +! \label{noahmp50_getsnodepvars} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 03OC2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! May 2023: Cenlin He; Modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getsnodepvars(n, LSM_State) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +! +!EOP + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + + integer :: t + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + snod(t) = NoahMP50_struc(n)%noahmp50(t)%snowh + enddo +end subroutine noahmp50_getsnodepvars + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_map_snodep.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_map_snodep.F90 new file mode 100644 index 000000000..f9ede066e --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_map_snodep.F90 @@ -0,0 +1,136 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_map_snodep +! \label{noahmp50_map_snodep} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! May 2023: Cenlin He; Modified for NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_map_snodep(n,k,OBS_State,LSM_Incr_State) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_surface + use LIS_constantsMod, only : LIS_CONST_TKFRZ + use LIS_logMod, only : LIS_logunit, LIS_verify + use LIS_lsmMod + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + type(ESMF_State) :: OBS_State + type(ESMF_State) :: LSM_Incr_State +! !DESCRIPTION: +! +! This subroutine directly maps the observation state to the corresponding +! variables in the LSM state for SNODEP data assimilation. +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[OBS\_State] ESMF State for observations \newline +! \item[LSM\_State] ESMF State for LSM state variables \newline +! \end{description} +! +!EOP + type(ESMF_Field) :: sweIncrField + type(ESMF_Field) :: obs_snodep_field + real, pointer :: sweincr(:) + type(ESMF_Field) :: snodIncrField + real, pointer :: snodincr(:) + real :: tmpsneqv + real, pointer :: snodepobs(:) + integer :: t + integer :: status + integer :: obs_state_count + integer :: st_id, en_id + character*100,allocatable :: obs_state_objs(:) + real, allocatable :: noahmp50_swe(:) + real, allocatable :: noahmp50_snod(:) + real, allocatable :: snod(:) + + allocate(noahmp50_swe(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(noahmp50_snod(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(snod(LIS_rc%npatch(n,LIS_rc%lsm_index))) + + call ESMF_StateGet(LSM_Incr_State,"SWE",sweIncrField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweIncrField,localDE=0,farrayPtr=sweincr,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(LSM_Incr_State,"Snowdepth",snodincrField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(snodincrField,localDE=0,farrayPtr=snodincr,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(OBS_State,itemCount=obs_state_count,rc=status) + call LIS_verify(status) + allocate(obs_state_objs(obs_state_count)) + + call ESMF_StateGet(OBS_State,itemNameList=obs_state_objs,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(OBS_State,obs_state_objs(1),obs_snodep_field,& + rc=status) + call LIS_verify(status) + call ESMF_FieldGet(obs_snodep_field,localDE=0,farrayPtr=snodepobs,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + noahmp50_swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + noahmp50_snod(t) = NoahMP50_struc(n)%noahmp50(t)%snowh + enddo + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + call LIS_lsm_DAmapTileSpaceToObsSpace(n,k,t,st_id,en_id) + +! Assume here that st_id and en_id are the same and that we are +! working with an model grid finer than the observation grid + + if(snodepobs(st_id).ge.0) then + if(noahmp50_snod(t).gt.1e-6) then + tmpsneqv = noahmp50_swe(t)/noahmp50_snod(t) + else + tmpsneqv = 0.0 + endif + + snod(t) = snodepobs(st_id) + +! Based on SNODEP, we manually update SWE + if(snod(t).lt.2.54E-3) tmpsneqv = 0.0 + if(snod(t).ge.2.54E-3.and.tmpsneqv.lt.0.001) then + tmpsneqv = 0.20 + endif + sweincr(t) = tmpsneqv*snod(t) - noahmp50_swe(t) + snodincr(t) = snod(t) - noahmp50_snod(t) + else + sweincr(t) = 0 + snodincr(t) = 0 + endif + enddo +! stop + deallocate(obs_state_objs) + deallocate(noahmp50_swe) + deallocate(noahmp50_snod) + deallocate(snod) + +end subroutine noahmp50_map_snodep + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_qc_snodepobs.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_qc_snodepobs.F90 new file mode 100755 index 000000000..7936d803e --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_qc_snodepobs.F90 @@ -0,0 +1,106 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_qc_snodepobs +! \label{noahmp50_qc_snodepobs} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 30 Jan 2015: Yuqiong Liu; added additional QC +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! May 2023: Cenlin He; Modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_qc_snodepobs(n,k,OBS_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod, only : LIS_verify + use LIS_constantsMod, only : LIS_CONST_TKFRZ + use LIS_DAobservationsMod + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + type(ESMF_State) :: OBS_State +! +! !DESCRIPTION: +! +! This subroutine performs any model-based QC of the observation +! prior to data assimilation. Here the snow observations +! are flagged when LSM indicates that (1) rain is falling (2) +! ground is fully or partially covered with snow. +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[OBS\_State] ESMF state container for observations \newline +! \end{description} +! +!EOP + type(ESMF_Field) :: obs_snow_field + + real, pointer :: snowobs(:) + integer :: t + integer :: gid + integer :: status + real :: stc1(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: vegt(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: fveg_obs(LIS_rc%obs_ngrid(k)) + real :: tv_obs(LIS_rc%obs_ngrid(k)) + real :: stc1_obs(LIS_rc%obs_ngrid(k)) + real :: vegt_obs(LIS_rc%obs_ngrid(k)) + + call ESMF_StateGet(OBS_State,"Observation01",obs_snow_field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet failed in noahmp50_qc_snodepobs") + call ESMF_FieldGet(obs_snow_field,localDE=0,farrayPtr=snowobs,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet failed in noahmp50_qc_snodepobs") + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + !stc1(t) = NoahMP50_struc(n)%noahmp50(t)%sstc(1) ! get snow/veg temp. + stc1(t) = NoahMP50_struc(n)%noahmp50(t)%tslb(1) ! get snow/veg temp. + vegt(t) = LIS_surface(n,1)%tile(t)%vegt + enddo + + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50(:)%tv,tv_obs) !tv: vegetation temperature. unit: K + call LIS_convertPatchSpaceToObsSpace(n,k,LIS_rc%lsm_index, & !fveg: green vegetation fraction. unit: - + NoahMP50_struc(n)%noahmp50(:)%fveg,fveg_obs) + + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index,stc1,stc1_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index,vegt,vegt_obs) + +! do t=1,LIS_rc%obs_ngrid(k) +! if(snowobs(t).ne.LIS_rc%udef) then +! if(fveg_obs(t).gt.0.7) then +! snowobs(t) = LIS_rc%udef +! ! elseif(vegt_obs(t).le.4) then !forest types +! ! snowobs(t) = LIS_rc%udef +! !assume that snow will not form at 5 deg. celcius or higher ground temp. +! elseif(tv_obs(t).ge.278.15) then +! snowobs(t) = LIS_rc%udef +! elseif(stc1_obs(t).ge.278.15) then +! snowobs(t) = LIS_rc%udef +! endif +! endif +! enddo + +end subroutine noahmp50_qc_snodepobs + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_qcsnodep.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_qcsnodep.F90 new file mode 100644 index 000000000..6e8dd1300 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_qcsnodep.F90 @@ -0,0 +1,125 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_qcsnodep +! \label{noahmp50_qcsnow} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 30 Jan 2015: Yuqiong Liu; added additional QC +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! 09 Jan 2020: Yeosang Yoon; update QC +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_qcsnodep(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod + use noahmp50_lsmMod + use LIS_logMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! QC's the related state prognostic variable objects for +! SNODEP data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + integer :: t, gid + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + + real :: swemax,snodmax + real :: swemin,snodmin + + real :: sndens + logical :: update_flag(LIS_rc%ngrid(n)) + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + call ESMF_AttributeGet(sweField,"Max Value",swemax,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(sweField,"Min Value",swemin,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(snodField,"Max Value",snodmax,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(snodField,"Min Value",snodmin,rc=status) + call LIS_verify(status) + + update_flag = .true. + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + if((snod(t).lt.snodmin) .or. swe(t).lt.swemin) then + update_flag(gid) = .false. + endif + + enddo + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + +!Use the model's snow density from the previous timestep + sndens = 0.0 + if(NoahMP50_struc(n)%noahmp50(t)%snowh.gt.0) then + sndens = NoahMP50_struc(n)%noahmp50(t)%sneqv/NoahMP50_struc(n)%noahmp50(t)%snowh + endif + +!If the update is unphysical, do not update. + if(update_flag(gid)) then + snod(t) = snod(t) + swe(t) = snod(t)*sndens + else ! do not update + snod(t) = NoahMP50_struc(n)%noahmp50(t)%snowh + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + end if + + if(swe(t).gt.swemax) then + swe(t) = swemax + endif + if(snod(t).gt.snodmax) then + snod(t) = snodmax + endif + + end do + +end subroutine noahmp50_qcsnodep + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_scale_snodep.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_scale_snodep.F90 new file mode 100644 index 000000000..d26a63d10 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_scale_snodep.F90 @@ -0,0 +1,73 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_scale_snodep +! \label{noahmp50_scale_snodep} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! May 2023: Cenlin He; Modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_scale_snodep(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use noahmp50_lsmMod + use LIS_logMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + + integer :: t + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + +#if 0 + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + swe(t) = swe(t)/1000.0 + enddo +#endif + +end subroutine noahmp50_scale_snodep + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_setsnodepvars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_setsnodepvars.F90 new file mode 100644 index 000000000..1237965b0 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_setsnodepvars.F90 @@ -0,0 +1,112 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_setsnodepvars +! \label{noahmp50_setsnodepvars} +! +! !REVISION HISTORY: +! 15 Aug 2017: Sujay Kumar; Initial Specification +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! 10 Nov 2020: Eric Kemp; Added update to LIS_snow_struc +! May 2023: Cenlin He; Modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_setsnodepvars(n, LSM_State) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_domain, LIS_surface + use LIS_logMod, only : LIS_logunit, LIS_verify + use LIS_snowMod, only : LIS_snow_struc + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! This routine assigns the snow progognostic variables to noah's +! model space. The state vector consists of total SWE and snow depth. +! This routine also updates other model prognostics (snice, snliq, +! snow thickness, snow temperature) based on the update. +! +!EOP + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + real, pointer :: swe(:) + real, pointer :: snod(:) + real :: dsneqv,dsnowh + integer :: t + integer :: status + integer :: ncount(LIS_rc%ngrid(n)) + integer :: tid, gid + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + dsneqv = swe(t) - NoahMP50_struc(n)%noahmp50(t)%sneqv !in mm + dsnowh = snod(t) - NoahMP50_struc(n)%noahmp50(t)%snowh !in m + + ! update + call noahmp50_snodep_update(n, t, dsneqv, dsnowh) + + enddo + + if (LIS_rc%snowsrc(n) .gt. 0) then + + ncount = 0 ! Number of tiles per grid id (over land) + LIS_snow_struc(n)%snowdepth = 0 ! At grid points + LIS_snow_struc(n)%sneqv = 0 ! At tiles + + ! Collect SWE at tiles + do t = 1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tid = LIS_surface(n, LIS_rc%lsm_index)%tile(t)%tile_id + LIS_snow_struc(n)%sneqv(tid) = LIS_snow_struc(n)%sneqv(tid) + & + NoahMP50_struc(n)%noahmp50(t)%sneqv + end do + + ! Collect mean snow depth at grid points + do t = 1, LIS_rc%npatch(n, LIS_rc%lsm_index) + gid = LIS_surface(n,LIS_rc%lsm_index)%tile(t)%index + LIS_snow_struc(n)%snowdepth(gid) = & + LIS_snow_struc(n)%snowdepth(gid) + & + NoahMP50_struc(n)%noahmp50(t)%snowh + ncount(gid) = ncount(gid) + 1 + end do + do t = 1, LIS_rc%ngrid(n) + if (ncount(t).gt.0) then + LIS_snow_struc(n)%snowdepth(t) = & + LIS_snow_struc(n)%snowdepth(t) / ncount(t) + else + LIS_snow_struc(n)%snowdepth(t) = 0.0 + endif + end do + end if + +end subroutine noahmp50_setsnodepvars + + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_snodep_update.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_snodep_update.F90 new file mode 100644 index 000000000..4074f0542 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_snodep_update.F90 @@ -0,0 +1,372 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_snodep_update +! \label{noahmp50_snodep_update} +! +! !REVISION HISTORY: +! 13 Aug 2017: Sujay Kumar; Initial specification +! 14 Dec 2018: Yeosang Yoon; Modified code for NoahMP 4.0.1 +! May 2023: Cenlin He; Modified for refactored NoahMP v5 and later +! +! !INTERFACE +subroutine noahmp50_snodep_update(n, t, dsneqv, dsnowh) + + use LIS_coreMod + use NoahMP50_lsmMod + use NoahMP50_snowphys_updateMod + + implicit none +! +! !DESCRIPTION: +! This subroutine updates relevant snow prognostics based +! on the update to the total SWE (dsneqv) and total +! snow depth (dsnowh). The updated variables include +! number of snow layers, snice, snliq, snow temperature +! and snow thickness. +! +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: t + real :: dsneqv !mm + real :: dsnowh !m +!EOP + real, parameter :: tfrz = 273.16 !freezing/melting point (k) + real, parameter :: hfus = 0.3336E06 !latent heat of fusion (j/kg) + real, parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) + real, parameter :: DENH2O = 1000.0 !density of water (kg/m3) + real, allocatable, dimension(:) :: zsoil + real, allocatable, dimension(:) :: ficeold + real, allocatable, dimension(:) :: snice + real, allocatable, dimension(:) :: snliq + real, allocatable, dimension(:) :: stc + real, allocatable, dimension(:) :: supercool + real, allocatable, dimension(:) :: mice + real, allocatable, dimension(:) :: mliq + real, allocatable, dimension(:) :: dzsnso + real, allocatable, dimension(:) :: zsnso + real, allocatable, dimension(:) :: BEXP + real, allocatable, dimension(:) :: PSISAT + real, allocatable, dimension(:) :: SMCMAX + + integer, allocatable, dimension(:) :: imelt !phase change index + real, allocatable, dimension(:) :: sice + + integer :: snl_idx,i,j,iz + integer :: iloc, jloc ! needed, but not use + real :: smp,sneqv,snowh + real :: sneqv1,snowh1 + real :: ponding1,ponding2 + integer :: newnode + integer :: isnow, nsoil, nsnow, soiltype(4), isoil + +! local + real :: SNOFLOW, BDSNOW + + isnow = NoahMP50_struc(n)%noahmp50(t)%isnow + nsoil = NoahMP50_struc(n)%nsoil + nsnow = NoahMP50_struc(n)%nsnow + + allocate(ficeold(-nsnow+1:0)) + allocate(snice(-nsnow+1:0)) + allocate(snliq(-nsnow+1:0)) + allocate(stc(-nsnow+1:nsoil)) + allocate(imelt(-nsnow+1:nsoil)) + allocate(supercool(-nsnow+1:nsoil)) + allocate(mice(-nsnow+1:nsoil)) + allocate(mliq(-nsnow+1:nsoil)) + allocate(dzsnso(-nsnow+1:nsoil)) + allocate(zsnso(-nsnow+1:nsoil)) + allocate(sice(nsoil)) + allocate(BEXP(nsoil)) + allocate(PSISAT(nsoil)) + allocate(SMCMAX(nsoil)) + + imelt = 0 + + !set empty snow layers to zero + do iz = -nsnow+1, isnow + snice(iz) = 0.0 + snliq(iz) = 0.0 + stc(iz) = 0.0 + dzsnso(iz)= 0.0 + zsnso(iz) = 0.0 + enddo + + ! initialize the variables + soiltype = NoahMP50_struc(n)%noahmp50(t)%soiltype + do isoil = 1, size(soiltype) + BEXP(isoil) = Noahmp50_struc(n)%noahmp50(t)%param%BEXP(isoil) + PSISAT(isoil) = Noahmp50_struc(n)%noahmp50(t)%param%PSISAT(isoil) + SMCMAX(isoil) = Noahmp50_struc(n)%noahmp50(t)%param%SMCMAX(isoil) + end do + + sneqv = NoahMP50_struc(n)%noahmp50(t)%sneqv + snowh = NoahMP50_struc(n)%noahmp50(t)%snowh + + zsnso(-nsnow+1:nsoil) = NoahMP50_struc(n)%noahmp50(t)%zss(1:nsnow+nsoil) + +! snow/soil layer thickness (m) + do iz = isnow+1, nsoil + if(iz == isnow+1) then + dzsnso(iz) = - zsnso(iz) + else + dzsnso(iz) = zsnso(iz-1) - zsnso(iz) + end if + end do + + ! set ZSOIL + allocate(zsoil(nsoil)) + ! zsoil is negative. + zsoil(1) = -NoahMP50_struc(n)%sldpth(1) + do i = 2, nsoil + zsoil(i) = zsoil(i-1) - NoahMP50_struc(n)%sldpth(i) + enddo + + + ! state variables + snice(-nsnow+1:0) = & + NoahMP50_struc(n)%noahmp50(t)%snowice(1:nsnow) + snliq(-nsnow+1:0) = & + NoahMP50_struc(n)%noahmp50(t)%snowliq(1:nsnow) + stc(-nsnow+1:0) = & + NoahMP50_struc(n)%noahmp50(t)%tsno(1:nsnow) + ! soil temperature + stc(1:nsoil) = & + NoahMP50_struc(n)%noahmp50(t)%tslb(1:nsoil) + + + ! from snowfall routine + ! creating a new layer + IF(ISNOW == 0.and.(dsneqv.gt.0.and.dsnowh.gt.0)) THEN + SNOWH = SNOWH + dsnowh + SNEQV = SNEQV + dsneqv + END IF + + NEWNODE = 0 + + IF(ISNOW == 0 .AND. SNOWH >= 0.025.and.& + (dsneqv.gt.0.and.dsnowh.gt.0)) THEN !MB: change limit + ISNOW = -1 + NEWNODE = 1 + DZSNSO(0)= SNOWH + SNOWH = 0. + STC(0) = MIN(273.16, NoahMP50_struc(n)%noahmp50(t)%sfctmp) ! temporary setup + SNICE(0) = SNEQV + SNLIQ(0) = 0. + END IF + + ! snow with layers + IF(ISNOW < 0 .AND. NEWNODE == 0 .and. & + (dsneqv.gt.0.and.dsnowh.gt.0)) then + SNICE(ISNOW+1) = SNICE(ISNOW+1) + dsneqv + DZSNSO(ISNOW+1) = DZSNSO(ISNOW+1) + dsnowh + ENDIF + + if(dsneqv.lt.0.and.dsnowh.lt.0) then + snowh1 = snowh + dsnowh + sneqv1 = sneqv + dsneqv + if(snowh1.ge.0.and.sneqv1.ge.0) then + SNOWH = SNOWH + dsnowh + SNEQV = SNEQV + dsneqv +! Update dzsnso +! how do you determine the thickness of a layer? + if(snowh.le.dzsnso(0)) then + isnow = 0 + dzsnso(-nsnow+1:(isnow-1)) = 0 + dzsnso(isnow) = snowh + elseif(snowh.le.(dzsnso(0)+dzsnso(-1))) then + isnow = -1 + dzsnso(-nsnow+1:(isnow-1)) = 0 + dzsnso(isnow) = snowh -dzsnso(isnow+1) + elseif(snowh.le.(dzsnso(0)+dzsnso(-1)+dzsnso(-2))) then + isnow = -2 + dzsnso(-nsnow+1:(isnow-2)) = 0 + dzsnso(isnow) = snowh -dzsnso(isnow+2) + endif + endif + endif + + ! ice fraction at the last timestep, add check for both snice and snliq are 0.0 + do snl_idx=isnow+1,0 + if(snice(snl_idx)+snliq(snl_idx)>0.0) then + ficeold(snl_idx) = snice(snl_idx) / (snice(snl_idx)+snliq(snl_idx)) + else + ficeold(snl_idx) = 0.0 + endif + enddo + + sice(:) = max(0.0, NoahMP50_struc(n)%noahmp50(t)%smc(:)& + - NoahMP50_struc(n)%noahmp50(t)%sh2o(:)) + + !imelt + do j = -nsnow+1, nsoil + supercool(j) = 0.0 + end do + + do j = isnow+1,0 ! all layers + mice(j) = snice(j) + mliq(j) = snliq(j) + end do + + do j = 1, nsoil ! soil + mliq(j) = NoahMP50_struc(n)%noahmp50(t)%sh2o(j) * dzsnso(j) * 1000. + mice(j) = (NoahMP50_struc(n)%noahmp50(t)%smc(j) - & + NoahMP50_struc(n)%noahmp50(t)%sh2o(j)) * dzsnso(j) * 1000. + end do + + do j = isnow+1,nsoil ! all layers + imelt(j) = 0 + enddo + + do j = 1,nsoil +! if (opt_frz == 1) then +! Assuming the use of option 1 for now + if(stc(j) < tfrz) then + smp = hfus*(tfrz-stc(j))/(grav*stc(j)) !(m) + SUPERCOOL(J) = SMCMAX(J)*(SMP/PSISAT(J))**(-1./BEXP(J)) + SUPERCOOL(J) = SUPERCOOL(J)*DZSNSO(J)*1000. !(mm) + end if +! end if +! if (opt_frz == 2) then +! call frh2o (supercool(j),& +! NoahMP50_struc(n)%noahmp50(t)%sstc(j),& +! NoahMP50_struc(n)%noahmp50(t)%smc(j),& +! NoahMP50_struc(n)%noahmp50(t)%sh2o(j)) +! supercool(j) = supercool(j)*dzsnso(j)*1000. !(mm) +! end if + enddo + + do j = isnow+1,nsoil + if (mice(j) > 0. .and. stc(j) >= tfrz) then !melting + imelt(j) = 1 + endif + if (mliq(j) > supercool(j) .and. stc(j) < tfrz) then + imelt(j) = 2 + endif + + ! If snow exists, but its thickness is not enough to create a layer + if (isnow == 0 & + .and. sneqv > 0. .and. j == 1) then + if (stc(j) >= tfrz) then + imelt(j) = 1 + endif + endif + enddo + + ! from SNOWWATER + SNOFLOW = 0.0 + ponding1 = 0.0 + ponding2 = 0.0 + + if(isnow < 0) & ! when multi-layer + call compact (Noahmp50_struc(n)%noahmp50(t)%param, & + nsnow, nsoil, NoahMP50_struc(n)%ts, & !in + stc, snice, snliq, zsoil, imelt, ficeold, iloc, jloc, & !in + isnow, dzsnso ,zsnso) !inout + if(isnow < 0) & + call combine (Noahmp50_struc(n)%noahmp50(t)%param, & + nsnow, nsoil ,iloc, jloc, & !in + isnow, NoahMP50_struc(n)%noahmp50(t)%sh2o, & !inout + stc, snice, snliq, dzsnso, sice, snowh, sneqv, & !inout + ponding1, ponding2) !out + if(isnow < 0) & + call divide (Noahmp50_struc(n)%noahmp50(t)%param, nsnow, nsoil, & !in + isnow, stc, snice, snliq, dzsnso) !inout + + !set empty snow layers to zero + do iz = -nsnow+1, isnow + snice(iz) = 0.0 + snliq(iz) = 0.0 + stc(iz) = 0.0 + dzsnso(iz)= 0.0 + zsnso(iz) = 0.0 + enddo + + !to obtain equilibrium state of snow in glacier region + IF(SNEQV > 5000.0) THEN ! 5000 mm -> maximum water depth + BDSNOW = SNICE(0) / DZSNSO(0) + SNOFLOW = (SNEQV - 5000.0) + SNICE(0) = SNICE(0) - SNOFLOW + DZSNSO(0) = DZSNSO(0) - SNOFLOW/BDSNOW + !SNOFLOW = SNOFLOW / DT + END IF + + ! sum up snow mass for layered snow + IF(ISNOW < 0) THEN ! MB: only do for multi-layer + SNEQV = 0.0 + DO IZ = ISNOW+1,0 + SNEQV = SNEQV + SNICE(IZ) + SNLIQ(IZ) + ENDDO + END IF + + ! Reset ZSNSO and layer thinkness DZSNSO + DO IZ = ISNOW+1, 0 + DZSNSO(IZ) = -DZSNSO(IZ) + END DO + + DZSNSO(1) = ZSOIL(1) + DO IZ = 2,NSOIL + DZSNSO(IZ) = (ZSOIL(IZ) - ZSOIL(IZ-1)) + END DO + + ZSNSO(ISNOW+1) = DZSNSO(ISNOW+1) + DO IZ = ISNOW+2 ,NSOIL + ZSNSO(IZ) = ZSNSO(IZ-1) + DZSNSO(IZ) + ENDDO + + DO IZ = ISNOW+1 ,NSOIL + DZSNSO(IZ) = -DZSNSO(IZ) + END DO + + ! sum up snow thickness for layered snow + IF(ISNOW < 0) THEN ! MB: only do for multi-layer + SNOWH = 0.0 ! Yeosang Yoon + DO IZ = ISNOW+1,0 + SNOWH = SNOWH + DZSNSO(IZ) ! Yeosang Yoon + ENDDO + END IF + + ! Yeosag Yoon, no snow layer case, limit snow density to 1000 + IF (ISNOW == 0 .AND. SNEQV > 0.0 .AND. SNOWH > 0.0) THEN + BDSNOW = SNEQV/SNOWH + IF (BDSNOW >= DENH2O) THEN + SNOWH = SNOWH*(BDSNOW/DENH2O) ! change unit, SNEQV=[mm] SNOWH=[m] + END IF + END IF + + ! update state vars + NoahMP50_struc(n)%noahmp50(t)%isnow = isnow + NoahMP50_struc(n)%noahmp50(t)%sneqv = sneqv + NoahMP50_struc(n)%noahmp50(t)%snowh = snowh + + NoahMP50_struc(n)%noahmp50(t)%zss(1:nsnow+nsoil) = zsnso(-nsnow+1:nsoil) + NoahMP50_struc(n)%noahmp50(t)%snowice(1:nsnow) = snice(-nsnow+1:0) + NoahMP50_struc(n)%noahmp50(t)%snowliq(1:nsnow) = snliq(-nsnow+1:0) + NoahMP50_struc(n)%noahmp50(t)%tsno(1:nsnow) = stc(-nsnow+1:0) + NoahMP50_struc(n)%noahmp50(t)%tslb(1:nsoil) = stc(1:nsoil) + + deallocate(ficeold) + deallocate(snice) + deallocate(snliq) + deallocate(stc) + deallocate(imelt) + deallocate(supercool) + deallocate(mice) + deallocate(mliq) + deallocate(dzsnso) + deallocate(zsnso) + deallocate(sice) + deallocate(bexp) + deallocate(psisat) + deallocate(smcmax) + +end subroutine noahmp50_snodep_update + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_transform_snodep.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_transform_snodep.F90 new file mode 100755 index 000000000..b9e920811 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_transform_snodep.F90 @@ -0,0 +1,75 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_transform_snodep +! \label{noahmp50_transform_snodep} +! +! !REVISION HISTORY: +! 25Jun2006: Sujay Kumar: Initial Specification +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 03 Oct 2018; Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! May 2023: Cenlin He; Modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_transform_snodep(n,OBS_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use noahmp50_lsmMod + use SNODEPobs_Mod, only : SNODEP_obs_obj +!EOP + implicit none + + integer, intent(in) :: n + type(ESMF_State) :: OBS_State +! +! !DESCRIPTION: +! +! This subroutine transforms the SNODEP state +! (mm) to the lsm state +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[OBS\_State] ESMF state container for observations \newline +! \end{description} +!EOP + type(ESMF_Field) :: obs_snodep_field + real, pointer :: snodepobs(:) + integer :: t + integer :: N_obs_size + integer :: status + + call ESMF_AttributeGet(OBS_State,name="Number Of Observations",& + value=N_obs_size,rc=status) + call LIS_verify(status, 'attributeget error in noahmp50_transform_snodep') + call ESMF_StateGet(OBS_State,"Observation01",obs_snodep_field,& + rc=status) + call LIS_verify(status,'stateget error in noahmp50_transform_snodep') + call ESMF_FieldGet(obs_snodep_field,localDE=0,farrayPtr=snodepobs,rc=status) + call LIS_verify(status,'fieldget error in noahmp50_transform_snodep') + + ! If using 8th mesh SNODEP data, convert it from inches to meters. + ! 16th mesh SNODEP data are already in meters. + if ( SNODEP_obs_obj(n)%mesh == 8 ) then + do t=1,N_obs_size + if(snodepobs(t).ne.LIS_rc%udef) then + if(snodepobs(t).gt.408.0) then + snodepobs(t) = 0.0 + endif + snodepobs(t) = snodepobs(t)*2.54E-2 !inches to meters + endif + enddo + endif +end subroutine noahmp50_transform_snodep diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_updatesnodepvars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_updatesnodepvars.F90 new file mode 100644 index 000000000..b87aee58a --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snodep/noahmp50_updatesnodepvars.F90 @@ -0,0 +1,172 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_updatesnodepvars +! \label{noahmp50_updatesnodepvars} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! 09 Jan 2020: Yeosang Yoon; Updated QC +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_updatesnodepvars(n, LSM_State, LSM_Incr_State) +! !USES: + use ESMF + use LIS_coreMod + use noahmp50_lsmMod + use LIS_logMod, only : LIS_logunit, LIS_verify + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \item[LSM\_Incr\_State] ESMF State container for LSM state increments \newline +! \end{description} +! +!EOP + + type(ESMF_Field) :: sweField, sweIncrField + type(ESMF_Field) :: snodField, snodIncrField + + integer :: t, gid + integer :: status + real, pointer :: swe(:), sweincr(:) + real, pointer :: snod(:), snodincr(:) + real :: swetmp, snodtmp,sndens + logical :: update_flag(LIS_rc%ngrid(n)) + real :: perc_violation(LIS_rc%ngrid(n)) + real :: snodmean(LIS_rc%ngrid(n)) + integer :: nsnodmean(LIS_rc%ngrid(n)) + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(LSM_Incr_State,"SWE",sweIncrField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_Incr_State,"Snowdepth",snodIncrField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweIncrField,localDE=0,farrayPtr=sweincr,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodIncrField,localDE=0,farrayPtr=snodincr,rc=status) + call LIS_verify(status) + + update_flag = .true. + perc_violation = 0.0 + snodmean = 0.0 + nsnodmean = 0 + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + swetmp = swe(t) + sweincr(t) + snodtmp = snod(t) + snodincr(t) + + if((snodtmp.lt.0 .or. swetmp.lt.0)) then + update_flag(gid) = .false. + perc_violation(gid) = perc_violation(gid) +1 + endif + + enddo + + do gid=1,LIS_rc%ngrid(n) + perc_violation(gid) = perc_violation(gid) / real(LIS_rc%nensem(n)) + enddo + +! For ensembles that are unphysical, compute the ensemble average after excluding them. This +! is done only if the majority of the ensemble members are good (>80%) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + if(.not.update_flag(gid)) then ! false + if(perc_violation(gid).lt.0.2) then + if(snod(t)+snodincr(t).ge.0) then + snodmean(gid) = snodmean(gid) + snod(t)+snodincr(t) + nsnodmean(gid) = nsnodmean(gid) + 1 + else + snodmean(gid) = 0.0 + endif + endif + endif + enddo + + do gid=1,LIS_rc%ngrid(n) + if(nsnodmean(gid).gt.0) then + snodmean(gid) = snodmean(gid) / real(nsnodmean(gid)) + endif + enddo + +! If the update is unphysical, simply set to the average of +! the good ensemble members. If all else fails, do not update. + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + + snodtmp = snod(t) + snodincr(t) + swetmp = swe(t) + sweincr(t) + +!Use the model's snow density from the previous timestep + sndens = 0.0 + if(NoahMP50_struc(n)%noahmp50(t)%snowh.gt.0) then + sndens = NoahMP50_struc(n)%noahmp50(t)%sneqv/NoahMP50_struc(n)%noahmp50(t)%snowh + endif + + if(update_flag(gid)) then + snod(t) = snodtmp + swe(t) = swetmp + elseif(perc_violation(gid).lt.0.2) then + if(snodtmp.lt.0.0) then ! average of the good ensemble members + snod(t) = snodmean(gid) + swe(t) = snodmean(gid)*sndens + else + snod(t) = snodtmp + swe(t) = swetmp + endif + else ! do not update + snod(t) = NoahMP50_struc(n)%noahmp50(t)%snowh + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + end if + + enddo + +end subroutine noahmp50_updatesnodepvars + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_dasnow_Mod.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_dasnow_Mod.F90 new file mode 100755 index 000000000..da42f7e42 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_dasnow_Mod.F90 @@ -0,0 +1,49 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +module noahmp50_dasnow_Mod +!BOP +! +! !MODULE: noahmp50_dasnow_Mod +! +! !DESCRIPTION: +! +! !REVISION HISTORY: +! +! !USES: + + implicit none + + PRIVATE +!----------------------------------------------------------------------------- +! !PUBLIC MEMBER FUNCTIONS: +!----------------------------------------------------------------------------- + public :: noahmp50_dasnow_init +!----------------------------------------------------------------------------- +! !PUBLIC TYPES: +!----------------------------------------------------------------------------- +!EOP + + SAVE +contains +!BOP +! +! !ROUTINE: noahmp50_dasnow_init +! \label{noahmp50_dasnow_init} +! +! !INTERFACE: + subroutine noahmp50_dasnow_init() +! !USES: +! !DESCRIPTION: +! +!EOP + implicit none + end subroutine noahmp50_dasnow_init +end module noahmp50_dasnow_Mod diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_descale_snow.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_descale_snow.F90 new file mode 100755 index 000000000..5dcf40e22 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_descale_snow.F90 @@ -0,0 +1,59 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_descale_snow +! \label{noahmp50_descale_snow} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with SNOW +! +! !INTERFACE: +subroutine noahmp50_descale_snow(n, LSM_State, LSM_Incr_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use noahmp50_lsmMod + use LIS_logMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + + integer :: t + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + + +end subroutine noahmp50_descale_snow + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_getsnowpred.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_getsnowpred.F90 new file mode 100755 index 000000000..a4fc7cddd --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_getsnowpred.F90 @@ -0,0 +1,60 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getsnowpred +! \label{noahmp50_getsnowpred} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 01 May 2014: Yuqiong Liu; modifed to include mesh8, mesh16, and 0p25 SNODEP data +! 24 May 2017: Yeosang Yoon: updated the file to work with the DA observation +! space updates. +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with SNOW +! May 2023: Cenlin He; Modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getsnowpred(n, k, obs_pred) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc,LIS_surface + use noahmp50_lsmMod + use LIS_DAobservationsMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + real :: obs_pred(LIS_rc%ngrid(n),LIS_rc%nensem(n)) + real :: snwd(LIS_rc%npatch(n,LIS_rc%lsm_index)) +!EOP + +! !DESCRIPTION: +! This routine computes the obspred ('Hx') term for SNOW DA assimilation +! instances. + + integer :: t + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + snwd(t) = NoahMP50_struc(n)%noahmp50(t)%snowh ! Keep in meters + enddo + + call LIS_convertPatchSpaceToObsEnsSpace(n,k,& + LIS_rc%lsm_index, & + snwd,& + obs_pred) + +end subroutine noahmp50_getsnowpred + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_getsnowvars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_getsnowvars.F90 new file mode 100755 index 000000000..1b5eec7b5 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_getsnowvars.F90 @@ -0,0 +1,73 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getsnowvars +! \label{noahmp50_getsnowvars} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 03OC2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with SNOW +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +! +subroutine noahmp50_getsnowvars(n, LSM_State) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +! +!EOP + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + + integer :: t + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + snod(t) = NoahMP50_struc(n)%noahmp50(t)%snowh + enddo +end subroutine noahmp50_getsnowvars + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_getswepred.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_getswepred.F90 new file mode 100644 index 000000000..8e35a1cdd --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_getswepred.F90 @@ -0,0 +1,49 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getswepred +! \label{noahmp50_getswepred} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getswepred(n, k, obs_pred) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc,LIS_surface + use noahmp50_lsmMod + use LIS_DAobservationsMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + real :: obs_pred(LIS_rc%ngrid(n),LIS_rc%nensem(n)) + real :: swe(LIS_rc%npatch(n,LIS_rc%lsm_index)) +!EOP + + integer :: t + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv !obs in mm + enddo + + call LIS_convertPatchSpaceToObsEnsSpace(n,k,& + LIS_rc%lsm_index, & + swe,& + obs_pred) + +end subroutine noahmp50_getswepred + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_qc_snowobs.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_qc_snowobs.F90 new file mode 100755 index 000000000..7911bd961 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_qc_snowobs.F90 @@ -0,0 +1,110 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_qc_snowobs +! \label{noahmp50_qc_snowobs} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 30 Jan 2015: Yuqiong Liu; added additional QC +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with SNOW +! May 2023: Cenlin He; modified for NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_qc_snowobs(n,k,OBS_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod, only : LIS_verify + use LIS_constantsMod, only : LIS_CONST_TKFRZ + use LIS_DAobservationsMod + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + type(ESMF_State) :: OBS_State +! +! !DESCRIPTION: +! +! This subroutine performs any model-based QC of the observation +! prior to data assimilation. Here the snow observations +! are flagged when LSM indicates that (1) rain is falling (2) +! ground is fully or partially covered with snow. +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[OBS\_State] ESMF state container for observations \newline +! \end{description} +! +!EOP + type(ESMF_Field) :: obs_snow_field + + real, pointer :: snowobs(:) + integer :: t + integer :: gid + integer :: status + real :: stc1(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: vegt(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: fveg_obs(LIS_rc%obs_ngrid(k)) + real :: tv_obs(LIS_rc%obs_ngrid(k)) + real :: stc1_obs(LIS_rc%obs_ngrid(k)) + real :: vegt_obs(LIS_rc%obs_ngrid(k)) + + call ESMF_StateGet(OBS_State,"Observation01",obs_snow_field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet failed in noahmp50_qc_snowobs") + call ESMF_FieldGet(obs_snow_field,localDE=0,farrayPtr=snowobs,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet failed in noahmp50_qc_snowobs") + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + !stc1(t) = NoahMP50_struc(n)%noahmp50(t)%sstc(1) ! get snow/veg temp. + stc1(t) = NoahMP50_struc(n)%noahmp50(t)%tslb(1) ! get snow/veg temp. + vegt(t) = LIS_surface(n,1)%tile(t)%vegt + enddo + + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, NoahMP50_struc(n)%noahmp50(:)%tv,tv_obs) !tv: vegetation temperature. unit: K + call LIS_convertPatchSpaceToObsSpace(n,k,LIS_rc%lsm_index, & !fveg: green vegetation fraction. unit: - + NoahMP50_struc(n)%noahmp50(:)%fveg,fveg_obs) + + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index,stc1,stc1_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index,vegt,vegt_obs) + + do t=1,LIS_rc%obs_ngrid(k) + if(snowobs(t).ne.LIS_rc%udef) then + if(fveg_obs(t).gt.0.7) then + snowobs(t) = LIS_rc%udef + elseif(vegt_obs(t).le.4) then !forest types + snowobs(t) = LIS_rc%udef + elseif(vegt_obs(t).eq.LIS_rc%glacierclass) then !TML: Eliminate Glaciers + snowobs(t) = LIS_rc%udef +!assume that snow will not form at 5 deg. celcius or higher ground temp. + elseif(tv_obs(t).ge.278.15) then + snowobs(t) = LIS_rc%udef + elseif(stc1_obs(t).ge.278.15) then + snowobs(t) = LIS_rc%udef + endif + endif + enddo + +end subroutine noahmp50_qc_snowobs + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_qcsnow.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_qcsnow.F90 new file mode 100755 index 000000000..b4665b135 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_qcsnow.F90 @@ -0,0 +1,127 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_qcsnow +! \label{noahmp50_qcsnow} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 30 Jan 2015: Yuqiong Liu; added additional QC +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with SNOW +! 09 Jan 2020: Yeosang Yoon; update QC +! May 2023: Cenlin He; modified for NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_qcsnow(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod + use noahmp50_lsmMod + use LIS_logMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! QC's the related state prognostic variable objects for +! SNOW data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + integer :: t, gid + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + + real :: swemax,snodmax + real :: swemin,snodmin + + real :: sndens + logical :: update_flag(LIS_rc%ngrid(n)) + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + call ESMF_AttributeGet(sweField,"Max Value",swemax,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(sweField,"Min Value",swemin,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(snodField,"Max Value",snodmax,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(snodField,"Min Value",snodmin,rc=status) + call LIS_verify(status) + + update_flag = .true. + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + if((snod(t).lt.snodmin) .or. swe(t).lt.swemin) then + update_flag(gid) = .false. + endif + + enddo + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + +!Use the model's snow density from the previous timestep + sndens = 0.0 + if(NoahMP50_struc(n)%noahmp50(t)%snowh.gt.0) then + sndens = NoahMP50_struc(n)%noahmp50(t)%sneqv/NoahMP50_struc(n)%noahmp50(t)%snowh + endif + +!If the update is unphysical, do not update. + if(update_flag(gid)) then + snod(t) = snod(t) + swe(t) = snod(t)*sndens + else ! do not update + snod(t) = NoahMP50_struc(n)%noahmp50(t)%snowh + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + end if + + if(swe(t).gt.swemax) then + swe(t) = swemax + endif + if(snod(t).gt.snodmax) then + snod(t) = snodmax + endif + + end do + +end subroutine noahmp50_qcsnow + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_scale_snow.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_scale_snow.F90 new file mode 100755 index 000000000..4321e17a2 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_scale_snow.F90 @@ -0,0 +1,58 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_scale_snow +! \label{noahmp50_scale_snow} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with SNOW +! +! !INTERFACE: +subroutine noahmp50_scale_snow(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use noahmp50_lsmMod + use LIS_logMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + + integer :: t + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + +end subroutine noahmp50_scale_snow + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_setsnowvars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_setsnowvars.F90 new file mode 100755 index 000000000..dfb2e9b82 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_setsnowvars.F90 @@ -0,0 +1,79 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_setsnowvars +! \label{noahmp50_setsnowvars} +! +! !REVISION HISTORY: +! 15 Aug 2017: Sujay Kumar; Initial Specification +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with SNOW +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_setsnowvars(n, LSM_State) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_domain, LIS_surface + use LIS_snowMod, only : LIS_snow_struc + use LIS_logMod, only : LIS_logunit, LIS_verify, LIS_endrun + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! This routine assigns the snow progognostic variables to noahmp's +! model space. The state vector consists of total SWE and snow depth. +! This routine also updates other model prognostics (snice, snliq, +! snow thickness, snow temperature) based on the update. +! +!EOP + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + real, pointer :: swe(:) + real, pointer :: snod(:) + real :: dsneqv,dsnowh + integer :: t + integer :: status + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + dsneqv = swe(t) - NoahMP50_struc(n)%noahmp50(t)%sneqv !in mm + dsnowh = snod(t) - NoahMP50_struc(n)%noahmp50(t)%snowh !in m + + ! update + call noahmp50_snow_update(n, t, dsneqv, dsnowh) + + enddo +end subroutine noahmp50_setsnowvars + + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_snow_update.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_snow_update.F90 new file mode 100755 index 000000000..ff149b2b2 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_snow_update.F90 @@ -0,0 +1,366 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_snow_update +! \label{noahmp50_snow_update} +! +! !REVISION HISTORY: +! 13 Aug 2017: Sujay Kumar; Initial specification +! 14 Dec 2018: Yeosang Yoon; Modified code for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with SNOW +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE +subroutine noahmp50_snow_update(n, t, dsneqv, dsnowh) + + use LIS_coreMod + use NoahMP50_lsmMod + use NoahMP50_snowphys_updateMod + + implicit none +! +! !DESCRIPTION: +! This subroutine updates relevant snow prognostics based +! on the update to the total SWE (dsneqv) and total +! snow depth (dsnowh). The updated variables include +! number of snow layers, snice, snliq, snow temperature +! and snow thickness. +! +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: t + real :: dsneqv !mm + real :: dsnowh !m +!EOP + real, parameter :: tfrz = 273.16 !freezing/melting point (k) + real, parameter :: hfus = 0.3336E06 !latent heat of fusion (j/kg) + real, parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) + real, parameter :: DENH2O = 1000.0 !density of water (kg/m3) + real, allocatable, dimension(:) :: zsoil + real, allocatable, dimension(:) :: ficeold + real, allocatable, dimension(:) :: snice + real, allocatable, dimension(:) :: snliq + real, allocatable, dimension(:) :: stc + real, allocatable, dimension(:) :: supercool + real, allocatable, dimension(:) :: mice + real, allocatable, dimension(:) :: mliq + real, allocatable, dimension(:) :: dzsnso + real, allocatable, dimension(:) :: zsnso + real, allocatable, dimension(:) :: BEXP + real, allocatable, dimension(:) :: PSISAT + real, allocatable, dimension(:) :: SMCMAX + + integer, allocatable, dimension(:) :: imelt !phase change index + real, allocatable, dimension(:) :: sice + + integer :: snl_idx,i,j,iz + integer :: iloc, jloc ! needed, but not use + real :: smp,sneqv,snowh + real :: sneqv1,snowh1 + real :: ponding1,ponding2 + integer :: newnode + integer :: isnow, nsoil, nsnow, soiltype(4), isoil + +! local + real :: SNOFLOW, BDSNOW + + isnow = NoahMP50_struc(n)%noahmp50(t)%isnow + nsoil = NoahMP50_struc(n)%nsoil + nsnow = NoahMP50_struc(n)%nsnow + + allocate(ficeold(-nsnow+1:0)) + allocate(snice(-nsnow+1:0)) + allocate(snliq(-nsnow+1:0)) + allocate(stc(-nsnow+1:nsoil)) + allocate(imelt(-nsnow+1:nsoil)) + allocate(supercool(-nsnow+1:nsoil)) + allocate(mice(-nsnow+1:nsoil)) + allocate(mliq(-nsnow+1:nsoil)) + allocate(dzsnso(-nsnow+1:nsoil)) + allocate(zsnso(-nsnow+1:nsoil)) + allocate(sice(nsoil)) + allocate(BEXP(nsoil)) + allocate(PSISAT(nsoil)) + allocate(SMCMAX(nsoil)) + + imelt = 0 + + !set empty snow layers to zero + do iz = -nsnow+1, isnow + snice(iz) = 0.0 + snliq(iz) = 0.0 + stc(iz) = 0.0 + dzsnso(iz)= 0.0 + zsnso(iz) = 0.0 + enddo + + ! initialize the variables + soiltype = NoahMP50_struc(n)%noahmp50(t)%soiltype + do isoil = 1, size(soiltype) + BEXP(isoil) = Noahmp50_struc(n)%noahmp50(t)%param%BEXP(isoil) + PSISAT(isoil) = Noahmp50_struc(n)%noahmp50(t)%param%PSISAT(isoil) + SMCMAX(isoil) = Noahmp50_struc(n)%noahmp50(t)%param%SMCMAX(isoil) + end do + + sneqv = NoahMP50_struc(n)%noahmp50(t)%sneqv + snowh = NoahMP50_struc(n)%noahmp50(t)%snowh + + zsnso(-nsnow+1:nsoil) = NoahMP50_struc(n)%noahmp50(t)%zss(1:nsnow+nsoil) + +! snow/soil layer thickness (m) + do iz = isnow+1, nsoil + if(iz == isnow+1) then + dzsnso(iz) = - zsnso(iz) + else + dzsnso(iz) = zsnso(iz-1) - zsnso(iz) + end if + end do + + ! set ZSOIL + allocate(zsoil(nsoil)) + ! zsoil is negative. + zsoil(1) = -NoahMP50_struc(n)%sldpth(1) + do i = 2, nsoil + zsoil(i) = zsoil(i-1) - NoahMP50_struc(n)%sldpth(i) + enddo + + + ! state variables + snice(-nsnow+1:0) = & + NoahMP50_struc(n)%noahmp50(t)%snowice(1:nsnow) + snliq(-nsnow+1:0) = & + NoahMP50_struc(n)%noahmp50(t)%snowliq(1:nsnow) + stc(-nsnow+1:0) = & + NoahMP50_struc(n)%noahmp50(t)%tsno(1:nsnow) + ! soil temperature + stc(1:nsoil) = & + NoahMP50_struc(n)%noahmp50(t)%tslb(1:nsoil) + + + ! from snowfall routine + ! creating a new layer + if(isnow == 0.and.(dsneqv.gt.0.and.dsnowh.gt.0)) then + snowh = snowh + dsnowh + sneqv = sneqv + dsneqv + end if + + newnode = 0 + + if(isnow == 0 .and. snowh >= 0.025.and.& + (dsneqv.gt.0.and.dsnowh.gt.0)) then !mb: change limit + isnow = -1 + newnode = 1 + dzsnso(0)= snowh + snowh = 0. + stc(0) = min(273.16, NoahMP50_struc(n)%noahmp50(t)%sfctmp) + snice(0) = sneqv + snliq(0) = 0. + end if + + ! snow with layers + if(isnow < 0 .and. newnode == 0 .and. & + (dsneqv.gt.0.and.dsnowh.gt.0)) then + snice(isnow+1) = snice(isnow+1) + dsneqv + dzsnso(isnow+1) = dzsnso(isnow+1) + dsnowh + endif + + if(dsneqv.lt.0.and.dsnowh.lt.0) then + snowh1 = snowh + dsnowh + sneqv1 = sneqv + dsneqv + if(snowh1.ge.0.and.sneqv1.ge.0) then + snowh = snowh + dsnowh + sneqv = sneqv + dsneqv +! update dzsnso +! how do you determine the thickness of a layer? + if(snowh.le.dzsnso(0)) then + isnow = 0 + dzsnso(-nsnow+1:(isnow-1)) = 0 + dzsnso(isnow) = snowh + elseif(snowh.le.(dzsnso(0)+dzsnso(-1))) then + isnow = -1 + dzsnso(-nsnow+1:(isnow-1)) = 0 + dzsnso(isnow) = snowh -dzsnso(isnow+1) + elseif(snowh.le.(dzsnso(0)+dzsnso(-1)+dzsnso(-2))) then + isnow = -2 + dzsnso(-nsnow+1:(isnow-2)) = 0 + dzsnso(isnow) = snowh -dzsnso(isnow+2) + endif + endif + endif + + ! ice fraction at the last timestep, add check for both snice and snliq are 0.0 + do snl_idx=isnow+1,0 + if(snice(snl_idx)+snliq(snl_idx)>0.0) then + ficeold(snl_idx) = snice(snl_idx) / (snice(snl_idx)+snliq(snl_idx)) + else + ficeold(snl_idx) = 0.0 + endif + enddo + + sice(:) = max(0.0, NoahMP50_struc(n)%noahmp50(t)%smc(:)& + - NoahMP50_struc(n)%noahmp50(t)%sh2o(:)) + + !imelt + do j = -nsnow+1, nsoil + supercool(j) = 0.0 + end do + + do j = isnow+1,0 ! all layers + mice(j) = snice(j) + mliq(j) = snliq(j) + end do + + do j = 1, nsoil ! soil + mliq(j) = NoahMP50_struc(n)%noahmp50(t)%sh2o(j) * dzsnso(j) * 1000. + mice(j) = (NoahMP50_struc(n)%noahmp50(t)%smc(j) - & + NoahMP50_struc(n)%noahmp50(t)%sh2o(j)) * dzsnso(j) * 1000. + end do + + do j = isnow+1,nsoil ! all layers + imelt(j) = 0 + enddo + + do j = 1,nsoil + if(stc(j) < tfrz) then + smp = hfus*(tfrz-stc(j))/(grav*stc(j)) !(m) + supercool(j) = smcmax(j)*(smp/psisat(j))**(-1./bexp(j)) + supercool(j) = supercool(j)*dzsnso(j)*1000. !(mm) + end if + enddo + + do j = isnow+1,nsoil + if (mice(j) > 0. .and. stc(j) >= tfrz) then !melting + imelt(j) = 1 + endif + if (mliq(j) > supercool(j) .and. stc(j) < tfrz) then + imelt(j) = 2 + endif + + ! if snow exists, but its thickness is not enough to create a layer + if (isnow == 0 & + .and. sneqv > 0. .and. j == 1) then + if (stc(j) >= tfrz) then + imelt(j) = 1 + endif + endif + enddo + + ! from snowwater + snoflow = 0.0 + ponding1 = 0.0 + ponding2 = 0.0 + + if(isnow < 0) & ! when multi-layer + call compact (Noahmp50_struc(n)%noahmp50(t)%param, & + nsnow, nsoil, NoahMP50_struc(n)%ts, & !in + stc, snice, snliq, zsoil, imelt, ficeold, iloc, jloc, & !in + isnow, dzsnso ,zsnso) !inout + if(isnow < 0) & + call combine (Noahmp50_struc(n)%noahmp50(t)%param, & + nsnow, nsoil ,iloc, jloc, & !in + isnow, NoahMP50_struc(n)%noahmp50(t)%sh2o, & !inout + stc, snice, snliq, dzsnso, sice, snowh, sneqv, & !inout + ponding1, ponding2) !out + if(isnow < 0) & + call divide (Noahmp50_struc(n)%noahmp50(t)%param, nsnow, nsoil, & !in + isnow, stc, snice, snliq, dzsnso) !inout + + !set empty snow layers to zero + do iz = -nsnow+1, isnow + snice(iz) = 0.0 + snliq(iz) = 0.0 + stc(iz) = 0.0 + dzsnso(iz)= 0.0 + zsnso(iz) = 0.0 + enddo + + !to obtain equilibrium state of snow in glacier region + if(sneqv > 5000.0) then ! 5000 mm -> maximum water depth + bdsnow = snice(0) / dzsnso(0) + snoflow = (sneqv - 5000.0) + snice(0) = snice(0) - snoflow + dzsnso(0) = dzsnso(0) - snoflow/bdsnow + !snoflow = snoflow / dt + end if + + ! sum up snow mass for layered snow + if(isnow < 0) then ! mb: only do for multi-layer + sneqv = 0.0 + do iz = isnow+1,0 + sneqv = sneqv + snice(iz) + snliq(iz) + enddo + end if + + ! reset zsnso and layer thinkness dzsnso + do iz = isnow+1, 0 + dzsnso(iz) = -dzsnso(iz) + end do + + dzsnso(1) = zsoil(1) + do iz = 2,nsoil + dzsnso(iz) = (zsoil(iz) - zsoil(iz-1)) + end do + + zsnso(isnow+1) = dzsnso(isnow+1) + do iz = isnow+2 ,nsoil + zsnso(iz) = zsnso(iz-1) + dzsnso(iz) + enddo + + do iz = isnow+1 ,nsoil + dzsnso(iz) = -dzsnso(iz) + end do + + ! sum up snow thickness for layered snow + IF(ISNOW < 0) THEN ! MB: only do for multi-layer + SNOWH = 0.0 ! Yeosang Yoon + DO IZ = ISNOW+1,0 + SNOWH = SNOWH + DZSNSO(IZ) ! Yeosang Yoon + ENDDO + END IF + + ! Yeosag Yoon, no snow layer case, limit snow density to 1000 + IF (ISNOW == 0 .AND. SNEQV > 0.0 .AND. SNOWH > 0.0) THEN + BDSNOW = SNEQV/SNOWH + IF (BDSNOW >= DENH2O) THEN + SNOWH = SNOWH*(BDSNOW/DENH2O) ! change unit, SNEQV=[mm] SNOWH=[m] + END IF + END IF + + ! update state vars + NoahMP50_struc(n)%noahmp50(t)%isnow = isnow + NoahMP50_struc(n)%noahmp50(t)%sneqv = sneqv + NoahMP50_struc(n)%noahmp50(t)%snowh = snowh + + NoahMP50_struc(n)%noahmp50(t)%zss(1:nsnow+& + nsoil) = zsnso(-nsnow+1:nsoil) + NoahMP50_struc(n)%noahmp50(t)%snowice(1:nsnow) = & + snice(-nsnow+1:0) + NoahMP50_struc(n)%noahmp50(t)%snowliq(1:nsnow) = & + snliq(-nsnow+1:0) + NoahMP50_struc(n)%noahmp50(t)%tsno(1:nsnow) = stc(-nsnow+1:0) + NoahMP50_struc(n)%noahmp50(t)%tslb(1:nsoil) = stc(1:nsoil) + + deallocate(ficeold) + deallocate(snice) + deallocate(snliq) + deallocate(stc) + deallocate(imelt) + deallocate(supercool) + deallocate(mice) + deallocate(mliq) + deallocate(dzsnso) + deallocate(zsnso) + deallocate(sice) + deallocate(bexp) + deallocate(psisat) + deallocate(smcmax) + +end subroutine noahmp50_snow_update diff --git a/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_updatesnowvars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_updatesnowvars.F90 new file mode 100755 index 000000000..257cc936e --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_snow/noahmp50_updatesnowvars.F90 @@ -0,0 +1,176 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_updatesnowvars +! \label{noahmp50_updatesnowvars} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with SNOW +! 09 Jan 2020: Yeosang Yoon; Updated QC +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! !INTERFACE: +subroutine noahmp50_updatesnowvars(n, LSM_State, LSM_Incr_State) +! !USES: + use ESMF + use LIS_coreMod + use noahmp50_lsmMod + use LIS_logMod, only : LIS_logunit, LIS_verify + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \item[LSM\_Incr\_State] ESMF State container for LSM state increments \newline +! \end{description} +! +!EOP + + type(ESMF_Field) :: sweField, sweIncrField + type(ESMF_Field) :: snodField, snodIncrField + + integer :: t, gid + integer :: status + real, pointer :: swe(:), sweincr(:) + real, pointer :: snod(:), snodincr(:) + real :: swetmp, snodtmp,sndens + logical :: update_flag(LIS_rc%ngrid(n)) + real :: perc_violation(LIS_rc%ngrid(n)) + + real :: snodmean(LIS_rc%ngrid(n)) + integer :: nsnodmean(LIS_rc%ngrid(n)) + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(LSM_Incr_State,"SWE",sweIncrField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_Incr_State,"Snowdepth",snodIncrField,rc=status) + call LIS_verify(status) + + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweIncrField,localDE=0,farrayPtr=sweincr,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodIncrField,localDE=0,farrayPtr=snodincr,rc=status) + call LIS_verify(status) + + + update_flag = .true. + perc_violation = 0.0 + snodmean = 0.0 + nsnodmean = 0 + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + swetmp = swe(t) + sweincr(t) + snodtmp = snod(t) + snodincr(t) + + if((snodtmp.lt.0 .or. swetmp.lt.0)) then + update_flag(gid) = .false. + perc_violation(gid) = perc_violation(gid) +1 + endif + + enddo + + do gid=1,LIS_rc%ngrid(n) + perc_violation(gid) = perc_violation(gid) / real(LIS_rc%nensem(n)) + enddo + +! For ensembles that are unphysical, compute the ensemble average after excluding them. This +! is done only if the majority of the ensemble members are good (>80%) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + if(.not.update_flag(gid)) then ! false + if(perc_violation(gid).lt.0.2) then + if(snod(t)+snodincr(t).ge.0) then + snodmean(gid) = snodmean(gid) + snod(t)+snodincr(t) + nsnodmean(gid) = nsnodmean(gid) + 1 + else + snodmean(gid) = 0.0 + endif + endif + endif + enddo + + do gid=1,LIS_rc%ngrid(n) + if(nsnodmean(gid).gt.0) then + snodmean(gid) = snodmean(gid) / real(nsnodmean(gid)) + endif + enddo + +! If the update is unphysical, simply set to the average of +! the good ensemble members. If all else fails, do not update. + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + + snodtmp = snod(t) + snodincr(t) + swetmp = swe(t) + sweincr(t) + +!Use the model's snow density from the previous timestep + sndens = 0.0 + if(NoahMP50_struc(n)%noahmp50(t)%snowh.gt.0) then + sndens = NoahMP50_struc(n)%noahmp50(t)%sneqv/NoahMP50_struc(n)%noahmp50(t)%snowh + endif + + if(update_flag(gid)) then + snod(t) = snodtmp + swe(t) = swetmp + elseif(perc_violation(gid).lt.0.2) then + if(snodtmp.lt.0.0) then ! average of the good ensemble members + snod(t) = snodmean(gid) + swe(t) = snodmean(gid)*sndens + else + snod(t) = snodtmp + swe(t) = swetmp + endif + else ! do not update + snod(t) = NoahMP50_struc(n)%noahmp50(t)%snowh + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + end if + + enddo + +end subroutine noahmp50_updatesnowvars + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_dasoilm_Mod.F90 b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_dasoilm_Mod.F90 new file mode 100644 index 000000000..ca68a0565 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_dasoilm_Mod.F90 @@ -0,0 +1,118 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +module NoahMP50_dasoilm_Mod +!BOP +! +! !MODULE: NoahMP50_dasoilm_Mod +! +! !DESCRIPTION: +! +! !REVISION HISTORY: + +! 15 Dec 2018: Mahdi Navari, Sujay Kumar ; Modified for NoahMP401 ! +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! !USES: + use ESMF + use LIS_coreMod + use LIS_dataAssimMod + use LIS_logMod + use LIS_constantsMod, only : LIS_CONST_PATH_LEN + + implicit none + + PRIVATE +!----------------------------------------------------------------------------- +! !PUBLIC MEMBER FUNCTIONS: +!----------------------------------------------------------------------------- + public :: NoahMP50_dasoilm_init +!----------------------------------------------------------------------------- +! !PUBLIC TYPES: +!----------------------------------------------------------------------------- + public :: noahmp50_dasm_struc +!EOP + + type, public :: dasm_dec + real, allocatable :: model_xrange(:,:,:) + real, allocatable :: model_cdf(:,:,:) + real, allocatable :: model_mu(:) + + integer :: nbins + integer :: ntimes + integer :: scal + + end type dasm_dec + + type(dasm_dec), allocatable :: noahmp50_dasm_struc(:) + +contains +!BOP +! +! !ROUTINE: NoahMP50_dasoilm_init +! \label{NoahMP50_dasoilm_init} +! +! !INTERFACE: + subroutine NoahMP50_dasoilm_init(k) +! !USES: +! !DESCRIPTION: +! +!EOP + + + implicit none + integer :: k + integer :: n + character(len=LIS_CONST_PATH_LEN) :: modelcdffile(LIS_rc%nnest) + integer :: status + integer :: ngrid + + if(.not.allocated(noahmp50_dasm_struc)) then + allocate(noahmp50_dasm_struc(LIS_rc%nnest)) + endif + +!TBD: SVK +#if 0 + if(LIS_rc%dascaloption(k).eq."Linear scaling") then + call ESMF_ConfigFindLabel(LIS_config,"Noah-MP.5.0 soil moisture CDF file:",& + rc=status) + do n=1,LIS_rc%nnest + call ESMF_ConfigGetAttribute(LIS_config,modelcdffile(n),rc=status) + call LIS_verify(status, 'Noah-MP.5.0 soil moisture CDF file: not defined') + enddo + + do n=1,LIS_rc%nnest + +!Hardcoded for now. + noahmp50_dasm_struc(n)%nbins = 100 + + call LIS_getCDFattributes(modelcdffile(n),& + noahmp50_dasm_struc(n)%ntimes, ngrid) + + allocate(noahmp50_dasm_struc(n)%model_xrange(& + LIS_rc%ngrid(n), noahmp50_dasm_struc(n)%ntimes, & + noahmp50_dasm_struc(n)%nbins)) + allocate(noahmp50_dasm_struc(n)%model_cdf(& + LIS_rc%ngrid(n), noahmp50_dasm_struc(n)%ntimes, & + noahmp50_dasm_struc(n)%nbins)) + + call LIS_readCDFdata(n,& + noahmp50_dasm_struc(n)%nbins, & + noahmp50_dasm_struc(n)%ntimes, & + ngrid, & + modelcdffile(n), & + "SoilMoist",& + noahmp50_dasm_struc(n)%model_xrange,& + noahmp50_dasm_struc(n)%model_cdf) + enddo + endif +#endif + + end subroutine NoahMP50_dasoilm_init +end module NoahMP50_dasoilm_Mod diff --git a/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_descale_soilm.F90 b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_descale_soilm.F90 new file mode 100644 index 000000000..0c3893e59 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_descale_soilm.F90 @@ -0,0 +1,48 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_descale_soilm +! \label{NoahMP50_descale_soilm} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 15 Dec 2018: Mahdi Navari; Modified for NoahMP50 +! +! !INTERFACE: +subroutine NoahMP50_descale_soilm(n, LSM_State, LSM_Incr_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! Descales soilmoisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + + +end subroutine NoahMP50_descale_soilm + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_getsmpred.F90 b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_getsmpred.F90 new file mode 100644 index 000000000..117910ef7 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_getsmpred.F90 @@ -0,0 +1,123 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_getsmpred +! \label{NoahMP50_getsmpred} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 9 Sep 2016: Mahdi Navari; Modified for NoahMP50 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine NoahMP50_getsmpred(n, k,obs_pred) +! !USES: + use ESMF + use LIS_constantsMod + use LIS_coreMod + use LIS_dataAssimMod + use LIS_DAobservationsMod + use NoahMP50_lsmMod + use NoahMP50_dasoilm_Mod +!EOP + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + real :: obs_pred(LIS_rc%obs_ngrid(k),LIS_rc%nensem(n)) +! +! !DESCRIPTION: +! +! Returns the Soil moisture obs pred (model's estimate of +! observations) for data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[obs\_pred] model's estimate of observations \newline +! \end{description} +!EOP + real :: obs_tmp + integer :: i,t,m,gid,kk + real :: inputs_tp(6), sm_out + character*50 :: units_tp(6) + real :: smc1(LIS_rc%npatch(n,LIS_rc%lsm_index)) + + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + smc1(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) + enddo + call LIS_convertPatchSpaceToObsEnsSpace(n,k,& + LIS_rc%lsm_index, & + smc1,& + obs_pred) + +#if 0 + if(LIS_rc%useANNinDA(n).ne.1) then +!rescaling to relative wetness space. + if(LIS_rc%dascaloption(k).eq."Linear scaling") then + + if(noahmp50_dasm_struc(n)%ntimes.gt.1) then + kk = LIS_rc%mo + else + kk = 1 + endif + + do i=1,LIS_rc%obs_ngrid(k) + do m=1,LIS_rc%nensem(n) + obs_tmp = (obs_pred(i,m) - noahmp50_dasm_struc(n)%model_xrange(i,kk,1))/& + (noahmp50_dasm_struc(n)%model_xrange(i,kk,noahmp50_dasm_struc(n)%nbins) - & + noahmp50_dasm_struc(n)%model_xrange(i,kk,1)) + obs_pred(i,m) = obs_tmp + enddo + enddo + endif + + else + obs_pred = 0.0 + count1 = 0 + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index),LIS_rc%nensem(n) + do m=1,LIS_rc%nensem(n) + t = i+m-1 + gid = LIS_surface(n,LIS_rc%lsm_index)%tile(t)%index + + inputs_tp(1) = NoahMP50_struc(n)%noahmp50(t)%smc(1) + inputs_tp(2) = NoahMP50_struc(n)%noahmp50(t)%prcp*(1-NoahMP50_struc(n)%noahmp50(t)%fpice) !Noah33 rainf + inputs_tp(3) = NoahMP50_struc(n)%noahmp50(t)%prcp*NoahMP50_struc(n)%noahmp50(t)%fpice !Noah33 snowf + !MN: NOTE: noahmp50 --> prcp (total precip), fpice (snow fraction in precipitation [-]) + inputs_tp(4) = NoahMP50_struc(n)%noahmp50(t)%fveg !Noah33 shdfac + inputs_tp(5) = NoahMP50_struc(n)%noahmp50(t)%sstc(NoahMP50_struc(n)%nsnow+1) !Noah33 stc(1) + inputs_tp(6) = NoahMP50_struc(n)%noahmp50(t)%sneqv*LIS_CONST_RHOFW + + units_tp(1) = "m^3 m-3" + units_tp(2) = "kg m-2 s-1" + units_tp(3) = "kg m-2 s-1" + units_tp(4) = "1" + units_tp(5) = "K" + units_tp(6) = "kg m-2" + + call LIS_forwardEstimate_with_ANN(n, gid, inputs_tp, & + units_tp, sm_out) + obs_pred(gid,m) = obs_pred(gid,m) + sm_out + count1(gid,m) = count1(gid,m) + 1 + enddo + enddo + + do i=1,LIS_rc%ngrid(n) + do m=1,LIS_rc%nensem(n) + obs_pred(i,m) = obs_pred(i,m)/(count1(i,m)) + enddo + enddo + endif +#endif +end subroutine NoahMP50_getsmpred + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_getsoilm.F90 b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_getsoilm.F90 new file mode 100644 index 000000000..89d289b6b --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_getsoilm.F90 @@ -0,0 +1,83 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_getsoilm +! \label{NoahMP50_getsoilm} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 15 Dec 2018: Mahdi Navari; Modified for NoahMP50 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! !INTERFACE: +subroutine NoahMP50_getsoilm(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the soilmoisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + type(ESMF_Field) :: sm1Field + type(ESMF_Field) :: sm2Field + type(ESMF_Field) :: sm3Field + type(ESMF_Field) :: sm4Field + integer :: t + integer :: status + real, pointer :: soilm1(:) + real, pointer :: soilm2(:) + real, pointer :: soilm3(:) + real, pointer :: soilm4(:) + character*100 :: lsm_state_objs(4) + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 1",sm1Field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for sm1 in NoahMP50_getsoilm') + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 2",sm2Field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for sm2 in NoahMP50_getsoilm') + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 3",sm3Field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for sm3 in NoahMP50_getsoilm') + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 4",sm4Field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for sm4 in NoahMP50_getsoilm') + + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm1,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for sm1 in NoahMP50_getsoilm') + call ESMF_FieldGet(sm2Field,localDE=0,farrayPtr=soilm2,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for sm2 in NoahMP50_getsoilm') + call ESMF_FieldGet(sm3Field,localDE=0,farrayPtr=soilm3,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for sm3 in NoahMP50_getsoilm') + call ESMF_FieldGet(sm4Field,localDE=0,farrayPtr=soilm4,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for sm4 in NoahMP50_getsoilm') + + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + soilm1(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) + soilm2(t) = NoahMP50_struc(n)%noahmp50(t)%smc(2) + soilm3(t) = NoahMP50_struc(n)%noahmp50(t)%smc(3) + soilm4(t) = NoahMP50_struc(n)%noahmp50(t)%smc(4) + enddo + +end subroutine NoahMP50_getsoilm + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_qc_soilmobs.F90 b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_qc_soilmobs.F90 new file mode 100644 index 000000000..f5e3827c9 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_qc_soilmobs.F90 @@ -0,0 +1,277 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_qc_soilmobs +! \label{NoahMP50_qc_soilmobs} +! +! !REVISION HISTORY: +! 25Feb2008: Sujay Kumar: Initial Specification +! 15 Dec 2018: Mahdi Navari; Modified for NoahMP50 +! 15 Jun 2020: Yonghwan Kwon: Modified vegetation fraction threshold +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine NoahMP50_qc_soilmobs(n,k,OBS_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod, only : LIS_verify + use LIS_constantsMod, only : LIS_CONST_TKFRZ + use LIS_DAobservationsMod + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + type(ESMF_State) :: OBS_State +! +! !DESCRIPTION: +! +! This subroutine performs any model-based QC of the observation +! prior to data assimilation. Here the soil moisture observations +! are flagged when LSM indicates that (1) rain is falling (2) +! soil is frozen or (3) ground is fully or partially covered +! with snow MN:(4) ground is covered with vegatation (more than 50%). +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[OBS\_State] ESMF state container for observations \newline +! \end{description} +! +!EOP + type(ESMF_Field) :: obs_sm_field + + real, pointer :: smobs(:) + integer :: t + integer :: gid + integer :: status + real :: lat,lon + +! mn + integer :: SOILTYP ! soil type index [-] + real :: smc1(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: smc2(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: smc3(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: smc4(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: sh2o1(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: sh2o2(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: sh2o3(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: sh2o4(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: stc1(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: stc2(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: stc3(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: stc4(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: vegt(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: SMCMAX(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: SMCWLT(LIS_rc%npatch(n,LIS_rc%lsm_index)) + + real :: rainf_obs(LIS_rc%obs_ngrid(k)) + real :: sneqv_obs(LIS_rc%obs_ngrid(k)) + real :: sca_obs(LIS_rc%obs_ngrid(k)) + real :: shdfac_obs(LIS_rc%obs_ngrid(k)) + real :: t1_obs(LIS_rc%obs_ngrid(k)) + real :: smcwlt_obs(LIS_rc%obs_ngrid(k)) + real :: smcmax_obs(LIS_rc%obs_ngrid(k)) + real :: smc1_obs(LIS_rc%obs_ngrid(k)) + real :: smc2_obs(LIS_rc%obs_ngrid(k)) + real :: smc3_obs(LIS_rc%obs_ngrid(k)) + real :: smc4_obs(LIS_rc%obs_ngrid(k)) + real :: sh2o1_obs(LIS_rc%obs_ngrid(k)) + real :: sh2o2_obs(LIS_rc%obs_ngrid(k)) + real :: sh2o3_obs(LIS_rc%obs_ngrid(k)) + real :: sh2o4_obs(LIS_rc%obs_ngrid(k)) + real :: stc1_obs(LIS_rc%obs_ngrid(k)) + real :: stc2_obs(LIS_rc%obs_ngrid(k)) + real :: stc3_obs(LIS_rc%obs_ngrid(k)) + real :: stc4_obs(LIS_rc%obs_ngrid(k)) + real :: vegt_obs(LIS_rc%obs_ngrid(k)) + + + call ESMF_StateGet(OBS_State,"Observation01",obs_sm_field,& + rc=status) + call LIS_verify(status,& + "ESMF_StateGet failed in NoahMP50_qc_soilmobs") + call ESMF_FieldGet(obs_sm_field,localDE=0,farrayPtr=smobs,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet failed in NoahMP50_qc_soilmobs") + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + smc1(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) + smc2(t) = NoahMP50_struc(n)%noahmp50(t)%smc(2) + smc3(t) = NoahMP50_struc(n)%noahmp50(t)%smc(3) + smc4(t) = NoahMP50_struc(n)%noahmp50(t)%smc(4) + + sh2o1(t) = NoahMP50_struc(n)%noahmp50(t)%sh2o(1) + sh2o2(t) = NoahMP50_struc(n)%noahmp50(t)%sh2o(2) + sh2o3(t) = NoahMP50_struc(n)%noahmp50(t)%sh2o(3) + sh2o4(t) = NoahMP50_struc(n)%noahmp50(t)%sh2o(4) +!--------------------------------------------------------------------------------------------------------- + ! MN NOTE:sstc contain soil and snow temperature first snow + ! temperature and then soil temeprature. + ! But the number of snow layers changes from 0 to 3 +!--------------------------------------------------------------------------------------------------------- + ! stc1(t) = NoahMP50_struc(n)%noahmp50(t)%sstc(NoahMP50_struc(n)%nsnow+1) + ! stc2(t) = NoahMP50_struc(n)%noahmp50(t)%sstc(NoahMP50_struc(n)%nsnow+2) + ! stc3(t) = NoahMP50_struc(n)%noahmp50(t)%sstc(NoahMP50_struc(n)%nsnow+3) + ! stc4(t) = NoahMP50_struc(n)%noahmp50(t)%sstc(NoahMP50_struc(n)%nsnow+4) + + stc1(t) = NoahMP50_struc(n)%noahmp50(t)%tslb(1) + stc2(t) = NoahMP50_struc(n)%noahmp50(t)%tslb(2) + stc3(t) = NoahMP50_struc(n)%noahmp50(t)%tslb(3) + stc4(t) = NoahMP50_struc(n)%noahmp50(t)%tslb(4) + + vegt(t) = NoahMP50_struc(n)%noahmp50(t)%vegetype + + !SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + !SMCMAX(t) = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) ! SMCMAX(t) = MAXSMC (SOILTYP) + !SMCWLT(t) = NoahMP50_struc(n)%noahmp50(t)%param%SMCWLT(1) ! SMCWLT(t) = WLTSMC (SOILTYP) + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + SMCMAX(t) = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) !SMCMAX_TABLE(SOILTYP) + SMCWLT(t) = NoahMP50_struc(n)%noahmp50(t)%param%SMCWLT(1) !SMCWLT_TABLE(SOILTYP) + enddo + + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + NoahMP50_struc(n)%noahmp50(:)%prcp,& + rainf_obs) ! MN prcp is total precip + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + NoahMP50_struc(n)%noahmp50(:)%sneqv,& + sneqv_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + NoahMP50_struc(n)%noahmp50(:)%snowc,& ! MP36 fsno + sca_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + NoahMP50_struc(n)%noahmp50(:)%fveg,& + shdfac_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + NoahMP50_struc(n)%noahmp50(:)%tg,& + t1_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + smcmax, & + smcmax_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + smcwlt,& + smcwlt_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + smc1,& + smc1_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + smc2,& + smc2_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + smc3,& + smc3_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + smc4,& + smc4_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + sh2o1,& + sh2o1_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + sh2o2,& + sh2o2_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + sh2o3,& + sh2o3_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + sh2o4,& + sh2o4_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + stc1,& + stc1_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + stc2,& + stc2_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + stc3,& + stc3_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + stc4,& + stc4_obs) + + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, & + vegt,& + vegt_obs) + + do t = 1,LIS_rc%obs_ngrid(k) + + if(smobs(t).ne.LIS_rc%udef) then +! MN: check for rain + if(rainf_obs(t).gt.3E-6) then ! Var name Noah36 --> rainf + smobs(t) = LIS_rc%udef +! print*, 'rainf ',gid,t,NoahMP50_struc(n)%noahmp50(t)%prcp +! MN: check for frozen soil + elseif(abs(smc1_obs(t)- & + sh2o1_obs(t)).gt.0.0001) then + smobs(t) = LIS_rc%udef + elseif(abs(smc2_obs(t)- & + sh2o2_obs(t)).gt.0.0001) then + smobs(t) = LIS_rc%udef + elseif(abs(smc3_obs(t)- & + sh2o3_obs(t)).gt.0.0001) then + smobs(t) = LIS_rc%udef + elseif(abs(smc4_obs(t)- & + sh2o4_obs(t)).gt.0.0001) then + smobs(t) = LIS_rc%udef + elseif(stc1_obs(t).le.LIS_CONST_TKFRZ) then + smobs(t) = LIS_rc%udef + elseif(stc2_obs(t).le.LIS_CONST_TKFRZ) then + smobs(t) = LIS_rc%udef + elseif(stc3_obs(t).le.LIS_CONST_TKFRZ) then + smobs(t) = LIS_rc%udef + elseif(stc4_obs(t).le.LIS_CONST_TKFRZ) then + smobs(t) = LIS_rc%udef + elseif(t1_obs(t).le.LIS_CONST_TKFRZ) then ! Var name Noah36 --> t1 + smobs(t) = LIS_rc%udef + elseif(vegt_obs(t).le.4) then !forest types ! Var name Noah36 --> vegt + smobs(t) = LIS_rc%udef + ! MN: check for snow + elseif(sneqv_obs(t).gt.0.001) then + smobs(t) = LIS_rc%udef + elseif(sca_obs(t).gt.0.0001) then ! Var name sca + smobs(t) = LIS_rc%udef + ! MN: check for green vegetation fraction NOTE: threshold incerased from 0.5 to 0.7 + elseif(shdfac_obs(t).gt.0.9) then ! var name Noah36 shdfac 12-month green veg. frac. + ! The threshold has been tuned for spatial coverage + ! Higher than Noah.3.9 because max greenness is used for shdfac in Noah-MP.4.0.1 + ! while Noah3.9 uses monthly climatological greenness. + smobs(t) = LIS_rc%udef +!too close to the tails, could be due to scaling, so reject. + elseif(smcmax_obs(t)-smobs(t).lt.0.02) then + smobs(t) = LIS_rc%udef + elseif(smobs(t) - smcwlt_obs(t).lt.0.02) then + smobs(t) = LIS_rc%udef + endif + endif + enddo + +end subroutine NoahMP50_qc_soilmobs + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_qcsoilm.F90 b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_qcsoilm.F90 new file mode 100644 index 000000000..539fb36d1 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_qcsoilm.F90 @@ -0,0 +1,80 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_qcsoilm +! \label{NoahMP50_qcsoilm} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 15 Dec 2018: Mahdi Navari; Modified for NoahMP50 +! +! !INTERFACE: +subroutine NoahMP50_qcsoilm(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the soilmoisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + type(ESMF_Field) :: sm1Field +! type(ESMF_Field) :: sm2Field +! type(ESMF_Field) :: sm3Field +! type(ESMF_Field) :: sm4Field + integer :: t + integer :: status + real, pointer :: soilm1(:) +! real, pointer :: soilm2(:) +! real, pointer :: soilm3(:) +! real, pointer :: soilm4(:) + real :: smmax1!,smmax2,smmax3,smmax4 + real :: smmin1!,smmin2,smmin3,smmin4 + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 1",sm1Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet for Soil Moisture Layer 1 failed in NoahMP50_qcsoilm") + + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm1,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet for Soil Moisture Layer 1 failed in NoahMP50_qcsoilm") + + call ESMF_AttributeGet(sm1Field,"Max Value",smmax1,rc=status) + call LIS_verify(status,& + "ESMF_AttributeGet: Max Value failed in NoahMP50_qcsoilm") + + call ESMF_AttributeGet(sm1Field,"Min Value",smmin1,rc=status) + call LIS_verify(status,& + "ESMF_AttributeGet: Min Value failed in NoahMP50_qcsoilm") + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + if(soilm1(t).gt.smmax1) soilm1(t) = smmax1 + if(soilm1(t).lt.smmin1) soilm1(t) = smmin1 + enddo + +end subroutine NoahMP50_qcsoilm + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_scale_soilm.F90 b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_scale_soilm.F90 new file mode 100644 index 000000000..e419e8531 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_scale_soilm.F90 @@ -0,0 +1,47 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_scale_soilm +! \label{NoahMP50_scale_soilm} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 15 Dec 2018: Mahdi Navari; Modified for NoahMP50 +! +! !INTERFACE: +subroutine NoahMP50_scale_soilm(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Scales soilmoisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + + +end subroutine NoahMP50_scale_soilm + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_setsoilm.F90 b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_setsoilm.F90 new file mode 100644 index 000000000..a62af24c3 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_setsoilm.F90 @@ -0,0 +1,508 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_setsoilm +! \label{NoahMP50_setsoilm} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 15 Dec 2018: Mahdi Navari: Modified for NoahMP50 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! Apply the update if it met the update conditions +! Update conditions: +! 1- Prior SM(sh2o) + increment > MIN_THRESHOLD +! 2- Prior SM(sh2o) + increment < sm_threshold +! There are 3 cases +! 1- If all the ensemble members met the update conditions --> apply the update +! 2- If more than 50% of the ensemble members met the update condition --> +! apply the update for that members and set the other member to the mean +! value of the ensemble (i.e. mean of the members that met the conditions) +! 3- If less then 50% of the ensemble members met the update conditions --> +! adjust the states + + +! !INTERFACE: +subroutine NoahMP50_setsoilm(n, LSM_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! This routine assigns the soil moisture prognostic variables to noah's +! model space. +! +!EOP + real, parameter :: MIN_THRESHOLD = 0.02 + real :: MAX_threshold + real :: sm_threshold + type(ESMF_Field) :: sm1Field + type(ESMF_Field) :: sm2Field + type(ESMF_Field) :: sm3Field + type(ESMF_Field) :: sm4Field + real, pointer :: soilm1(:) + real, pointer :: soilm2(:) + real, pointer :: soilm3(:) + real, pointer :: soilm4(:) + integer :: t, j,i, gid, m, t_unpert + integer :: status + real :: delta(4) + real :: delta1,delta2,delta3,delta4 + real :: tmpval + logical :: bounds_violation + integer :: nIter + logical :: update_flag(LIS_rc%ngrid(n)) + logical :: ens_flag(LIS_rc%nensem(n)) +! mn + integer :: SOILTYP ! soil type index [-] + real :: SMCMAX , SMCWLT + real :: tmp(LIS_rc%nensem(n)), tmp0(LIS_rc%nensem(n)) + real :: tmp1(LIS_rc%nensem(n)),tmp2(LIS_rc%nensem(n)),tmp3(LIS_rc%nensem(n)),tmp4(LIS_rc%nensem(n)) + logical :: update_flag_tile(LIS_rc%npatch(n,LIS_rc%lsm_index)) + logical :: flag_ens(LIS_rc%ngrid(n)) + logical :: flag_tmp(LIS_rc%nensem(n)) + logical :: update_flag_ens(LIS_rc%ngrid(n)) + logical :: update_flag_new(LIS_rc%ngrid(n)) + integer :: RESULT, pcount, icount + real :: MaxEnsSM1 ,MaxEnsSM2 ,MaxEnsSM3 ,MaxEnsSM4 + real :: MinEnsSM1 ,MinEnsSM2 ,MinEnsSM3 ,MinEnsSM4 + real :: MaxEns_sh2o1, MaxEns_sh2o2, MaxEns_sh2o3, MaxEns_sh2o4 + real :: smc_rnd, smc_tmp + real :: sh2o_tmp, sh2o_rnd + INTEGER, DIMENSION (1) :: seed + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 1",sm1Field,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Soil Moisture Layer 1 failed in NoahMP50_setsoilm") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 2",sm2Field,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Soil Moisture Layer 2 failed in NoahMP50_setsoilm") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 3",sm3Field,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Soil Moisture Layer 3 failed in NoahMP50_setsoilm") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 4",sm4Field,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Soil Moisture Layer 4 failed in NoahMP50_setsoilm") + + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm1,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 1 failed in NoahMP50_setsoilm") + call ESMF_FieldGet(sm2Field,localDE=0,farrayPtr=soilm2,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 2 failed in NoahMP50_setsoilm") + call ESMF_FieldGet(sm3Field,localDE=0,farrayPtr=soilm3,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 3 failed in NoahMP50_setsoilm") + call ESMF_FieldGet(sm4Field,localDE=0,farrayPtr=soilm4,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 4 failed in NoahMP50_setsoilm") + + update_flag = .true. + update_flag_tile= .true. + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + MAX_THRESHOLD = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) ! MAXSMC (SOILTYP) + sm_threshold = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) - 0.02 ! MAXSMC (SOILTYP) - 0.02 + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + !MN: delta = X(+) - X(-) + !NOTE: "noahmp50_updatesoilm.F90" updates the soilm_(t) + delta1 = soilm1(t)-NoahMP50_struc(n)%noahmp50(t)%smc(1) + delta2 = soilm2(t)-NoahMP50_struc(n)%noahmp50(t)%smc(2) + delta3 = soilm3(t)-NoahMP50_struc(n)%noahmp50(t)%smc(3) + delta4 = soilm4(t)-NoahMP50_struc(n)%noahmp50(t)%smc(4) + + ! MN: check MIN_THRESHOLD < volumetric liquid soil moisture < threshold + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(1)+delta1.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(1)+delta1.lt.& + sm_threshold) then + update_flag(gid) = update_flag(gid).and.(.true.) + ! MN save the flag for each tile (col*row*ens) (64*44)*20 + update_flag_tile(t) = update_flag_tile(t).and.(.true.) + else + update_flag(gid) = update_flag(gid).and.(.false.) + update_flag_tile(t) = update_flag_tile(t).and.(.false.) + endif + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(2)+delta2.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(2)+delta2.lt.sm_threshold) then + update_flag(gid) = update_flag(gid).and.(.true.) + update_flag_tile(t) = update_flag_tile(t).and.(.true.) + else + update_flag(gid) = update_flag(gid).and.(.false.) + update_flag_tile(t) = update_flag_tile(t).and.(.false.) + endif + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(3)+delta3.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(3)+delta3.lt.sm_threshold) then + update_flag(gid) = update_flag(gid).and.(.true.) + update_flag_tile(t) = update_flag_tile(t).and.(.true.) + else + update_flag(gid) = update_flag(gid).and.(.false.) + update_flag_tile(t) = update_flag_tile(t).and.(.false.) + endif + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(4)+delta4.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(4)+delta4.lt.sm_threshold) then + update_flag(gid) = update_flag(gid).and.(.true.) + update_flag_tile(t) = update_flag_tile(t).and.(.true.) + else + update_flag(gid) = update_flag(gid).and.(.false.) + update_flag_tile(t) = update_flag_tile(t).and.(.false.) + endif + enddo + +!----------------------------------------------------------------------------------------- +! MN create new falg: if update falg for 50% of the ensemble members is true +! then update the state variabels +!----------------------------------------------------------------------------------------- + update_flag_ens = .True. + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index),LIS_rc%nensem(n) + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(i)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(i)%row) + flag_tmp=update_flag_tile(i:i+LIS_rc%nensem(n)-1) + !flag_tmp=update_flag_tile((i-1)*LIS_rc%nensem(n)+1:(i)*LIS_rc%nensem(n)) + pcount = COUNT(flag_tmp) ! Counts the number of .TRUE. elements + if (pcount.lt.LIS_rc%nensem(n)*0.5) then ! 50% + update_flag_ens(gid)= .False. + endif + update_flag_new(gid)= update_flag(gid).or.update_flag_ens(gid) ! new flag + enddo + + ! MN print +#if 0 +if(i.eq.66) then !i=66 ! --> domain's center 1376 + if(LIS_rc%hr.eq.12) then + write(2001,'(I4, 2x, 3(I2,x), 2x, 23(L1,2x))'),& + i, LIS_rc%mo, LIS_rc%da, LIS_rc%hr,update_flag_tile& + ((i-1)*LIS_rc%nensem(n)+1:(i)*LIS_rc%nensem(n)),& + update_flag_ens(i), update_flag_new(i), update_flag(i) + endif !mn + endif +#endif + + ! update step + ! loop over grid points + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index),LIS_rc%nensem(n) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(i)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(i)%row) + + !if(update_flag(gid)) then + if(update_flag_new(gid)) then +!----------------------------------------------------------------------------------------- + ! 1- update the states + ! 1-1- if update flag for tile is TRUE --> apply the DA update + ! 1-2- if update flag for tile is FALSE --> resample the states + ! 2- adjust the states +!----------------------------------------------------------------------------------------- + ! store update value for cases that update_flag_tile & update_flag_new are TRUE + ! update_flag_tile = TRUE --> means met the both min and max threshold + + tmp1 = LIS_rc%udef + tmp2 = LIS_rc%udef + tmp3 = LIS_rc%udef + tmp4 = LIS_rc%udef + !icount = 1 + do m=1,LIS_rc%nensem(n) + t = i+m-1 + !t = (i-1)*LIS_rc%nensem(n)+m + + if(update_flag_tile(t)) then + + tmp1(m) = soilm1(t) + tmp2(m) = soilm2(t) + tmp3(m) = soilm3(t) + tmp4(m) = soilm4(t) + !icount = icount + 1 + endif + enddo + + MaxEnsSM1 = -10000 + MaxEnsSM2 = -10000 + MaxEnsSM3 = -10000 + MaxEnsSM4 = -10000 + + MinEnsSM1 = 10000 + MinEnsSM2 = 10000 + MinEnsSM3 = 10000 + MinEnsSM4 = 10000 + + do m=1,LIS_rc%nensem(n) + if(tmp1(m).ne.LIS_rc%udef) then + MaxEnsSM1 = max(MaxEnsSM1, tmp1(m)) + MaxEnsSM2 = max(MaxEnsSM2, tmp2(m)) + MaxEnsSM3 = max(MaxEnsSM3, tmp3(m)) + MaxEnsSM4 = max(MaxEnsSM4, tmp4(m)) + + MinEnsSM1 = min(MinEnsSM1, tmp1(m)) + MinEnsSM2 = min(MinEnsSM2, tmp2(m)) + MinEnsSM3 = min(MinEnsSM3, tmp3(m)) + MinEnsSM4 = min(MinEnsSM4, tmp4(m)) + + endif + enddo + + + ! loop over tile + do m=1,LIS_rc%nensem(n) + t = i+m-1 + !t = (i-1)*LIS_rc%nensem(n)+m + + ! MN check update status for each tile + if(update_flag_tile(t)) then + + delta1 = soilm1(t)-NoahMP50_struc(n)%noahmp50(t)%smc(1) + delta2 = soilm2(t)-NoahMP50_struc(n)%noahmp50(t)%smc(2) + delta3 = soilm3(t)-NoahMP50_struc(n)%noahmp50(t)%smc(3) + delta4 = soilm4(t)-NoahMP50_struc(n)%noahmp50(t)%smc(4) + + NoahMP50_struc(n)%noahmp50(t)%sh2o(1) = NoahMP50_struc(n)%noahmp50(t)%sh2o(1)+& + delta1 + NoahMP50_struc(n)%noahmp50(t)%smc(1) = soilm1(t) + if(soilm1(t).lt.0) then + print*, 'setsoilm1 ',t,soilm1(t) + stop + endif + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(2)+delta2.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(2)+delta2.lt.sm_threshold) then + NoahMP50_struc(n)%noahmp50(t)%sh2o(2) = NoahMP50_struc(n)%noahmp50(t)%sh2o(2)+& + soilm2(t)-NoahMP50_struc(n)%noahmp50(t)%smc(2) + NoahMP50_struc(n)%noahmp50(t)%smc(2) = soilm2(t) + if(soilm2(t).lt.0) then + print*, 'setsoilm2 ',t,soilm2(t) + stop + endif + endif + + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(3)+delta3.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(3)+delta3.lt.sm_threshold) then + NoahMP50_struc(n)%noahmp50(t)%sh2o(3) = NoahMP50_struc(n)%noahmp50(t)%sh2o(3)+& + soilm3(t)-NoahMP50_struc(n)%noahmp50(t)%smc(3) + NoahMP50_struc(n)%noahmp50(t)%smc(3) = soilm3(t) + if(soilm3(t).lt.0) then + print*, 'setsoilm3 ',t,soilm3(t) + stop + endif + endif + + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(4)+delta4.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(4)+delta4.lt.sm_threshold) then + NoahMP50_struc(n)%noahmp50(t)%sh2o(4) = NoahMP50_struc(n)%noahmp50(t)%sh2o(4)+& + soilm4(t)-NoahMP50_struc(n)%noahmp50(t)%smc(4) + NoahMP50_struc(n)%noahmp50(t)%smc(4) = soilm4(t) + + if(soilm4(t).lt.0) then + print*, 'setsoilm4 ',t,soilm4(t) + stop + endif + endif + + +!----------------------------------------------------------------------------------------- + ! randomly resample the smc from [MIN_THRESHOLD, Max value from DA @ that tiem step] +!----------------------------------------------------------------------------------------- + else + +!----------------------------------------------------------------------------------------- +! set the soil moisture to the ensemble mean +!----------------------------------------------------------------------------------------- + + ! use mean value + ! Assume sh2o = smc (i.e. ice content=0) + smc_tmp = (MaxEnsSM1 - MinEnsSM1)/2 + MinEnsSM1 + NoahMP50_struc(n)%noahmp50(t)%sh2o(1) = smc_tmp + NoahMP50_struc(n)%noahmp50(t)%smc(1) = smc_tmp + + smc_tmp = (MaxEnsSM2 - MinEnsSM2)/2 + MinEnsSM2 + NoahMP50_struc(n)%noahmp50(t)%sh2o(2) = smc_tmp + NoahMP50_struc(n)%noahmp50(t)%smc(2) = smc_tmp + + smc_tmp = (MaxEnsSM3 - MinEnsSM3)/2 + MinEnsSM3 + NoahMP50_struc(n)%noahmp50(t)%sh2o(3) = smc_tmp + NoahMP50_struc(n)%noahmp50(t)%smc(3) = smc_tmp + + smc_tmp = (MaxEnsSM4 - MinEnsSM4)/2 + MinEnsSM4 + NoahMP50_struc(n)%noahmp50(t)%sh2o(4) = smc_tmp + NoahMP50_struc(n)%noahmp50(t)%smc(4) = smc_tmp + + + endif ! flag for each tile + + enddo ! loop over tile + + else ! if update_flag_new(gid) is FALSE + if(LIS_rc%pert_bias_corr.eq.1) then + !-------------------------------------------------------------------------- + ! if no update is made, then we need to readjust the ensemble if pert bias + ! correction is turned on because the forcing perturbations may cause + ! biases to persist. + !-------------------------------------------------------------------------- + bounds_violation = .true. + nIter = 0 + ens_flag = .true. + + do while(bounds_violation) + niter = niter + 1 + !t_unpert = i*LIS_rc%nensem(n) + t_unpert = i+LIS_rc%nensem(n)-1 + do j=1,4 + delta(j) = 0.0 + do m=1,LIS_rc%nensem(n)-1 + t = i+m-1 + !t = (i-1)*LIS_rc%nensem(n)+m + + if(m.ne.LIS_rc%nensem(n)) then + delta(j) = delta(j) + & + (NoahMP50_struc(n)%noahmp50(t)%sh2o(j) - & + NoahMP50_struc(n)%noahmp50(t_unpert)%sh2o(j)) + endif + + enddo + enddo + + do j=1,4 + delta(j) =delta(j)/(LIS_rc%nensem(n)-1) + do m=1,LIS_rc%nensem(n)-1 + t = i+m-1 + !t = (i-1)*LIS_rc%nensem(n)+m + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + MAX_THRESHOLD = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) !SMCMAX_TABLE(SOILTYP) + sm_threshold = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) - 0.02 !SMCMAX_TABLE(SOILTYP) - 0.02 + + tmpval = NoahMP50_struc(n)%noahmp50(t)%sh2o(j) - delta(j) + if(tmpval.le.MIN_THRESHOLD) then + NoahMP50_struc(n)%noahmp50(t)%sh2o(j) = & + max(NoahMP50_struc(n)%noahmp50(t_unpert)%sh2o(j),& + MIN_THRESHOLD) + NoahMP50_struc(n)%noahmp50(t)%smc(j) = & + max(NoahMP50_struc(n)%noahmp50(t_unpert)%smc(j),& + MIN_THRESHOLD) + ens_flag(m) = .false. + elseif(tmpval.ge.sm_threshold) then + NoahMP50_struc(n)%noahmp50(t)%sh2o(j) = & + min(NoahMP50_struc(n)%noahmp50(t_unpert)%sh2o(j),& + sm_threshold) + NoahMP50_struc(n)%noahmp50(t)%smc(j) = & + min(NoahMP50_struc(n)%noahmp50(t_unpert)%smc(j),& + sm_threshold) + ens_flag(m) = .false. + endif + enddo + enddo + + !-------------------------------------------------------------------------- + ! Recalculate the deltas and adjust the ensemble + !-------------------------------------------------------------------------- + do j=1,4 + delta(j) = 0.0 + do m=1,LIS_rc%nensem(n)-1 + t = i+m-1 + !t = (i-1)*LIS_rc%nensem(n)+m + if(m.ne.LIS_rc%nensem(n)) then + delta(j) = delta(j) + & + (NoahMP50_struc(n)%noahmp50(t)%sh2o(j) - & + NoahMP50_struc(n)%noahmp50(t_unpert)%sh2o(j)) + endif + enddo + enddo + + do j=1,4 + delta(j) =delta(j)/(LIS_rc%nensem(n)-1) + do m=1,LIS_rc%nensem(n)-1 + t = i+m-1 + !t = (i-1)*LIS_rc%nensem(n)+m + + if(ens_flag(m)) then + tmpval = NoahMP50_struc(n)%noahmp50(t)%sh2o(j) - & + delta(j) + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + MAX_THRESHOLD = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) !SMCMAX_TABLE(SOILTYP) + + if(.not.(tmpval.le.0.0 .or.& + tmpval.gt.(MAX_THRESHOLD))) then + + NoahMP50_struc(n)%noahmp50(t)%smc(j) = & + NoahMP50_struc(n)%noahmp50(t)%smc(j) - delta(j) + NoahMP50_struc(n)%noahmp50(t)%sh2o(j) = & + NoahMP50_struc(n)%noahmp50(t)%sh2o(j) - delta(j) + bounds_violation = .false. + endif + endif + + tmpval = NoahMP50_struc(n)%noahmp50(t)%sh2o(j) + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + MAX_THRESHOLD = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) !SMCMAX_TABLE(SOILTYP) + + if(tmpval.le.0.0 .or.& + tmpval.gt.(MAX_THRESHOLD)) then + bounds_violation = .true. + else + bounds_violation = .false. + endif + enddo + enddo + + if(nIter.gt.10.and.bounds_violation) then + !-------------------------------------------------------------------------- + ! All else fails, set to the bounds + !-------------------------------------------------------------------------- + + write(LIS_logunit,*) '[ERR] Ensemble structure violates physical bounds ' + write(LIS_logunit,*) '[ERR] Please adjust the perturbation settings ..' + + do j=1,4 + do m=1,LIS_rc%nensem(n) + t = i+m-1 + !t = (i-1)*LIS_rc%nensem(n)+m + + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + MAX_THRESHOLD = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) !SMCMAX_TABLE(SOILTYP) + + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(j).gt.MAX_THRESHOLD.or.& + NoahMP50_struc(n)%noahmp50(t)%smc(j).gt.MAX_THRESHOLD) then + NoahMP50_struc(n)%noahmp50(t)%sh2o(j) = MAX_THRESHOLD + NoahMP50_struc(n)%noahmp50(t)%smc(j) = MAX_THRESHOLD + endif + + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(j).lt.MIN_THRESHOLD.or.& + NoahMP50_struc(n)%noahmp50(t)%smc(j).lt.MIN_THRESHOLD) then + NoahMP50_struc(n)%noahmp50(t)%sh2o(j) = MIN_THRESHOLD + NoahMP50_struc(n)%noahmp50(t)%smc(j) = MIN_THRESHOLD + endif +! print*, i, m +! print*, 'smc',t, NoahMP50_struc(n)%noahmp50(t)%smc(:) +! print*, 'sh2o ',t,NoahMP50_struc(n)%noahmp50(t)%sh2o(:) +! print*, 'max ',t,MAX_THRESHOLD !NoahMP50_struc(n)%noahmp50(t)%smcmax + enddo +! call LIS_endrun() + enddo + endif + end do + endif + endif + enddo + + +end subroutine NoahMP50_setsoilm + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_updatesoilm.F90 b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_updatesoilm.F90 new file mode 100644 index 000000000..abe8e8950 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_updatesoilm.F90 @@ -0,0 +1,119 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_updatesoilm +! \label{NoahMP50_updatesoilm} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 15 Dec 2018: Mahdi Navari; Modified for NoahMP401 +! +! !INTERFACE: +subroutine NoahMP50_updatesoilm(n, LSM_State, LSM_Incr_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! This routine assigns the soil moisture prognostic variables to noah's +! model space. +! +!EOP + + type(ESMF_Field) :: sm1Field + type(ESMF_Field) :: sm2Field + type(ESMF_Field) :: sm3Field + type(ESMF_Field) :: sm4Field + type(ESMF_Field) :: sm1IncrField + type(ESMF_Field) :: sm2IncrField + type(ESMF_Field) :: sm3IncrField + type(ESMF_Field) :: sm4IncrField + + real, pointer :: soilm1(:) + real, pointer :: soilm2(:) + real, pointer :: soilm3(:) + real, pointer :: soilm4(:) + real, pointer :: soilmIncr1(:) + real, pointer :: soilmIncr2(:) + real, pointer :: soilmIncr3(:) + real, pointer :: soilmIncr4(:) + integer :: t,i,m + integer :: status + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 1",sm1Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 1 failed in NoahMP50_updatesoilm") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 2",sm2Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 2 failed in NoahMP50_updatesoilm") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 3",sm3Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 3 failed in NoahMP50_updatesoilm") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 4",sm4Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 4 failed in NoahMP50_updatesoilm") + + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm1,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 1 failed in NoahMP50_updatesoilm") + call ESMF_FieldGet(sm2Field,localDE=0,farrayPtr=soilm2,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 2 failed in NoahMP50_updatesoilm") + call ESMF_FieldGet(sm3Field,localDE=0,farrayPtr=soilm3,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 3 failed in NoahMP50_updatesoilm") + call ESMF_FieldGet(sm4Field,localDE=0,farrayPtr=soilm4,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 4 failed in NoahMP50_updatesoilm") + + call ESMF_StateGet(LSM_Incr_State,"Soil Moisture Layer 1",sm1IncrField,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 1 failed in NoahMP50_updatesoilm") + call ESMF_StateGet(LSM_Incr_State,"Soil Moisture Layer 2",sm2IncrField,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 2 failed in NoahMP50_updatesoilm") + call ESMF_StateGet(LSM_Incr_State,"Soil Moisture Layer 3",sm3IncrField,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 3 failed in NoahMP50_updatesoilm") + call ESMF_StateGet(LSM_Incr_State,"Soil Moisture Layer 4",sm4IncrField,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 4 failed in NoahMP50_updatesoilm") + + call ESMF_FieldGet(sm1IncrField,localDE=0,farrayPtr=soilmIncr1,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 1 failed in NoahMP50_updatesoilm") + call ESMF_FieldGet(sm2IncrField,localDE=0,farrayPtr=soilmIncr2,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 2 failed in NoahMP50_updatesoilm") + call ESMF_FieldGet(sm3IncrField,localDE=0,farrayPtr=soilmIncr3,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 3 failed in NoahMP50_updatesoilm") + call ESMF_FieldGet(sm4IncrField,localDE=0,farrayPtr=soilmIncr4,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 4 failed in NoahMP50_updatesoilm") + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + soilm1(t) = soilm1(t) + soilmIncr1(t) + soilm2(t) = soilm2(t) + soilmIncr2(t) + soilm3(t) = soilm3(t) + soilmIncr3(t) + soilm4(t) = soilm4(t) + soilmIncr4(t) + enddo +end subroutine NoahMP50_updatesoilm + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_write_soilm.F90 b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_write_soilm.F90 new file mode 100644 index 000000000..5133c8352 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_soilm/noahmp50_write_soilm.F90 @@ -0,0 +1,72 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_write_soilm +! \label{NoahMP50_write_soilm} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 15 Dec 2018: Mahdi Navari; Modified for NoahMP401 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine NoahMP50_write_soilm(ftn,n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use NoahMP50_lsmMod + use LIS_historyMod, only : LIS_writevar_restart + implicit none +! !ARGUMENTS: + integer, intent(in) :: ftn + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the soilmoisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + integer :: t + real, allocatable :: tmp(:) + + allocate(tmp(LIS_rc%npatch(n,LIS_rc%lsm_index))) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(2) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(3) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(4) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + deallocate(tmp) + +end subroutine NoahMP50_write_soilm + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_datws_Mod.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_datws_Mod.F90 new file mode 100755 index 000000000..e95f18c03 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_datws_Mod.F90 @@ -0,0 +1,79 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +module noahmp50_datws_Mod +!BOP +! +! !MODULE: noahmp50_datws_Mod +! +! !DESCRIPTION: +! +! !REVISION HISTORY: +! +! 14 Mar 2017: Sujay Kumar; Initial Specification +! 29 May 2020: Bailing Li created for Noah-MP.4.0.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! !USES: + use ESMF + use LIS_coreMod + use LIS_dataAssimMod + use LIS_logMod + + implicit none + + PRIVATE +!----------------------------------------------------------------------------- +! !PUBLIC MEMBER FUNCTIONS: +!----------------------------------------------------------------------------- + public :: noahmp50_datws_init +!----------------------------------------------------------------------------- +! !PUBLIC TYPES: +!----------------------------------------------------------------------------- + public :: noahmp50_dasm_struc +!EOP + + type, public :: dasm_dec + real, allocatable :: model_xrange(:,:,:) + real, allocatable :: model_cdf(:,:,:) + real, allocatable :: model_mu(:) + + integer :: nbins + integer :: ntimes + integer :: scal + + end type dasm_dec + + type(dasm_dec), allocatable :: noahmp50_dasm_struc(:) + +contains +!BOP +! +! !ROUTINE: noahmp50_datws_init +! \label{noahmp50_datws_init} +! +! !INTERFACE: + subroutine noahmp50_datws_init(k) +! !USES: +! !DESCRIPTION: +! +!EOP + + implicit none + integer :: k + integer :: n + integer :: status + integer :: ngrid + + if(.not.allocated(noahmp50_dasm_struc)) then + allocate(noahmp50_dasm_struc(LIS_rc%nnest)) + endif + + end subroutine noahmp50_datws_init +end module noahmp50_datws_Mod diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_descale_tws.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_descale_tws.F90 new file mode 100755 index 000000000..405310fc2 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_descale_tws.F90 @@ -0,0 +1,43 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_descale_tws +! \label{noahmp50_descale_tws} +! +! !REVISION HISTORY: +! 14 Mar 2017: Sujay Kumar; Initial Specification +! 29 May 2020: Bailing Li; created for Noah-MP4.0.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_descale_tws(n, LSM_State, LSM_Incr_State) + +! !USES: + use ESMF + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! Descales tws related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + +end subroutine noahmp50_descale_tws diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_gettws.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_gettws.F90 new file mode 100755 index 000000000..7ed7e4e8d --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_gettws.F90 @@ -0,0 +1,96 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_gettws +! \label{noahmp50_gettws} +! +! !REVISION HISTORY: +! 14 Mar 2017: Sujay Kumar; Initial Specification +! 18 Aug 2017: Wanshu Nie; Add groundwater component +! 29 May 2020: Bailing Li; created for Noah-MP4.0.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! !INTERFACE: +subroutine noahmp50_gettws(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the soilmoisture and groundwater related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + type(ESMF_Field) :: sm1Field + type(ESMF_Field) :: sm2Field + type(ESMF_Field) :: sm3Field + type(ESMF_Field) :: sm4Field + type(ESMF_Field) :: gwField + type(ESMF_Field) :: sweField + integer :: t + integer :: status + real, pointer :: soilm1(:) + real, pointer :: soilm2(:) + real, pointer :: soilm3(:) + real, pointer :: soilm4(:) + real, pointer :: gws(:) + real, pointer :: swe(:) + character*100 :: lsm_state_objs(4) + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 1",sm1Field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for sm1 in noahmp50_gettws') + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 2",sm2Field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for sm2 in noahmp50_gettws') + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 3",sm3Field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for sm3 in noahmp50_gettws') + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 4",sm4Field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for sm4 in noahmp50_gettws') + call ESMF_StateGet(LSM_State,"Groundwater Storage",gwField,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for gw in noahmp50_gettws') + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for SWE in noahmp50_gettws') + + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm1,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for sm1 in noahmp50_gettws') + call ESMF_FieldGet(sm2Field,localDE=0,farrayPtr=soilm2,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for sm2 in noahmp50_gettws') + call ESMF_FieldGet(sm3Field,localDE=0,farrayPtr=soilm3,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for sm3 in noahmp50_gettws') + call ESMF_FieldGet(sm4Field,localDE=0,farrayPtr=soilm4,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for sm4 in noahmp50_gettws') + call ESMF_FieldGet(gwField,localDE=0,farrayPtr=gws,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for gw in noahmp50_gettws') + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for SWE in noahmp50_gettws') + + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) !to mm + soilm1(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) + soilm2(t) = NoahMP50_struc(n)%noahmp50(t)%smc(2) + soilm3(t) = NoahMP50_struc(n)%noahmp50(t)%smc(3) + soilm4(t) = NoahMP50_struc(n)%noahmp50(t)%smc(4) + gws(t) = NoahMP50_struc(n)%noahmp50(t)%wa + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + enddo + +end subroutine noahmp50_gettws diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_gettwspred.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_gettwspred.F90 new file mode 100755 index 000000000..3d9be62ce --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_gettwspred.F90 @@ -0,0 +1,60 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_gettwspred +! \label{noahmp50_gettwspred} +! +! !REVISION HISTORY: +! 14 Mar 2017: Sujay Kumar; Initial Specification +! 29 May 2020: Baiing Li; Created for Noah-MP4.0.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_gettwspred(n, k,obs_pred) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use LIS_DAobservationsMod + use noahmp50_tws_DAlogMod + use noahmp50_lsmMod + +!EOP + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + real :: obs_pred(LIS_rc%obs_ngrid(k),LIS_rc%nensem(n)) +! +! !DESCRIPTION: +! +! Returns the Soil moisture obs pred (model's estimate of +! observations) for data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[obs\_pred] model's estimate of observations \newline +! \end{description} +!EOP + integer :: t + real :: tws(LIS_rc%npatch(n,LIS_rc%lsm_index)) + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + tws(t) = (NOAHMPpred_struc(n)%clmnwater(1,t) + & + NOAHMPpred_struc(n)%clmnwater(2,t)+& + NOAHMPpred_struc(n)%clmnwater(3,t))/3. + enddo + call LIS_convertPatchSpaceToObsEnsSpace(n,k,& + LIS_rc%lsm_index, & + tws,& + obs_pred) +end subroutine noahmp50_gettwspred diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_qc_twsobs.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_qc_twsobs.F90 new file mode 100755 index 000000000..a26c6f278 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_qc_twsobs.F90 @@ -0,0 +1,49 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_qc_twsobs +! \label{noahmp50_qc_twsobs} +! +! !REVISION HISTORY: +! 14 Mar 2017: Sujay Kumar: Initial Specification +! +! !INTERFACE: +subroutine noahmp50_qc_twsobs(n,k,OBS_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod, only : LIS_verify + use LIS_constantsMod, only : LIS_CONST_TKFRZ + use LIS_DAobservationsMod + use noahmp50_lsmMod + + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + type(ESMF_State) :: OBS_State +! +! !DESCRIPTION: +! +! This subroutine performs any model-based QC of the observation +! prior to data assimilation. Here the soil moisture observations +! are flagged when LSM indicates that (1) rain is falling (2) +! soil is frozen or (3) ground is fully or partially covered +! with snow MN:(4) ground is covered with vegatation (more than 50%). +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[OBS\_State] ESMF state container for observations \newline +! \end{description} +! +!EOP +end subroutine noahmp50_qc_twsobs diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_qctws.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_qctws.F90 new file mode 100755 index 000000000..dc0d5c693 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_qctws.F90 @@ -0,0 +1,186 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_qctws +! \label{noahmp50_qctws} +! +! !REVISION HISTORY: +! 14 Mar 2017: Sujay Kumar; Initial Specification +! 29 May 2020: Bailing Li; Created for Noah-MP4.0.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_qctws(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod, only : LIS_verify + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the soilmoisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + integer :: t,gid + integer :: status + real, pointer :: soilm1(:) + real, pointer :: soilm2(:) + real, pointer :: soilm3(:) + real, pointer :: soilm4(:) + real :: smmax + real :: smmin + + type(ESMF_Field) :: sm1Field + type(ESMF_Field) :: sm2Field + type(ESMF_Field) :: sm3Field + type(ESMF_Field) :: sm4Field + +!Wanshu + type(ESMF_Field) :: gwField, sweField + real, pointer :: gws(:) + real :: gwsmax, gwsmin + real :: MIN_THRESHOLD,MAX_threshold,sm_threshold + integer :: SOILTYP + + real, pointer :: swe(:) + + real :: swemax + real :: swemin + + real :: sndens + logical :: update_flag(LIS_rc%ngrid(n)) +!------- + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 1",sm1Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet for Soil Moisture Layer 1 failed in noahmp50_qctws") + + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm1,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet for Soil Moisture Layer 1 failed in noahmp50_qctws") + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 2",sm2Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet for Soil Moisture Layer 2 failed in noahmp50_qctws") + + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm2,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet for Soil Moisture Layer 2 failed in noahmp50_qctws") + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 3",sm3Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet for Soil Moisture Layer 3 failed in noahmp50_qctws") + + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm3,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet for Soil Moisture Layer 3 failed in noahmp50_qctws") + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 4",sm4Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet for Soil Moisture Layer 4 failed in noahmp50_qctws") + + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm4,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet for Soil Moisture Layer 4 failed in noahmp50_qctws") + + !Wanshu + call ESMF_StateGet(LSM_State,"Groundwater Storage",gwField,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for gw in noahmp50_qctws') + + call ESMF_FieldGet(gwField,localDE=0,farrayPtr=gws,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for gw in noahmp50_qctws') + + call ESMF_AttributeGet(gwField,"Max Value",gwsmax,rc=status) + call LIS_verify(status,& + "ESMF_AttributeGet: Max Value failed in noahmp50_qctws") + + call ESMF_AttributeGet(gwField,"Min Value",gwsmin,rc=status) + call LIS_verify(status,& + "ESMF_AttributeGet: Min Value failed in noahmp50_qctws") + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + + call ESMF_AttributeGet(sweField,"Max Value",swemax,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(sweField,"Min Value",swemin,rc=status) + call LIS_verify(status) + + !------- + + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + !Bailing Li: max min soil moisture should be retrieved based on soil type + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + MAX_THRESHOLD = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) !SMCMAX_TABLE(SOILTYP) + MIN_THRESHOLD = NoahMP50_struc(n)%noahmp50(t)%param%SMCWLT(1) !SMCWLT_TABLE(SOILTYP) + sm_threshold = MAX_THRESHOLD - 0.02 + + + if(soilm1(t).gt.sm_threshold) then + soilm1(t) = sm_threshold + endif + + if(soilm1(t).lt.MIN_THRESHOLD) then + soilm1(t) = MIN_THRESHOLD + endif + + if(soilm2(t).gt.sm_threshold) then + soilm2(t) = sm_threshold + endif + if(soilm2(t).lt.MIN_THRESHOLD) then + soilm2(t) = MIN_THRESHOLD + endif + + if(soilm3(t).gt.sm_threshold) then + soilm3(t) = sm_threshold + endif + if(soilm3(t).lt.MIN_THRESHOLD) then + soilm3(t) = MIN_THRESHOLD + endif + + if(soilm4(t).gt.sm_threshold) then + soilm4(t) = sm_threshold + endif + if(soilm4(t).lt.MIN_THRESHOLD) then + soilm4(t) = MIN_THRESHOLD + endif + !Wanshu + if(gws(t).gt.gwsmax) then + gws(t) = gwsmax + endif + if(gws(t).lt.gwsmin) then + gws(t) = gwsmin + endif + + if(swe(t).lt.swemin) then + swe(t) = swemin + endif + + !------ + enddo + +end subroutine noahmp50_qctws diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_scale_tws.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_scale_tws.F90 new file mode 100755 index 000000000..0f5518f3e --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_scale_tws.F90 @@ -0,0 +1,42 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_scale_tws +! \label{noahmp50_scale_tws} +! +! !REVISION HISTORY: +! 14 Mar 2017: Sujay Kumar; Initial Specification +! 29 May 2020: Bailing Li; created for Noah-MP4.0.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_scale_tws(n, LSM_State) + +! !USES: + use ESMF + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Scales tws related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + +end subroutine noahmp50_scale_tws diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_settws.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_settws.F90 new file mode 100755 index 000000000..1434ccb97 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_settws.F90 @@ -0,0 +1,470 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_settws +! \label{noahmp50_settws} +! +! !REVISION HISTORY: +! 14 Mar 2017: Sujay Kumar; Initial Specification +! 29 May 2020: Bailing Li; created for Noah-MP4.0.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_settws(n, LSM_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_constantsMod + use LIS_logMod + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! This routine assigns the soil moisture prognostic variables to noah's +! model space. +! +!EOP + real, parameter :: MIN_GWS_THRESHOLD = 0.00 + real, parameter :: MAX_GWS_THRESHOLD = 7000.0 + real, parameter :: MAX_WA = 7000.0 + real, parameter :: ZSOIL = 2 !mm + real, parameter :: ROUS = 0.2 ! specific yield + !Bailing changed this to be WLTSMC +! real, parameter :: MIN_THRESHOLD = 0.02 + real :: MIN_THRESHOLD + real :: MAX_THRESHOLD + real :: sm_threshold + type(ESMF_Field) :: sm1Field + type(ESMF_Field) :: sm2Field + type(ESMF_Field) :: sm3Field + type(ESMF_Field) :: sm4Field + type(ESMF_Field) :: gwField + type(ESMF_Field) :: sweField + + real, pointer :: soilm1(:) + real, pointer :: soilm2(:) + real, pointer :: soilm3(:) + real, pointer :: soilm4(:) + real, pointer :: gws(:) + real, pointer :: swe(:) + + real :: delta + logical :: diffCheck(LIS_rc%ngrid(n)) + logical :: ensCheck(LIS_rc%ngrid(n)) + logical :: largeSM(LIS_rc%ngrid(n)) + real :: snodens(LIS_rc%npatch(n,LIS_rc%lsm_index)) + integer :: i, c,r,t,m,gid + integer :: SOILTYP ! soil type index [-] + real :: sh2o_tmp, sh2o_rnd + real :: dsneqv,dsnowh,snowh_new + real :: TWS1, TWS2, TWSd,delta1 + integer :: status + logical :: update_flag(LIS_rc%ngrid(n)) + logical :: rc1,rc2,rc3,rc4,rc5 + + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 1",sm1Field,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Soil Moisture Layer 1 failed in noahmp50_settws") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 2",sm2Field,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Soil Moisture Layer 2 failed in noahmp50_settws") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 3",sm3Field,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Soil Moisture Layer 3 failed in noahmp50_settws") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 4",sm4Field,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Soil Moisture Layer 4 failed in noahmp50_settws") + call ESMF_StateGet(LSM_State,"Groundwater Storage",gwField,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Groundwater Storage failed in noahmp50_settws") + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: SWE failed in noahmp50_settws") + + + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm1,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 1 failed in noahmp50_settws") + call ESMF_FieldGet(sm2Field,localDE=0,farrayPtr=soilm2,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 2 failed in noahmp50_settws") + call ESMF_FieldGet(sm3Field,localDE=0,farrayPtr=soilm3,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 3 failed in noahmp50_settws") + call ESMF_FieldGet(sm4Field,localDE=0,farrayPtr=soilm4,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 4 failed in noahmp50_settws") + call ESMF_FieldGet(gwField,localDE=0,farrayPtr=gws,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Groundwater Storage failed in noahmp50_settws") + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: SWE failed in noahmp50_settws") + + + ensCheck = .true. + diffCheck = .false. + largeSM = .false. + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + c = LIS_domain(n)%tile(t)%col + r = LIS_domain(n)%tile(t)%row + i = LIS_domain(n)%gindex(c,r) + + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + MAX_THRESHOLD = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) !SMCMAX_TABLE(SOILTYP) + + !locations with large soil moisture values are ice points. + !we turn off the increments in such locations. + if(NoahMP50_struc(n)%noahmp50(t)%smc(1).gt.MAX_THRESHOLD.or.& + NoahMP50_struc(n)%noahmp50(t)%smc(1).gt.0.50) then + largeSM(i) = .true. + endif + + if(NoahMP50_struc(n)%noahmp50(t)%snowh.gt.0) then + snodens(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv/& + NoahMP50_struc(n)%noahmp50(t)%snowh + else + snodens(t) = 0.0 + endif + + enddo + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + c = LIS_domain(n)%tile(t)%col + r = LIS_domain(n)%tile(t)%row + i = LIS_domain(n)%gindex(c,r) + if(largeSM(i)) then + soilm1(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) + soilm2(t) = NoahMP50_struc(n)%noahmp50(t)%smc(2) + soilm3(t) = NoahMP50_struc(n)%noahmp50(t)%smc(3) + soilm4(t) = NoahMP50_struc(n)%noahmp50(t)%smc(4) + gws(t) = NoahMP50_struc(n)%noahmp50(t)%wa + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + endif + enddo + + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + c = LIS_domain(n)%tile(t)%col + r = LIS_domain(n)%tile(t)%row + i = LIS_domain(n)%gindex(c,r) + + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + MAX_THRESHOLD = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) !SMCMAX_TABLE(SOILTYP) + MIN_THRESHOLD = 0.02 !SMCWLT_TABLE(SOILTYP) + sm_threshold = MAX_THRESHOLD - 0.02 + + if((soilm1(t).lt.MIN_THRESHOLD.or.& + soilm1(t).gt.MAX_THRESHOLD).or.& + (soilm2(t).lt.MIN_THRESHOLD.or.& + soilm2(t).gt.MAX_THRESHOLD).or.& + (soilm3(t).lt.MIN_THRESHOLD.or.& + soilm3(t).gt.MAX_THRESHOLD).or.& + (soilm4(t).lt.MIN_THRESHOLD.or.& + soilm4(t).gt.MAX_THRESHOLD).or.& + (gws(t).lt.MIN_GWS_THRESHOLD.or.& + gws(t).gt.MAX_GWS_THRESHOLD)) then + ensCheck(i) = .false. + endif + if((soilm1(t).ne.soilm1(i*LIS_rc%nensem(n))).and.& + (soilm2(t).ne.soilm2(i*LIS_rc%nensem(n))).and.& + (soilm3(t).ne.soilm3(i*LIS_rc%nensem(n))).and.& + (soilm4(t).ne.soilm4(i*LIS_rc%nensem(n))).and.& + (gws(t).ne.gws(i*LIS_rc%nensem(n)))) then + diffCheck(i) = .true. + endif + enddo + + do i=1,LIS_rc%ngrid(n) + rc1 = .true. + rc2 = .true. + rc3 = .true. + rc4 = .true. + rc5 = .true. + if(.not.ensCheck(i).and.diffCheck(i).and.(.not.largeSM(i))) then + call noahmp50_tws_reorderEnsForOutliers(i,& + LIS_rc%nensem(n),& + soilm1((i-1)*LIS_rc%nensem(n)+1:i*LIS_rc%nensem(n)),& + MIN_THRESHOLD, MAX_THRESHOLD,rc1) + call noahmp50_tws_reorderEnsForOutliers(i,& + LIS_rc%nensem(n),& + soilm2((i-1)*LIS_rc%nensem(n)+1:i*LIS_rc%nensem(n)),& + MIN_THRESHOLD, MAX_THRESHOLD,rc2) + call noahmp50_tws_reorderEnsForOutliers(i,& + LIS_rc%nensem(n),& + soilm3((i-1)*LIS_rc%nensem(n)+1:i*LIS_rc%nensem(n)),& + MIN_THRESHOLD, MAX_THRESHOLD,rc3) + call noahmp50_tws_reorderEnsForOutliers(i,& + LIS_rc%nensem(n),& + soilm4((i-1)*LIS_rc%nensem(n)+1:i*LIS_rc%nensem(n)),& + MIN_THRESHOLD, MAX_THRESHOLD,rc4) + call noahmp50_tws_reorderEnsForOutliers(i,& + LIS_rc%nensem(n),& + gws((i-1)*LIS_rc%nensem(n)+1:i*LIS_rc%nensem(n)),& + MIN_GWS_THRESHOLD, MAX_GWS_THRESHOLD,rc5) + endif + if(.not.rc1.or.& + .not.rc2.or.& + .not.rc3.or.& + .not.rc4.or.& + .not.rc5) then + + do m=1,LIS_rc%nensem(n) + t = (i-1)*LIS_rc%nensem(n)+m + soilm1(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) + soilm2(t) = NoahMP50_struc(n)%noahmp50(t)%smc(2) + soilm3(t) = NoahMP50_struc(n)%noahmp50(t)%smc(3) + soilm4(t) = NoahMP50_struc(n)%noahmp50(t)%smc(4) + gws(t) = NoahMP50_struc(n)%noahmp50(t)%wa + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + enddo + endif + enddo + + update_flag = .true. + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + SOILTYP = NoahMP50_struc(n)%noahmp50(t)%soiltype + MAX_THRESHOLD = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) ! MAXSMC (SOILTYP) + sm_threshold = NoahMP50_struc(n)%noahmp50(t)%param%SMCMAX(1) - 0.02 ! MAXSMC (SOILTYP) - 0.02 + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + delta1 = soilm1(t)-NoahMP50_struc(n)%noahmp50(t)%smc(1) + + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(1)+delta1.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(1)+delta1.lt.& + sm_threshold) then + update_flag(gid) = update_flag(gid).and.(.true.) + else + update_flag(gid) = update_flag(gid).and.(.false.) + endif + delta1 = soilm2(t)-NoahMP50_struc(n)%noahmp50(t)%smc(2) + + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(2)+delta1.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(2)+delta1.lt.& + sm_threshold) then + update_flag(gid) = update_flag(gid).and.(.true.) + else + update_flag(gid) = update_flag(gid).and.(.false.) + endif + + delta1 = soilm3(t)-NoahMP50_struc(n)%noahmp50(t)%smc(3) + + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(3)+delta1.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(3)+delta1.lt.& + sm_threshold) then + update_flag(gid) = update_flag(gid).and.(.true.) + else + update_flag(gid) = update_flag(gid).and.(.false.) + endif + + delta1 = soilm4(t)-NoahMP50_struc(n)%noahmp50(t)%smc(4) + + if(NoahMP50_struc(n)%noahmp50(t)%sh2o(4)+delta1.gt.MIN_THRESHOLD .and.& + NoahMP50_struc(n)%noahmp50(t)%sh2o(4)+delta1.lt.& + sm_threshold) then + update_flag(gid) = update_flag(gid).and.(.true.) + else + update_flag(gid) = update_flag(gid).and.(.false.) + endif + + enddo + +! if(LIS_localPet.eq.387) then +! gid = LIS_domain(n)%gindex(& +! LIS_surface(n,LIS_rc%lsm_index)%tile(16068)%col,& +! LIS_surface(n,LIS_rc%lsm_index)%tile(16068)%row) +! print*, 'tw1 ',NoahMP50_struc(n)%noahmp50(16068)%smc,& +! NoahMP50_struc(n)%noahmp50(16068)%sh2o,& +! NoahMP50_struc(n)%noahmp50(16068)%sneqv,& +! update_flag(gid) +! endif + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + if(update_flag(gid)) then + delta = soilm1(t) - NoahMP50_struc(n)%noahmp50(t)%smc(1) + NoahMP50_struc(n)%noahmp50(t)%smc(1) = soilm1(t) + NoahMP50_struc(n)%noahmp50(t)%sh2o(1) = & + NoahMP50_struc(n)%noahmp50(t)%sh2o(1) + delta + + delta = soilm2(t) - NoahMP50_struc(n)%noahmp50(t)%smc(2) + NoahMP50_struc(n)%noahmp50(t)%smc(2) = soilm2(t) + NoahMP50_struc(n)%noahmp50(t)%sh2o(2) = & + NoahMP50_struc(n)%noahmp50(t)%sh2o(2) + delta + + delta = soilm3(t) - NoahMP50_struc(n)%noahmp50(t)%smc(3) + NoahMP50_struc(n)%noahmp50(t)%smc(3) = soilm3(t) + NoahMP50_struc(n)%noahmp50(t)%sh2o(3) = & + NoahMP50_struc(n)%noahmp50(t)%sh2o(3) + delta + + delta = soilm4(t) - NoahMP50_struc(n)%noahmp50(t)%smc(4) + NoahMP50_struc(n)%noahmp50(t)%smc(4) = soilm4(t) + NoahMP50_struc(n)%noahmp50(t)%sh2o(4) = & + NoahMP50_struc(n)%noahmp50(t)%sh2o(4) + delta + + else + + TWS2 =(soilm1(t)*NoahMP50_struc(n)%sldpth(1)*& + soilm2(t)*NoahMP50_struc(n)%sldpth(2)*& + soilm3(t)*NoahMP50_struc(n)%sldpth(3)*& + soilm4(t)*NoahMP50_struc(n)%sldpth(4))*& + LIS_CONST_RHOFW + + + TWS1 =(NoahMP50_struc(n)%noahmp50(t)%smc(1)*& + NoahMP50_struc(n)%sldpth(1)*& + NoahMP50_struc(n)%noahmp50(t)%smc(2)*& + NoahMP50_struc(n)%sldpth(2)*& + NoahMP50_struc(n)%noahmp50(t)%smc(3)*& + NoahMP50_struc(n)%sldpth(3)*& + NoahMP50_struc(n)%noahmp50(t)%smc(4)*& + NoahMP50_struc(n)%sldpth(4))*& + LIS_CONST_RHOFW + + TWSd = TWS1 - TWS2 + + if(NoahMP50_struc(n)%noahmp50(t)%sneqv > 5.and.& + swe(t)+TWSd.gt.0) then +!only add snow if the increment is small + if(TWSd/NoahMP50_struc(n)%noahmp50(t)%sneqv < 0.10) then + swe(t) = swe(t)+TWSd + endif + else + swe(t) = 0.0 + endif + +! if(LIS_localPet.eq.387.and.t.eq.16068) then +! print*, 'swe ',LIS_localPet, t, swe(t), TWSd +! !since soil moisture update is not accepted, add this to snow +! endif + + endif + + NoahMP50_struc(n)%noahmp50(t)%wa=gws(t) + + enddo + +! if(LIS_localPet.eq.387) then +! gid = LIS_domain(n)%gindex(& +! LIS_surface(n,LIS_rc%lsm_index)%tile(16068)%col,& +! LIS_surface(n,LIS_rc%lsm_index)%tile(16068)%row) +! print*, 'tw2 ',NoahMP50_struc(n)%noahmp50(16068)%smc,& +! NoahMP50_struc(n)%noahmp50(16068)%sh2o,& +! NoahMP50_struc(n)%noahmp50(16068)%sneqv,& +! update_flag(gid) +! endif + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if(snodens(t).eq.0) then + swe(t) = 0.0 + endif + dsneqv = swe(t) - NoahMP50_struc(n)%noahmp50(t)%sneqv + + snowh_new = 0 + if(snodens(t).gt.0) then + snowh_new = swe(t)/snodens(t) + endif + + dsnowh = snowh_new - NoahMP50_struc(n)%noahmp50(t)%sneqv + + call noahmp50_snow_update(n, t, dsneqv, dsnowh) + enddo + + + +! write(101,fmt='(I4.4, 1x, I2.2, 1x, I2.2, 1x, I2.2, 1x, I2.2,1x,10E14.6)') & +! LIS_rc%yr, LIS_rc%mo, LIS_rc%da, LIS_rc%hr,LIS_rc%mn,& +! NoahMP50_struc(n)%noahmp50(991:1000)%sneqv + +end subroutine noahmp50_settws + + +subroutine noahmp50_tws_reorderEnsForOutliers(i,nensem, statevec, & + minvalue,maxvalue, status) + + use LIS_coreMod + + implicit none + integer :: i + integer :: nensem + real :: statevec(nensem) + real :: minvalue,maxvalue + logical :: status + + real :: minvT, maxvT, minvG, maxvG + integer :: k + real :: spread_total, spread_good, spread_ratio + + !Ensemble spread (total and with 'good' ensemble members + minvT = 1E10 + maxvT = -1E10 + minvG = 1E10 + maxvG = -1E10 + status = .true. + + do k=1,nensem + + if(statevec(k).lt.minvT) then + minvT = statevec(k) + endif + if(statevec(k).gt.maxvT) then + maxvT = statevec(k) + endif + + if(statevec(k).gt.minvalue.and.statevec(k).lt.maxvalue) then + if(statevec(k).lt.minvG) then + minvG = statevec(k) + endif + if(statevec(k).gt.maxvG) then + maxvG = statevec(k) + endif + endif + enddo + + if(minvG.eq.1E10.and.maxvG.eq.-1E10) then + !all members are unphysical. + + statevec = minvalue + status = .false. + + else + spread_total = (maxvT - minvT) + spread_good = (maxvG - minvG) + + spread_ratio = spread_good/spread_total + + !rescale the ensemble + + do k=1,nensem-1 + statevec(k) = statevec(nensem) + & + (statevec(k) - statevec(nensem))*spread_ratio + enddo + endif + +end subroutine noahmp50_tws_reorderEnsForOutliers diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_tws_DAlogMod.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_tws_DAlogMod.F90 new file mode 100755 index 000000000..a28c9f946 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_tws_DAlogMod.F90 @@ -0,0 +1,187 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +! +! 16Feb12 Ben Zaitchik; Initial Specification +! 29 May 2020: Bailing Li; created for Noah-MP4.0.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! + +module noahmp50_tws_DAlogMod + + use LIS_constantsMod, only : LIS_CONST_RHOFW + use ESMF +! !PUBLIC MEMBER FUNCTIONS: +!------------------------------------------ + public :: noahmp50_tws_DAlog +!----------------------------------------- +! !PUBLIC TYPES: +!----------------------------------------- + public :: NOAHMPpred_struc +!EOP + + type, public ::NOAHMPpred_dec + + real,allocatable ::clmnwater(:,:) + + end type NOAHMPpred_dec + + type (NOAHMPpred_dec),allocatable :: NOAHMPpred_struc(:) + +contains + + subroutine noahmp50_tws_DAlog(n) + + ! USES: + use LIS_coreMod, only : LIS_rc,LIS_surface + use LIS_timeMgrMod + use noahmp50_lsmMod + use LIS_logMod, only : LIS_logunit, LIS_verify + ! use smootherDA_runMod, only : smootherDA_increments_mode + + ! ARGUMENTS: + integer, intent(in) :: n + + ! DESCRIPTION: + ! Calculates total column water storage three times per month, to + ! approximate the GRACE return frequency + + integer :: i,m,t,gid,d + integer :: yr,mo,da,hr,mn,ss + integer :: yr1, mo1, da1 + integer :: yr2, mo2, da2 + integer :: yr3, mo3, da3 + integer :: tw_tmp1, tw_tmp2 + type(ESMF_Time) :: tTime1,tTime2,tTime3 + type(ESMF_TimeInterval) :: tw1, tw2 + integer :: status + + if(LIS_rc%DAincrMode(n).eq.0) then + if(LIS_rc%twInterval.eq.2592000.0) then + if((LIS_rc%da.eq.1).and.(LIS_rc%hr.eq.12).and.(LIS_rc%mn.eq.0)) then + if(.not.allocated(NOAHMPpred_struc)) then + allocate(NOAHMPpred_struc(LIS_rc%nnest)) + allocate(NOAHMPpred_struc(n)%clmnwater(3,& + LIS_rc%npatch(n,LIS_rc%lsm_index))) + endif + NOAHMPpred_struc(n)%clmnwater = 0.0 + end if + + if(((LIS_rc%da.eq.5).and.(LIS_rc%hr.eq.4).and.(LIS_rc%mn.eq.0)).or. & + ((LIS_rc%da.eq.15).and.(LIS_rc%hr.eq.12).and.(LIS_rc%mn.eq.0)).or. & + ((LIS_rc%da.eq.25).and.(LIS_rc%hr.eq.18).and.(LIS_rc%mn.eq.0))) then + + d = (LIS_rc%da+5)/10 + write(LIS_logunit,*)'[INFO] logging obspred data for GRACE-DA' + + NOAHMPpred_struc(n)%clmnwater(d,:) = 0.0 + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + NOAHMPpred_struc(n)%clmnwater(d,t)= & + NOAHMPpred_struc(n)%clmnwater(d,t) + & + NoahMP50_struc(n)%noahmp50(t)%sneqv + & + (NoahMP50_struc(n)%noahmp50(t)%canliq + & + NoahMP50_struc(n)%noahmp50(t)%canice) + & + (NoahMP50_struc(n)%noahmp50(t)%smc(1) * & + NoahMP50_struc(n)%sldpth(1)*LIS_CONST_RHOFW) + & + (NoahMP50_struc(n)%noahmp50(t)%smc(2) * & + NoahMP50_struc(n)%sldpth(2)*LIS_CONST_RHOFW) + & + (NoahMP50_struc(n)%noahmp50(t)%smc(3) * & + NoahMP50_struc(n)%sldpth(3)*LIS_CONST_RHOFW) + & + (NoahMP50_struc(n)%noahmp50(t)%smc(4) * & + NoahMP50_struc(n)%sldpth(4)*LIS_CONST_RHOFW) + & + NoahMP50_struc(n)%noahmp50(t)%wa + enddo + endif + + else + call ESMF_TimeGet(LIS_twMidTime, yy = yr, & + mm = mo, & + dd = da, & + h = hr, & + m = mn,& + s = ss, & + calendar = LIS_calendar, & + rc = status) + + if((LIS_rc%mo.eq.mo).and.(LIS_rc%da.eq.da) & + .and.(LIS_rc%hr.eq.12).and.(LIS_rc%mn.eq.0)) then + if(.not.allocated(NOAHMPpred_struc)) then + allocate(NOAHMPpred_struc(LIS_rc%nnest)) + allocate(NOAHMPpred_struc(n)%clmnwater(3,& + LIS_rc%npatch(n,LIS_rc%lsm_index))) + endif + NOAHMPpred_struc(n)%clmnwater = 0.0 + end if + + tw_tmp1 = nint(LIS_rc%twInterval/3.0) + tw_tmp2 = tw_tmp1/2 + call ESMF_TimeIntervalSet(tw1,s=tw_tmp1,rc=status) + call ESMF_TimeIntervalSet(tw2,s=tw_tmp2,rc=status) + + tTime1 = LIS_twMidTime + tw2 + tTime2 = tTime1 + tw1 + tTime3 = tTime2 + tw1 + + call ESMF_TimeGet(tTime1,yy=yr1,mm=mo1,dd=da1,calendar=LIS_calendar,& + rc=status) + call ESMF_TimeGet(tTime2,yy=yr2,mm=mo2,dd=da2,calendar=LIS_calendar,& + rc=status) + call ESMF_TimeGet(tTime3,yy=yr3,mm=mo3,dd=da3,calendar=LIS_calendar,& + rc=status) + + if(& + ((LIS_rc%yr.eq.yr1).and.(LIS_rc%mo.eq.mo1).and.(LIS_rc%da.eq.da1)& + .and.(LIS_rc%hr.eq.12).and.(LIS_rc%mn.eq.0)).or. & + ((LIS_rc%yr.eq.yr2).and.(LIS_rc%mo.eq.mo2).and.(LIS_rc%da.eq.da2)& + .and.(LIS_rc%hr.eq.12).and.(LIS_rc%mn.eq.0)).or. & + ((LIS_rc%yr.eq.yr3).and.(LIS_rc%mo.eq.mo3).and.(LIS_rc%da.eq.da3)& + .and.(LIS_rc%hr.eq.12).and.(LIS_rc%mn.eq.0)) & + ) then + + d = -1 + if((LIS_rc%yr.eq.yr1).and.(LIS_rc%mo.eq.mo1).and.(LIS_rc%da.eq.da1)& + .and.(LIS_rc%hr.eq.12).and.(LIS_rc%mn.eq.0)) then + d = 1 + elseif((LIS_rc%yr.eq.yr2).and.(LIS_rc%mo.eq.mo2).and.(LIS_rc%da.eq.da2)& + .and.(LIS_rc%hr.eq.12).and.(LIS_rc%mn.eq.0)) then + d = 2 + elseif((LIS_rc%yr.eq.yr3).and.(LIS_rc%mo.eq.mo3).and.(LIS_rc%da.eq.da3)& + .and.(LIS_rc%hr.eq.12).and.(LIS_rc%mn.eq.0)) then + d = 3 + endif + write(LIS_logunit,*)'[INFO] logging obspred data for GRACE-DA' + NOAHMPpred_struc(n)%clmnwater(d,:) = 0.0 + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + NOAHMPpred_struc(n)%clmnwater(d,t)= & + NOAHMPpred_struc(n)%clmnwater(d,t) + & + NoahMP50_struc(n)%noahmp50(t)%sneqv + & + (NoahMP50_struc(n)%noahmp50(t)%canliq + & + NoahMP50_struc(n)%noahmp50(t)%canice) + & + (NoahMP50_struc(n)%noahmp50(t)%smc(1) * & + NoahMP50_struc(n)%sldpth(1)*LIS_CONST_RHOFW) + & + (NoahMP50_struc(n)%noahmp50(t)%smc(2) * & + NoahMP50_struc(n)%sldpth(2)*LIS_CONST_RHOFW) + & + (NoahMP50_struc(n)%noahmp50(t)%smc(3) * & + NoahMP50_struc(n)%sldpth(3)*LIS_CONST_RHOFW) + & + (NoahMP50_struc(n)%noahmp50(t)%smc(4) * & + NoahMP50_struc(n)%sldpth(4)*LIS_CONST_RHOFW) + & + NoahMP50_struc(n)%noahmp50(t)%wa + + enddo + + endif + + endif + endif + + end subroutine noahmp50_tws_DAlog + +end module noahmp50_tws_DAlogMod diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_updatetws.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_updatetws.F90 new file mode 100755 index 000000000..c21d07839 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_updatetws.F90 @@ -0,0 +1,162 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_updatetws +! \label{noahmp50_updatetws} +! +! !REVISION HISTORY: +! 14 Mar 2017: Sujay Kumar; Initial Specification +! 29 May 2020: Bailing Li; created for Noah-MP4.0.1 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_updatetws(n, LSM_State, LSM_Incr_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use noahmp50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! This routine assigns the soil moisture prognostic variables to noahmp's +! model space. +! +!EOP + + type(ESMF_Field) :: sm1Field + type(ESMF_Field) :: sm2Field + type(ESMF_Field) :: sm3Field + type(ESMF_Field) :: sm4Field + type(ESMF_Field) :: sm1IncrField + type(ESMF_Field) :: sm2IncrField + type(ESMF_Field) :: sm3IncrField + type(ESMF_Field) :: sm4IncrField + type(ESMF_Field) :: sweField, sweIncrField + + !Wanshu + type(ESMF_Field) :: gwField + type(ESMF_Field) :: gwIncrField + real, pointer :: gws(:) + real, pointer :: gwsIncr(:) + + real, pointer :: soilm1(:) + real, pointer :: soilm2(:) + real, pointer :: soilm3(:) + real, pointer :: soilm4(:) + real, pointer :: soilmIncr1(:) + real, pointer :: soilmIncr2(:) + real, pointer :: soilmIncr3(:) + real, pointer :: soilmIncr4(:) + real, pointer :: swe(:), sweincr(:) + integer :: t,i,m,gid + integer :: status + real :: swetmp, sndens + logical :: update_flag(LIS_rc%ngrid(n)) + real :: perc_violation(LIS_rc%ngrid(n)) + + + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 1",sm1Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 1 failed in noahmp50_updatetws") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 2",sm2Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 2 failed in noahmp50_updatetws") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 3",sm3Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 3 failed in noahmp50_updatetws") + call ESMF_StateGet(LSM_State,"Soil Moisture Layer 4",sm4Field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 4 failed in noahmp50_updatetws") + + call ESMF_StateGet(LSM_State,"Groundwater Storage",gwField,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Groundwater Storage failed in noahmp50_updatetws") + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + + + call ESMF_StateGet(LSM_Incr_State,"Soil Moisture Layer 1",sm1IncrField,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 1 failed in noahmp50_updatetws") + call ESMF_StateGet(LSM_Incr_State,"Soil Moisture Layer 2",sm2IncrField,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 2 failed in noahmp50_updatetws") + call ESMF_StateGet(LSM_Incr_State,"Soil Moisture Layer 3",sm3IncrField,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 3 failed in noahmp50_updatetws") + call ESMF_StateGet(LSM_Incr_State,"Soil Moisture Layer 4",sm4IncrField,rc=status) + call LIS_verify(status,& + "ESMF_StateGet: Soil Moisture Layer 4 failed in noahmp50_updatetws") + + call ESMF_StateGet(LSM_Incr_State, "Groundwater Storage",gwIncrField,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Groundwater Storage failed in noahmp50_updatetws") + call ESMF_StateGet(LSM_Incr_State,"SWE",sweIncrField,rc=status) + call LIS_verify(status) + + + !------------------- + call ESMF_FieldGet(sm1Field,localDE=0,farrayPtr=soilm1,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 1 failed in noahmp50_updatetws") + call ESMF_FieldGet(sm2Field,localDE=0,farrayPtr=soilm2,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 2 failed in noahmp50_updatetws") + call ESMF_FieldGet(sm3Field,localDE=0,farrayPtr=soilm3,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 3 failed in noahmp50_updatetws") + call ESMF_FieldGet(sm4Field,localDE=0,farrayPtr=soilm4,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 4 failed in noahmp50_updatetws") + call ESMF_FieldGet(gwField,localDE=0,farrayPtr=gws,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Groundwater Storage failed in noahmp50_updatetws") + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + + + call ESMF_FieldGet(sm1IncrField,localDE=0,farrayPtr=soilmIncr1,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 1 failed in noahmp50_updatetws") + call ESMF_FieldGet(sm2IncrField,localDE=0,farrayPtr=soilmIncr2,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 2 failed in noahmp50_updatetws") + call ESMF_FieldGet(sm3IncrField,localDE=0,farrayPtr=soilmIncr3,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 3 failed in noahmp50_updatetws") + call ESMF_FieldGet(sm4IncrField,localDE=0,farrayPtr=soilmIncr4,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet: Soil Moisture Layer 4 failed in noahmp50_updatetws") + call ESMF_FieldGet(gwIncrField, localDE=0, farrayPtr=gwsIncr,rc=status) + call LIS_verify(status,& + "ESMF_StateSet: Groundwater Storage failed in noahmp50_updatetws") + call ESMF_FieldGet(sweIncrField,localDE=0,farrayPtr=sweincr,rc=status) + call LIS_verify(status) + + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + soilm1(t) = soilm1(t) + soilmIncr1(t) + soilm2(t) = soilm2(t) + soilmIncr2(t) + soilm3(t) = soilm3(t) + soilmIncr3(t) + soilm4(t) = soilm4(t) + soilmIncr4(t) + gws(t) = gws(t) + gwsIncr(t) + swe(t) = swe(t) + sweIncr(t) + enddo + +end subroutine noahmp50_updatetws diff --git a/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_write_tws.F90 b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_write_tws.F90 new file mode 100755 index 000000000..428c6e1bd --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_tws/noahmp50_write_tws.F90 @@ -0,0 +1,76 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_write_tws +! \label{noahmp50_write_tws} +! +! !REVISION HISTORY: +! 14 Mar 2017: Sujay Kumar; Initial Specification +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_write_tws(ftn,n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use noahmp50_lsmMod + use LIS_historyMod, only : LIS_writevar_restart + + implicit none +! !ARGUMENTS: + integer, intent(in) :: ftn + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the twsoisture related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + integer :: t + real, allocatable :: tmp(:) + + allocate(tmp(LIS_rc%npatch(n,LIS_rc%lsm_index))) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(1) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(2) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(3) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%smc(4) + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + !Wanshu + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + tmp(t) = NoahMP50_struc(n)%noahmp50(t)%wa + enddo + call LIS_writevar_restart(ftn,n,1,tmp) + !--------- + deallocate(tmp) + +end subroutine noahmp50_write_tws diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_dausafsi_Mod.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_dausafsi_Mod.F90 new file mode 100755 index 000000000..979a34b4f --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_dausafsi_Mod.F90 @@ -0,0 +1,50 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" +module noahmp50_dausafsi_Mod +!BOP +! +! !MODULE: noahmp50_dausafsi_Mod +! +! !DESCRIPTION: +! +! !REVISION HISTORY: +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !USES: + + implicit none + + PRIVATE +!----------------------------------------------------------------------------- +! !PUBLIC MEMBER FUNCTIONS: +!----------------------------------------------------------------------------- + public :: noahmp50_dausafsi_init +!----------------------------------------------------------------------------- +! !PUBLIC TYPES: +!----------------------------------------------------------------------------- +!EOP + + SAVE +contains +!BOP +! +! !ROUTINE: noahmp50_dausafsi_init +! \label{noahmp50_dausafsi_init} +! +! !INTERFACE: + subroutine noahmp50_dausafsi_init() +! !USES: +! !DESCRIPTION: +! +!EOP + implicit none + end subroutine noahmp50_dausafsi_init +end module noahmp50_dausafsi_Mod diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_descale_usafsi.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_descale_usafsi.F90 new file mode 100755 index 000000000..87e4e6d99 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_descale_usafsi.F90 @@ -0,0 +1,75 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_descale_usafsi +! \label{noahmp50_descale_usafsi} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !INTERFACE: +subroutine noahmp50_descale_usafsi(n, LSM_State, LSM_Incr_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use NoahMP50_lsmMod + use LIS_logMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + + integer :: t + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + +#if 0 + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + swe(t) = swe(t)*1000.0 + enddo +#endif + +end subroutine noahmp50_descale_usafsi + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_getusafsipred.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_getusafsipred.F90 new file mode 100755 index 000000000..6fa11710c --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_getusafsipred.F90 @@ -0,0 +1,60 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getusafsipred +! \label{noahmp50_getusafsipred} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 01 May 2014: Yuqiong Liu; modifed to include mesh8, mesh16, and 0p25 SNODEP data +! 24 May 2017: Yeosang Yoon: updated the file to work with the DA observation +! space updates. +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !INTERFACE: +subroutine noahmp50_getusafsipred(n, k, obs_pred) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc,LIS_surface + use NoahMP50_lsmMod + use LIS_DAobservationsMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + real :: obs_pred(LIS_rc%ngrid(n),LIS_rc%nensem(n)) + real :: snwd(LIS_rc%npatch(n,LIS_rc%lsm_index)) +!EOP + +! !DESCRIPTION: +! This routine computes the obspred ('Hx') term for USAFSI DA assimilation +! instances. + + integer :: t + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + snwd(t) = Noahmp50_struc(n)%noahmp50(t)%snowh ! Keep in meters + enddo + + call LIS_convertPatchSpaceToObsEnsSpace(n,k,& + LIS_rc%lsm_index, & + snwd,& + obs_pred) + +end subroutine noahmp50_getusafsipred + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_getusafsivars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_getusafsivars.F90 new file mode 100755 index 000000000..177969c22 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_getusafsivars.F90 @@ -0,0 +1,73 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getusafsivars +! \label{noahmp50_getusafsivars} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 03OC2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! May 2023: Cenlin He, update to work with refactored NoahMP (v5.0 and newer) + +! !INTERFACE: +! +subroutine noahmp50_getusafsivars(n, LSM_State) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +! +!EOP + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + + integer :: t + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + swe(t) = Noahmp50_struc(n)%noahmp50(t)%sneqv + snod(t) = Noahmp50_struc(n)%noahmp50(t)%snowh + enddo +end subroutine noahmp50_getusafsivars + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_map_usafsi.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_map_usafsi.F90 new file mode 100755 index 000000000..60a32b80c --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_map_usafsi.F90 @@ -0,0 +1,137 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_map_usafsi +! \label{noahmp50_map_usafsi} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 31 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! May 2023: Cenlin He, update to work with refactored NoahMP (v5.0 and newer) + +! !INTERFACE: +subroutine noahmp50_map_usafsi(n,k,OBS_State,LSM_Incr_State) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_surface + use LIS_constantsMod, only : LIS_CONST_TKFRZ + use LIS_logMod, only : LIS_logunit, LIS_verify + use LIS_lsmMod + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + type(ESMF_State) :: OBS_State + type(ESMF_State) :: LSM_Incr_State +! !DESCRIPTION: +! +! This subroutine directly maps the observation state to the corresponding +! variables in the LSM state for USAFSI data assimilation. +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[OBS\_State] ESMF State for observations \newline +! \item[LSM\_State] ESMF State for LSM state variables \newline +! \end{description} +! +!EOP + type(ESMF_Field) :: sweIncrField + type(ESMF_Field) :: obs_usafsi_field + real, pointer :: sweincr(:) + type(ESMF_Field) :: snodIncrField + real, pointer :: snodincr(:) + real :: tmpsneqv + real, pointer :: usafsiobs(:) + integer :: t + integer :: status + integer :: obs_state_count + integer :: st_id, en_id + character*100,allocatable :: obs_state_objs(:) + real, allocatable :: noahmp50_swe(:) + real, allocatable :: noahmp50_snod(:) + real, allocatable :: snod(:) + + allocate(noahmp50_swe(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(noahmp50_snod(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(snod(LIS_rc%npatch(n,LIS_rc%lsm_index))) + + call ESMF_StateGet(LSM_Incr_State,"SWE",sweIncrField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweIncrField,localDE=0,farrayPtr=sweincr,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(LSM_Incr_State,"Snowdepth",snodincrField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(snodincrField,localDE=0,farrayPtr=snodincr,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(OBS_State,itemCount=obs_state_count,rc=status) + call LIS_verify(status) + allocate(obs_state_objs(obs_state_count)) + + call ESMF_StateGet(OBS_State,itemNameList=obs_state_objs,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(OBS_State,obs_state_objs(1),obs_usafsi_field,& + rc=status) + call LIS_verify(status) + call ESMF_FieldGet(obs_usafsi_field,localDE=0,farrayPtr=usafsiobs,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + noahmp50_swe(t) = Noahmp50_struc(n)%noahmp50(t)%sneqv + noahmp50_snod(t) = Noahmp50_struc(n)%noahmp50(t)%snowh + enddo + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + call LIS_lsm_DAmapTileSpaceToObsSpace(n,k,t,st_id,en_id) +! Assume here that st_id and en_id are the same and that we are +! working with an model grid finer than the observation grid + + if(usafsiobs(st_id).ge.0) then + if(noahmp50_snod(t).gt.1e-6) then + tmpsneqv = noahmp50_swe(t)/noahmp50_snod(t) + else + tmpsneqv = 0.0 + endif + + snod(t) = usafsiobs(st_id) + +! Based on USAFSI, we manually update SWE + if(snod(t).lt.2.54E-3) tmpsneqv = 0.0 + if(snod(t).ge.2.54E-3.and.tmpsneqv.lt.0.001) then + tmpsneqv = 0.20 + endif + sweincr(t) = tmpsneqv*snod(t) - noahmp50_swe(t) + snodincr(t) = snod(t) - noahmp50_snod(t) + else + sweincr(t) = 0 + snodincr(t) = 0 + endif + enddo + + deallocate(obs_state_objs) + deallocate(noahmp50_swe) + deallocate(noahmp50_snod) + deallocate(snod) + +end subroutine noahmp50_map_usafsi + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_qc_usafsiobs.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_qc_usafsiobs.F90 new file mode 100755 index 000000000..89db60bbd --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_qc_usafsiobs.F90 @@ -0,0 +1,108 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_qc_usafsiobs +! \label{noahmp50_qc_usafsiobs} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 30 Jan 2015: Yuqiong Liu; added additional QC +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !INTERFACE: +subroutine noahmp50_qc_usafsiobs(n,k,OBS_State) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod, only : LIS_verify + use LIS_constantsMod, only : LIS_CONST_TKFRZ + use LIS_DAobservationsMod + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: k + type(ESMF_State) :: OBS_State +! +! !DESCRIPTION: +! +! This subroutine performs any model-based QC of the observation +! prior to data assimilation. Here the snow observations +! are flagged when LSM indicates that (1) rain is falling (2) +! ground is fully or partially covered with snow. +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[OBS\_State] ESMF state container for observations \newline +! \end{description} +! +!EOP + type(ESMF_Field) :: obs_snow_field + + real, pointer :: snowobs(:) + integer :: t + integer :: gid + integer :: status + real :: stc1(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: vegt(LIS_rc%npatch(n,LIS_rc%lsm_index)) + real :: fveg_obs(LIS_rc%obs_ngrid(k)) + real :: tv_obs(LIS_rc%obs_ngrid(k)) + real :: stc1_obs(LIS_rc%obs_ngrid(k)) + real :: vegt_obs(LIS_rc%obs_ngrid(k)) + + call ESMF_StateGet(OBS_State,"Observation01",obs_snow_field,rc=status) + call LIS_verify(status,& + "ESMF_StateGet failed in noahmp50_qc_usafsiobs") + call ESMF_FieldGet(obs_snow_field,localDE=0,farrayPtr=snowobs,rc=status) + call LIS_verify(status,& + "ESMF_FieldGet failed in noahmp50_qc_usafsiobs") + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + !stc1(t) = Noahmp50_struc(n)%noahmp50(t)%sstc(1) ! get snow/veg temp. + stc1(t) = Noahmp50_struc(n)%noahmp50(t)%tslb(1) ! get snow/veg temp. + vegt(t) = LIS_surface(n,1)%tile(t)%vegt + enddo + + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index, Noahmp50_struc(n)%noahmp50(:)%tv,tv_obs) !tv: vegetation temperature. unit: K + call LIS_convertPatchSpaceToObsSpace(n,k,LIS_rc%lsm_index, & !fveg: green vegetation fraction. unit: - + Noahmp50_struc(n)%noahmp50(:)%fveg,fveg_obs) + + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index,stc1,stc1_obs) + call LIS_convertPatchSpaceToObsSpace(n,k,& + LIS_rc%lsm_index,vegt,vegt_obs) + +! do t=1,LIS_rc%obs_ngrid(k) +! if(snowobs(t).ne.LIS_rc%udef) then +! if(fveg_obs(t).gt.0.7) then +! snowobs(t) = LIS_rc%udef +! ! elseif(vegt_obs(t).le.4) then !forest types +! ! snowobs(t) = LIS_rc%udef +! !assume that snow will not form at 5 deg. celcius or higher ground temp. +! elseif(tv_obs(t).ge.278.15) then +! snowobs(t) = LIS_rc%udef +! elseif(stc1_obs(t).ge.278.15) then +! snowobs(t) = LIS_rc%udef +! endif +! endif +! enddo + +end subroutine noahmp50_qc_usafsiobs + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_qcusafsi.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_qcusafsi.F90 new file mode 100755 index 000000000..486d8090c --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_qcusafsi.F90 @@ -0,0 +1,127 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_qcusafsi +! \label{noahmp50_qcsnow} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 30 Jan 2015: Yuqiong Liu; added additional QC +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! 09 Jan 2020: Yeosang Yoon; update QC +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !INTERFACE: +subroutine noahmp50_qcusafsi(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod + use NoahMP50_lsmMod + use LIS_logMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! QC's the related state prognostic variable objects for +! USAFSI data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + integer :: t, gid + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + + real :: swemax,snodmax + real :: swemin,snodmin + + real :: sndens + logical :: update_flag(LIS_rc%ngrid(n)) + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + call ESMF_AttributeGet(sweField,"Max Value",swemax,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(sweField,"Min Value",swemin,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(snodField,"Max Value",snodmax,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(snodField,"Min Value",snodmin,rc=status) + call LIS_verify(status) + + update_flag = .true. + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + if((snod(t).lt.snodmin) .or. swe(t).lt.swemin) then + update_flag(gid) = .false. + endif + + enddo + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + +!Use the model's snow density from the previous timestep + sndens = 0.0 + if(Noahmp50_struc(n)%noahmp50(t)%snowh.gt.0) then + sndens = Noahmp50_struc(n)%noahmp50(t)%sneqv/Noahmp50_struc(n)%noahmp50(t)%snowh + endif + +!If the update is unphysical, do not update. + if(update_flag(gid)) then + snod(t) = snod(t) + swe(t) = snod(t)*sndens + else ! do not update + snod(t) = Noahmp50_struc(n)%noahmp50(t)%snowh + swe(t) = Noahmp50_struc(n)%noahmp50(t)%sneqv + end if + + if(swe(t).gt.swemax) then + swe(t) = swemax + endif + if(snod(t).gt.snodmax) then + snod(t) = snodmax + endif + + end do + +end subroutine noahmp50_qcusafsi + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_scale_usafsi.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_scale_usafsi.F90 new file mode 100755 index 000000000..6e835ac30 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_scale_usafsi.F90 @@ -0,0 +1,75 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_scale_usafsi +! \label{noahmp50_scale_usafsi} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !INTERFACE: +subroutine noahmp50_scale_usafsi(n, LSM_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use NoahMP50_lsmMod + use LIS_logMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \end{description} +!EOP + + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + + integer :: t + integer :: status + real, pointer :: swe(:) + real, pointer :: snod(:) + +#if 0 + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + swe(t) = swe(t)/1000.0 + enddo +#endif + +end subroutine noahmp50_scale_usafsi + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_setusafsivars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_setusafsivars.F90 new file mode 100755 index 000000000..9e7e435f5 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_setusafsivars.F90 @@ -0,0 +1,112 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_setusafsivars +! \label{noahmp50_setusafsivars} +! +! !REVISION HISTORY: +! 15 Aug 2017: Sujay Kumar; Initial Specification +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 03 Oct 2018: Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! 10 Nov 2020: Eric Kemp; Update LIS_snow_struc +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !INTERFACE: +subroutine noahmp50_setusafsivars(n, LSM_State) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_domain, LIS_surface + use LIS_logMod, only : LIS_logunit, LIS_verify, LIS_endrun + use LIS_snowMod, only : LIS_snow_struc + use NoahMP50_lsmMod + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State +! +! !DESCRIPTION: +! +! This routine assigns the snow progognostic variables to noah's +! model space. The state vector consists of total SWE and snow depth. +! This routine also updates other model prognostics (snice, snliq, +! snow thickness, snow temperature) based on the update. +! +!EOP + type(ESMF_Field) :: sweField + type(ESMF_Field) :: snodField + real, pointer :: swe(:) + real, pointer :: snod(:) + real :: dsneqv,dsnowh + integer :: t + integer :: status + integer :: ncount(LIS_rc%ngrid(n)) + integer :: tid, gid + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + dsneqv = swe(t) - Noahmp50_struc(n)%noahmp50(t)%sneqv !in mm + dsnowh = snod(t) - Noahmp50_struc(n)%noahmp50(t)%snowh !in m + + ! update + call noahmp50_usafsi_update(n, t, dsneqv, dsnowh) + + enddo + + if (LIS_rc%snowsrc(n) .gt. 0) then + + ncount = 0 ! Number of tiles per grid id (over land) + LIS_snow_struc(n)%snowdepth = 0 ! At grid points + LIS_snow_struc(n)%sneqv = 0 ! At tiles + + ! Collect SWE at tiles + do t = 1, LIS_rc%npatch(n, LIS_rc%lsm_index) + tid = LIS_surface(n, LIS_rc%lsm_index)%tile(t)%tile_id + LIS_snow_struc(n)%sneqv(tid) = LIS_snow_struc(n)%sneqv(tid) + & + Noahmp50_struc(n)%noahmp50(t)%sneqv + end do + + ! Collect mean snow depth at grid points + do t = 1, LIS_rc%npatch(n, LIS_rc%lsm_index) + gid = LIS_surface(n,LIS_rc%lsm_index)%tile(t)%index + LIS_snow_struc(n)%snowdepth(gid) = & + LIS_snow_struc(n)%snowdepth(gid) + & + Noahmp50_struc(n)%noahmp50(t)%snowh + ncount(gid) = ncount(gid) + 1 + end do + do t = 1, LIS_rc%ngrid(n) + if (ncount(t).gt.0) then + LIS_snow_struc(n)%snowdepth(t) = & + LIS_snow_struc(n)%snowdepth(t) / ncount(t) + else + LIS_snow_struc(n)%snowdepth(t) = 0.0 + endif + end do + end if + +end subroutine noahmp50_setusafsivars diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_transform_usafsi.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_transform_usafsi.F90 new file mode 100755 index 000000000..d322e474c --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_transform_usafsi.F90 @@ -0,0 +1,52 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_transform_usafsi +! \label{noahmp50_transform_usafsi} +! +! !REVISION HISTORY: +! 25Jun2006: Sujay Kumar: Initial Specification +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 21 Jul 2011: James Geiger; Modified for Noah 3.2 +! 03 Oct 2018; Yeosang Yoon; Modified for NoahMP 3.6 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !INTERFACE: +subroutine noahmp50_transform_usafsi(n,OBS_State) + +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_verify + use NoahMP50_lsmMod +!EOP + implicit none + + integer, intent(in) :: n + type(ESMF_State) :: OBS_State +! +! !DESCRIPTION: +! +! This subroutine transforms the USAFSI state +! (mm) to the lsm state +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[OBS\_State] ESMF state container for observations \newline +! \end{description} +!EOP + + ! Since USAFSI is already in meters, no work is needed here. + +end subroutine noahmp50_transform_usafsi diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_updateusafsivars.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_updateusafsivars.F90 new file mode 100755 index 000000000..f854c8e91 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_updateusafsivars.F90 @@ -0,0 +1,177 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_updateusafsivars +! \label{noahmp50_updateusafsivars} +! +! !REVISION HISTORY: +! 27Feb2005: Sujay Kumar; Initial Specification +! 25Jun2006: Sujay Kumar: Updated for the ESMF design +! 02 Mar 2010: Sujay Kumar; Modified for Noah 3.1 +! 14 Dec 2018: Yeosang Yoon; Modified for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! 09 Jan 2020: Yeosang Yoon; Updated QC +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !INTERFACE: +subroutine noahmp50_updateusafsivars(n, LSM_State, LSM_Incr_State) +! !USES: + use ESMF + use LIS_coreMod + use NoahMP50_lsmMod + use LIS_logMod, only : LIS_logunit, LIS_verify + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n + type(ESMF_State) :: LSM_State + type(ESMF_State) :: LSM_Incr_State +! +! !DESCRIPTION: +! +! Returns the snow related state prognostic variables for +! data assimilation +! +! The arguments are: +! \begin{description} +! \item[n] index of the nest \newline +! \item[LSM\_State] ESMF State container for LSM state variables \newline +! \item[LSM\_Incr\_State] ESMF State container for LSM state increments \newline +! \end{description} +! +!EOP + + type(ESMF_Field) :: sweField, sweIncrField + type(ESMF_Field) :: snodField, snodIncrField + + integer :: t, gid + integer :: status + real, pointer :: swe(:), sweincr(:) + real, pointer :: snod(:), snodincr(:) + real :: swetmp, snodtmp,sndens + logical :: update_flag(LIS_rc%ngrid(n)) + real :: perc_violation(LIS_rc%ngrid(n)) + + real :: snodmean(LIS_rc%ngrid(n)) + integer :: nsnodmean(LIS_rc%ngrid(n)) + + call ESMF_StateGet(LSM_State,"SWE",sweField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_State,"Snowdepth",snodField,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(LSM_Incr_State,"SWE",sweIncrField,rc=status) + call LIS_verify(status) + call ESMF_StateGet(LSM_Incr_State,"Snowdepth",snodIncrField,rc=status) + call LIS_verify(status) + + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweIncrField,localDE=0,farrayPtr=sweincr,rc=status) + call LIS_verify(status) + call ESMF_FieldGet(snodIncrField,localDE=0,farrayPtr=snodincr,rc=status) + call LIS_verify(status) + + + update_flag = .true. + perc_violation = 0.0 + snodmean = 0.0 + nsnodmean = 0 + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + swetmp = swe(t) + sweincr(t) + snodtmp = snod(t) + snodincr(t) + + if((snodtmp.lt.0 .or. swetmp.lt.0)) then + update_flag(gid) = .false. + perc_violation(gid) = perc_violation(gid) +1 + endif + + enddo + + do gid=1,LIS_rc%ngrid(n) + perc_violation(gid) = perc_violation(gid) / real(LIS_rc%nensem(n)) + enddo + +! For ensembles that are unphysical, compute the ensemble average after excluding them. This +! is done only if the majority of the ensemble members are good (>80%) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + if(.not.update_flag(gid)) then ! false + if(perc_violation(gid).lt.0.2) then + if(snod(t)+snodincr(t).ge.0) then + snodmean(gid) = snodmean(gid) + snod(t)+snodincr(t) + nsnodmean(gid) = nsnodmean(gid) + 1 + else + snodmean(gid) = 0.0 + endif + endif + endif + enddo + + do gid=1,LIS_rc%ngrid(n) + if(nsnodmean(gid).gt.0) then + snodmean(gid) = snodmean(gid) / real(nsnodmean(gid)) + endif + enddo + +! If the update is unphysical, simply set to the average of +! the good ensemble members. If all else fails, do not update. + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + gid = LIS_domain(n)%gindex(& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col,& + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + + snodtmp = snod(t) + snodincr(t) + swetmp = swe(t) + sweincr(t) + +!Use the model's snow density from the previous timestep + sndens = 0.0 + if(Noahmp50_struc(n)%noahmp50(t)%snowh.gt.0) then + sndens = Noahmp50_struc(n)%noahmp50(t)%sneqv/Noahmp50_struc(n)%noahmp50(t)%snowh + endif + + if(update_flag(gid)) then + snod(t) = snodtmp + swe(t) = swetmp + elseif(perc_violation(gid).lt.0.2) then + if(snodtmp.lt.0.0) then ! average of the good ensemble members + snod(t) = snodmean(gid) + swe(t) = snodmean(gid)*sndens + else + snod(t) = snodtmp + swe(t) = swetmp + endif + else ! do not update + snod(t) = Noahmp50_struc(n)%noahmp50(t)%snowh + swe(t) = Noahmp50_struc(n)%noahmp50(t)%sneqv + end if + + enddo + +end subroutine noahmp50_updateusafsivars + diff --git a/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_usafsi_update.F90 b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_usafsi_update.F90 new file mode 100755 index 000000000..f8adc8d2b --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/da_usafsi/noahmp50_usafsi_update.F90 @@ -0,0 +1,375 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_usafsi_update +! \label{noahmp50_usafsi_update} +! +! !REVISION HISTORY: +! 13 Aug 2017: Sujay Kumar; Initial specification +! 14 Dec 2018: Yeosang Yoon; Modified code for NoahMP 4.0.1 and SNODEP +! 15 May 2019: Yeosang Yoon; Modified for NoahMP 4.0.1 and LDTSI +! 13 Dec 2019: Eric Kemp; Replaced LDTSI with USAFSI +! May 2023: Cenlin He; update to work with refactored NoahMP (v5.0 and newer) +! +! !INTERFACE +subroutine noahmp50_usafsi_update(n, t, dsneqv, dsnowh) + + use LIS_coreMod + use NoahMP50_lsmMod + use NoahMP50_snowphys_updateMod + + implicit none +! +! !DESCRIPTION: +! This subroutine updates relevant snow prognostics based +! on the update to the total SWE (dsneqv) and total +! snow depth (dsnowh). The updated variables include +! number of snow layers, snice, snliq, snow temperature +! and snow thickness. +! +! !ARGUMENTS: + integer, intent(in) :: n + integer, intent(in) :: t + real :: dsneqv !mm + real :: dsnowh !m + +!EOP + real, parameter :: tfrz = 273.16 !freezing/melting point (k) + real, parameter :: hfus = 0.3336E06 !latent heat of fusion (j/kg) + real, parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) + real, parameter :: DENH2O = 1000.0 !density of water (kg/m3) + real, allocatable, dimension(:) :: zsoil + real, allocatable, dimension(:) :: ficeold + real, allocatable, dimension(:) :: snice + real, allocatable, dimension(:) :: snliq + real, allocatable, dimension(:) :: stc + real, allocatable, dimension(:) :: supercool + real, allocatable, dimension(:) :: mice + real, allocatable, dimension(:) :: mliq + real, allocatable, dimension(:) :: dzsnso + real, allocatable, dimension(:) :: zsnso + real, allocatable, dimension(:) :: BEXP + real, allocatable, dimension(:) :: PSISAT + real, allocatable, dimension(:) :: SMCMAX + + integer, allocatable, dimension(:) :: imelt !phase change index + real, allocatable, dimension(:) :: sice + + integer :: snl_idx,i,j,iz + integer :: iloc, jloc ! needed, but not use + real :: smp,sneqv,snowh + real :: sneqv1,snowh1 + real :: ponding1,ponding2 + integer :: newnode + integer :: isnow, nsoil, nsnow, soiltype(4), isoil + +! local + real :: SNOFLOW, BDSNOW + + isnow = Noahmp50_struc(n)%noahmp50(t)%isnow + nsoil = Noahmp50_struc(n)%nsoil + nsnow = Noahmp50_struc(n)%nsnow + + allocate(ficeold(-nsnow+1:0)) + allocate(snice(-nsnow+1:0)) + allocate(snliq(-nsnow+1:0)) + allocate(stc(-nsnow+1:nsoil)) + allocate(imelt(-nsnow+1:nsoil)) + allocate(supercool(-nsnow+1:nsoil)) + allocate(mice(-nsnow+1:nsoil)) + allocate(mliq(-nsnow+1:nsoil)) + allocate(dzsnso(-nsnow+1:nsoil)) + allocate(zsnso(-nsnow+1:nsoil)) + allocate(sice(nsoil)) + allocate(BEXP(nsoil)) + allocate(PSISAT(nsoil)) + allocate(SMCMAX(nsoil)) + + imelt = 0 + + !set empty snow layers to zero + do iz = -nsnow+1, isnow + snice(iz) = 0.0 + snliq(iz) = 0.0 + stc(iz) = 0.0 + dzsnso(iz)= 0.0 + zsnso(iz) = 0.0 + enddo + + ! initialize the variables + soiltype = Noahmp50_struc(n)%noahmp50(t)%soiltype + do isoil = 1, size(soiltype) + BEXP(isoil) = Noahmp50_struc(n)%noahmp50(t)%param%BEXP(isoil) + PSISAT(isoil) = Noahmp50_struc(n)%noahmp50(t)%param%PSISAT(isoil) + SMCMAX(isoil) = Noahmp50_struc(n)%noahmp50(t)%param%SMCMAX(isoil) + end do + + sneqv = Noahmp50_struc(n)%noahmp50(t)%sneqv + snowh = Noahmp50_struc(n)%noahmp50(t)%snowh + + zsnso(-nsnow+1:nsoil) = Noahmp50_struc(n)%noahmp50(t)%zss(1:nsnow+nsoil) + +! snow/soil layer thickness (m) + do iz = isnow+1, nsoil + if(iz == isnow+1) then + dzsnso(iz) = - zsnso(iz) + else + dzsnso(iz) = zsnso(iz-1) - zsnso(iz) + end if + end do + + ! set ZSOIL + allocate(zsoil(nsoil)) + ! zsoil is negative. + zsoil(1) = -Noahmp50_struc(n)%sldpth(1) + do i = 2, nsoil + zsoil(i) = zsoil(i-1) - Noahmp50_struc(n)%sldpth(i) + enddo + + + ! state variables + snice(-nsnow+1:0) = & + Noahmp50_struc(n)%noahmp50(t)%snowice(1:nsnow) + snliq(-nsnow+1:0) = & + Noahmp50_struc(n)%noahmp50(t)%snowliq(1:nsnow) + stc(-nsnow+1:0) = & + Noahmp50_struc(n)%noahmp50(t)%tsno(1:nsnow) + ! soil temperature + stc(1:nsoil) = & + Noahmp50_struc(n)%noahmp50(t)%tslb(1:nsoil) + + + ! from snowfall routine + ! creating a new layer + IF(ISNOW == 0.and.(dsneqv.gt.0.and.dsnowh.gt.0)) THEN + SNOWH = SNOWH + dsnowh + SNEQV = SNEQV + dsneqv + END IF + + NEWNODE = 0 + + IF(ISNOW == 0 .AND. SNOWH >= 0.025.and.& + (dsneqv.gt.0.and.dsnowh.gt.0)) THEN !MB: change limit + ISNOW = -1 + NEWNODE = 1 + DZSNSO(0)= SNOWH + SNOWH = 0. + STC(0) = MIN(273.16, Noahmp50_struc(n)%noahmp50(t)%sfctmp) ! temporary setup + SNICE(0) = SNEQV + SNLIQ(0) = 0. + END IF + + ! snow with layers + IF(ISNOW < 0 .AND. NEWNODE == 0 .and. & + (dsneqv.gt.0.and.dsnowh.gt.0)) then + SNICE(ISNOW+1) = SNICE(ISNOW+1) + dsneqv + DZSNSO(ISNOW+1) = DZSNSO(ISNOW+1) + dsnowh + ENDIF + + if(dsneqv.lt.0.and.dsnowh.lt.0) then + snowh1 = snowh + dsnowh + sneqv1 = sneqv + dsneqv + if(snowh1.ge.0.and.sneqv1.ge.0) then + SNOWH = SNOWH + dsnowh + SNEQV = SNEQV + dsneqv +! Update dzsnso +! how do you determine the thickness of a layer? + if(snowh.le.dzsnso(0)) then + isnow = 0 + dzsnso(-nsnow+1:(isnow-1)) = 0 + dzsnso(isnow) = snowh + elseif(snowh.le.(dzsnso(0)+dzsnso(-1))) then + isnow = -1 + dzsnso(-nsnow+1:(isnow-1)) = 0 + dzsnso(isnow) = snowh -dzsnso(isnow+1) + elseif(snowh.le.(dzsnso(0)+dzsnso(-1)+dzsnso(-2))) then + isnow = -2 + dzsnso(-nsnow+1:(isnow-2)) = 0 + dzsnso(isnow) = snowh -dzsnso(isnow+2) + endif + endif + endif + + ! ice fraction at the last timestep, add check for both snice and snliq are 0.0 + do snl_idx=isnow+1,0 + if(snice(snl_idx)+snliq(snl_idx)>0.0) then + ficeold(snl_idx) = snice(snl_idx) / (snice(snl_idx)+snliq(snl_idx)) + else + ficeold(snl_idx) = 0.0 + endif + enddo + + sice(:) = max(0.0, Noahmp50_struc(n)%noahmp50(t)%smc(:)& + - Noahmp50_struc(n)%noahmp50(t)%sh2o(:)) + + !imelt + do j = -nsnow+1, nsoil + supercool(j) = 0.0 + end do + + do j = isnow+1,0 ! all layers + mice(j) = snice(j) + mliq(j) = snliq(j) + end do + + do j = 1, nsoil ! soil + mliq(j) = Noahmp50_struc(n)%noahmp50(t)%sh2o(j) * dzsnso(j) * 1000. + mice(j) = (Noahmp50_struc(n)%noahmp50(t)%smc(j) - & + Noahmp50_struc(n)%noahmp50(t)%sh2o(j)) * dzsnso(j) * 1000. + end do + + do j = isnow+1,nsoil ! all layers + imelt(j) = 0 + enddo + + do j = 1,nsoil +! if (opt_frz == 1) then +! Assuming the use of option 1 for now + if(stc(j) < tfrz) then + smp = hfus*(tfrz-stc(j))/(grav*stc(j)) !(m) + SUPERCOOL(J) = SMCMAX(J)*(SMP/PSISAT(J))**(-1./BEXP(J)) + SUPERCOOL(J) = SUPERCOOL(J)*DZSNSO(J)*1000. !(mm) + end if +! end if +! if (opt_frz == 2) then +! call frh2o (supercool(j),& +! Noahmp50_struc(n)%noahmp50(t)%sstc(j),& +! Noahmp50_struc(n)%noahmp50(t)%smc(j),& +! Noahmp50_struc(n)%noahmp50(t)%sh2o(j)) +! supercool(j) = supercool(j)*dzsnso(j)*1000. !(mm) +! end if + enddo + + do j = isnow+1,nsoil + if (mice(j) > 0. .and. stc(j) >= tfrz) then !melting + imelt(j) = 1 + endif + if (mliq(j) > supercool(j) .and. stc(j) < tfrz) then + imelt(j) = 2 + endif + + ! If snow exists, but its thickness is not enough to create a layer + if (isnow == 0 & + .and. sneqv > 0. .and. j == 1) then + if (stc(j) >= tfrz) then + imelt(j) = 1 + endif + endif + enddo + + ! from SNOWWATER + SNOFLOW = 0.0 + ponding1 = 0.0 + ponding2 = 0.0 + + ! based on Noah-MP v4.5 physics + if(isnow < 0) & + call compact (Noahmp50_struc(n)%noahmp50(t)%param, & + nsnow, nsoil, noahmp50_struc(n)%ts, & !in + stc, snice, snliq, zsoil, imelt, ficeold, iloc, jloc, & !in + isnow, dzsnso ,zsnso) !inout + if(isnow < 0) & + call combine (Noahmp50_struc(n)%noahmp50(t)%param, & + nsnow, nsoil ,iloc, jloc, & !in + isnow, noahmp50_struc(n)%noahmp50(t)%sh2o, & !inout + stc, snice, snliq, dzsnso, sice, snowh, sneqv, & !inout + ponding1, ponding2) !out + if(isnow < 0) & + call divide (Noahmp50_struc(n)%noahmp50(t)%param, nsnow, nsoil, & !in + isnow, stc, snice, snliq, dzsnso) !inout + + !set empty snow layers to zero + do iz = -nsnow+1, isnow + snice(iz) = 0.0 + snliq(iz) = 0.0 + stc(iz) = 0.0 + dzsnso(iz)= 0.0 + zsnso(iz) = 0.0 + enddo + + !to obtain equilibrium state of snow in glacier region + IF(SNEQV > 5000.0) THEN ! 5000 mm -> maximum water depth + BDSNOW = SNICE(0) / DZSNSO(0) + SNOFLOW = (SNEQV - 5000.0) + SNICE(0) = SNICE(0) - SNOFLOW + DZSNSO(0) = DZSNSO(0) - SNOFLOW/BDSNOW + !SNOFLOW = SNOFLOW / DT + END IF + + ! sum up snow mass for layered snow + IF(ISNOW < 0) THEN ! MB: only do for multi-layer + SNEQV = 0.0 + DO IZ = ISNOW+1,0 + SNEQV = SNEQV + SNICE(IZ) + SNLIQ(IZ) + ENDDO + END IF + + ! Reset ZSNSO and layer thinkness DZSNSO + DO IZ = ISNOW+1, 0 + DZSNSO(IZ) = -DZSNSO(IZ) + END DO + + DZSNSO(1) = ZSOIL(1) + DO IZ = 2,NSOIL + DZSNSO(IZ) = (ZSOIL(IZ) - ZSOIL(IZ-1)) + END DO + + ZSNSO(ISNOW+1) = DZSNSO(ISNOW+1) + DO IZ = ISNOW+2 ,NSOIL + ZSNSO(IZ) = ZSNSO(IZ-1) + DZSNSO(IZ) + ENDDO + + DO IZ = ISNOW+1 ,NSOIL + DZSNSO(IZ) = -DZSNSO(IZ) + END DO + + ! sum up snow thickness for layered snow + IF(ISNOW < 0) THEN ! MB: only do for multi-layer + SNOWH = 0.0 ! Yeosang Yoon + DO IZ = ISNOW+1,0 + SNOWH = SNOWH + DZSNSO(IZ) ! Yeosang Yoon + ENDDO + END IF + + ! Yeosag Yoon, no snow layer case, limit snow density to 1000 + IF (ISNOW == 0 .AND. SNEQV > 0.0 .AND. SNOWH > 0.0) THEN + BDSNOW = SNEQV/SNOWH + IF (BDSNOW >= DENH2O) THEN + SNOWH = SNOWH*(BDSNOW/DENH2O) ! change unit, SNEQV=[mm] SNOWH=[m] + END IF + END IF + + ! update state vars + Noahmp50_struc(n)%noahmp50(t)%isnow = isnow + Noahmp50_struc(n)%noahmp50(t)%sneqv = sneqv + Noahmp50_struc(n)%noahmp50(t)%snowh = snowh + Noahmp50_struc(n)%noahmp50(t)%zss(1:nsnow+nsoil) = zsnso(-nsnow+1:nsoil) + Noahmp50_struc(n)%noahmp50(t)%snowice(1:nsnow) = snice(-nsnow+1:0) + Noahmp50_struc(n)%noahmp50(t)%snowliq(1:nsnow) = snliq(-nsnow+1:0) + Noahmp50_struc(n)%noahmp50(t)%tsno(1:nsnow) = stc(-nsnow+1:0) + Noahmp50_struc(n)%noahmp50(t)%tslb(1:nsoil) = stc(1:nsoil) + + deallocate(ficeold) + deallocate(snice) + deallocate(snliq) + deallocate(stc) + deallocate(imelt) + deallocate(supercool) + deallocate(mice) + deallocate(mliq) + deallocate(dzsnso) + deallocate(zsnso) + deallocate(sice) + deallocate(bexp) + deallocate(psisat) + deallocate(smcmax) + +end subroutine noahmp50_usafsi_update + diff --git a/lis/surfacemodels/land/noahmp.5.0/irrigation/noahmp50_getirrigationstates.F90 b/lis/surfacemodels/land/noahmp.5.0/irrigation/noahmp50_getirrigationstates.F90 new file mode 100755 index 000000000..b9bf95b31 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/irrigation/noahmp50_getirrigationstates.F90 @@ -0,0 +1,513 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +#include "LIS_misc.h" + +!BOP +! +! !ROUTINE: noahmp50_getirrigationstates +! \label{noahmp50_getirrigationstates} +! +! !INTERFACE: +subroutine noahmp50_getirrigationstates(n,irrigState) +! !USES: + use ESMF + use LIS_coreMod + use LIS_logMod + use NoahMP50_lsmMod + use LIS_vegDataMod, only: LIS_read_shdmin, LIS_read_shdmax + +! !DESCRIPTION: +! +! Calculate water requirement and apply the amount to precipitation. +! +! Irrigate when root zone soil moisture falls below 50 % of +! the field capacity (reference soil moiture) at 6 am LST. +! The root zone is actual maximum root depth rather than NOAH root zone. +! Method of irrigation is by precipitation between 6-10 am LST. +! +! Irrigation amount is scaled to grid total crop fraction when intensity +! is less than the fraction. Irrigation is expanded to non-crop, non-forest, +! non-baresoil/urban tiles if intensity exceeds grid total crop fraction. +! In latter case, scaled irrigation is applied to grassland first, +! then further applied over the rest of tiles equally if the intensity +! exceeds grassland fraction as well. +! +! Optionally efficiency correction is applied to account for field loss. +! +! Optionally outputs amount of water put into the system to a text file. +! +! This version includes modifications to irr4 as follows: +! 1) Use location specific growing season threshold (40% of GFRAC range) +! 2) Allow irrigation in non-crop/non-forest tiles when irrigation +! intensity exceeds total crop fraction +! +! REVISION HISTORY: +! +! Aug 2008: Hiroko Kato; Initial code +! Nov 2012: Sujay Kumar, Incorporated into LIS +! Jun 2014: Ben Zaitchik; Added flood scheme +! Aug 2016: Wanshu Nie; Incorporated into NoahMP +! May 2018: Wanshu Nie; Add temperature check for GRACE-DA purpose +! May 2019: Jessica Erlingis; Incorporate W. Nie's updates into LIS +! and add optional flag for groundwater abstraction +! Feb 2020: Jessica Erlingis; Correct sprinkler scheme so that it checks moisture +! at otimess and applies constant rate for irrhrs +! March 2020: Jessica Erlingis; Add to Noah-MP 4.0.1 +! Apr 2021: Wanshu Nie; Add option to interact with DVEG +! May 2021: Wanshu Nie; update irrigation using ensemble mean when runing with DA. +! May 2023: Cenlin He; update to work with Noah-MP refactored code (v5.0 and later) + +!EOP + implicit none + ! Sprinkler parameters + real, parameter :: otimess = 6.0 ! local trigger check start time [hour] + real, parameter :: irrhrs = 4. ! duration of irrigation hours + ! Drip parameters (not currently implemented) + real, parameter :: otimeds = 6.0 ! local trigger check start time [hour] + real, parameter :: irrhrd = 12.0 ! duration of irrigation hours + ! Flood parameters + real, parameter :: otimefs = 6.0 ! local trigger check start time [hour] + real, parameter :: irrhrf = 1.0 ! duration of irrigation hours + !!!real, parameter :: ffreq = 0.0 ! frequency of flood irrig [days] set to 0.0 to use thresh instead + + real, parameter :: efcor = 0.0 ! Efficiency Correction (%) + integer, parameter :: nsoil = 4 + + integer :: n + integer :: rc + integer :: t,k,gid,vegt,l + type(ESMF_State) :: irrigState + type(ESMF_Field) :: irrigRateField,irrigFracField + type(ESMF_Field) :: irrigRootDepthField,irrigScaleField + + real, pointer :: irrigRate(:), irrigFrac(:) + real, pointer :: irrigRootDepth(:), irrigScale(:) + integer :: chhr, lhr + integer :: soiltyp ! soil type index [-] + real :: asmc, tsmcwlt, tsmcref, ma, otimes, otimee, irrhr + real :: sldpth(nsoil) + real :: rdpth(nsoil) + real :: zdpth(nsoil) + real :: water(nsoil) + real :: twater, twater1, twater2 + real :: ippix, crootd + real :: smcmax, smcref, smcwlt + !real :: smcref1, smcwlt1, shdfac + real :: smhigh, smlow + integer :: lroot,veg_index1,veg_index2 + real :: gsthresh, ltime + real :: shdfac, shdmin, shdmax + real :: timestep, shift_otimes, shift_otimee + real :: AWS + real :: Dtime + real, allocatable :: placeshdmax(:,:), placeshdmin(:,:) + real :: sfctemp, tempcheck + + type(ESMF_Field) :: irriggwratioField + real, pointer :: irriggwratio(:) + + integer :: i, m + real :: sfctemp_avg + real :: shdfac_avg + real :: smc_avg(nsoil) + + call ESMF_StateGet(irrigState, "Irrigation rate",irrigRateField,rc=rc) + call LIS_verify(rc,'ESMF_StateGet failed for Irrigation rate') + call ESMF_FieldGet(irrigRateField, localDE=0,farrayPtr=irrigRate,rc=rc) + call LIS_verify(rc,'ESMF_FieldGet failed for Irrigation rate') + + call ESMF_StateGet(irrigState, "Irrigation frac",& + irrigFracField,rc=rc) + call LIS_verify(rc,'ESMF_StateGet failed for Irrigation frac') + call ESMF_FieldGet(irrigFracField, localDE=0,& + farrayPtr=irrigFrac,rc=rc) + call LIS_verify(rc,'ESMF_FieldGet failed for Irrigation frac') + + call ESMF_StateGet(irrigState, "Irrigation max root depth",& + irrigRootDepthField,rc=rc) + call LIS_verify(rc,'ESMF_StateGet failed for Irrigation max root depth') + call ESMF_FieldGet(irrigRootDepthField, localDE=0,& + farrayPtr=irrigRootDepth,rc=rc) + call LIS_verify(rc,'ESMF_FieldGet failed for Irrigation root depth') + + call ESMF_StateGet(irrigState, "Irrigation scale",& + irrigScaleField,rc=rc) + call LIS_verify(rc,'ESMF_StateGet failed for Irrigation scale') + call ESMF_FieldGet(irrigScaleField, localDE=0,& + farrayPtr=irrigScale,rc=rc) + call LIS_verify(rc,'ESMF_FieldGet failed for Irrigation scale') + + call ESMF_StateGet(irrigState, "Groundwater irrigation ratio",& + irriggwratioField,rc=rc) + call LIS_verify(rc,'ESMF_StateGet failed for Groundwater irrigation ratio') + call ESMF_FieldGet(irriggwratioField, localDE=0,& + farrayPtr=irriggwratio,rc=rc) + call LIS_verify(rc,'ESMF_FieldGet failed for Groundwater irrigation ratio') + + allocate(placeshdmax(LIS_rc%lnc(n),LIS_rc%lnr(n))) + allocate(placeshdmin(LIS_rc%lnc(n),LIS_rc%lnr(n))) + + call LIS_read_shdmax(n,placeshdmax) + call LIS_read_shdmin(n,placeshdmin) + +!---------------------------------------------------------------------- +! Set start and end times for selected irrigation type +!---------------------------------------------------------------------- + if(LIS_rc%irrigation_type.eq."Sprinkler") then + otimes = otimess + irrhr = irrhrs + otimee = otimess + irrhrs + elseif(LIS_rc%irrigation_type.eq."Drip") then + otimes = otimeds + irrhr = irrhrd + otimee = otimeds + irrhrd + elseif(LIS_rc%irrigation_type.eq."Flood") then + otimes = otimefs + irrhr = irrhrf + otimee = otimefs + irrhrf + endif + + + + do i=1,LIS_rc%npatch(n,LIS_rc%lsm_index)/LIS_rc%nensem(n) + + sfctemp_avg = 0.0 + shdfac_avg = 0.0 + smc_avg = 0.0 + + do m=1,LIS_rc%nensem(n) + + t=(i-1)*LIS_rc%nensem(n)+m + + sfctemp_avg = sfctemp_avg + Noahmp50_struc(n)%noahmp50(t)%sfctmp + shdfac_avg = shdfac_avg + Noahmp50_struc(n)%noahmp50(t)%fveg + + do k=1,nsoil + + smc_avg(k) = smc_avg(k) + Noahmp50_struc(n)%noahmp50(t)%smc(k) + + end do + + end do + + sfctemp_avg = sfctemp_avg/LIS_rc%nensem(n) + shdfac_avg = shdfac_avg/LIS_rc%nensem(n) + + do k=1,nsoil + + smc_avg(k) = smc_avg(k)/LIS_rc%nensem(n) + + end do + + + do m=1,LIS_rc%nensem(n) + + t = (i-1)*LIS_rc%nensem(n)+m + + timestep = Noahmp50_struc(n)%dt + soiltyp = Noahmp50_struc(n)%noahmp50(t)%soiltype + + + ! Adjust bounds by timestep to account for the fact that LIS_rc%hr, etc. + ! will represents the END of the integration timestep window + + + shift_otimes = otimes + (timestep/3600.) + shift_otimee = otimee + (timestep/3600.) + + twater = 0.0 + water = 0.0 + asmc = 0.0 + tsmcwlt = 0.0 + tsmcref = 0.0 + ma = 0.0 + crootd = 0.0 + lroot = 0 + + !JE this code block will need to be changed to account for variable + ! soil layers in Noah-MP + + sldpth(1) = 0.1 ! Soil layer thicknesses (m) + sldpth(2) = 0.3 + sldpth(3) = 0.6 + sldpth(4) = 1.0 + zdpth(1) = sldpth(1) ! Soil layer depth from top (m) + zdpth(2) = sldpth(1) + sldpth(2) + zdpth(3) = sldpth(1) + sldpth(2) + sldpth(3) + zdpth(4) = sldpth(1) + sldpth(2) + sldpth(3) + sldpth(4) + + smcmax = Noahmp50_struc(n)%noahmp50(t)%param%SMCMAX(1) !SMCMAX_TABLE(soiltyp) + smcref = Noahmp50_struc(n)%noahmp50(t)%param%SMCREF(1) !SMCREF_TABLE(soiltyp) + smcwlt = Noahmp50_struc(n)%noahmp50(t)%param%SMCWLT(1) !SMCWLT_TABLE(soiltyp) + + ! sfctemp = Noahmp50_struc(n)%noahmp50(t)%sfctmp + tempcheck = 273.16 + 2.5 + + gid = LIS_surface(n,LIS_rc%lsm_index)%tile(t)%index + chhr = nint(24.0*(LIS_domain(n)%grid(gid)%lon/360.0)) + if((LIS_domain(n)%grid(gid)%lon.lt.0.0).and.& + (abs(mod(LIS_domain(n)%grid(gid)%lon,15.0)).ge.0.0001)) & + chhr = chhr -1 + lhr = LIS_rc%hr +chhr + if(lhr.ge.24) lhr = lhr-24 + if(lhr.lt.0) lhr = lhr+24 + + ltime = real(lhr)+real(LIS_rc%mn)/60.0+real(LIS_rc%ss)/3600.0 + + if((Noahmp50_struc(n)%dveg_opt == 2 .OR. & + Noahmp50_struc(n)%dveg_opt == 5 .OR. & + Noahmp50_struc(n)%dveg_opt == 6) .AND. LIS_rc%irrigation_dveg == 1) then + shdfac = shdfac_avg + + else + shdfac = Noahmp50_struc(n)%noahmp50(t)%shdfac_monthly(LIS_rc%mo) + end if + + + ! If we are outside of the irrigation window, set rate to 0 + if ((ltime.gt.shift_otimee).or.(ltime.lt.shift_otimes)) then + irrigRate(t) = 0.0 + endif + +! Calculate vegetation and root depth parameters + +! JE This temperature check avoids irrigating at temperatures near or below 0C + if((ltime.ge.shift_otimes).and.(ltime.le.shift_otimee).and. & + (sfctemp_avg.gt.tempcheck)) then +!------------------------------------ + vegt = LIS_surface(n,LIS_rc%lsm_index)%tile(t)%vegt + !---------------------------------------------------------------------- + ! Proceed if it is non-forest, non-baresoil, non-urban + !---------------------------------------------------------------------- + if(LIS_rc%lcscheme.eq."UMD") then !UMD + veg_index1 = 6 + veg_index2 = 11 + elseif(LIS_rc%lcscheme.eq."MODIS".or.LIS_rc%lcscheme.eq."IGBPNCEP") & + then + veg_index1 = 6 + veg_index2 = 14 + elseif(LIS_rc%lcscheme.eq."USGS") then !UMD + veg_index1 = 2 + veg_index2 = 10 + else + write(LIS_logunit,*) '[ERR] The landcover scheme ',& + trim(LIS_rc%lcscheme),' is not supported for irrigation ' + call LIS_endrun() + endif + + if(vegt.ge.veg_index1.and.vegt.le.veg_index2& + .and.vegt.ne.LIS_rc%bareclass.and.& + vegt.ne.LIS_rc%urbanclass) then + if(irrigFrac(t).gt.0) then + ippix = irrigFrac(t)*0.01 + + ! Determine the amount of irrigation to apply if irrigated tile + if( IrrigScale(t).gt.0.0 ) then ! irrigated tile +! if(ippix.gt.0.0) then ! irrigated tile + + !shdmin = minval(Noahmp50_struc(n)%noahmp50(t)%shdfac_monthly) + !shdmax = maxval(Noahmp50_struc(n)%noahmp50(t)%shdfac_monthly) + shdmin =placeshdmin(LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col, & + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + shdmax =placeshdmax(LIS_surface(n,LIS_rc%lsm_index)%tile(t)%col, & + LIS_surface(n,LIS_rc%lsm_index)%tile(t)%row) + + ! let gsthresh be a function of the range, which means the larger + ! the range is, the higher GVF threshold will be for this grid. + ! JE Gsthresh is a GVF threshold used to identify a growing season for each + ! pixel and allow irrigation during that time + gsthresh = shdmin + & + (LIS_rc%irrigation_GVFparam1 + LIS_rc%irrigation_GVFparam2*& + (shdmax-shdmin)) * (shdmax - shdmin) + + + !JE Changes needed to this code block to account for variable soil layers + ! in Noah-MP + + if(shdfac .ge. gsthresh) then + crootd = irrigRootdepth(t)*shdfac + if(crootd.gt.0.and.crootd.lt.zdpth(1)) then + lroot = 1 + rdpth(1) = crootd + elseif(crootd .ge. zdpth(1).and.crootd .lt. zdpth(2) ) then + lroot = 2 + rdpth(1) = sldpth(1) + rdpth(2) = crootd - zdpth(1) + elseif ( crootd.ge.zdpth(2).and.crootd .lt. zdpth(3) ) then + lroot = 3 + rdpth(1) = sldpth(1) + rdpth(2) = sldpth(2) + rdpth(3) = crootd - zdpth(2) + elseif ( crootd.ge.zdpth(3).and.crootd .lt. zdpth(4) ) then + lroot = 4 + rdpth(1) = sldpth(1) + rdpth(2) = sldpth(2) + rdpth(3) = sldpth(3) + rdpth(4) = crootd - zdpth(3) +! else +! print*,'error getting root depth' +! stop + endif + + !!!!! SPRINKLER IRRIGATION + if(LIS_rc%irrigation_type.eq."Sprinkler") then + !---------------------------------------------------------------------- + ! Set the irrigation rate at start time; keep the value till next day + ! If local time at the tile fall in the irrigation check + ! hour then check the root zone average soil moisture + !---------------------------------------------------------------------- + if(ltime.eq.shift_otimes) then !Check moisture availability at otimes only + !------------------------------------------------------------- + ! Compute the root zone accumlative soil moisture [mm], + ! field capacity [mm], and wilting point [mm] + !------------------------------------------------------------- + if(lroot.gt.0) then + do k=1,lroot + asmc = asmc + smc_avg(k)*rdpth(k)*1000.0 + tsmcwlt = tsmcwlt + smcwlt * rdpth(k)*1000.0 + tsmcref = tsmcref + smcref * rdpth(k)*1000.0 + enddo + !--------------------------------------------------------------- + ! Get the root zone moisture availability to the plant + !--------------------------------------------------------------- + ma = (asmc-tsmcwlt) /(tsmcref - tsmcwlt) + if(ma.le.LIS_rc%irrigation_thresh) then + do k=1,lroot + water(k) = & + (smcref-smc_avg(k))*rdpth(k)*1000.0 + twater = twater + water(k) + enddo + + !----------------------------------------------------------------------------- + ! Scale the irrigation intensity to the crop % when intensity < crop%. + ! Expand irrigation for non-crop, non-forest when intensity > crop % + ! in preference order of grassland first then rest. + ! *scale is pre-computed for each tile in getirrpmapetc module in a way + ! that is transparent to every tile irrigated or non-irrigated + !----------------------------------------------------------------------------- + twater1 = twater + twater = twater * irrigScale(t) + + !----------------------------------------------------------------------------- + ! Apply efficiency correction + !----------------------------------------------------------------------------- + twater2 = twater + twater = twater*(100.0/(100.0-efcor)) + !----------------------------------------------------------------------------- + ! Compute irrigation rate + irrigRate(t) = twater/(irrhr*3600.0) + + endif + endif + endif + !!!!! DRIP IRRIGATION (NOT CURRENTLY IMPLEMENTED) + elseif(LIS_rc%irrigation_type.eq."Drip") then + ! Need to get crop coefficient so that we can caculate unstressed Transp + ! RC=RSMIN/(XLAI*RCS*RCT*RCQ) + ! PCIRR=(RR+DELTA)/(RR*(1.+RC*CH)+DELTA) + ! CALL TRANSP (with PCIRR) + + ! Then add enough water to get from actual Transp to unstressed Transp + twater = 0.0 + !----------------------------------------------------------------------------- + ! Apply efficiency correction + !----------------------------------------------------------------------------- + twater2 = twater + twater = twater*(100.0/(100.0-efcor)) + !----------------------------------------------------------------------------- + ! Compute irrigation rate + !----------------------------------------------------------------------------- + irrigRate(t) = twater ! for drip calculation, twater is a rate [kg/m2/s] + Noahmp50_struc(n)%noahmp50(t)%smc(1) = & + Noahmp50_struc(n)%noahmp50(t)%smc(1) + (twater-twater2)/(sldpth(1)*1000.0) !! check this with Sujay + + !!!!! FLOOD IRRIGATION + elseif(LIS_rc%irrigation_type.eq."Flood") then + !------------------------------------------------------------- + ! Compute the root zone accumlative soil moisture [mm], + ! field capacity [mm], and wilting point [mm] + !------------------------------------------------------------- + if(lroot.gt.0) then + do k=1,lroot + asmc = asmc + Noahmp50_struc(n)%noahmp50(t)%smc(k)*& + rdpth(k)*1000.0 + tsmcwlt = tsmcwlt + smcwlt * rdpth(k)*1000.0 + tsmcref = tsmcref + smcref * rdpth(k)*1000.0 + enddo + !--------------------------------------------------------------- + ! Get the root zone moisture availability to the plant + !--------------------------------------------------------------- +! ma = (asmc-tsmcwlt) /(tsmcref - tsmcwlt) ! Original + ma = (asmc-tsmcwlt) /(tsmcref - tsmcwlt)/IrrigScale(t) ! BZ added IrrigScale + + if( ma .le. LIS_rc%irrigation_thresh ) then + do l = 1, LIS_rc%irrigation_mxsoildpth + if( l == 1 ) then + twater = (SMCMAX - Noahmp50_struc(n)%noahmp50(t)%smc(l))*sldpth(l)*1000.0 + else + ! BZ modification 4/2/2015 to saturate entire column and apply ippix + twater = twater + (smcmax - Noahmp50_struc(n)%noahmp50(t)%smc(l))*sldpth(l)*1000.0 + endif + end do + + !----------------------------------------------------------------------------- + ! Scale the irrigation intensity to the crop % when intensity < crop%. + ! Expand irrigation for non-crop, non-forest when intensity > crop % + ! in preference order of grassland first then rest. + ! *scale is pre-computed for each tile in getirrpmapetc module in a way + ! that is transparent to every tile irrigated or non-irrigated + !----------------------------------------------------------------------------- + twater1 = twater + twater = twater * irrigScale(t) + !----------------------------------------------------------------------------- + ! Apply efficiency correction + !----------------------------------------------------------------------------- + twater2 = twater + twater = twater*(100.0/(100.0-efcor)) + !----------------------------------------------------------------------------- + ! Compute irrigation rate + !----------------------------------------------------------------------------- + irrigRate(t) = twater/LIS_rc%ts + + ! BZ modification 4/2/2015 to account for ippix and all soil layers: + do l = 1, LIS_rc%irrigation_mxsoildpth + Noahmp50_struc(n)%noahmp50(t)%smc(l) = IrrigScale(t)*smcmax + & + (1-IrrigScale(t))*Noahmp50_struc(n)%noahmp50(t)%smc(l) + end do + endif + endif + + endif + + endif + end if + end if + end if + + ! Remove irrigated water from groundwater + !JE Add in flag to turn groundwater abstraction on/off + if (LIS_rc%irrigation_GWabstraction.eq.1) then + AWS = Noahmp50_struc(n)%noahmp50(t)%wa + Dtime = Noahmp50_struc(n)%ts + if (LIS_rc%irrigation_SourcePartition.eq.1) then + if(irriggwratio(t).gt.0) then + Noahmp50_struc(n)%noahmp50(t)%wa = AWS - irrigRate(t)*Dtime*irriggwratio(t)/100 + + end if + else + Noahmp50_struc(n)%noahmp50(t)%wa = AWS - irrigRate(t)*Dtime + end if + end if + end if + + end do + end do + + end subroutine noahmp50_getirrigationstates diff --git a/lis/surfacemodels/land/noahmp.5.0/kwm_date_utilities_50.F90 b/lis/surfacemodels/land/noahmp.5.0/kwm_date_utilities_50.F90 new file mode 100644 index 000000000..315b9247d --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/kwm_date_utilities_50.F90 @@ -0,0 +1,822 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +module kwm_date_utilities_50 +contains + subroutine geth_newdate (ndate, odate, idt) + implicit none + +! From old date ('YYYY-MM-DD HH:MM:SS.ffff') and +! delta-time, compute the new date. + +! on entry - odate - the old hdate. +! idt - the change in time + +! on exit - ndate - the new hdate. + + integer, intent(in) :: idt + character (len=*), intent(out) :: ndate + character (len=*), intent(in) :: odate + + +! Local Variables + +! yrold - indicates the year associated with "odate" +! moold - indicates the month associated with "odate" +! dyold - indicates the day associated with "odate" +! hrold - indicates the hour associated with "odate" +! miold - indicates the minute associated with "odate" +! scold - indicates the second associated with "odate" + +! yrnew - indicates the year associated with "ndate" +! monew - indicates the month associated with "ndate" +! dynew - indicates the day associated with "ndate" +! hrnew - indicates the hour associated with "ndate" +! minew - indicates the minute associated with "ndate" +! scnew - indicates the second associated with "ndate" + +! mday - a list assigning the number of days in each month + +! i - loop counter +! nday - the integer number of days represented by "idt" +! nhour - the integer number of hours in "idt" after taking out +! all the whole days +! nmin - the integer number of minutes in "idt" after taking out +! all the whole days and whole hours. +! nsec - the integer number of minutes in "idt" after taking out +! all the whole days, whole hours, and whole minutes. + + integer :: nlen, olen + integer :: yrnew, monew, dynew, hrnew, minew, scnew, frnew + integer :: yrold, moold, dyold, hrold, miold, scold, frold + integer :: mday(12), nday, nhour, nmin, nsec, nfrac, i, ifrc + logical :: opass + character (len=10) :: hfrc + character (len=1) :: sp + + logical :: punctuated + logical :: idtdy, idthr, idtmin, idtsec, idtfrac + +! Assign the number of days in a months + + mday( 1) = 31 + mday( 2) = 28 + mday( 3) = 31 + mday( 4) = 30 + mday( 5) = 31 + mday( 6) = 30 + mday( 7) = 31 + mday( 8) = 31 + mday( 9) = 30 + mday(10) = 31 + mday(11) = 30 + mday(12) = 31 + +! Determine if the date is "punctuated" or just a string of numbers. + if ( odate(5:5) == "-") then + punctuated = .TRUE. + else + punctuated = .FALSE. + endif + +! Break down old hdate into parts + + hrold = 0 + miold = 0 + scold = 0 + frold = 0 + olen = len(odate) + if (punctuated) then + if (olen.ge.11) then + sp = odate(11:11) + else + sp = ' ' + end if + endif + +! Use internal READ statements to convert the CHARACTER string +! date into INTEGER components. + + idtdy = .FALSE. + idthr = .FALSE. + idtmin = .FALSE. + idtsec = .FALSE. + idtfrac = .FALSE. + read(odate(1:4), '(i4)') yrold + if (punctuated) then + read(odate(6:7), '(i2)') moold + read(odate(9:10), '(i2)') dyold + idtdy = .TRUE. + if (olen.ge.13) then + idthr = .TRUE. + read(odate(12:13),'(i2)') hrold + if (olen.ge.16) then + idtmin = .TRUE. + read(odate(15:16),'(i2)') miold + if (olen.ge.19) then + idtsec = .TRUE. + read(odate(18:19),'(i2)') scold + if (olen.gt.20) then + idtfrac = .TRUE. + read(odate(21:olen),*) frold + end if + end if + end if + end if + else ! Not punctuated + read(odate(5:6), '(i2)') moold + read(odate(7:8), '(i2)') dyold + idtdy = .TRUE. + if (olen.ge.10) then + idthr = .TRUE. + read(odate(9:10),'(i2)') hrold + if (olen.ge.12) then + idtmin = .TRUE. + read(odate(11:12),'(i2)') miold + if (olen.ge.14) then + idtsec = .TRUE. + read(odate(13:14),'(i2)') scold + if (olen.ge.15) then + idtfrac = .TRUE. + read(odate(15:olen),*) frold + end if + end if + end if + end if + endif + +! Set the number of days in February for that year. + + mday(2) = nfeb(yrold) + +! Check that ODATE makes sense. + + opass = .TRUE. + +! Check that the month of ODATE makes sense. + + if ((moold.gt.12).or.(moold.lt.1)) then + write(*,*) 'GETH_NEWDATE: Month of ODATE = ', moold + opass = .FALSE. + end if + +! Check that the day of ODATE makes sense. + + if ((dyold.gt.mday(moold)).or.(dyold.lt.1)) then + write(*,*) 'GETH_NEWDATE: Day of ODATE = ', dyold + opass = .FALSE. + end if + +! Check that the hour of ODATE makes sense. + + if ((hrold.gt.23).or.(hrold.lt.0)) then + write(*,*) 'GETH_NEWDATE: Hour of ODATE = ', hrold + opass = .FALSE. + end if + +! Check that the minute of ODATE makes sense. + + if ((miold.gt.59).or.(miold.lt.0)) then + write(*,*) 'GETH_NEWDATE: Minute of ODATE = ', miold + opass = .FALSE. + end if + +! Check that the second of ODATE makes sense. + + if ((scold.gt.59).or.(scold.lt.0)) then + write(*,*) 'GETH_NEWDATE: Second of ODATE = ', scold + opass = .FALSE. + end if + +! Check that the fractional part of ODATE makes sense. + +!KWM IF ((scold.GT.59).or.(scold.LT.0)) THEN +!KWM WRITE(*,*) 'GETH_NEWDATE: Second of ODATE = ', scold +!KWM opass = .FALSE. +!KWM END IF + + if (.not.opass) then + write(*,*) 'Crazy ODATE: ', odate(1:olen), olen + call abort() + end if + +! Date Checks are completed. Continue. + + +! Compute the number of days, hours, minutes, and seconds in idt + + if (idtfrac) then !idt should be in fractions of seconds + if (punctuated) then + ifrc = olen-14 + else + ifrc = olen-20 + endif + ifrc = 10**ifrc + nday = abs(idt)/(86400*ifrc) + nhour = mod(abs(idt),86400*ifrc)/(3600*ifrc) + nmin = mod(abs(idt),3600*ifrc)/(60*ifrc) + nsec = mod(abs(idt),60*ifrc)/(ifrc) + nfrac = mod(abs(idt), ifrc) + else if (idtsec) then !idt should be in seconds + ifrc = 1 + nday = abs(idt)/86400 ! integer number of days in delta-time + nhour = mod(abs(idt),86400)/3600 + nmin = mod(abs(idt),3600)/60 + nsec = mod(abs(idt),60) + nfrac = 0 + else if (idtmin) then !idt should be in minutes + ifrc = 1 + nday = abs(idt)/1440 ! integer number of days in delta-time + nhour = mod(abs(idt),1440)/60 + nmin = mod(abs(idt),60) + nsec = 0 + nfrac = 0 + else if (idthr) then !idt should be in hours + ifrc = 1 + nday = abs(idt)/24 ! integer number of days in delta-time + nhour = mod(abs(idt),24) + nmin = 0 + nsec = 0 + nfrac = 0 + else if (idtdy) then !idt should be in days + ifrc = 1 + nday = abs(idt) ! integer number of days in delta-time + nhour = 0 + nmin = 0 + nsec = 0 + nfrac = 0 + else + write(*,'(''GETH_NEWDATE: Strange length for ODATE: '', i3)') & + olen + write(*,*) odate(1:olen) + call abort() + end if + + if (idt.ge.0) then + + frnew = frold + nfrac + if (frnew.ge.ifrc) then + frnew = frnew - ifrc + nsec = nsec + 1 + end if + + scnew = scold + nsec + if (scnew .ge. 60) then + scnew = scnew - 60 + nmin = nmin + 1 + end if + + minew = miold + nmin + if (minew .ge. 60) then + minew = minew - 60 + nhour = nhour + 1 + end if + + hrnew = hrold + nhour + if (hrnew .ge. 24) then + hrnew = hrnew - 24 + nday = nday + 1 + end if + + dynew = dyold + monew = moold + yrnew = yrold + do i = 1, nday + dynew = dynew + 1 + if (dynew.gt.mday(monew)) then + dynew = dynew - mday(monew) + monew = monew + 1 + if (monew .gt. 12) then + monew = 1 + yrnew = yrnew + 1 + ! If the year changes, recompute the number of days in February + mday(2) = nfeb(yrnew) + end if + end if + end do + + else if (idt.lt.0) then + + frnew = frold - nfrac + if (frnew .lt. 0) then + frnew = frnew + ifrc + nsec = nsec + 1 + end if + + scnew = scold - nsec + if (scnew .lt. 00) then + scnew = scnew + 60 + nmin = nmin + 1 + end if + + minew = miold - nmin + if (minew .lt. 00) then + minew = minew + 60 + nhour = nhour + 1 + end if + + hrnew = hrold - nhour + if (hrnew .lt. 00) then + hrnew = hrnew + 24 + nday = nday + 1 + end if + + dynew = dyold + monew = moold + yrnew = yrold + do i = 1, nday + dynew = dynew - 1 + if (dynew.eq.0) then + monew = monew - 1 + if (monew.eq.0) then + monew = 12 + yrnew = yrnew - 1 + ! If the year changes, recompute the number of days in February + mday(2) = nfeb(yrnew) + end if + dynew = mday(monew) + end if + end do + end if + +! Now construct the new mdate + + nlen = LEN(ndate) + + if (punctuated) then + + if (nlen.gt.20) then + write(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew + write(hfrc,'(i10)') frnew+1000000000 + ndate = ndate(1:19)//'.'//hfrc(31-nlen:10) + + else if (nlen.eq.19.or.nlen.eq.20) then + write(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew +19 format(i4,'-',i2.2,'-',i2.2,'_',i2.2,':',i2.2,':',i2.2) + if (nlen.eq.20) ndate = ndate(1:19)//'.' + + else if (nlen.eq.16) then + write(ndate,16) yrnew, monew, dynew, hrnew, minew +16 format(i4,'-',i2.2,'-',i2.2,'_',i2.2,':',i2.2) + + else if (nlen.eq.13) then + write(ndate,13) yrnew, monew, dynew, hrnew +13 format(i4,'-',i2.2,'-',i2.2,'_',i2.2) + + else if (nlen.eq.10) then + write(ndate,10) yrnew, monew, dynew +10 format(i4,'-',i2.2,'-',i2.2) + + end if + + if (olen.ge.11) ndate(11:11) = sp + + else + + if (nlen.gt.20) then + write(ndate(1:14),14) yrnew, monew, dynew, hrnew, minew, scnew + write(hfrc,'(i10)') frnew+1000000000 + ndate = ndate(1:18)//hfrc(31-nlen:10) + + else if (nlen.eq.14) then + write(ndate(1:14),14) yrnew, monew, dynew, hrnew, minew, scnew +14 format(i4,i2.2,i2.2,i2.2,i2.2,i2.2) + + else if (nlen.eq.12) then + write(ndate,12) yrnew, monew, dynew, hrnew, minew +12 format(i4,i2.2,i2.2,i2.2,i2.2) + + else if (nlen.eq.10) then + write(ndate,210) yrnew, monew, dynew, hrnew +210 format(i4,i2.2,i2.2,i2.2) + + else if (nlen.eq.8) then + write(ndate,8) yrnew, monew, dynew +8 format(i4,i2.2,i2.2) + + else + stop "DATELEN PROBLEM" + end if + endif + + end subroutine geth_newdate + + subroutine geth_idts (newdate, olddate, idt) + implicit none + +! From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'), +! compute the time difference. + +! on entry - newdate - the new hdate. +! olddate - the old hdate. + +! on exit - idt - the change in time. +! Units depend on length of date strings. + + character (len=*) , intent(in) :: newdate, olddate + integer , intent(out) :: idt + +! Local Variables + +! yrnew - indicates the year associated with "ndate" +! yrold - indicates the year associated with "odate" +! monew - indicates the month associated with "ndate" +! moold - indicates the month associated with "odate" +! dynew - indicates the day associated with "ndate" +! dyold - indicates the day associated with "odate" +! hrnew - indicates the hour associated with "ndate" +! hrold - indicates the hour associated with "odate" +! minew - indicates the minute associated with "ndate" +! miold - indicates the minute associated with "odate" +! scnew - indicates the second associated with "ndate" +! scold - indicates the second associated with "odate" +! i - loop counter +! mday - a list assigning the number of days in each month + +! ndate, odate: local values of newdate and olddate + character(len=24) :: ndate, odate + + character (len=24) :: tdate + integer :: olen, nlen + integer :: yrnew, monew, dynew, hrnew, minew, scnew, frnew + integer :: yrold, moold, dyold, hrold, miold, scold, frold + integer :: mday(12), i, newdys, olddys + logical :: npass, opass + integer :: isign + integer :: ifrc + + logical :: punctuated + + olen = len(olddate) + nlen = len(newdate) + if (nlen.ne.olen) then + write(*,'("GETH_IDTS: NLEN /= OLEN: ", A, 3x, A)') newdate(1:nlen), olddate(1:olen) + call abort + endif + + if (olddate.gt.newdate) then + isign = -1 + + ifrc = olen + olen = nlen + nlen = ifrc + + ndate = olddate + odate = newdate + else + isign = 1 + ndate = newdate + odate = olddate + end if + +! Assign the number of days in a months + + mday( 1) = 31 + mday( 2) = 28 + mday( 3) = 31 + mday( 4) = 30 + mday( 5) = 31 + mday( 6) = 30 + mday( 7) = 31 + mday( 8) = 31 + mday( 9) = 30 + mday(10) = 31 + mday(11) = 30 + mday(12) = 31 + +! Determine if the date is "punctuated" or just a string of numbers. + if ( odate(5:5) == "-") then + punctuated = .TRUE. + else + punctuated = .FALSE. + endif + + +! Break down old and new hdates into parts + + + hrold = 0 + miold = 0 + scold = 0 + frold = 0 + + hrnew = 0 + minew = 0 + scnew = 0 + frnew = 0 + + read(odate(1:4), '(i4)') yrold + read(ndate(1:4), '(i4)') yrnew + + if (punctuated) then + +! Break down old hdate into parts + + read(odate(6:7), '(i2)') moold + read(odate(9:10), '(i2)') dyold + if (olen.ge.13) then + read(odate(12:13),'(i2)') hrold + if (olen.ge.16) then + read(odate(15:16),'(i2)') miold + if (olen.ge.19) then + read(odate(18:19),'(i2)') scold + if (olen.gt.20) then + if (olen.eq.21) then + read(odate(21:21),'(i1)') frold + else if (olen.eq.22) then + read(odate(21:22),'(i2)') frold + else if (olen.eq.23) then + read(odate(21:23),'(i3)') frold + else if (olen.eq.24) then + read(odate(21:24),'(i4)') frold + endif + end if + end if + end if + end if + +! Break down new hdate into parts + + read(ndate(6:7), '(i2)') monew + read(ndate(9:10), '(i2)') dynew + if (nlen.ge.13) then + read(ndate(12:13),'(i2)') hrnew + if (nlen.ge.16) then + read(ndate(15:16),'(i2)') minew + if (nlen.ge.19) then + read(ndate(18:19),'(i2)') scnew + if (nlen.gt.20) then + read(ndate(21:nlen),*) frnew + end if + end if + end if + end if + else + +! Break down old hdate into parts + + read(odate(5:6), '(i2)') moold + read(odate(7:8), '(i2)') dyold + if (olen.ge.10) then + read(odate(9:10),'(i2)') hrold + if (olen.ge.12) then + read(odate(11:12),'(i2)') miold + if (olen.ge.14) then + read(odate(13:14),'(i2)') scold + if (olen.ge.15) then + read(odate(15:olen),*) frold + end if + end if + end if + end if + +! Break down new hdate into parts + + read(ndate(5:6), '(i2)') monew + read(ndate(7:8), '(i2)') dynew + if (nlen.ge.10) then + read(ndate(9:10),'(i2)') hrnew + if (nlen.ge.12) then + read(ndate(11:12),'(i2)') minew + if (nlen.ge.14) then + read(ndate(13:14),'(i2)') scnew + if (nlen.ge.15) then + read(ndate(15:nlen),*) frnew + end if + end if + end if + end if + endif + +! Check that the dates make sense. + + npass = .true. + opass = .true. + +! Check that the month of NDATE makes sense. + + if ((monew.gt.12).or.(monew.lt.1)) then + print*, 'GETH_IDTS: Month of NDATE = ', monew + npass = .false. + end if + +! Check that the month of ODATE makes sense. + + if ((moold.gt.12).or.(moold.lt.1)) then + print*, 'GETH_IDTS: Month of ODATE = ', moold + opass = .false. + end if + +! Check that the day of NDATE makes sense. + + if (monew.ne.2) then + ! ...... For all months but February + if ((dynew.gt.mday(monew)).or.(dynew.lt.1)) then + print*, 'GETH_IDTS: Day of NDATE = ', dynew + npass = .false. + end if + else if (monew.eq.2) then + ! ...... For February + if ((dynew > nfeb(yrnew)).or.(dynew < 1)) then + print*, 'GETH_IDTS: Day of NDATE = ', dynew + npass = .false. + end if + endif + +! Check that the day of ODATE makes sense. + + if (moold.ne.2) then + ! ...... For all months but February + if ((dyold.gt.mday(moold)).or.(dyold.lt.1)) then + print*, 'GETH_IDTS: Day of ODATE = ', dyold + opass = .false. + end if + else if (moold.eq.2) then + ! ....... For February + if ((dyold > nfeb(yrold)).or.(dyold < 1)) then + print*, 'GETH_IDTS: Day of ODATE = ', dyold + opass = .false. + end if + end if + +! Check that the hour of NDATE makes sense. + + if ((hrnew.gt.23).or.(hrnew.lt.0)) then + print*, 'GETH_IDTS: Hour of NDATE = ', hrnew + npass = .false. + end if + +! Check that the hour of ODATE makes sense. + + if ((hrold.gt.23).or.(hrold.lt.0)) then + print*, 'GETH_IDTS: Hour of ODATE = ', hrold + opass = .false. + end if + +! Check that the minute of NDATE makes sense. + + if ((minew.gt.59).or.(minew.lt.0)) then + print*, 'GETH_IDTS: Minute of NDATE = ', minew + npass = .false. + end if + +! Check that the minute of ODATE makes sense. + + if ((miold.gt.59).or.(miold.lt.0)) then + print*, 'GETH_IDTS: Minute of ODATE = ', miold + opass = .false. + end if + +! Check that the second of NDATE makes sense. + + if ((scnew.gt.59).or.(scnew.lt.0)) then + print*, 'GETH_IDTS: SECOND of NDATE = ', scnew + npass = .false. + end if + +! Check that the second of ODATE makes sense. + + if ((scold.gt.59).or.(scold.lt.0)) then + print*, 'GETH_IDTS: Second of ODATE = ', scold + opass = .false. + end if + + if (.not. npass) then + print*, 'Screwy NDATE: ', ndate(1:nlen) + call abort() + end if + + if (.not. opass) then + print*, 'Screwy ODATE: ', odate(1:olen) + call abort() + end if + +! Date Checks are completed. Continue. + +! Compute number of days from 1 January ODATE, 00:00:00 until ndate +! Compute number of hours from 1 January ODATE, 00:00:00 until ndate +! Compute number of minutes from 1 January ODATE, 00:00:00 until ndate + + newdys = 0 + do i = yrold, yrnew - 1 + newdys = newdys + 337 + nfeb(i) + end do + + if (monew .gt. 1) then + mday(2) = nfeb(yrnew) + do i = 1, monew - 1 + newdys = newdys + mday(i) + end do + mday(2) = 28 + end if + + newdys = newdys + dynew - 1 + +! Compute number of hours from 1 January ODATE, 00:00:00 until odate +! Compute number of minutes from 1 January ODATE, 00:00:00 until odate + + olddys = 0 + + if (moold .gt. 1) then + mday(2) = nfeb(yrold) + do i = 1, moold - 1 + olddys = olddys + mday(i) + end do + mday(2) = 28 + end if + + olddys = olddys + dyold -1 + +! Determine the time difference + + idt = (newdys - olddys) + if (punctuated) then + if (olen.gt.10) then + idt = idt*24 + (hrnew - hrold) + if (olen.gt.13) then + idt = idt*60 + (minew - miold) + if (olen.gt.16) then + idt = idt*60 + (scnew - scold) + if (olen.gt.20) then + ifrc = olen-20 + ifrc = 10**ifrc + idt = idt * ifrc + (frnew-frold) + endif + endif + endif + endif + else + if (olen.gt.8) then + idt = idt*24 + (hrnew - hrold) + if (olen.gt.10) then + idt = idt*60 + (minew - miold) + if (olen.gt.12) then + idt = idt*60 + (scnew - scold) + if (olen.gt.14) then + ifrc = olen-14 + ifrc = 10**ifrc + idt = idt * ifrc + (frnew-frold) + endif + endif + endif + endif + endif + + if (isign .eq. -1) then + idt = idt * isign + end if + + end subroutine geth_idts + + + integer function nfeb(year) +! +! Compute the number of days in February for the given year. +! + implicit none + integer, intent(in) :: year ! Four-digit year + + nfeb = 28 ! By default, February has 28 days ... + if (mod(year,4).eq.0) then + nfeb = 29 ! But every four years, it has 29 days ... + if (mod(year,100).eq.0) then + nfeb = 28 ! Except every 100 years, when it has 28 days ... + if (mod(year,400).eq.0) then + nfeb = 29 ! Except every 400 years, when it has 29 days ... + if (mod(year,3600).eq.0) then + nfeb = 28 ! Except every 3600 years, when it has 28 days. + endif + endif + endif + endif + end function nfeb + + integer function nmdays(hdate) +! +! Compute the number of days in the month of given date hdate. +! + implicit none + character(len=*), intent(in) :: hdate + + integer :: year, month + integer, dimension(12), parameter :: ndays = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) + + if (hdate(5:5) == "-") then + read(hdate(1:7), '(I4,1x,I2)') year, month + else + read(hdate(1:6), '(I4,I2)') year, month + endif + + if (month == 2) then + nmdays = nfeb(year) + else + nmdays = ndays(month) + endif + end function nmdays +end module kwm_date_utilities_50 diff --git a/lis/surfacemodels/land/noahmp.5.0/noahmp_driver_50.F90 b/lis/surfacemodels/land/noahmp.5.0/noahmp_driver_50.F90 new file mode 100644 index 000000000..5ecc59277 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/noahmp_driver_50.F90 @@ -0,0 +1,285 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +! Oct 15 2018 Shugong Wang started for implementing Noah-MP 4.0.1 based on the version of 3.6 +! Oct 15 2018 Zhuo Wang modifed for implementing Noah-MP 4.0.1 +! May 2023: Cenlin He modified for refactored Noah-MP v5 and later + +#undef LIS_NoahMP_TEST +! !INTERFACE +subroutine noahmp_driver_50(n, LISparam) + + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_logunit, LIS_endrun + use LIS_timeMgrMod, only : LIS_date2time, LIS_tick + use NoahmpIOVarType + use LisNoahmpParamType + use NoahmpDriverMainMod + + implicit none + integer, intent(in) :: n ! nest id + type(LisNoahmpParam_type), intent(in) :: LISparam ! lis/noahmp parameter + +!-------------------------------------------------------------------------------- + ! external function + real, external :: month_d_new + + ! local variables + character(len=12) :: nowdate + integer :: k + + ! Added by David Mocko on 11/19/2018 + logical :: Bondvillecheck + integer :: i,local_hour + integer :: locyr,locmo,locda,lochr,locmn,locss,locdoy + real*8 :: loctime + real :: locgmt,change + + ! --------------------------------------- + NoahmpIO%xland(1,1) = 1 + NoahmpIO%xice(1,1) = 0 + ! Fraction of grid determining seaice (from WRF and HRLDAS) + NoahmpIO%xice_threshold = 0.5 + +#ifndef WRF_HYDRO + NoahmpIO%sfcheadrt(1,1) = 0.0 +#endif +! SR = frozen precip fraction. For offline, it is set to zero. +! If running coupled to WRF, then SR is set by the WRF model. + if (NoahmpIO%IOPT_SNF .ne. 4) then + NoahmpIO%SR(1,1) = 0.0 + else + write(LIS_logunit,*) "[ERR] SR should be set by the WRF model." + write(LIS_logunit,*) "[ERR] Code needs fixing. Stopping LIS." + call LIS_endrun + endif + + !!!!! print all the options not supported in offline mode + if (NoahmpIO%IOPT_SFC > 2) then + stop "(opt_sfc == 3) and (opt_sfc == 4) are not for offline use" + endif + + + ! cosz, yearlen, and julian are calculated in subroutine calc_declin. + ! Be careful here!!!, LIS uses GMT; the date for calc_declin_401 should + ! be local time. Longitude is need to convert GMT into local time!!!. + ! This should only be done when using Bondville single_point forcing, + ! as the forcing file uses local time instead of GMT. + Bondvillecheck = .false. + do i=1,LIS_rc%nmetforc + if (trim(LIS_rc%metforc(i)).eq."Bondville") Bondvillecheck = .true. + enddo + +! For a true benchmark against the HRLDAS Noah-MP testcase +! from NCAR, set "change = -21600.0". This line allows the code +! to _incorrectly_ run in the same way as the HRLDAS testcase, +! which runs on local time instead of on UTC time. The changes +! is 6 hours * 3600.0 seconds per hour, to go from GMT to the +! Bondville location in Illinois, which uses Central time. + change = 0.0 + if (Bondvillecheck) change = -21600.0 + locyr = LIS_rc%yr + locmo = LIS_rc%mo + locda = LIS_rc%da + lochr = LIS_rc%hr + locmn = LIS_rc%mn + locss = LIS_rc%ss + + call LIS_date2time(loctime,locdoy,locgmt,locyr,locmo,locda,lochr,locmn,locss) + call LIS_tick(loctime,locdoy,locgmt,locyr,locmo,locda,lochr,locmn,locss,change) + + write(nowdate,'(I4.4,4I2.2)') locyr, locmo, locda, lochr, locmn + call calc_declin(nowdate(1:4)//"-"//nowdate(5:6)//"-"//nowdate(7:8)//"_"//nowdate(9:10)//":"//nowdate(11:12)//":00", & + NoahmpIO%xlat(1,1), NoahmpIO%xlon(1,1), NoahmpIO%coszen(1,1), NoahmpIO%yearlen, NoahmpIO%julian) + + read(nowdate(1:4), '(I4)') NoahmpIO%YR + + if ((NoahmpIO%IOPT_DVEG .eq. 1).or.(NoahmpIO%IOPT_DVEG .eq. 6).or.(NoahmpIO%IOPT_DVEG .eq. 7)) then + ! with dveg_opt==1/6/7, shdfac is fed directly to fveg + NoahmpIO%vegfra(1,1) = month_d_new(NoahmpIO%shdfac_monthly(1,:,1), nowdate) + else + ! with dveg_opt==2/3/8, fveg is computed from lai and sai, and shdfac is unused + ! with dveg_opt==4/5/9, fveg is set to the maximum shdfac, and shdfac is unused + NoahmpIO%vegfra(1,1) = -1.E36 ! To match with HRLDAS initialization + endif + NoahmpIO%gvfmax(1,1) = maxval(NoahmpIO%shdfac_monthly(1,:,1)) + + ! assign forcing variables + NoahmpIO%dz8w(1,2,1) = NoahmpIO%dz8w(1,1,1) + NoahmpIO%T_PHY(1,2,1) = NoahmpIO%T_PHY(1,1,1) + NoahmpIO%P8W(1,2,1) = NoahmpIO%P8W(1,1,1) + NoahmpIO%QV_CURR(1,1,1) = NoahmpIO%QV_CURR(1,1,1)/& + (1.0 - NoahmpIO%QV_CURR(1,1,1)) ! Convert specific humidity to water vapor mixing ratio + NoahmpIO%QV_CURR(1,2,1) = NoahmpIO%QV_CURR(1,1,1) + NoahmpIO%U_PHY(1,2,1) = NoahmpIO%U_PHY(1,1,1) + NoahmpIO%V_PHY(1,2,1) = NoahmpIO%V_PHY(1,1,1) + NoahmpIO%QSFC(1,1) = NoahmpIO%QV_CURR(1,1,1) + NoahmpIO%SNOWBL(1,1) = 0.0 + NoahmpIO%SR(1,1) = 0.0 ! Will only use component if opt_snf=4 + NoahmpIO%RAINCV(1,1) = 0.0 + NoahmpIO%RAINNCV(1,1) = NoahmpIO%RAINBL(1,1) + NoahmpIO%RAINSHV(1,1) = 0.0 + NoahmpIO%SNOWNCV(1,1) = NoahmpIO%SNOWBL(1,1) + NoahmpIO%GRAUPELNCV(1,1) = 0.0 + NoahmpIO%HAILNCV(1,1) = 0.0 + + ! If coupled to WRF, set these variables to realistic values, + ! and then pass back to WRF after the call to noahmp. + NoahmpIO%z0(1,1) = 0.0 + NoahmpIO%znt(1,1) = 0.0 + ! z0 and znt should be passed to WRF, if coupled. - dmm + + ! Code from module_NoahMP_hrldas_driver.F. Initial guess only. + if ((trim(LIS_rc%startcode).eq."coldstart").and.(NoahmpIO%itimestep.eq.1)) then + NoahmpIO%eahxy(1,1) = NoahmpIO%P8W(1,1,1) * (NoahmpIO%QV_CURR(1,1,1)/(0.622+NoahmpIO%QV_CURR(1,1,1))) + NoahmpIO%tahxy(1,1) = NoahmpIO%T_PHY(1,1,1) + NoahmpIO%cmxy(1,1) = 0.1 + NoahmpIO%chxy(1,1) = 0.1 + endif + + ! main NoahMP driver physics + call NoahmpDriverMain(NoahmpIO,LISparam) + +end subroutine noahmp_driver_50 + +real function month_d_new(a12, nowdate) result (nowval) + ! + ! Given a set of 12 values, taken to be valid on the fifteenth of each month (Jan through Dec) + ! and a date in the form .... + ! + ! Return a value valid for the day given in , as an interpolation from the 12 + ! monthly values. + ! + use kwm_date_utilities_50 + implicit none + real, dimension(12), intent(in) :: a12 ! 12 monthly values, taken to be valid on the 15th of + ! ! the month + character(len=12), intent(in) :: nowdate ! Date, in the form + integer :: nowy, nowm, nowd + integer :: prevm, postm + real :: factor + integer, dimension(12) :: ndays = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) + ! + ! Handle leap year by setting the number of days in February for the year in question. + ! + read(nowdate(1:8),'(I4,I2,I2)') nowy, nowm, nowd + ndays(2) = nfeb(nowy) + + ! + ! Do interpolation between the fifteenth of two successive months. + ! + if (nowd == 15) then + nowval = a12(nowm) + return + else if (nowd < 15) then + postm = nowm + prevm = nowm - 1 + if (prevm == 0) prevm = 12 + factor = real(ndays(prevm)-15+nowd)/real(ndays(prevm)) + else if (nowd > 15) then + prevm = nowm + postm = nowm + 1 + if (postm == 13) postm = 1 + factor = real(nowd-15)/real(ndays(prevm)) + endif + + nowval = a12(prevm)*(1.0-factor) + a12(postm)*factor + +end function month_d_new + +SUBROUTINE calc_declin ( nowdate, latitude, longitude, cosz, yearlen, julian) + use kwm_date_utilities_50 +!--------------------------------------------------------------------- + IMPLICIT NONE +!--------------------------------------------------------------------- + +! !ARGUMENTS: + character(len=19), intent(in) :: nowdate ! YYYY-MM-DD_HH:mm:ss + real, intent(in) :: latitude + real, intent(in) :: longitude + real, intent(out) :: cosz + integer, intent(out) :: yearlen + real, intent(out) :: JULIAN + + REAL :: hrang + real :: DECLIN + real :: GMT + real :: tloctim + REAL :: OBECL + REAL :: SINOB + REAL :: SXLONG + REAL :: ARG + integer :: iyear + integer :: iday + integer :: ihour + integer :: iminute + integer :: isecond + + REAL, PARAMETER :: DEGRAD = 3.14159265/180. + REAL, PARAMETER :: DPD = 360./365. + + ! + ! Determine the number of days in the year + ! + + read(nowdate(1:4), '(I4)') iyear + yearlen = 365 + if (mod(iyear,4) == 0) then + yearlen = 366 + if (mod(iyear,100) == 0) then + yearlen = 365 + if (mod(iyear,400) == 0) then + yearlen = 366 + if (mod(iyear,3600) == 0) then + yearlen = 365 + endif + endif + endif + endif + + ! + ! Determine the Julian time (floating-point day of year). + ! + + call geth_idts(nowdate(1:10), nowdate(1:4)//"-01-01", iday) + read(nowdate(12:13), *) ihour + read(nowdate(15:16), *) iminute + read(nowdate(18:19), *) isecond + GMT = REAL(IHOUR) + IMINUTE/60.0 + ISECOND/3600.0 + JULIAN = REAL(IDAY) + GMT/24. + +! for short wave radiation + + DECLIN=0. + +!-----OBECL : OBLIQUITY = 23.5 DEGREE. + + OBECL=23.5*DEGRAD + SINOB=SIN(OBECL) + +!-----CALCULATE LONGITUDE OF THE SUN FROM VERNAL EQUINOX: + + IF(JULIAN.GE.80.)SXLONG=DPD*(JULIAN-80.)*DEGRAD + IF(JULIAN.LT.80.)SXLONG=DPD*(JULIAN+285.)*DEGRAD + ARG=SINOB*SIN(SXLONG) + DECLIN=ASIN(ARG) + + TLOCTIM = REAL(IHOUR) + REAL(IMINUTE)/60.0 + REAL(ISECOND)/3600.0 + LONGITUDE/15.0 ! Local time in hours + tloctim = AMOD(tloctim+24.0, 24.0) + HRANG=15.*(TLOCTIM-12.)*DEGRAD + COSZ=SIN(LATITUDE*DEGRAD)*SIN(DECLIN)+COS(LATITUDE*DEGRAD)*COS(DECLIN)*COS(HRANG) + COSZ=MIN(COSZ,1.0); !Added by kwH 3/1/16 to address floating point roundoff errors + COSZ=MAX(COSZ,-1.0); ! + +!KWM write(wrf_err_message,10)DECDEG/DEGRAD +!KWM10 FORMAT(1X,'*** SOLAR DECLINATION ANGLE = ',F6.2,' DEGREES.',' ***') +!KWM CALL wrf_debug (50, wrf_err_message) + +END SUBROUTINE calc_declin + diff --git a/lis/surfacemodels/land/noahmp.5.0/pe/NoahMP50_peMod.F90 b/lis/surfacemodels/land/noahmp.5.0/pe/NoahMP50_peMod.F90 new file mode 100755 index 000000000..e6531c539 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/pe/NoahMP50_peMod.F90 @@ -0,0 +1,715 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +module NoahMP50_peMod +!BOP +! +! !MODULE: NoahMP50_peMod +! +! !DESCRIPTION: +! This module contains the definitions of the NoahMP.4.0.1 model parameters +! used in parameter estimation. The data structure is used to expose +! the LSM parameters to be used in opt/ue. +! +! !REVISION HISTORY: +! 27 Apr 2020; Sujay Kumar, Initial Code +! May 2023: Cenlin He, modified for refactored NoahMP v5 and later +! !USES: + use ESMF + use LIS_numerRecipesMod, only : LIS_rand_func + use LIS_constantsMod, only : LIS_CONST_PATH_LEN + + implicit none + + PRIVATE +!----------------------------------------------------------------------------- +! !PUBLIC MEMBER FUNCTIONS: +!----------------------------------------------------------------------------- + public :: NoahMP50_setup_pedecvars +!----------------------------------------------------------------------------- +! !PUBLIC TYPES: +!----------------------------------------------------------------------------- + public :: NoahMP50_pe_struc + +!EOP + type, public :: NoahMP50_pe_dec + integer :: nparams + character*40, allocatable :: param_name(:) + integer , allocatable :: param_select(:) + real , allocatable :: param_min(:) + real , allocatable :: param_max(:) + end type NoahMP50_pe_dec + + type(NoahMP50_pe_dec), allocatable :: NoahMP50_pe_struc(:) + + SAVE +contains + +!BOP +! !ROUTINE: NoahMP50_setup_pedecvars +! \label{NoahMP50_setup_pedecvars} +! +! !REVISION HISTORY: +! 02 Feb 2018: Soni Yatheendradas; Initial Specification +! May 2023: Cenlin He, modified for refactored NoahMP v5 and later +! +! !INTERFACE: + subroutine NoahMP50_setup_pedecvars(DEC_State, Feas_State) +! !USES: + use LIS_coreMod + use LIS_logMod + use NoahMP50_lsmMod, only : NoahMP50_struc + + implicit none +! !ARGUMENTS: + character(len=LIS_CONST_PATH_LEN) :: decSpaceAttribsFile + type(ESMF_State) :: DEC_State + type(ESMF_State) :: Feas_State + +! +! !DESCRIPTION: +! +! This routine determines the list of parameters to be used in parameter +! estimation, initializes them, and updates the LIS decision space. +! +!EOP + + integer :: n + type(ESMF_ArraySpec) :: arrspec1 + type(ESMF_Field) :: varField + type(ESMF_Field) :: feasField + real, pointer :: vardata(:) + integer, pointer :: mod_flag(:) + integer :: i,t,m + integer :: status + integer, parameter :: seed_base=-1000 + integer :: seed + real :: rand + integer :: NT + character*100 :: vname + integer :: count + integer :: gid + + call ESMF_StateGet(Feas_State, "Feasibility Flag", feasField, rc=status) + call LIS_verify(status) + call ESMF_FieldGet(feasField,localDE=0,farrayPtr=mod_flag,rc=status) + call LIS_verify(status) + + call ESMF_ConfigGetAttribute(LIS_config,decSpaceAttribsFile,& + label="LSM Decision space attributes file:",rc=status) + call LIS_verify(status, "LSM Decision space attributes file: not defined") + + allocate(NoahMP50_pe_struc(LIS_rc%nnest)) + n = 1 + NoahMP50_pe_struc(n)%nparams = 76 + + allocate(NoahMP50_pe_struc(n)%param_name(NoahMP50_pe_struc(n)%nparams)) + allocate(NoahMP50_pe_struc(n)%param_select(NoahMP50_pe_struc(n)%nparams)) + allocate(NoahMP50_pe_struc(n)%param_min(NoahMP50_pe_struc(n)%nparams)) + allocate(NoahMP50_pe_struc(n)%param_max(NoahMP50_pe_struc(n)%nparams)) + + ! read the attributes file. + call LIS_readPEDecSpaceAttributes(decSpaceAttribsFile, & + NoahMP50_pe_struc(n)%nparams, & + NoahMP50_pe_struc(n)%param_name, & + NoahMP50_pe_struc(n)%param_select, & + NoahMP50_pe_struc(n)%param_min, & + NoahMP50_pe_struc(n)%param_max) + + call ESMF_ArraySpecSet(arrspec1,rank=1,typekind=ESMF_TYPEKIND_R4,& + rc=status) + call LIS_verify(status) + + do i=1,NoahMP50_pe_struc(n)%nparams + if(NoahMP50_pe_struc(n)%param_select(i).eq.1) then + vname=trim(NoahMP50_pe_struc(n)%param_name(i)) + varField = ESMF_FieldCreate(arrayspec=arrspec1, & + grid=LIS_vecPatch(n,LIS_rc%lsm_index),& + name=vname,& + rc=status) + call LIS_verify(status, & + 'problem with fieldcreate in NoahMP50_setup_pedecvars') + call ESMF_AttributeSet(varField,'MinRange',& + NoahMP50_pe_struc(n)%param_min(i),rc=status) + call LIS_verify(status, & + 'setting minrange to decspace obj in NoahMP50_setup_devars') + call ESMF_AttributeSet(varField,'MaxRange',& + NoahMP50_pe_struc(n)%param_max(i),rc=status) + call LIS_verify(status, & + 'setting maxrange to decspace obj in NoahMP50_setup_devars') + + call ESMF_StateAdd(DEC_State,(/varField/),rc=status) + call LIS_verify(status,& + 'stateadd in NoahMP50_setup_pedecvars') + + call ESMF_StateGet(DEC_State,vname,varField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(varField,localDE=0,farrayPtr=vardata,& + rc=status) + call LIS_verify(status) + + !Put in vardata(:) the noah value + + NT=LIS_rc%npatch(n,LIS_rc%lsm_index) + if(vname.eq."TOPT") then + do t=1,NT; vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%topt + enddo + endif + + if(vname.eq."RGL") then + do t=1,NT; vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%rgl + enddo + endif + if(vname.eq."RSMAX") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%rsmax + enddo + endif + if(vname.eq."RSMIN") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%rsmin + enddo + endif + if(vname.eq."HS") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%hs + enddo + endif + + if(vname.eq."NROOT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%nroot + enddo + endif + if(vname.eq."CSOIL") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%csoil + enddo + endif + + if(vname.eq."BEXP") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%bexp(1) + enddo + endif + + if(vname.eq."DKSAT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%dksat(1) + enddo + endif + + if(vname.eq."DWSAT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%dwsat(1) + enddo + endif + + if(vname.eq."PSISAT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%psisat(1) + enddo + endif + + if(vname.eq."QUARTZ") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%quartz(1) + enddo + endif + + if(vname.eq."SMCMAX") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%smcmax(1) + enddo + endif + + if(vname.eq."SMCREF") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%smcref(1) + enddo + endif + + if(vname.eq."SMCWLT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%smcwlt(1) + enddo + endif + + if(vname.eq."CZIL") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%czil + enddo + endif + + + if(vname.eq."SLOPE") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%slope + enddo + endif + + if(vname.eq."CH2OP") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%CH2OP + enddo + endif + + if(vname.eq."DLEAF") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%DLEAF + enddo + endif + + if(vname.eq."Z0MVT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%Z0MVT + enddo + endif + + if(vname.eq."HVT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%HVT + enddo + endif + + if(vname.eq."HVB") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%HVB + enddo + endif + if(vname.eq."RC") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%RC + enddo + endif + if(vname.eq."MFSNO") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%mfsno + enddo + endif + if(vname.eq."ALBSAT1") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%albsat(1) + enddo + endif + if(vname.eq."ALBSAT2") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%albsat(2) + enddo + endif + if(vname.eq."ALBDRY1") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%albdry(1) + enddo + endif + if(vname.eq."ALBDRY2") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%albdry(2) + enddo + endif + if(vname.eq."ALBICE1") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%albice(1) + enddo + endif + if(vname.eq."ALBICE2") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%albice(2) + enddo + endif + if(vname.eq."OMEGAS1") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%omegas(1) + enddo + endif + if(vname.eq."OMEGAS2") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%omegas(2) + enddo + endif + if(vname.eq."BETADS") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%betads + enddo + endif + if(vname.eq."BETAIS") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%betais + enddo + endif + if(vname.eq."EG1") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%eg(1) + enddo + endif + if(vname.eq."EG2") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%eg(2) + enddo + endif + if(vname.eq."EG2") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%eg(2) + enddo + endif + if(vname.eq."Z0SNO") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%z0sno + enddo + endif + if(vname.eq."SSI") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%ssi + enddo + endif + if(vname.eq."SWEMX") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%swemx + enddo + endif + if(vname.eq."RSURF_SNOW") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%rsurf_snow + enddo + endif + if(vname.eq."MNSNALB") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%mnsnalb + enddo + endif + if(vname.eq."MXSNALB") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%mxsnalb + enddo + endif + if(vname.eq."SNDECAYEXP") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%sndecayexp + enddo + endif + + if(vname.eq."T_ULIMIT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%t_ulimit + enddo + endif + + if(vname.eq."T_LLIMIT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%t_llimit + enddo + endif + + if(vname.eq."T_MLIMIT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%t_mlimit + enddo + endif + + if(vname.eq."SNOWF_SCALEF") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%snowf_scalef + enddo + endif + + if(vname.eq."RHOL1") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%RHOL(1) + enddo + endif + + if(vname.eq."RHOL2") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%RHOL(2) + enddo + endif + + if(vname.eq."RHOS1") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%RHOS(1) + enddo + endif + + if(vname.eq."RHOS2") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%RHOS(2) + enddo + endif + + if(vname.eq."TAUL1") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%TAUL(1) + enddo + endif + + if(vname.eq."TAUL2") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%TAUL(2) + enddo + endif + + if(vname.eq."TAUS1") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%TAUS(1) + enddo + endif + + if(vname.eq."TAUS2") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%TAUS(2) + enddo + endif + + if(vname.eq."XL") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%XL + enddo + endif + + if(vname.eq."CWPVT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%CWPVT + enddo + endif + + if(vname.eq."C3PSN") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%C3PSN + enddo + endif + + if(vname.eq."KC25") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%KC25 + enddo + endif + + if(vname.eq."AKC") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%AKC + enddo + endif + + if(vname.eq."KO25") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%KO25 + enddo + endif + + if(vname.eq."AKO") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%AKO + enddo + endif + + if(vname.eq."AVCMX") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%AVCMX + enddo + endif + + if(vname.eq."AQE") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%AQE + enddo + endif + + if(vname.eq."LTOVRC") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%LTOVRC + enddo + endif + + if(vname.eq."DILEFC") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%DILEFC + enddo + endif + + if(vname.eq."DILEFW") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%DILEFW + enddo + endif + + if(vname.eq."RMF25") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%RMF25 + enddo + endif + + if(vname.eq."SLA") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%SLA + enddo + endif + + if(vname.eq."FRAGR") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%FRAGR + enddo + endif + + if(vname.eq."TMIN") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%TMIN + enddo + endif + + if(vname.eq."VCMX25") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%VCMX25 + enddo + endif + + if(vname.eq."TDLEF") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%TDLEF + enddo + endif + + if(vname.eq."BP") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%BP + enddo + endif + + if(vname.eq."MP") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%MP + enddo + endif + + if(vname.eq."QE25") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%QE25 + enddo + endif + + if(vname.eq."RMS25") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%RMS25 + enddo + endif + + if(vname.eq."RMR25") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%RMR25 + enddo + endif + + if(vname.eq."ARM") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%ARM + enddo + endif + + if(vname.eq."FOLNMX") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%FOLNMX + enddo + endif + + if(vname.eq."WDPOOL") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%WDPOOL + enddo + endif + + if(vname.eq."WRRAT") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%WRRAT + enddo + endif + + if(vname.eq."MRP") then + do t=1,NT + vardata(t) = NoahMP50_struc(n)%noahmp50(t)%param%MRP + enddo + endif + + !Test whether any defaults are out of bounds + count=0 + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index)/LIS_rc%nensem(n) + do m=1,LIS_rc%nensem(n) + gid=(t-1)*LIS_rc%nensem(n)+m + if( (m.eq.1) & + .and. & + (count.eq.0) & + .and. & + ((vardata(gid) .lt. NoahMP50_pe_struc(n)%param_min(i)) & + .or. & + (vardata(gid) .gt. NoahMP50_pe_struc(n)%param_max(i))) ) then + count=count+1 + write(LIS_logunit,*) '*****************************************************************', ' ', & + 'WARNING: noah default value is out of LIS-OPT/UE bounds ' , ' ', & + 'for ', vname , ' ', & + 'at ' , ' ', & + 'col: ', LIS_surface(n,LIS_rc%lsm_index)%tile(gid)%col , ' ', & + 'row: ', LIS_surface(n,LIS_rc%lsm_index)%tile(gid)%row , ' ', & + 'vegt class: ', NoahMP50_struc(n)%noahmp50(gid)%vegetype , ' ', & + 'soiltype: ', NoahMP50_struc(n)%noahmp50(gid)%soiltype , ' ', & + 'default value: ', vardata(gid) , ' ', & + 'parameter min: ', NoahMP50_pe_struc(n)%param_min(i) , ' ', & + 'parameter max: ', NoahMP50_pe_struc(n)%param_max(i) , ' ', & + '*****************************************************************' + + endif + enddo + enddo + endif ! if(NoahMP50_pe_struc(n)%param_select(i).eq.1) then + enddo ! do i=1,NoahMP50_pe_struc(n)%nparams + + !random initialization + if(LIS_rc%decSpaceInitMode.eq.1) then !random initialization + seed=seed_base-LIS_localPet !seed must be negative number + call LIS_rand_func(seed,rand) !initialize random seed with negative number + + do i=1,NoahMP50_pe_struc(n)%nparams + if(NoahMP50_pe_struc(n)%param_select(i).eq.1) then + vname=trim(NoahMP50_pe_struc(n)%param_name(i)) + + call ESMF_StateGet(DEC_State,vname,varField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(varField,localDE=0,farrayPtr=vardata,& + rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index)/LIS_rc%nensem(n) + do m=1,LIS_rc%nensem(n) + if (m.eq.1) then + !nothing; leave ensemble 1 with default values + else + call LIS_rand_func(1,rand) + vardata((t-1)*LIS_rc%nensem(n)+m) = & + NoahMP50_pe_struc(n)%param_min(i) & + + rand * ( NoahMP50_pe_struc(n)%param_max(i) - NoahMP50_pe_struc(n)%param_min(i) ) + endif + enddo + enddo + if(vname.eq."NROOT") then !integer value + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index)/LIS_rc%nensem(n) + do m=1,LIS_rc%nensem(n) + vardata((t-1)*LIS_rc%nensem(n)+m) = & + nint(vardata((t-1)*LIS_rc%nensem(n)+m)) + enddo + enddo + + endif + endif + enddo + endif + + write(LIS_logunit,*) '[INFO] Finished setting up Noah-MP.5.0 decision space ' + end subroutine NoahMP50_setup_pedecvars + +end module NoahMP50_peMod diff --git a/lis/surfacemodels/land/noahmp.5.0/pe/NoahMP50_set_pedecvars.F90 b/lis/surfacemodels/land/noahmp.5.0/pe/NoahMP50_set_pedecvars.F90 new file mode 100755 index 000000000..7298c28b0 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/pe/NoahMP50_set_pedecvars.F90 @@ -0,0 +1,524 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_set_pedecvars +! \label{NoahMP50_set_pedecvars} +! +! !REVISION HISTORY: +! 02 Feb 2018: Soni Yatheendradas; Initial Specification +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! + + +! !INTERFACE: +subroutine NoahMP50_set_pedecvars(DEC_State, Feas_State) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_surface + use LIS_logMod, only : LIS_logunit,LIS_verify + use NoahMP50_lsmMod, only : NoahMP50_struc + use NoahMP50_peMod, only : NoahMP50_pe_struc + + implicit none +! !ARGUMENTS: + type(ESMF_State) :: DEC_State + type(ESMF_State) :: Feas_State +! +! !DESCRIPTION: +! +! This routine assigns the decision space to NoahMP model variables. +! +!EOP + integer :: n + real, pointer :: vdata(:) + character*100 :: vname + integer, pointer :: mod_flag_NoahMP50(:) + integer :: i,t + integer :: status + + n = 1 + + allocate(mod_flag_NoahMP50(LIS_rc%npatch(n,LIS_rc%lsm_index))) + + mod_flag_NoahMP50 = 0 + + !set modflag based on bounds + allocate(vdata(LIS_rc%npatch(n,LIS_rc%lsm_index))) + do i=1,NoahMP50_pe_struc(n)%nparams + if(NoahMP50_pe_struc(n)%param_select(i).eq.1) then + vname=trim(NoahMP50_pe_struc(n)%param_name(i)) + call NoahMP50_getvardata(n,DEC_State,vname, vdata, status) + call LIS_verify(status) + call NoahMP50_checkBounds(n,DEC_State,vname, vdata, mod_flag_NoahMP50) + endif + enddo + deallocate(vdata) + + !update modflags based on constraints + call NoahMP50_checkConstraints(n,DEC_State, mod_flag_NoahMP50) + + !set variables given modflag; if flag set will leave values alone + call NoahMP50_setVars(n,DEC_State,mod_flag_NoahMP50) + + !send mod flag to ESMF state (feasibility flag) + call NoahMP50_setModFlag(n,DEC_State,Feas_State,mod_flag_NoahMP50) +end subroutine NoahMP50_set_pedecvars + +!BOP +! +! !ROUTINE: randArray +! \label{randArray} +! +! !INTERFACE: +subroutine NoahMP50_getvardata(n,DEC_State,vname, vdata, statusStateGet) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_logMod, only : LIS_logunit,LIS_verify + + implicit none +! !ARGUMENTS: + integer :: n + type(ESMF_State) :: DEC_State + character*100 :: vname + real :: vdata(LIS_rc%npatch(n,LIS_rc%lsm_index)) +! +! !DESCRIPTION: +! +! This routine assigns the decision space to NoahMP model variables. +! +!EOP + real, pointer :: vardata(:) + type(ESMF_Field) :: varField + integer :: statusStateGet, statusFieldGet,i + + call ESMF_StateGet(DEC_State,vname,varField,rc=statusStateGet) +! call LIS_verify(status) + + if(statusStateGet.eq.0) then + call ESMF_FieldGet(varField,localDE=0,farrayPtr=vardata,& + rc=statusFieldGet) + call LIS_verify(statusFieldGet) + vdata=vardata + endif + +end subroutine NoahMP50_getvardata + +subroutine NoahMP50_checkBounds(n,DEC_State,vname, vardata, mod_flag_NoahMP50) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_surface + use LIS_logMod, only : LIS_logunit,LIS_verify + + implicit none +! !ARGUMENTS: + integer :: n + type(ESMF_State) :: DEC_State + character*100 :: vname + real :: vardata(LIS_rc%npatch(n,LIS_rc%lsm_index)) + integer :: mod_flag_NoahMP50(LIS_rc%npatch(n,LIS_rc%lsm_index)) +! +! !DESCRIPTION: +! +! This routine assigns the decision space to NoahMP model variables. +! +!EOP + type(ESMF_Field) :: varField + real :: vardata_min, vardata_max + integer :: status + integer :: t + + call ESMF_StateGet(DEC_State,vname,varField,rc=status) + call LIS_verify(status) + + call ESMF_AttributeGet(varField,'MinRange',vardata_min,rc=status) + call LIS_verify(status) + call ESMF_AttributeGet(varField,'MaxRange',vardata_max,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if(vardata(t).lt.vardata_min) then + mod_flag_NoahMP50(t) = 1 + endif + if(vardata(t).gt.vardata_max) then + mod_flag_NoahMP50(t) = 1 + endif + enddo +end subroutine NoahMP50_checkBounds + +subroutine NoahMP50_checkConstraints(n,DEC_State,mod_flag_NoahMP50) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_surface + use NoahMP50_lsmMod, only : NoahMP50_struc + + implicit none +! !ARGUMENTS: + integer :: n + type(ESMF_State) :: DEC_State + integer :: mod_flag_NoahMP50(LIS_rc%npatch(n,LIS_rc%lsm_index)) +! +! !DESCRIPTION: +! +! This routine assigns the decision space to NoahMP model variables. +! +!EOP + type(ESMF_Field) :: varField + real :: vardata_min, vardata_max + character*100 :: vname + integer :: t + integer :: status1, status2 + real, allocatable :: vardata1(:) + real, allocatable :: vardata2(:) + real, allocatable :: vardata3(:) + + allocate(vardata1(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(vardata2(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(vardata3(LIS_rc%npatch(n,LIS_rc%lsm_index))) + + vname='SMCMAX' + call NoahMP50_getvardata(n,DEC_State,vname,vardata1, status1) + + if(status1.ne.0) vardata1=NoahMP50_struc(n)%noahmp50(:)%param%smcmax(1) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if(vardata1(t).le.NoahMP50_struc(n)%noahmp50(t)%param%smcdry(1)) then + mod_flag_NoahMP50(t) = 1 + endif + enddo + + !SMCREF > SMCWLT + vname='SMCREF' + call NoahMP50_getvardata(n,DEC_State,vname,vardata1, status1) + vname='SMCWLT' + call NoahMP50_getvardata(n,DEC_State,vname,vardata2, status2) + if(status1.ne.0) vardata1=NoahMP50_struc(n)%noahmp50(:)%param%smcref(1) + if(status2.ne.0) vardata2=NoahMP50_struc(n)%noahmp50(:)%param%smcwlt(1) + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if(vardata1(t).le.vardata2(t)) then + mod_flag_NoahMP50(t) = 1 + endif + enddo + + !SMCMAX > SMCREF + vname='SMCMAX' + call NoahMP50_getvardata(n,DEC_State,vname,vardata1, status1) + vname='SMCREF' + call NoahMP50_getvardata(n,DEC_State,vname,vardata2, status2) + if(status1.ne.0) vardata1=NoahMP50_struc(n)%noahmp50(:)%param%smcmax(1) + if(status2.ne.0) vardata2=NoahMP50_struc(n)%noahmp50(:)%param%smcref(1) + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if(vardata1(t).le.vardata2(t)) then + mod_flag_NoahMP50(t) = 1 + endif + enddo + + !HVT > HVB + vname='HVT' + call NoahMP50_getvardata(n,DEC_State,vname,vardata1, status1) + vname='HVB' + call NoahMP50_getvardata(n,DEC_State,vname,vardata2, status2) + if(status1.ne.0) vardata1=NoahMP50_struc(n)%noahmp50(:)%param%HVT + if(status2.ne.0) vardata2=NoahMP50_struc(n)%noahmp50(:)%param%HVB + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if(vardata1(t).lt.vardata2(t)) then ! SY: Note .lt. instead of .le., following some entries with HVT=HVB in MPTABLE_UMD.TBL + mod_flag_NoahMP50(t) = 1 + endif + enddo + + !HVT > Z0MVT + vname='HVT' + call NoahMP50_getvardata(n,DEC_State,vname,vardata1, status1) + vname='Z0MVT' + call NoahMP50_getvardata(n,DEC_State,vname,vardata2, status2) + if(status1.ne.0) vardata1=NoahMP50_struc(n)%noahmp50(:)%param%HVT + if(status2.ne.0) vardata2=NoahMP50_struc(n)%noahmp50(:)%param%Z0MVT + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if(vardata1(t).le.vardata2(t)) then + mod_flag_NoahMP50(t) = 1 + endif + enddo + + + !HVT > Z0MVT + vname='MNSNALB' + call NoahMP50_getvardata(n,DEC_State,vname,vardata1, status1) + vname='MXSNALB' + call NoahMP50_getvardata(n,DEC_State,vname,vardata2, status2) + if(status1.ne.0) vardata1=NoahMP50_struc(n)%noahmp50(:)%param%MNSNALB + if(status2.ne.0) vardata2=NoahMP50_struc(n)%noahmp50(:)%param%MXSNALB + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if(vardata1(t).ge.vardata2(t)) then + mod_flag_NoahMP50(t) = 1 + endif + enddo + + !HVT > Z0MVT + vname='T_ULIMIT' + call NoahMP50_getvardata(n,DEC_State,vname,vardata1, status1) + vname='T_MLIMIT' + call NoahMP50_getvardata(n,DEC_State,vname,vardata2, status2) + vname='T_LLIMIT' + call NoahMP50_getvardata(n,DEC_State,vname,vardata3, status2) + if(status1.ne.0) vardata1=NoahMP50_struc(n)%noahmp50(:)%param%T_ULIMIT + if(status2.ne.0) vardata2=NoahMP50_struc(n)%noahmp50(:)%param%T_MLIMIT + if(status2.ne.0) vardata3=NoahMP50_struc(n)%noahmp50(:)%param%T_LLIMIT + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if((vardata3(t).gt.vardata2(t)).or.& + (vardata2(t).gt.vardata1(t)).or.& + (vardata3(t).gt.vardata1(t))) then + mod_flag_NoahMP50(t) = 1 + endif + enddo + + deallocate(vardata1) + deallocate(vardata2) + deallocate(vardata3) + +end subroutine NoahMP50_checkConstraints + +subroutine NoahMP50_setVars(n,DEC_State,mod_flag_NoahMP50) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_surface + use LIS_logMod, only : LIS_logunit,LIS_verify + use NoahMP50_lsmMod, only : NoahMP50_struc + use NoahMP50_peMod, only : NoahMP50_pe_struc + + implicit none +! !ARGUMENTS: + integer :: n + integer :: mod_flag_NoahMP50(LIS_rc%npatch(n,LIS_rc%lsm_index)) + type(ESMF_State) :: DEC_State +! +! !DESCRIPTION: +! +! This routine assigns the decision space to NoahMP model variables. +! Only does so if the proposed parameter set is feasible (meets bounds and constraints) +! +!EOP + real :: vardata(LIS_rc%npatch(n,LIS_rc%lsm_index)) + character*100 :: vname + integer :: i,t, status + + do i=1,NoahMP50_pe_struc(n)%nparams + if(NoahMP50_pe_struc(n)%param_select(i).eq.1) then + vname=trim(NoahMP50_pe_struc(n)%param_name(i)) + call NoahMP50_getvardata(n,DEC_State,vname,vardata, status) + call LIS_verify(status) + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if(mod_flag_NoahMP50(t).eq.0) then + if(vname.eq."TOPT") & + NoahMP50_struc(n)%noahmp50(t)%param%topt = vardata(t) + if(vname.eq."RGL") & + NoahMP50_struc(n)%noahmp50(t)%param%rgl = vardata(t) + if(vname.eq."RSMAX") & + NoahMP50_struc(n)%noahmp50(t)%param%rsmax = vardata(t) + if(vname.eq."RSMIN") & + NoahMP50_struc(n)%noahmp50(t)%param%rsmin = vardata(t) + if(vname.eq."HS") & + NoahMP50_struc(n)%noahmp50(t)%param%hs = vardata(t) + if(vname.eq."NROOT") & + NoahMP50_struc(n)%noahmp50(t)%param%nroot = vardata(t) + if(vname.eq."CSOIL") & + NoahMP50_struc(n)%noahmp50(t)%param%csoil = vardata(t) + if(vname.eq."BEXP") & + NoahMP50_struc(n)%noahmp50(t)%param%bexp = vardata(t) + if(vname.eq."DKSAT") & + NoahMP50_struc(n)%noahmp50(t)%param%dksat = vardata(t) + if(vname.eq."DWSAT") & + NoahMP50_struc(n)%noahmp50(t)%param%dwsat = vardata(t) + if(vname.eq."PSISAT") & + NoahMP50_struc(n)%noahmp50(t)%param%psisat = vardata(t) + if(vname.eq."QUARTZ") & + NoahMP50_struc(n)%noahmp50(t)%param%quartz = vardata(t) + if(vname.eq."SMCMAX") & + NoahMP50_struc(n)%noahmp50(t)%param%smcmax = vardata(t) + if(vname.eq."SMCREF") & + NoahMP50_struc(n)%noahmp50(t)%param%smcref = vardata(t) + if(vname.eq."SMCWLT") & + NoahMP50_struc(n)%noahmp50(t)%param%smcwlt = vardata(t) + if(vname.eq."CZIL") & + NoahMP50_struc(n)%noahmp50(t)%param%czil = vardata(t) + if(vname.eq."SLOPE") & + NoahMP50_struc(n)%noahmp50(t)%param%slope = vardata(t) + if(vname.eq."CH2OP") & + NoahMP50_struc(n)%noahmp50(t)%param%CH2OP = vardata(t) + if(vname.eq."DLEAF") & + NoahMP50_struc(n)%noahmp50(t)%param%DLEAF = vardata(t) + if(vname.eq."Z0MVT") & + NoahMP50_struc(n)%noahmp50(t)%param%Z0MVT = vardata(t) + if(vname.eq."HVT") & + NoahMP50_struc(n)%noahmp50(t)%param%HVT = vardata(t) + if(vname.eq."HVB") & + NoahMP50_struc(n)%noahmp50(t)%param%HVB = vardata(t) + if(vname.eq."RC") & + NoahMP50_struc(n)%noahmp50(t)%param%RC = vardata(t) + if(vname.eq."MFSNO") & + NoahMP50_struc(n)%noahmp50(t)%param%MFSNO = vardata(t) + if(vname.eq."ALBSAT1") & + NoahMP50_struc(n)%noahmp50(t)%param%ALBSAT(1) = vardata(t) + if(vname.eq."ALBSAT2") & + NoahMP50_struc(n)%noahmp50(t)%param%ALBSAT(2) = vardata(t) + if(vname.eq."ALBDRY1") & + NoahMP50_struc(n)%noahmp50(t)%param%ALBDRY(1) = vardata(t) + if(vname.eq."ALBDRY2") & + NoahMP50_struc(n)%noahmp50(t)%param%ALBDRY(2) = vardata(t) + if(vname.eq."ALBICE1") & + NoahMP50_struc(n)%noahmp50(t)%param%ALBICE(1) = vardata(t) + if(vname.eq."ALBICE2") & + NoahMP50_struc(n)%noahmp50(t)%param%ALBICE(2) = vardata(t) + if(vname.eq."OMEGAS1") & + NoahMP50_struc(n)%noahmp50(t)%param%OMEGAS(1) = vardata(t) + if(vname.eq."OMEGAS2") & + NoahMP50_struc(n)%noahmp50(t)%param%OMEGAS(2) = vardata(t) + if(vname.eq."BETADS") & + NoahMP50_struc(n)%noahmp50(t)%param%BETADS = vardata(t) + if(vname.eq."BETAIS") & + NoahMP50_struc(n)%noahmp50(t)%param%BETAIS = vardata(t) + if(vname.eq."EG1") & + NoahMP50_struc(n)%noahmp50(t)%param%EG(1) = vardata(t) + if(vname.eq."EG2") & + NoahMP50_struc(n)%noahmp50(t)%param%EG(2) = vardata(t) + if(vname.eq."Z0SNO") & + NoahMP50_struc(n)%noahmp50(t)%param%Z0SNO = vardata(t) + if(vname.eq."SSI") & + NoahMP50_struc(n)%noahmp50(t)%param%SSI = vardata(t) + if(vname.eq."SWEMX") & + NoahMP50_struc(n)%noahmp50(t)%param%SWEMX = vardata(t) + if(vname.eq."RSURF_SNOW") & + NoahMP50_struc(n)%noahmp50(t)%param%RSURF_SNOW = vardata(t) + if(vname.eq."MNSNALB") & + NoahMP50_struc(n)%noahmp50(t)%param%MNSNALB = vardata(t) + if(vname.eq."MXSNALB") & + NoahMP50_struc(n)%noahmp50(t)%param%MXSNALB = vardata(t) + if(vname.eq."SNDECAYEXP") & + NoahMP50_struc(n)%noahmp50(t)%param%SNDECAYEXP = vardata(t) + if(vname.eq."T_ULIMIT") & + NoahMP50_struc(n)%noahmp50(t)%param%T_ULIMIT = vardata(t) + if(vname.eq."T_MLIMIT") & + NoahMP50_struc(n)%noahmp50(t)%param%T_MLIMIT = vardata(t) + if(vname.eq."T_LLIMIT") & + NoahMP50_struc(n)%noahmp50(t)%param%T_LLIMIT = vardata(t) + if(vname.eq."SNOWF_SCALEF") & + NoahMP50_struc(n)%noahmp50(t)%param%snowf_scalef = vardata(t) + if(vname.eq."RHOL1") & + NoahMP50_struc(n)%noahmp50(t)%param%RHOL(1) = vardata(t) + if(vname.eq."RHOL2") & + NoahMP50_struc(n)%noahmp50(t)%param%RHOL(2) = vardata(t) + if(vname.eq."RHOS1") & + NoahMP50_struc(n)%noahmp50(t)%param%RHOS(1) = vardata(t) + if(vname.eq."RHOS2") & + NoahMP50_struc(n)%noahmp50(t)%param%RHOS(2) = vardata(t) + if(vname.eq."TAUL1") & + NoahMP50_struc(n)%noahmp50(t)%param%TAUL(1) = vardata(t) + if(vname.eq."TAUL2") & + NoahMP50_struc(n)%noahmp50(t)%param%TAUL(2) = vardata(t) + if(vname.eq."TAUS1") & + NoahMP50_struc(n)%noahmp50(t)%param%TAUS(1) = vardata(t) + if(vname.eq."TAUS2") & + NoahMP50_struc(n)%noahmp50(t)%param%TAUS(2) = vardata(t) + if(vname.eq."XL") & + NoahMP50_struc(n)%noahmp50(t)%param%XL = vardata(t) + if(vname.eq."CWPVT") & + NoahMP50_struc(n)%noahmp50(t)%param%CWPVT = vardata(t) + if(vname.eq."C3PSN") & + NoahMP50_struc(n)%noahmp50(t)%param%C3PSN = vardata(t) + if(vname.eq."KC25") & + NoahMP50_struc(n)%noahmp50(t)%param%KC25 = vardata(t) + if(vname.eq."AKC") & + NoahMP50_struc(n)%noahmp50(t)%param%AKC = vardata(t) + if(vname.eq."KO25") & + NoahMP50_struc(n)%noahmp50(t)%param%KO25 = vardata(t) + if(vname.eq."AKO") & + NoahMP50_struc(n)%noahmp50(t)%param%AKO = vardata(t) + if(vname.eq."AVCMX") & + NoahMP50_struc(n)%noahmp50(t)%param%AVCMX = vardata(t) + if(vname.eq."AQE") & + NoahMP50_struc(n)%noahmp50(t)%param%AQE = vardata(t) + if(vname.eq."LTOVRC") & + NoahMP50_struc(n)%noahmp50(t)%param%LTOVRC = vardata(t) + if(vname.eq."DILEFC") & + NoahMP50_struc(n)%noahmp50(t)%param%DILEFC = vardata(t) + if(vname.eq."DILEFW") & + NoahMP50_struc(n)%noahmp50(t)%param%DILEFW = vardata(t) + if(vname.eq."RMF25") & + NoahMP50_struc(n)%noahmp50(t)%param%RMF25 = vardata(t) + if(vname.eq."SLA") & + NoahMP50_struc(n)%noahmp50(t)%param%SLA = vardata(t) + if(vname.eq."FRAGR") & + NoahMP50_struc(n)%noahmp50(t)%param%FRAGR = vardata(t) + if(vname.eq."TMIN") & + NoahMP50_struc(n)%noahmp50(t)%param%TMIN = vardata(t) + if(vname.eq."VCMX25") & + NoahMP50_struc(n)%noahmp50(t)%param%VCMX25 = vardata(t) + if(vname.eq."TDLEF") & + NoahMP50_struc(n)%noahmp50(t)%param%TDLEF = vardata(t) + if(vname.eq."BP") & + NoahMP50_struc(n)%noahmp50(t)%param%BP = vardata(t) + if(vname.eq."MP") & + NoahMP50_struc(n)%noahmp50(t)%param%MP = vardata(t) + if(vname.eq."QE25") & + NoahMP50_struc(n)%noahmp50(t)%param%QE25 = vardata(t) + if(vname.eq."RMS25") & + NoahMP50_struc(n)%noahmp50(t)%param%RMS25 = vardata(t) + if(vname.eq."RMR25") & + NoahMP50_struc(n)%noahmp50(t)%param%RMR25 = vardata(t) + if(vname.eq."ARM") & + NoahMP50_struc(n)%noahmp50(t)%param%ARM = vardata(t) + if(vname.eq."FOLNMX") & + NoahMP50_struc(n)%noahmp50(t)%param%FOLNMX = vardata(t) + if(vname.eq."WDPOOL") & + NoahMP50_struc(n)%noahmp50(t)%param%WDPOOL = vardata(t) + if(vname.eq."WRRAT") & + NoahMP50_struc(n)%noahmp50(t)%param%WRRAT = vardata(t) + if(vname.eq."MRP") & + NoahMP50_struc(n)%noahmp50(t)%param%MRP = vardata(t) + endif + enddo + endif + enddo +end subroutine NoahMP50_setVars + +subroutine NoahMP50_setModFlag(n,DEC_State,Feas_State,mod_flag_NoahMP50) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_surface + use LIS_logMod, only : LIS_logunit,LIS_verify + + implicit none +! !ARGUMENTS: + integer :: n + integer :: mod_flag_NoahMP50(LIS_rc%npatch(n,LIS_rc%lsm_index)) + type(ESMF_State) :: DEC_State + type(ESMF_State) :: Feas_State +! +! !DESCRIPTION: +! +! This routine sets the feasibility flag +! +!EOP + type(ESMF_Field) :: feasField + integer :: t + integer :: status + integer, pointer :: modflag(:) + + call ESMF_StateGet(Feas_State, "Feasibility Flag", feasField, rc=status) + call LIS_verify(status) + call ESMF_FieldGet(feasField,localDE=0,farrayPtr=modflag,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + if(mod_flag_NoahMP50(t).eq.1) then + modflag(t)=1 + endif + enddo + +end subroutine NoahMP50_setModFlag diff --git a/lis/surfacemodels/land/noahmp.5.0/pe/obspred/UAsnow/NoahMP50_getpeobspred_UAsnowobs.F90 b/lis/surfacemodels/land/noahmp.5.0/pe/obspred/UAsnow/NoahMP50_getpeobspred_UAsnowobs.F90 new file mode 100644 index 000000000..a6dfbb69d --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/pe/obspred/UAsnow/NoahMP50_getpeobspred_UAsnowobs.F90 @@ -0,0 +1,69 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_getpeobspred_UAsnowobs +! \label{NoahMP50_getpeobspred_UAsnowobs} +! +! !REVISION HISTORY: +! 02 May 2020: Sujay Kumar; Initial Specification +! +! !INTERFACE: +subroutine NoahMP50_getpeobspred_UAsnowobs(Obj_Func) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc + use LIS_soilsMod, only : LIS_soils + use NoahMP50_lsmMod, only : NoahMP50_struc + use LIS_logMod, only : LIS_verify, LIS_logunit + + implicit none +! !ARGUMENTS: + type(ESMF_State) :: Obj_Func +! +! !DESCRIPTION: +! +! This routine retrieves the observation prediction, which is the +! model's estimate of snow depth. +! +!EOP + integer :: n + type(ESMF_Field) :: snodField + real, pointer :: snod(:) + type(ESMF_Field) :: sweField + real, pointer :: swe(:) + integer :: t + integer :: i + integer :: status + + + n = 1 + + call ESMF_StateGet(Obj_Func,"UA_SNOD",snodField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(snodField,localDE=0,farrayPtr=snod,rc=status) + call LIS_verify(status) + + call ESMF_StateGet(Obj_Func,"UA_SWE",sweField,rc=status) + call LIS_verify(status) + + call ESMF_FieldGet(sweField,localDE=0,farrayPtr=swe,rc=status) + call LIS_verify(status) + + do t=1,LIS_rc%npatch(n,LIS_rc%lsm_index) + snod(t) = NoahMP50_struc(n)%noahmp50(t)%snowh*1000.0 !mm + swe(t) = NoahMP50_struc(n)%noahmp50(t)%sneqv + enddo + + +end subroutine NoahMP50_getpeobspred_UAsnowobs + + + diff --git a/lis/surfacemodels/land/noahmp.5.0/pe/obspred/UAsnow/NoahMP50_setupobspred_UAsnowobs.F90 b/lis/surfacemodels/land/noahmp.5.0/pe/obspred/UAsnow/NoahMP50_setupobspred_UAsnowobs.F90 new file mode 100644 index 000000000..1e2d9f1fe --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/pe/obspred/UAsnow/NoahMP50_setupobspred_UAsnowobs.F90 @@ -0,0 +1,62 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: NoahMP50_setupobspred_UAsnowobs +! \label{NoahMP50_setupobspred_UAsnowobs} +! +! !REVISION HISTORY: +! 2 May 2020: Sujay Kumar; Initial Specification +! +! !INTERFACE: +subroutine NoahMP50_setupobspred_UAsnowobs(OBSPred) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_vecPatch + use LIS_logMod, only : LIS_verify + + implicit none +! !ARGUMENTS: + type(ESMF_State) :: OBSPred +! +! !DESCRIPTION: +! +! This routine creates an entry in the Obs pred object from +! NoahMP used for parameter estimation +! +!EOP + integer :: n + type(ESMF_ArraySpec) :: realarrspec + type(ESMF_Field) :: snodField,sweField + integer :: status + + n = 1 + call ESMF_ArraySpecSet(realarrspec, rank=1,typekind=ESMF_TYPEKIND_R4,& + rc=status) + call LIS_verify(status) + + snodField = ESMF_FieldCreate(arrayspec=realarrspec, & + grid=LIS_vecPatch(n,LIS_rc%lsm_index), & + name="UA_SNOD", rc=status) + call LIS_verify(status) + + + sweField = ESMF_FieldCreate(arrayspec=realarrspec, & + grid=LIS_vecPatch(n,LIS_rc%lsm_index), & + name="UA_SWE", rc=status) + call LIS_verify(status) + + call ESMF_StateAdd(OBSPred,(/snodField/),rc=status) + call LIS_verify(status) + + call ESMF_StateAdd(OBSPred,(/sweField/),rc=status) + call LIS_verify(status) + +end subroutine NoahMP50_setupobspred_UAsnowobs + diff --git a/lis/surfacemodels/land/noahmp.5.0/phys/noahmp b/lis/surfacemodels/land/noahmp.5.0/phys/noahmp new file mode 160000 index 000000000..0cd33858d --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/phys/noahmp @@ -0,0 +1 @@ +Subproject commit 0cd33858d6ed373d558f64757ffc385e925d4ee8 diff --git a/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs.F90 b/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs.F90 new file mode 100644 index 000000000..5945405d3 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs.F90 @@ -0,0 +1,150 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getrunoffs +! \label{noahmp50_getrunoffs} +! +! !REVISION HISTORY: +! 6 May 2011: Sujay Kumar; Initial Specification +! 26 Feb 2019: David Mocko, added Noah-MP-4.0.1 routing into LIS-7 +! May 2023: Cenlin He, modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getrunoffs(n) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_masterproc + use LIS_routingMod, only : LIS_runoff_state + use LIS_logMod, only : LIS_verify + use LIS_constantsMod + use LIS_historyMod + use NoahMP50_lsmMod, only : NoahMP50_struc + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n +! +! !DESCRIPTION: +! +! +! +!EOP + type(ESMF_Field) :: sfrunoff_field + type(ESMF_Field) :: baseflow_field + real, pointer :: sfrunoff(:) + real, pointer :: baseflow(:) + real, allocatable :: gvar1(:) + real, allocatable :: gvar2(:) + real, allocatable :: runoff1(:) + real, allocatable :: runoff2(:) + real, allocatable :: runoff1_t(:) + real, allocatable :: runoff2_t(:) + integer :: t + integer :: c,r + integer :: status + + !ag (25Apr2017) + type(ESMF_Field) :: evapotranspiration_Field + real,pointer :: evapotranspiration(:) + real, allocatable :: gvar3(:) + real, allocatable :: evapotranspiration1(:) + real, allocatable :: evapotranspiration1_t(:) + integer :: evapflag + + allocate(runoff1(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(runoff2(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(runoff1_t(LIS_rc%ntiles(n))) + allocate(runoff2_t(LIS_rc%ntiles(n))) + + call ESMF_AttributeGet(LIS_runoff_state(n),"Routing model evaporation option",& + evapflag, rc=status) +!if option is not defined, then assume that no evap calculations will be done + if(status.ne.0)then + evapflag = 0 + endif + + if(LIS_masterproc) then + call ESMF_StateGet(LIS_runoff_state(n),"Surface Runoff",& + sfrunoff_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for Surface Runoff') + + call ESMF_StateGet(LIS_runoff_state(n),"Subsurface Runoff",& + baseflow_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for Subsurface Runoff') + + call ESMF_FieldGet(sfrunoff_field,localDE=0,farrayPtr=sfrunoff,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for Surface Runoff') + + call ESMF_FieldGet(baseflow_field,localDE=0,farrayPtr=baseflow,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for Subsurface Runoff') + + endif + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + runoff1(t) = NoahMP50_struc(n)%noahmp50(t)%runsf/LIS_CONST_RHOFW + runoff2(t) = NoahMP50_struc(n)%noahmp50(t)%runsb/LIS_CONST_RHOFW + enddo + + call LIS_patch2tile(n,1,runoff1_t, runoff1) + call LIS_patch2tile(n,1,runoff2_t, runoff2) + +!gather the model tiles before assigning to the global data structure. + call LIS_gather_tiled_vector_withhalo_output(n, gvar1, runoff1_t) + call LIS_gather_tiled_vector_withhalo_output(n, gvar2, runoff2_t) + + if(LIS_masterproc) then + + sfrunoff = gvar1 + baseflow = gvar2 + + deallocate(gvar1) + deallocate(gvar2) + + endif + + deallocate(runoff1) + deallocate(runoff2) + deallocate(runoff1_t) + deallocate(runoff2_t) + + !ag (05Jun2017) + !Including meteorological forcings + evapotranspiration for computing evaporation from open waters in HyMAP2) + if(evapflag.ne.0)then + allocate(evapotranspiration1(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(evapotranspiration1_t(LIS_rc%ntiles(n))) + + if(LIS_masterproc) then + + call ESMF_StateGet(LIS_runoff_state(n),"Total Evapotranspiration",evapotranspiration_Field, rc=status) + call LIS_verify(status, "noahmp50_getrunoffs: ESMF_StateGet failed for Total Evapotranspiration") + + call ESMF_FieldGet(evapotranspiration_Field,localDE=0,farrayPtr=evapotranspiration,rc=status) + call LIS_verify(status, "noahmp50_getrunoffs: ESMF_FieldGet failed for Total Evapotranspiration") + + endif + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + evapotranspiration1(t) = NoahMP50_struc(n)%noahmp50(t)%ecan + NoahMP50_struc(n)%noahmp50(t)%etran + NoahMP50_struc(n)%noahmp50(t)%edir + enddo + + call LIS_patch2tile(n,1,evapotranspiration1_t, evapotranspiration1) + + call LIS_gather_tiled_vector_withhalo_output(n, gvar3, evapotranspiration1_t) + + if(LIS_masterproc) then + evapotranspiration = gvar3 + deallocate(gvar3) + endif + + deallocate(evapotranspiration1) + deallocate(evapotranspiration1_t) + endif + +end subroutine noahmp50_getrunoffs diff --git a/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs_hymap2.F90 b/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs_hymap2.F90 new file mode 100644 index 000000000..df34e6dc1 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs_hymap2.F90 @@ -0,0 +1,133 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getrunoffs_hymap2 +! \label{noahmp50_getrunoffs_hymap2} +! +! !REVISION HISTORY: +! 6 May 2011: Sujay Kumar; Initial Specification +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getrunoffs_hymap2(n) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_masterproc + use LIS_routingMod, only : LIS_runoff_state + use LIS_logMod + use LIS_historyMod + use NoahMP50_lsmMod, only : NoahMP50_struc + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n +! +! !DESCRIPTION: +! +! +! +!EOP + type(ESMF_Field) :: sfrunoff_field + type(ESMF_Field) :: baseflow_field + real, pointer :: sfrunoff(:) + real, pointer :: baseflow(:) + integer :: t + integer :: c,r + integer :: status + real, allocatable :: runoff1(:) + real, allocatable :: runoff2(:) + real, allocatable :: runoff1_t(:) + real, allocatable :: runoff2_t(:) + + !ag (25Apr2017) + type(ESMF_Field) :: evapotranspiration_Field + real,pointer :: evapotranspiration(:) + real, allocatable :: evapotranspiration1(:) + real, allocatable :: evapotranspiration1_t(:) + integer :: evapflag + + allocate(runoff1(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(runoff2(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(runoff1_t(LIS_rc%ntiles(n))) + allocate(runoff2_t(LIS_rc%ntiles(n))) + + runoff1_t = -9999.0 + runoff2_t = -9999.0 + + call ESMF_AttributeGet(LIS_runoff_state(n),"Routing model evaporation option",& + evapflag, rc=status) +!if option is not defined, then assume that no evap calculations will be done + if(status.ne.0)then + evapflag = 0 + endif + + call ESMF_StateGet(LIS_runoff_state(n),"Surface Runoff",& + sfrunoff_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for Surface Runoff') + + call ESMF_StateGet(LIS_runoff_state(n),"Subsurface Runoff",& + baseflow_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for Subsurface Runoff') + + call ESMF_FieldGet(sfrunoff_field,localDE=0,farrayPtr=sfrunoff,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for Surface Runoff') + + call ESMF_FieldGet(baseflow_field,localDE=0,farrayPtr=baseflow,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for Subsurface Runoff') + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) !units? + runoff1(t) = NoahMP50_struc(n)%noahmp50(t)%runsf + runoff2(t) = NoahMP50_struc(n)%noahmp50(t)%runsb + enddo + + runoff1_t = LIS_rc%udef + runoff2_t = LIS_rc%udef + + call LIS_patch2tile(n,1,runoff1_t, runoff1) + call LIS_patch2tile(n,1,runoff2_t, runoff2) + + sfrunoff = runoff1_t + baseflow = runoff2_t + + deallocate(runoff1) + deallocate(runoff2) + deallocate(runoff1_t) + deallocate(runoff2_t) + + !ag (05Jun2017) + !Including meteorological forcings + evapotranspiration for computing evaporation from open waters in HyMAP2) + if(evapflag.ne.0)then + allocate(evapotranspiration1(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(evapotranspiration1_t(LIS_rc%ntiles(n))) + + call ESMF_StateGet(LIS_runoff_state(n),"Total Evapotranspiration",& + evapotranspiration_Field, rc=status) + call LIS_verify(status, "noahmp50_getrunoffs_hymap2: ESMF_StateGet failed for Total Evapotranspiration") + + call ESMF_FieldGet(evapotranspiration_Field,localDE=0,& + farrayPtr=evapotranspiration,rc=status) + call LIS_verify(status, "noahmp50_getrunoffs_hymap2: ESMF_FieldGet failed for Total Evapotranspiration") + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + evapotranspiration1(t) = & + NoahMP50_struc(n)%noahmp50(t)%ecan + & + NoahMP50_struc(n)%noahmp50(t)%etran + & + NoahMP50_struc(n)%noahmp50(t)%edir + enddo + + call LIS_patch2tile(n,1,evapotranspiration1_t, evapotranspiration1) + + evapotranspiration = evapotranspiration1_t + + deallocate(evapotranspiration1) + deallocate(evapotranspiration1_t) + endif + +end subroutine noahmp50_getrunoffs_hymap2 diff --git a/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs_mm.F90 b/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs_mm.F90 new file mode 100644 index 000000000..00bcfc5e4 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs_mm.F90 @@ -0,0 +1,152 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getrunoffs_mm +! \label{noahmp50_getrunoffs_mm} +! +! !REVISION HISTORY: +! 6 May 2011: Sujay Kumar; Initial Specification +! 26 Feb 2019: David Mocko, added Noah-MP-4.0.1 routing into LIS-7 +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getrunoffs_mm(n) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_masterproc + use LIS_routingMod, only : LIS_runoff_state + use LIS_logMod, only : LIS_verify + use LIS_historyMod + use noahmp50_lsmMod, only : noahmp50_struc + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n +! +! !DESCRIPTION: +! +! +! +!EOP + type(ESMF_Field) :: sfrunoff_field + type(ESMF_Field) :: baseflow_field + real, pointer :: sfrunoff(:) + real, pointer :: baseflow(:) + real, allocatable :: gvar1(:) + real, allocatable :: gvar2(:) + real, allocatable :: runoff1(:) + real, allocatable :: runoff2(:) + real, allocatable :: runoff1_t(:) + real, allocatable :: runoff2_t(:) + integer :: t + integer :: c,r + integer :: status + + !ag (25Apr2017) + type(ESMF_Field) :: evapotranspiration_Field + real,pointer :: evapotranspiration(:) + real, allocatable :: gvar3(:) + real, allocatable :: evapotranspiration1(:) + real, allocatable :: evapotranspiration1_t(:) + integer :: evapflag + + allocate(runoff1(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(runoff2(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(runoff1_t(LIS_rc%ntiles(n))) + allocate(runoff2_t(LIS_rc%ntiles(n))) + + runoff1_t = -9999.0 + runoff2_t = -9999.0 + + call ESMF_AttributeGet(LIS_runoff_state(n),"Routing model evaporation option",& + evapflag, rc=status) +!if option is not defined, then assume that no evap calculations will be done + if(status.ne.0)then + evapflag = 0 + endif + + if(LIS_masterproc) then + call ESMF_StateGet(LIS_runoff_state(n),"Surface Runoff",& + sfrunoff_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for Surface Runoff') + + call ESMF_StateGet(LIS_runoff_state(n),"Subsurface Runoff",& + baseflow_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for Subsurface Runoff') + + call ESMF_FieldGet(sfrunoff_field,localDE=0,farrayPtr=sfrunoff,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for Surface Runoff') + + call ESMF_FieldGet(baseflow_field,localDE=0,farrayPtr=baseflow,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for Subsurface Runoff') + + endif + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + runoff1(t) = NoahMP50_struc(n)%noahmp50(t)%runsf + runoff2(t) = NoahMP50_struc(n)%noahmp50(t)%runsb + enddo + + call LIS_patch2tile(n,1,runoff1_t, runoff1) + call LIS_patch2tile(n,1,runoff2_t, runoff2) + +!gather the model tiles before assigning to the global data structure. + call LIS_gather_tiled_vector_withhalo_output(n, gvar1, runoff1_t) + call LIS_gather_tiled_vector_withhalo_output(n, gvar2, runoff2_t) + + if(LIS_masterproc) then + + sfrunoff = gvar1 + baseflow = gvar2 + + deallocate(gvar1) + deallocate(gvar2) + + endif + + deallocate(runoff1) + deallocate(runoff2) + deallocate(runoff1_t) + deallocate(runoff2_t) + + !ag (05Jun2017) + !Including meteorological forcings + evapotranspiration for computing evaporation from open waters in HyMAP2) + if(evapflag.ne.0)then + allocate(evapotranspiration1(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(evapotranspiration1_t(LIS_rc%ntiles(n))) + + if(LIS_masterproc) then + + call ESMF_StateGet(LIS_runoff_state(n),"Total Evapotranspiration",evapotranspiration_Field, rc=status) + call LIS_verify(status, "noahmp50_getrunoffs_mm: ESMF_StateGet failed for Total Evapotranspiration") + + call ESMF_FieldGet(evapotranspiration_Field,localDE=0,farrayPtr=evapotranspiration,rc=status) + call LIS_verify(status, "noahmp50_getrunoffs_mm: ESMF_FieldGet failed for Total Evapotranspiration") + + endif + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) + evapotranspiration1(t) = NoahMP50_struc(n)%noahmp50(t)%ecan + NoahMP50_struc(n)%noahmp50(t)%etran + NoahMP50_struc(n)%noahmp50(t)%edir + enddo + + call LIS_patch2tile(n,1,evapotranspiration1_t, evapotranspiration1) + + call LIS_gather_tiled_vector_withhalo_output(n, gvar3, evapotranspiration1_t) + + if(LIS_masterproc) then + evapotranspiration = gvar3 + deallocate(gvar3) + endif + + deallocate(evapotranspiration1) + deallocate(evapotranspiration1_t) + endif + +end subroutine noahmp50_getrunoffs_mm diff --git a/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs_rapid.F90 b/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs_rapid.F90 new file mode 100644 index 000000000..4b5d150ef --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getrunoffs_rapid.F90 @@ -0,0 +1,90 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.3 +! +! Copyright (c) 2020 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getrunoffs_rapid +! \label{noahmp50_getrunoffs_rapid} +! +! !REVISION HISTORY: +! 17 Mar 2021: Yeosang Yoon; Initial Specification +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getrunoffs_rapid(n) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_masterproc + use LIS_routingMod, only : LIS_runoff_state + use LIS_logMod + use LIS_historyMod + use noahmp50_lsmMod, only : noahmp50_struc + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n +! +! !DESCRIPTION: +! +! +! +!EOP + type(ESMF_Field) :: sfrunoff_field + type(ESMF_Field) :: baseflow_field + real, pointer :: sfrunoff(:) + real, pointer :: baseflow(:) + integer :: t + integer :: c,r + integer :: status + real, allocatable :: runoff1(:) + real, allocatable :: runoff2(:) + real, allocatable :: runoff1_t(:) + real, allocatable :: runoff2_t(:) + + allocate(runoff1(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(runoff2(LIS_rc%npatch(n,LIS_rc%lsm_index))) + allocate(runoff1_t(LIS_rc%ntiles(n))) + allocate(runoff2_t(LIS_rc%ntiles(n))) + + runoff1_t = -9999.0 + runoff2_t = -9999.0 + + call ESMF_StateGet(LIS_runoff_state(n),"Surface Runoff",& + sfrunoff_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for Surface Runoff') + + call ESMF_StateGet(LIS_runoff_state(n),"Subsurface Runoff",& + baseflow_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for Subsurface Runoff') + + call ESMF_FieldGet(sfrunoff_field,localDE=0,farrayPtr=sfrunoff,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for Surface Runoff') + + call ESMF_FieldGet(baseflow_field,localDE=0,farrayPtr=baseflow,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for Subsurface Runoff') + + do t=1, LIS_rc%npatch(n,LIS_rc%lsm_index) !units? + runoff1(t) = NoahMP50_struc(n)%noahmp50(t)%runsf + runoff2(t) = NoahMP50_struc(n)%noahmp50(t)%runsb + enddo + + runoff1_t = LIS_rc%udef + runoff2_t = LIS_rc%udef + + call LIS_patch2tile(n,1,runoff1_t, runoff1) + call LIS_patch2tile(n,1,runoff2_t, runoff2) + + sfrunoff = runoff1_t + baseflow = runoff2_t + + deallocate(runoff1) + deallocate(runoff2) + deallocate(runoff1_t) + deallocate(runoff2_t) + +end subroutine noahmp50_getrunoffs_rapid diff --git a/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getsws_hymap2.F90 b/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getsws_hymap2.F90 new file mode 100644 index 000000000..faa511b07 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/routing/noahmp50_getsws_hymap2.F90 @@ -0,0 +1,79 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- +!BOP +! !ROUTINE: noahmp50_getsws_hymap2 +! \label{noahmp50_getsws_hymap2} +! +! !REVISION HISTORY: +! 12 Sep 2019: Augusto Getirana; implementation of two-way coupling +! May 2023: Cenlin He; modified for refactored NoahMP v5 and later +! +! !INTERFACE: +subroutine noahmp50_getsws_hymap2(n) +! !USES: + use ESMF + use LIS_coreMod, only : LIS_rc, LIS_masterproc + use LIS_routingMod, only : LIS_runoff_state + use LIS_logMod + use LIS_historyMod + use noahmp50_lsmMod, only : noahmp50_struc + + implicit none +! !ARGUMENTS: + integer, intent(in) :: n +! +! !DESCRIPTION: +! This routine defines the surface water storage variables in NoahMP +! to be updated based on feedback from HYMAP2 +! +!EOP + type(ESMF_Field) :: rivsto_field + type(ESMF_Field) :: fldsto_field + type(ESMF_Field) :: fldfrc_field + real, pointer :: rivstotmp(:) + real, pointer :: fldstotmp(:) + real, pointer :: fldfrctmp(:) + integer :: t + integer :: c,r + integer :: status + integer :: enable2waycpl + + call ESMF_AttributeGet(LIS_runoff_state(n),"2 way coupling",& + enable2waycpl, rc=status) + call LIS_verify(status) + + if(enable2waycpl==1) then + ! River Storage + call ESMF_StateGet(LIS_runoff_state(n),"River Storage",rivsto_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for River Storage') + + call ESMF_FieldGet(rivsto_field,localDE=0,farrayPtr=rivstotmp,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for River Storage') + where(rivstotmp/=LIS_rc%udef) & + NoahMP50_struc(n)%noahmp50(:)%rivsto=rivstotmp/NoahMP50_struc(n)%ts + + ! Flood Storage + call ESMF_StateGet(LIS_runoff_state(n),"Flood Storage",fldsto_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for Flood Storage') + + call ESMF_FieldGet(fldsto_field,localDE=0,farrayPtr=fldstotmp,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for Flood Storage') + where(fldstotmp/=LIS_rc%udef)& + NoahMP50_struc(n)%noahmp50(:)%fldsto=fldstotmp/NoahMP50_struc(n)%ts + + ! Flooded Fraction Flag + call ESMF_StateGet(LIS_runoff_state(n),"Flooded Fraction",fldfrc_field,rc=status) + call LIS_verify(status,'ESMF_StateGet failed for Flooded Fraction') + + call ESMF_FieldGet(fldfrc_field,localDE=0,farrayPtr=fldfrctmp,rc=status) + call LIS_verify(status,'ESMF_FieldGet failed for Flooded Fraction') + NoahMP50_struc(n)%noahmp50(:)%fldfrc=fldfrctmp + endif +end subroutine noahmp50_getsws_hymap2 diff --git a/lis/surfacemodels/land/noahmp.5.0/wrf_debug.F90 b/lis/surfacemodels/land/noahmp.5.0/wrf_debug.F90 new file mode 100644 index 000000000..a45b4f251 --- /dev/null +++ b/lis/surfacemodels/land/noahmp.5.0/wrf_debug.F90 @@ -0,0 +1,19 @@ +!-----------------------BEGIN NOTICE -- DO NOT EDIT----------------------- +! NASA Goddard Space Flight Center +! Land Information System Framework (LISF) +! Version 7.4 +! +! Copyright (c) 2022 United States Government as represented by the +! Administrator of the National Aeronautics and Space Administration. +! All Rights Reserved. +!-------------------------END NOTICE -- DO NOT EDIT----------------------- + +subroutine wrf_debug(unit_number, message) + + use LIS_logMod, only : LIS_logunit + implicit none + integer :: unit_number + character(len=*) :: message + write(LIS_logunit, *) "Noah-MP.5.0 refactored version (wrf_debug): ", message + +end subroutine wrf_debug