diff --git a/Registry/Registry.EM_COMMON b/Registry/Registry.EM_COMMON index 9913cc34af..a87b8f90a0 100644 --- a/Registry/Registry.EM_COMMON +++ b/Registry/Registry.EM_COMMON @@ -825,6 +825,9 @@ state real SMSTOT ij misc 1 - r state real SOLDRAIN ij misc 1 - r "SOLDRAIN" "soil column drainage" "mm" state real SFCHEADRT ij misc 1 - r "SFCHEADRT" "surface water depth" "mm" state real INFXSRT ij misc 1 - r "INFXSRT" "time step infiltration excess" "mm" +state real qtiledrain ij misc 1 - r "qtiledrain" "accumulated tile drainage" "mm" +state real ZWATBLE2D ij misc 1 - r "ZWATBLE2D" "water table depth for tile drainage" "mm" + state real SFCRUNOFF ij misc 1 - rhd=(interp_mask_field:lu_index,iswater) "SFROFF" "SURFACE RUNOFF" "mm" state real UDRUNOFF ij misc 1 - rhd=(interp_mask_field:lu_index,iswater) "UDROFF" "UNDERGROUND RUNOFF" "mm" state integer IVGTYP ij misc 1 - i02rhd=(interp_fcni)u=(copy_fcni) "IVGTYP" "DOMINANT VEGETATION CATEGORY" "" @@ -2615,7 +2618,7 @@ rconfig integer madwrf_cldinit namelist,physics 1 rconfig integer dveg namelist,noah_mp 1 4 h "dveg" "dynamic vegetation (1 -> off ; 2 -> on)" "" rconfig integer opt_crs namelist,noah_mp 1 1 h "opt_crs" "canopy stomatal resistance (1-> Ball-Berry; 2->Jarvis)" "" rconfig integer opt_btr namelist,noah_mp 1 1 h "opt_btr" "soil moisture factor for stomatal resistance (1-> Noah; 2-> CLM; 3-> SSiB)" "" -rconfig integer opt_run namelist,noah_mp 1 3 h "opt_run" "runoff and groundwater (1->SIMGM; 2->SIMTOP; 3->Schaake96; 4->BATS; 5->Miguez-Macho & Fan)" "" +rconfig integer opt_run namelist,noah_mp 1 3 h "opt_run" "runoff and groundwater (1->SIMGM; 2->SIMTOP; 3->Schaake96; 4->BATS; 5->Miguez-Macho & Fan; 6->VIC; 7->Xiananjiang; 8->Dynamic VIC)" "" rconfig integer opt_sfc namelist,noah_mp 1 1 h "opt_sfc" "surface layer drag coeff (CH & CM) (1->M-O; 2->Chen97)" "" rconfig integer opt_frz namelist,noah_mp 1 1 h "opt_frz" "supercooled liquid water (1-> NY06; 2->Koren99)" "" rconfig integer opt_inf namelist,noah_mp 1 1 h "opt_inf" "frozen soil permeability (1-> NY06; 2->Koren99)" "" @@ -2631,7 +2634,12 @@ rconfig integer opt_pedo namelist,noah_mp 1 1 h " rconfig integer opt_crop namelist,noah_mp 1 0 h "opt_crop" "crop model option" "" rconfig integer opt_irr namelist,noah_mp 1 0 h "opt_irr" "Noah-MP irrigation option" "" rconfig integer opt_irrm namelist,noah_mp 1 0 h "opt_irrm" "Noah-MP irrigation method option" "" -rconfig real WTDDT namelist,physics max_domains 30. h "wtddt" "minutes between calls to lateral hydro" "" +rconfig integer opt_infdv namelist,noah_mp 1 0 h "opt_infdv" "Noah-MP infiltration option in dynamic VIC runoff scheme (only works with opt_run=8), 1->Philip; 2->Green-Ampt; 3->Smith-Parlange" +rconfig integer opt_tdrn namelist,noah_mp 1 0 h "opt_tdrn" "NoahMP tile drainage option (currently only tested & works with opt_run=3), 0->no tile drainage; 1->Simple drainage; 2->Hooghoudt scheme" +rconfig real soiltstep namelist,noah_mp 1 0. h "soiltstep" "NoahMP soil process timestep (s) for solving soil temperature and water (default:0->same as main noahmp timestep)" +rconfig real WTDDT namelist,physics max_domains 30. h "wtddt" "minutes between calls to lateral hydro" "" +rconfig real noahmp_acc_dt namelist,noah_mp 1 0. h "noahmp_acc_dt" "bucket reset time interval between outputs for noah-mp accumulation" "minutes" +rconfig integer noahmp_output namelist,noah_mp 1 1 h "noahmp_output" "noahmp output level" "" # For WRF Hydro rconfig integer wrf_hydro derived 1 0 h "wrf_hydro" "descrip" "unit" @@ -3065,7 +3073,7 @@ package slabscheme sf_surface_physics==1 - - package lsmscheme sf_surface_physics==2 - state:flx4,fvb,fbur,fgsn,smcrel,xlaidyn package ruclsmscheme sf_surface_physics==3 - state:smfr3d,keepfr3dflag,soilt1,rhosnf,snowfallac,precipfr,acrunoff package clmscheme sf_surface_physics==5 - state:numc,nump,sabv,sabg,lwup,lhsoi,lhveg,lhtran,snl,snowdp,wtc,wtp,h2osno,t_grnd,t_veg,h2ocan,h2ocan_col,t2m_max,t2m_min,t2clm,t_ref2m,q_ref2m,h2osoi_liq_s1,h2osoi_liq_s2,h2osoi_liq_s3,h2osoi_liq_s4,h2osoi_liq_s5,h2osoi_liq1,h2osoi_liq2,h2osoi_liq3,h2osoi_liq4,h2osoi_liq5,h2osoi_liq6,h2osoi_liq7,h2osoi_liq8,h2osoi_liq9,h2osoi_liq10,h2osoi_ice_s1,h2osoi_ice_s2,h2osoi_ice_s3,h2osoi_ice_s4,h2osoi_ice_s5,h2osoi_ice1,h2osoi_ice2,h2osoi_ice3,h2osoi_ice4,h2osoi_ice5,h2osoi_ice6,h2osoi_ice7,h2osoi_ice8,h2osoi_ice9,h2osoi_ice10,t_soisno_s1,t_soisno_s2,t_soisno_s3,t_soisno_s4,t_soisno_s5,t_soisno1,t_soisno2,t_soisno3,t_soisno4,t_soisno5,t_soisno6,t_soisno7,t_soisno8,t_soisno9,t_soisno10,dzsnow1,dzsnow2,dzsnow3,dzsnow4,dzsnow5,snowrds1,snowrds2,snowrds3,snowrds4,snowrds5,t_lake1,t_lake2,t_lake3,t_lake4,t_lake5,t_lake6,t_lake7,t_lake8,t_lake9,t_lake10,h2osoi_vol1,h2osoi_vol2,h2osoi_vol3,h2osoi_vol4,h2osoi_vol5,h2osoi_vol6,h2osoi_vol7,h2osoi_vol8,h2osoi_vol9,h2osoi_vol10,albedosubgrid,lhsubgrid,hfxsubgrid,lwupsubgrid,q2subgrid,sabvsubgrid,sabgsubgrid,nrasubgrid,swupsubgrid,t_veg24,t_veg240,fsun,fsun24,fsun240,fsd24,fsd240,fsi24,fsi240,laip,pct_pft_input -package noahmpscheme sf_surface_physics==4 - state:isnowxy,tvxy,tgxy,canliqxy,canicexy,eahxy,tahxy,cmxy,chxy,fwetxy,sneqvoxy,alboldxy,qsnowxy,qrainxy,wslakexy,zwtxy,waxy,wtxy,tsnoxy,zsnsoxy,snicexy,snliqxy,lfmassxy,rtmassxy,stmassxy,woodxy,stblcpxy,fastcpxy,xsaixy,taussxy,t2mvxy,t2mbxy,q2mvxy,q2mbxy,tradxy,neexy,gppxy,nppxy,fvegxy,qinxy,runsfxy,runsbxy,ecanxy,edirxy,etranxy,fsaxy,firaxy,aparxy,psnxy,savxy,sagxy,rssunxy,rsshaxy,bgapxy,wgapxy,tgvxy,tgbxy,chvxy,chbxy,shgxy,shcxy,shbxy,evgxy,evbxy,ghvxy,ghbxy,irgxy,ircxy,irbxy,trxy,evcxy,chleafxy,chucxy,chv2xy,chb2xy,chstarxy,smoiseq,smcwtdxy,rechxy,deeprechxy,fdepthxy,areaxy,rivercondxy,riverbedxy,eqzwt,pexpxy,qrfxy,qrfsxy,qspringxy,qspringsxy,qslatxy,stepwtd,rechclim,gddxy,grainxy,croptype,planting,harvest,season_gdd,cropcat,pgsxy,soilcomp,soilcl1,soilcl2,soilcl3,soilcl4,irfract,sifract,mifract,fifract,irnumsi,irnummi,irnumfi,irwatsi,irwatmi,irwatfi,irsivol,irmivol,irfivol,ireloss,irrsplh +package noahmpscheme sf_surface_physics==4 - state:isnowxy,tvxy,tgxy,canliqxy,canicexy,eahxy,tahxy,cmxy,chxy,fwetxy,sneqvoxy,alboldxy,qsnowxy,qrainxy,wslakexy,zwtxy,waxy,wtxy,tsnoxy,zsnsoxy,snicexy,snliqxy,lfmassxy,rtmassxy,stmassxy,woodxy,stblcpxy,fastcpxy,xsaixy,taussxy,t2mvxy,t2mbxy,q2mvxy,q2mbxy,tradxy,neexy,gppxy,nppxy,fvegxy,qinxy,runsfxy,runsbxy,ecanxy,edirxy,etranxy,fsaxy,firaxy,aparxy,psnxy,savxy,sagxy,rssunxy,rsshaxy,bgapxy,wgapxy,tgvxy,tgbxy,chvxy,chbxy,shgxy,shcxy,shbxy,evgxy,evbxy,ghvxy,ghbxy,irgxy,ircxy,irbxy,trxy,evcxy,chleafxy,chucxy,chv2xy,chb2xy,chstarxy,smoiseq,smcwtdxy,rechxy,deeprechxy,fdepthxy,areaxy,rivercondxy,riverbedxy,eqzwt,pexpxy,qrfxy,qrfsxy,qspringxy,qspringsxy,qslatxy,stepwtd,rechclim,gddxy,grainxy,croptype,planting,harvest,season_gdd,cropcat,pgsxy,soilcomp,soilcl1,soilcl2,soilcl3,soilcl4,irfract,sifract,mifract,fifract,irnumsi,irnummi,irnumfi,irwatsi,irwatmi,irwatfi,irsivol,irmivol,irfivol,ireloss,irrsplh,td_fraction,qtdrain,acrech,acqspring,qlatxy,qintsxy,qintrxy,qdripsxy,qdriprxy,qthrosxy,qthrorxy,qsnsubxy,qsnfroxy,qsubcxy,qfrocxy,qevacxy,qdewcxy,qfrzcxy,qmeltcxy,qsnbotxy,pondingxy,pahxy,pahgxy,pahvxy,pahbxy,fpicexy,rainlsm,snowlsm,acints,acintr,acdripr,acthror,acevac,acdewc,forctlsm,forcqlsm,forcplsm,forczlsm,forcwlsm,acrainlsm,acrunsb,acrunsf,acecan,acetran,acedir,acqlat,acqrf,acetlsm,acsnowlsm,acsubc,acfroc,acfrzc,acmeltc,acsnbot,acponding,acsnsub,acsnfro,acrainsnow,acdrips,acthros,acsagb,acirb,acshb,acevb,acghb,acpahb,acsagv,acirg,acshg,acevg,acghv,acpahg,acsav,acirc,acshc,acevc,actr,acpahv,acswdnlsm,acswuplsm,aclwdnlsm,aclwuplsm,acshflsm,aclhflsm,acghflsm,acpahlsm,accanhs,canhsxy,soilenergy,snowenergy,acc_ssoil,acc_qinsur,acc_qseva,acc_etrani,aceflxb,eflxbxy,acc_dwaterxy,acc_prcpxy,acc_ecanxy,acc_etranxy,acc_edirxy package ctsmscheme sf_surface_physics==6 - - package pxlsmscheme sf_surface_physics==7 - state:t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old,t2obs,q2obs,vegf_px,imperv,canfra,lai_px,wwlt_px,wfc_px,wsat_px,clay_px,csand_px,fmsand_px package ssibscheme sf_surface_physics==8 - state:ssib_fm,ssib_fh,ssib_cm,ssibxdd,ssib_br,ssib_lhf,ssib_shf,ssib_ghf,ssib_egs,ssib_eci,ssib_ect,ssib_egi,ssib_egt,ssib_sdn,ssib_sup,ssib_ldn,ssib_lup,ssib_wat,ssib_shc,ssib_shg,ssib_lai,ssib_vcf,ssib_z00,ssib_veg,isnow,swe,snowden,snowdepth,tkair,dzo1,wo1,tssn1,tssno1,bwo1,bto1,cto1,fio1,flo1,bio1,blo1,ho1,dzo2,wo2,tssn2,tssno2,bwo2,bto2,cto2,fio2,flo2,bio2,blo2,ho2,dzo3,wo3,tssn3,tssno3,bwo3,bto3,cto3,fio3,flo3,bio3,blo3,ho3,dzo4,wo4,tssn4,tssno4,bwo4,bto4,cto4,fio4,flo4,bio4,blo4,ho4 @@ -3294,7 +3302,7 @@ package io_netcdfpar io_form_restart==13 - - #WRF Hydro package no_wrfhydro wrf_hydro==0 - - -package wrfhydro wrf_hydro==1 - state:SOLDRAIN, SFCHEADRT, INFXSRT +package wrfhydro wrf_hydro==1 - state:SOLDRAIN,SFCHEADRT,INFXSRT,qtiledrain,ZWATBLE2D #WRF Windfarm package no_windfarm windfarm_opt==0 - - diff --git a/Registry/registry.noahmp b/Registry/registry.noahmp index ab3f3e5f43..cbeec1a9cd 100644 --- a/Registry/registry.noahmp +++ b/Registry/registry.noahmp @@ -79,12 +79,15 @@ state real SMOISEQ ilj - 1 Z r "SMOISEQ" "EQ. state real smcwtdxy ij - 1 - rh "smcwtd" "deep soil moisture " "m3 m-3" state real rechxy ij - 1 - rh "rech" "water table recharge" "mm" state real deeprechxy ij - 1 - r "deeprech" "deep water table recharge" "mm" +state real acrech ij - 1 - r "acrech" "accumulated recharge" "mm" state real areaxy ij - 1 - r "area" "area of grid boxes" "m2" state real qrfxy ij - 1 - r "qrf" "baseflow " "m" state real qrfsxy ij - 1 - rh "qrfs" "sum baseflow " "mm" state real qspringxy ij - 1 - r "qspring" "seeping water " "m" state real qspringsxy ij - 1 - rh "qsprings" "sum seeping water " "mm" +state real acqspring ij - 1 - r "acqspring" "accumulated seeping water" "mm" state real qslatxy ij - 1 - rh "qslat" "sum lateral flow " "mm" +state real qlatxy ij - 1 - r "qlat" "instantaneous lateral flow" "mm" state integer STEPWTD - misc 1 - r "STEPWTD" "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN WTD CALLS" "" state real pexpxy ij - 1 - r "pexp" "exponent for river conductance" "Kg m s-1" state real rivercondxy ij - 1 - r "rivercond" "river conductance" "Kg m s-1" @@ -92,14 +95,123 @@ state real fdepthxy ij - 1 - i012rd=(interp_mask_fiel state real eqzwt ij - 1 - i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "EQZWT" "equilibrium water table depth " "m" state real rechclim ij - 1 - i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "RECHCLIM" "equilibrium recharge rate " "mm" state real riverbedxy ij - 1 - i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "RIVERBED" "river bed depth" "m" +state real qintsxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qints" "canopy snow interception rate" "mm/s" +state real qintrxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qintr" "canopy rain interception rate" "mm/s" +state real qdripsxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qdrips" "canopy snow drip rate" "mm/s" +state real qdriprxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qdripr" "canopy rain drip rate" "mm/s" +state real qthrosxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qthros" "snow throughfall rate" "mm/s" +state real qthrorxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qthror" "rain throughfall rate" "mm/s" +state real qsnsubxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qsnsub" "snow pack sublimation rate" "mm/s" +state real qsnfroxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qsnfro" "snow pack frost rate" "mm/s" +state real qsubcxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qsubc" "canopy sublimation rate" "mm/s" +state real qfrocxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qfroc" "canopy frost rate" "mm/s" +state real qevacxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qevac" "canopy evaporation rate" "mm/s" +state real qdewcxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qdewc" "canopy dew rate" "mm/s" +state real qfrzcxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qfrzc" "canopy liquid freeze rate" "mm/s" +state real qmeltcxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qmeltc" "canopy snow melt rate" "mm/s" +state real qsnbotxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "qsnbot" "snow melt out of pack bottom" "mm/s" +state real pondingxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "ponding" "surface ponding from complete pack melt" "mm" +state real pahxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "pah" "precipitation advected energy" "W/m2" +state real pahgxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "pahg" "precipitation advected energy - to below canopy" "W/m2" +state real pahvxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "pahv" "precipitation advected energy - to vegetation" "W/m2" +state real pahbxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "pahb" "precipitation advected energy - to bare ground" "W/m2" +state real canhsxy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "canhs" "canopy heat storage change due to canopy temperature change" "W/m2" +state real fpicexy ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "fpice" "fraction of ice in precipitation" "fraction" +state real rainlsm ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "rainlsm" "liquid precipitation into LSM" "mm/s" +state real snowlsm ij - 1 - i02d=(interp_mask_land_field:lu_index)u=(copy_fcnm) "snowlsm" "frozen precipitation into LSM" "mm/s" state real soilcomp i{soilc}j - 1 Z i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "SOILCOMP" "soil composition" "%" state real soilcl1 ij - 1 - i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "SOILCL1" "soil texture class - level 1" "cat" state real soilcl2 ij - 1 - i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "SOILCL2" "soil texture class - level 2" "cat" state real soilcl3 ij - 1 - i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "SOILCL3" "soil texture class - level 3" "cat" state real soilcl4 ij - 1 - i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "SOILCL4" "soil texture class - level 4" "cat" -# Crop model only +# Some additional water movement +state real acints ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acints" "Accumulated canopy snow interception" "mm" +state real acintr ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acintr" "Accumulated canopy rain interception" "mm" +state real acdripr ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acdripr" "Accumulated canopy rain drip" "mm" +state real acthror ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acthror" "Accumulated rain throughfall" "mm" +state real acevac ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acevac" "Accumulated canopy evaporation" "mm" +state real acdewc ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acdewc" "Accumulated canopy dew" "mm" + +# LSM forcing variables +state real forctlsm ij - 1 - i02hd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "forctlsm" "lowest model T into LSM" "K" +state real forcqlsm ij - 1 - i02hd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "forcqlsm" "lowest model Q into LSM" "kg/kg" +state real forcplsm ij - 1 - i02hd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "forcplsm" "lowest model P into LSM" "Pa" +state real forczlsm ij - 1 - i02hd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "forczlsm" "lowest model Z into LSM" "m" +state real forcwlsm ij - 1 - i02hd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "forcwlsm" "lowest model wind speed into LSM" "m/s" + +# Needed for water budget +state real acrainlsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acrainlsm" "Accumulated liquid precipitation into LSM" "mm" +state real acrunsb ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acrunsb" "Accumulated subsurface runoff" "mm" +state real acrunsf ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acrunsf" "Accumulated surface runoff" "mm" +state real acecan ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acecan" "Accumulated evaporation of intercepted water" "mm" +state real acetran ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acetran" "Accumulated transpiration" "mm" +state real acedir ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acedir" "Accumulated ground surface evaporation" "mm" +state real acqlat ij - 1 - rh "acqlat" "accumulated lateral flow" "mm" +state real acqrf ij - 1 - rh "acqrf" "accumulated baseflow" "mm" +state real acetlsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acetlsm" "Accumulated evaporation" "mm" + +# Needed for snow water budget +state real acsnowlsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acsnowlsm" "Accumulated frozen precipitation into LSM" "mm" +state real acsubc ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acsubc" "Accumulated canopy sublimation" "mm" +state real acfroc ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acfroc" "Accumulated canopy frost" "mm" +state real acfrzc ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acfrzc" "Accumulated canopy liquid freeze" "mm" +state real acmeltc ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acmeltc" "Accumulated canopy snow melt" "mm" + +# Needed for snowpack water budget +state real acsnbot ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acsnbot" "Accumulated snow melt out of pack bottom" "mm" +state real acponding ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acponding" "Accumulated surface ponding from complete pack melt" "mm" +state real acsnsub ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acsnsub" "Accumulated snow pack sublimation" "mm" +state real acsnfro ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acsnfro" "Accumulated snow pack frost" "mm" +state real acrainsnow ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acrainsnow" "accumulated rain on snow pack" "mm" +state real acdrips ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acdrips" "Accumulated canopy snow drip" "mm" +state real acthros ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acthros" "Accumulated snow throughfall" "mm" +# Needed for energy budget +state real acsagb ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acsagb" "Accumulated solar radiation absorbed at bare fraction" "kJ/m2" +state real acirb ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acirb" "Accumulated net longwave at bare fraction " "kJ/m2" +state real acshb ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acshb" "Accumulated sensible heat flux at bare fraction" "kJ/m2" +state real acevb ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acevb" "Accumulated latent heat flux at bare fraction" "kJ/m2" +state real acghb ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acghb" "Accumulated heat flux into soil at bare fraction" "kJ/m2" +state real acpahb ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acpahb" "Accumulated precipitation advected energy to bare ground" "kJ/m2" +state real acsagv ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acsagv" "Accumulated solar radiation absorbed at vegetated fraction" "kJ/m2" +state real acirg ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acirg" "Accumulated net longwave below canopy surface" "kJ/m2" +state real acshg ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acshg" "Accumulated sensible heat flux: ground to canopy" "kJ/m2" +state real acevg ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acevg" "Accumulated latent heat flux: ground to canopy" "kJ/m2" +state real acghv ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acghv" "Accumulated heat flux into soil under canopy" "kJ/m2" +state real acpahg ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acpahg" "Accumulated precipitation advected energy to below canopy" "kJ/m2" +state real acsav ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acsav" "Accumulated solar rad absorbed by vegetated fraction" "kJ/m2" +state real acirc ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acirc" "Accumulated net longwave in canopy" "kJ/m2" +state real acshc ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acshc" "Accumulated sensible heat flux: canopy to atmosphere" "kJ/m2" +state real acevc ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acevc" "Accumulated canopy evaporation" "kJ/m2" +state real actr ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "actr" "Accumulated transpiration" "kJ/m2" +state real acpahv ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acpahv" "Accumulated precipitation advected energy to vegetation" "kJ/m2" +state real acswdnlsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acswdnlsm" "Accumulated shortwave down at LSM" "kJ/m2" +state real acswuplsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acswuplsm" "Accumulated shortwave up at LSM" "kJ/m2" +state real aclwdnlsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "aclwdnlsm" "Accumulated longwave down at LSM" "kJ/m2" +state real aclwuplsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "aclwuplsm" "Accumulated longwave up at LSM" "kJ/m2" +state real acshflsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acshflsm" "accumulated total sensible heat flux" "kJ/m2" +state real aclhflsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "aclhflsm" "accumulated total latent heat flux" "kJ/m2" +state real acghflsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acghflsm" "accumulated total ground heat flux" "kJ/m2" +state real acpahlsm ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acpahlsm" "accumulated total precip heat flux" "kJ/m2" +state real accanhs ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "accanhs" "accumulated canopy storage change" "KJ/m2" + +state real soilenergy ij - 1 - hd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "soilenergy" "energy content in soil relative to 273.16" "kJ/m2" +state real snowenergy ij - 1 - hd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "snowenergy" "energy content in snow relative to 273.16" "kJ/m2" + +state real acc_ssoil ij - 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acc_ssoil" "accumulated SSOIL between dt_soil" "W/m2" +state real acc_qinsur ij - 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acc_qinsur" "accumulated QINSUR between dt_soil" "mm/s" +state real acc_qseva ij - 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acc_qseva" "accumulated QSEVA between dt_soil" "mm/s" +state real acc_etrani ilj - 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acc_etrani" "accumulated ETRANI between dt_soil" "mm/s" +state real aceflxb ij - 1 - rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "aceflxb " "accumulated bottom soil heat flux" "kJ/m2" +state real eflxbxy ij - 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "eflxbxy " "bottom soil heat flux" "W/m2" +state real acc_dwaterxy ij - 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acc_dwater" "accumulated canopy,snow,soil water change between dt_soil" "mm" +state real acc_prcpxy ij - 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acc_prcp" "accumulated precipitation between dt_soil" "mm" +state real acc_ecanxy ij - 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acc_ecan" "accumulated net canopy evaporation between dt_soil" "mm" +state real acc_etranxy ij - 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acc_etran" "accumulated transpiration between dt_soil" "mm" +state real acc_edirxy ij - 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "acc_edir" "accumulated net soil evaporation between dt_soil" "mm" + +# Crop model only state real grainxy ij - 1 - i02rhd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "grain" "mass of grain" "g/m2" state real gddxy ij - 1 - i02rhd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "gdd" "growing degree days" "" state real croptype i{crop}j - 1 Z i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "croptype" "crop type" "fraction" @@ -112,6 +224,10 @@ state integer pgsxy ij - 1 - rh # Gecros crop model only state real gecros_state i{gecros}j - 1 Z rhd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "gecros" "gecros state array" "-" +# NoahMP tile drainage +state real TD_FRACTION ij - 1 - i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "TD_FRACTION" "Tile drainage fraction" "" +state real QTDRAIN ij - 1 - i02rhd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "QTDRAIN" "Accumulated tile drainage flux" "mm" + #Noah-MP Irrigation state real IRFRACT ij - 1 - i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "IRFRACT" "Irrigation fraction" "" state real SIFRACT ij - 1 - i012rd=(interp_mask_field:lu_index,iswater)u=(copy_fcnm) "SIFRACT" "Sprinkler Irrigation fraction" "" diff --git a/dyn_em/module_first_rk_step_part1.F b/dyn_em/module_first_rk_step_part1.F index 456126669a..41b4f33411 100644 --- a/dyn_em/module_first_rk_step_part1.F +++ b/dyn_em/module_first_rk_step_part1.F @@ -515,6 +515,7 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & CALL surface_driver( & & HYDRO_dt=HYDRO_dt, sfcheadrt=grid%sfcheadrt, & & INFXSRT=grid%INFXSRT, soldrain=grid%soldrain, & + & qtiledrain=grid%qtiledrain,ZWATBLE2D=grid%ZWATBLE2D, & ! tile drainage for WRF-Hydro & ACGRDFLX=grid%acgrdflx ,ACHFX=grid%achfx ,ACLHF=grid%aclhf & & ,ACSNOM=grid%acsnom ,ACSNOW=grid%acsnow ,AKHS=grid%akhs & & ,AKMS=grid%akms ,ALBBCK=grid%albbck ,ALBEDO=grid%albedo & @@ -838,9 +839,11 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & & ,iopt_alb=config_flags%opt_alb, iopt_snf=config_flags%opt_snf & & ,iopt_tbot=config_flags%opt_tbot, iopt_stc=config_flags%opt_stc & & ,iopt_gla=config_flags%opt_gla, iopt_rsf=config_flags%opt_rsf & - & ,iopt_soil=config_flags%opt_soil, iopt_pedo=config_flags%opt_pedo & - & ,iopt_crop=config_flags%opt_crop, iopt_irr=config_flags%opt_irr & - & ,iopt_irrm=config_flags%opt_irrm & + & ,iopt_soil=config_flags%opt_soil, iopt_pedo=config_flags%opt_pedo & + & ,iopt_crop=config_flags%opt_crop, iopt_irr=config_flags%opt_irr & + & ,iopt_irrm=config_flags%opt_irrm & + & ,iopt_infdv=config_flags%opt_infdv,iopt_tdrn=config_flags%opt_tdrn & + & ,soiltstep=config_flags%soiltstep & , isnowxy=grid%isnowxy , tvxy=grid%tvxy , tgxy=grid%tgxy & & ,canicexy=grid%canicexy ,canliqxy=grid%canliqxy, eahxy=grid%eahxy & & , tahxy=grid%tahxy , cmxy=grid%cmxy , chxy=grid%chxy & @@ -874,17 +877,35 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & & , irbxy=grid%irbxy , trxy=grid%trxy , evcxy=grid%evcxy & & ,chleafxy=grid%chleafxy , chucxy=grid%chucxy & & , chv2xy=grid%chv2xy , chb2xy=grid%chb2xy , chstarxy=grid%chstarxy & - !Noah-MP irrigation +! Noah-MP extra output fields + & , qintsxy=grid%qintsxy , qintrxy=grid%qintrxy , qdripsxy=grid%qdripsxy & + & , qdriprxy=grid%qdriprxy , qthrosxy=grid%qthrosxy , qthrorxy=grid%qthrorxy & + & , qsnsubxy=grid%qsnsubxy , qsnfroxy=grid%qsnfroxy , qsubcxy=grid%qsubcxy & + & , qfrocxy=grid%qfrocxy , qfrzcxy=grid%qfrzcxy , qmeltcxy=grid%qmeltcxy & + & , qsnbotxy=grid%qsnbotxy , pondingxy=grid%pondingxy , PAHXY=grid%PAHXY & + & , PAHGXY=grid%PAHGXY , PAHVXY=grid%PAHVXY , PAHBXY=grid%PAHBXY & + & , FPICEXY=grid%FPICEXY , qevacxy=grid%qevacxy & + & , qdewcxy=grid%qdewcxy , RAINLSM=grid%RAINLSM , SNOWLSM=grid%SNOWLSM & + & , forctlsm=grid%forctlsm , forcqlsm=grid%forcqlsm , forcplsm=grid%forcplsm & + & , forczlsm=grid%forczlsm , forcwlsm=grid%forcwlsm & + & , acc_ssoil=grid%acc_ssoil ,acc_qinsur=grid%acc_qinsur, acc_qseva=grid%acc_qseva & + & , acc_etrani=grid%acc_etrani , eflxbxy=grid%eflxbxy & + & , soilenergy=grid%soilenergy ,snowenergy=grid%snowenergy, canhsxy=grid%canhsxy & + & , ACC_DWATERXY=grid%ACC_DWATERXY, ACC_PRCPXY=grid%ACC_PRCPXY,ACC_ECANXY=grid%ACC_ECANXY & + & , ACC_ETRANXY=grid%ACC_ETRANXY, ACC_EDIRXY=grid%ACC_EDIRXY & +! Noah-MP irrigation & , IRFRACT=grid%IRFRACT , SIFRACT=grid%SIFRACT ,MIFRACT=grid%MIFRACT & & , FIFRACT=grid%FIFRACT , IRNUMSI=grid%IRNUMSI ,IRNUMMI=grid%IRNUMMI & & , IRNUMFI=grid%IRNUMFI , IRWATSI=grid%IRWATSI ,IRWATMI=grid%IRWATMI & & , IRWATFI=grid%IRWATFI , IRELOSS=grid%IRELOSS ,IRSIVOL=grid%IRSIVOL & & , IRMIVOL=grid%IRMIVOL , IRFIVOL=grid%IRFIVOL ,IRRSPLH=grid%IRRSPLH & - !Optional hydro variables in NOAHMP +! Noah-MP tile drainage + & , QTDRAIN=grid%QTDRAIN , TD_FRACTION=grid%TD_FRACTION & +! Optional hydro variables in NOAHMP & ,smcwtdxy=grid%smcwtdxy ,rechxy=grid%rechxy ,deeprechxy=grid%deeprechxy & & ,fdepthxy=grid%fdepthxy, areaxy=grid%areaxy, rivercondxy=grid%rivercondxy & & ,riverbedxy=grid%riverbedxy, eqzwt=grid%eqzwt, pexpxy=grid%pexpxy & - & ,qrfxy=grid%qrfxy, qspringxy=grid%qspringxy, qslatxy=grid%qslatxy, qrfsxy=grid%qrfsxy & + & ,qrfxy=grid%qrfxy, qspringxy=grid%qspringxy, qslatxy=grid%qslatxy, qrfsxy=grid%qrfsxy, qlatxy=grid%qlatxy & & ,qspringsxy=grid%qspringsxy, smoiseq=grid%smoiseq, wtddt=config_flags%wtddt, stepwtd=grid%stepwtd & & ,gecros_state=grid%gecros_state & ! Optional gecros crop ! Noah UA changes diff --git a/dyn_em/start_em.F b/dyn_em/start_em.F index bb51075b65..117242a7f1 100644 --- a/dyn_em/start_em.F +++ b/dyn_em/start_em.F @@ -1126,7 +1126,7 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & config_flags%opt_irr, config_flags%opt_irrm, & ! Optional Noah-MP grid%IRNUMSI, grid%IRNUMMI, grid%IRNUMFI, grid%IRWATSI, grid%IRWATMI, & ! Optional Noah-MP grid%IRWATFI, grid%IRELOSS, grid%IRSIVOL, grid%IRMIVOL, grid%IRFIVOL, & ! Optional Noah-MP - grid%IRRSPLH, & ! Optional Noah-MP + grid%IRRSPLH, grid%qtdrain, & ! Optional Noah-MP grid%gecros_state, & ! Optional gecros crop grid%XSAIXY,grid%LAI, & ! Optional Noah-MP grid%T2MVXY, grid%T2MBXY, grid%CHSTARXY, & ! Optional Noah-MP @@ -1285,8 +1285,9 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & config_flags%num_soil_layers, grid%dzs, grid%isltyp, grid%ivgtyp, config_flags%wtddt , & grid%fdepthxy , grid%ht , grid%riverbedxy, grid%eqzwt , & grid%rivercondxy, grid%pexpxy , grid%areaxy , grid%zwtxy , & - grid%smois , grid%sh2o , grid%smoiseq , grid%smcwtdxy , grid%deeprechxy, & - grid%rechxy , grid%qslatxy, grid%qrfsxy , grid%qspringsxy, & + grid%smois , grid%sh2o , grid%smoiseq , grid%smcwtdxy , & + grid%qlatxy , grid%qslatxy, grid%qrfxy , grid%qrfsxy , & + grid%deeprechxy , grid%rechxy , grid%qspringxy , grid%qspringsxy, & grid%rechclim , & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & diff --git a/phys/module_diag_misc.F b/phys/module_diag_misc.F index 691e0ae154..9c4a8a9411 100644 --- a/phys/module_diag_misc.F +++ b/phys/module_diag_misc.F @@ -636,5 +636,212 @@ SUBROUTINE diagnostic_output_calc( & END SUBROUTINE diagnostic_output_calc + +!-------------------------- NOAHMP model diagnostic output + subroutine noahmp_output_calc( ims,ime, jms,jme ,& + i_start ,i_end ,j_start ,j_end ,num_tiles ,& + dt ,noahmp_acc_dt ,curr_secs2,opt_run ,stepwtd ,itimestep ,& + acsagv ,acsagb ,acirg ,acshg ,acevg ,acghv ,acpahg ,acirb ,& + acshb ,acevb ,acghb ,acpahb ,acsav ,acirc ,acshc ,acevc ,& + actr ,acpahv ,acswdnlsm,acswuplsm, & + aclwdnlsm,aclwuplsm,acshflsm ,aclhflsm ,acghflsm ,acpahlsm,acints ,acintr ,& + acdrips ,acdripr ,acthros ,acthror ,acetlsm ,& + acsnsub ,acsnfro ,acsubc ,acfroc ,acevac ,acdewc ,acfrzc ,acmeltc ,& + acsnbot ,acponding,acrainlsm,acsnowlsm,acrainsnow,acrunsb ,acrunsf ,isnow ,& + acqlat ,acqrf ,acrech ,acqspring ,acecan ,acetran ,acedir ,aceflxb ,accanhs ,& + sag ,irg ,shg ,evg ,ghv ,pahg ,irb ,shb ,& + evb ,ghb ,pahb ,sav ,ircmp ,shc ,evc ,tr ,& + pahv ,swdown ,albedo ,emiss , & + glw ,trad ,qints ,qintr ,qdrips ,qdripr ,qthros ,qthror ,& + qsnsub ,qsnfro ,qsubc ,qfroc ,qevac ,qdewc ,qfrzc ,qmeltc ,& + qsnbot ,ponding ,rainlsm ,snowlsm ,runsb ,runsf ,fpice ,fveg ,& + qlat ,qrf ,deeprech ,qspring ,ecan ,etran ,edir ,eflxb, canhs ) + +!---------------------------------------------------------------------- + + implicit none + +!====================================================================== + + integer, intent(in ) :: ims,ime, jms,jme, num_tiles + + integer, dimension(num_tiles), intent(in) :: i_start,i_end,j_start,j_end + + real , intent(in) :: dt + real , optional, intent(in) :: noahmp_acc_dt, curr_secs2 + integer, optional, intent(in) :: opt_run, stepwtd, itimestep + + real, dimension( ims:ime, jms:jme ), optional, intent(inout) :: & + acsagv ,acsagb ,acirg ,acshg ,acevg ,acghv ,acpahg ,acirb ,& + acshb ,acevb ,acghb ,acpahb ,acsav ,acirc ,acshc ,acevc ,& + actr ,acpahv ,acswdnlsm,acswuplsm, & + aclwdnlsm,aclwuplsm,acshflsm ,aclhflsm ,acghflsm ,acpahlsm,acints ,acintr ,& + acdrips ,acdripr ,acthros ,acthror ,acetlsm ,& + acsnsub ,acsnfro ,acsubc ,acfroc ,acevac ,acdewc ,acfrzc ,acmeltc ,& + acsnbot ,acponding,acrainlsm,acsnowlsm,acrainsnow,acrunsb ,acrunsf , & + acqlat ,acqrf ,acrech ,acqspring,acecan ,acetran ,acedir ,aceflxb ,& + accanhs + + real, dimension( ims:ime, jms:jme ), optional, intent(in) :: & + sag ,irg ,shg ,evg ,ghv ,pahg ,irb ,shb ,& + evb ,ghb ,pahb ,sav ,ircmp ,shc ,evc ,tr ,& + pahv ,swdown ,albedo ,emiss , & + glw ,trad ,qints ,qintr ,qdrips ,qdripr ,qthros ,qthror ,& + qsnsub ,qsnfro ,qsubc ,qfroc ,qevac ,qdewc ,qfrzc ,qmeltc ,& + qsnbot ,ponding ,rainlsm ,snowlsm ,runsb ,runsf ,fpice ,fveg ,& + qlat ,qrf ,deeprech ,qspring ,ecan ,etran ,edir ,eflxb ,& + canhs + + integer, dimension( ims:ime, jms:jme ), optional, intent(in) :: isnow + + integer :: i,j,ij + real :: kjconvert + +! compute noah-mp accumulation in a given time window: noahmp_acc_dt + + if (noahmp_acc_dt .gt. 0.) then + +! !$omp parallel do & +! !$omp private ( ij ) + + do ij = 1 , num_tiles + + do j=j_start(ij),j_end(ij) + do i=i_start(ij),i_end(ij) + if (mod(curr_secs2, 60.* noahmp_acc_dt) == 0.) then + acsagb(i,j) = 0. + acsagv(i,j) = 0. + acirg(i,j) = 0. + acshg(i,j) = 0. + acevg(i,j) = 0. + acghv(i,j) = 0. + acpahg(i,j) = 0. + acirb(i,j) = 0. + acshb(i,j) = 0. + acevb(i,j) = 0. + acghb(i,j) = 0. + acpahb(i,j) = 0. + acsav(i,j) = 0. + acirc(i,j) = 0. + acshc(i,j) = 0. + acevc(i,j) = 0. + actr (i,j) = 0. + acpahv(i,j) = 0. + accanhs(i,j)= 0. + acswdnlsm(i,j) = 0. + acswuplsm(i,j) = 0. + aclwdnlsm(i,j) = 0. + aclwuplsm(i,j) = 0. + acshflsm(i,j) = 0. + aclhflsm(i,j) = 0. + acghflsm(i,j) = 0. + acpahlsm(i,j) = 0. + acints(i,j) = 0. + acintr(i,j) = 0. + acdrips(i,j) = 0. + acdripr(i,j) = 0. + acthros(i,j) = 0. + acthror(i,j) = 0. + acsnsub(i,j) = 0. + acsnfro(i,j) = 0. + acsubc(i,j) = 0. + acfroc(i,j) = 0. + acevac(i,j) = 0. + acdewc(i,j) = 0. + acfrzc(i,j) = 0. + acmeltc(i,j) = 0. + acsnbot(i,j) = 0. + acrunsf(i,j) = 0. + acrunsb(i,j) = 0. + acecan(i,j) = 0. + acetran(i,j) = 0. + acedir(i,j) = 0. + acetlsm(i,j) = 0. + aceflxb(i,j) = 0. + acponding(i,j) = 0. + acrainsnow(i,j) = 0. + acrainlsm(i,j) = 0. + acsnowlsm(i,j) = 0. + acqlat(i,j) = 0. + acqrf(i,j) = 0. + acrech(i,j) = 0. + acqspring(i,j) = 0. + endif + + kjconvert = dt / 1000.0 + acsagb(i,j) = acsagb(i,j) + kjconvert * (1.0 - fveg(i,j)) * sag(i,j) + acsagv(i,j) = acsagv(i,j) + kjconvert * fveg(i,j) * sag(i,j) + acirg(i,j) = acirg(i,j) + kjconvert * fveg(i,j) * irg(i,j) + acshg(i,j) = acshg(i,j) + kjconvert * fveg(i,j) * shg(i,j) + acevg(i,j) = acevg(i,j) + kjconvert * fveg(i,j) * evg(i,j) + acghv(i,j) = acghv(i,j) + kjconvert * fveg(i,j) * ghv(i,j) + acpahg(i,j) = acpahg(i,j) + kjconvert * fveg(i,j) * pahg(i,j) + acirb(i,j) = acirb(i,j) + kjconvert * (1.0 - fveg(i,j)) * irb(i,j) + acshb(i,j) = acshb(i,j) + kjconvert * (1.0 - fveg(i,j)) * shb(i,j) + acevb(i,j) = acevb(i,j) + kjconvert * (1.0 - fveg(i,j)) * evb(i,j) + acghb(i,j) = acghb(i,j) + kjconvert * (1.0 - fveg(i,j)) * ghb(i,j) + acpahb(i,j) = acpahb(i,j) + kjconvert * (1.0 - fveg(i,j)) * pahb(i,j) + acsav(i,j) = acsav(i,j) + kjconvert * sav(i,j) + acirc(i,j) = acirc(i,j) + kjconvert * ircmp(i,j) + acshc(i,j) = acshc(i,j) + kjconvert * shc(i,j) + acevc(i,j) = acevc(i,j) + kjconvert * evc(i,j) + actr(i,j) = actr(i,j) + kjconvert * tr(i,j) + aceflxb(i,j)= aceflxb(i,j)+ eflxb(i,j) / 1000.0 ! multiplied by dt_soil in ENERGY + accanhs(i,j)= accanhs(i,j)+ kjconvert * canhs(i,j) + acpahv(i,j) = acpahv(i,j) + kjconvert * pahv(i,j) + acswdnlsm(i,j) = acswdnlsm(i,j) + kjconvert * swdown(i,j) + acswuplsm(i,j) = acswuplsm(i,j) + kjconvert * swdown(i,j)*albedo(i,j) + aclwdnlsm(i,j) = aclwdnlsm(i,j) + kjconvert * glw(i,j)*emiss(i,j) + aclwuplsm(i,j) = aclwuplsm(i,j) + kjconvert * 5.67e-08*emiss(i,j)*trad(i,j)*trad(i,j)*trad(i,j)*trad(i,j) + acshflsm(i,j) = acshg(i,j) + acshc(i,j) + acshb(i,j) + aclhflsm(i,j) = acevg(i,j) + acevc(i,j) + actr(i,j) + acevb(i,j) + acghflsm(i,j) = acghv(i,j) + acghb(i,j) + acpahlsm(i,j) = acpahv(i,j) + acpahg(i,j) + acpahb(i,j) + acints(i,j) = acints(i,j) + dt * qints(i,j) + acintr(i,j) = acintr(i,j) + dt * qintr(i,j) + acdrips(i,j) = acdrips(i,j) + dt * qdrips(i,j) + acdripr(i,j) = acdripr(i,j) + dt * qdripr(i,j) + acthros(i,j) = acthros(i,j) + dt * qthros(i,j) + acthror(i,j) = acthror(i,j) + dt * qthror(i,j) + acsnsub(i,j) = acsnsub(i,j) + dt * qsnsub(i,j) + acsnfro(i,j) = acsnfro(i,j) + dt * qsnfro(i,j) + acsubc(i,j) = acsubc(i,j) + dt * qsubc(i,j) + acfroc(i,j) = acfroc(i,j) + dt * qfroc(i,j) + acevac(i,j) = acevac(i,j) + dt * qevac(i,j) + acdewc(i,j) = acdewc(i,j) + dt * qdewc(i,j) + acfrzc(i,j) = acfrzc(i,j) + dt * qfrzc(i,j) + acmeltc(i,j) = acmeltc(i,j) + dt * qmeltc(i,j) + acsnbot(i,j) = acsnbot(i,j) + dt * qsnbot(i,j) + acrunsf(i,j) = acrunsf(i,j) + runsf(i,j) ! multiplied by dt_soil in WATER + acrunsb(i,j) = acrunsb(i,j) + runsb(i,j) ! multiplied by dt_soil in WATER + acecan(i,j) = acecan(i,j) + dt * ecan(i,j) + acetran(i,j) = acetran(i,j) + dt * etran(i,j) + acedir(i,j) = acedir(i,j) + dt * edir(i,j) + acetlsm(i,j) = acetlsm(i,j) + dt * (etran(i,j) + edir(i,j) + ecan(i,j)) + acponding(i,j) = acponding(i,j) + ponding(i,j) + acrainlsm(i,j) = acrainlsm(i,j) + dt * rainlsm(i,j) + acsnowlsm(i,j) = acsnowlsm(i,j) + dt * snowlsm(i,j) + if(opt_run == 5) then + if(mod(itimestep,stepwtd) == 0) then + acqlat(i,j) = acqlat(i,j) + qlat(i,j) * 1000.0 + acqrf(i,j) = acqrf(i,j) + qrf(i,j) * 1000.0 + acrech(i,j) = acrech(i,j) + deeprech(i,j) + acqspring(i,j) = acqspring(i,j) + qspring(i,j) + endif + endif + if(isnow(i,j) < 0 .and. isnow(i,j) > -5) then + acrainsnow(i,j) = acrainsnow(i,j) + dt * (qdripr(i,j) + qthror(i,j)) + endif + enddo + enddo + + enddo + +! !$omp end parallel do + endif + + end subroutine noahmp_output_calc + + END MODULE module_diag_misc #endif diff --git a/phys/module_diagnostics_driver.F b/phys/module_diagnostics_driver.F index 1574a8e3b4..ab47779335 100644 --- a/phys/module_diagnostics_driver.F +++ b/phys/module_diagnostics_driver.F @@ -69,7 +69,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & !============================================================= USE module_lightning_driver, ONLY : lightning_driver - USE module_diag_misc, ONLY : diagnostic_output_calc + USE module_diag_misc, ONLY : diagnostic_output_calc, noahmp_output_calc USE module_diag_nwp, ONLY : diagnostic_output_nwp USE module_diag_cl, ONLY : clwrf_output_calc USE module_diag_pld, ONLY : pld @@ -1092,6 +1092,84 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & END IF RASM_DIAGS_DIURNAL + ! Noah-MP accumulation output + + NOAHMP_DIAGS : IF ( config_flags%sf_surface_physics == 4 .and. config_flags%noahmp_output == 3 ) THEN + + CALL wrf_debug ( 100 , '--> CALL DIAGNOSTICS PACKAGE: NOAHMP_DIAGS' ) + + CALL domain_clock_get ( grid, current_time=currentTime) + + CALL noahmp_output_calc( & + ims=ims, ime=ime, jms=jms, jme=jme ,& + i_start=grid%i_start, i_end=min(grid%i_end, ide-1) ,& + j_start=grid%j_start, j_end=min(grid%j_end, jde-1) ,& + num_tiles=grid%num_tiles ,& + dt=grid%dt ,& + noahmp_acc_dt=config_flags%noahmp_acc_dt ,& + opt_run=config_flags%opt_run ,& + stepwtd=grid%stepwtd ,& + itimestep=grid%itimestep ,& + curr_secs2=curr_secs2 ,& + acsagb=grid%acsagb , acsagv=grid%acsagv , sag=grid%sagxy ,& + acirg=grid%acirg , irg=grid%irgxy ,& + acshg=grid%acshg , shg=grid%shgxy ,& + acevg=grid%acevg , evg=grid%evgxy ,& + acghv=grid%acghv , ghv=grid%ghvxy ,& + acpahg=grid%acpahg , pahg=grid%pahgxy ,& + acirb=grid%acirb , irb=grid%irbxy ,& + acshb=grid%acshb , shb=grid%shbxy ,& + acevb=grid%acevb , evb=grid%evbxy ,& + acghb=grid%acghb , ghb=grid%ghbxy ,& + acpahb=grid%acpahb , pahb=grid%pahbxy ,& + acsav=grid%acsav , sav=grid%savxy ,& + acirc=grid%acirc , ircmp=grid%ircxy ,& + acshc=grid%acshc , shc=grid%shcxy ,& + acevc=grid%acevc , evc=grid%evcxy ,& + actr=grid%actr , tr=grid%trxy ,& + acpahv=grid%acpahv , pahv=grid%pahvxy ,& + acswdnlsm=grid%acswdnlsm , swdown=grid%swnorm ,& + acswuplsm=grid%acswuplsm , albedo=grid%albedo ,& + aclwdnlsm=grid%aclwdnlsm , emiss=grid%emiss , glw=grid%glw ,& + aclwuplsm=grid%aclwuplsm , trad=grid%tradxy ,& + acshflsm=grid%acshflsm ,aclhflsm=grid%aclhflsm ,& + acghflsm=grid%acghflsm ,acpahlsm=grid%acpahlsm ,& + acints=grid%acints , qints=grid%qintsxy ,& + acintr=grid%acintr , qintr=grid%qintrxy ,& + acdrips=grid%acdrips , qdrips=grid%qdripsxy ,& + acdripr=grid%acdripr , qdripr=grid%qdriprxy ,& + acthros=grid%acthros , qthros=grid%qthrosxy ,& + acthror=grid%acthror , qthror=grid%qthrorxy ,& + acsnsub=grid%acsnsub , qsnsub=grid%qsnsubxy ,& + acsnfro=grid%acsnfro , qsnfro=grid%qsnfroxy ,& + acsubc=grid%acsubc , qsubc=grid%qsubcxy ,& + acfroc=grid%acfroc , qfroc=grid%qfrocxy ,& + acevac=grid%acevac , qevac=grid%qevacxy ,& + acdewc=grid%acdewc , qdewc=grid%qdewcxy ,& + acfrzc=grid%acfrzc , qfrzc=grid%qfrzcxy ,& + acmeltc=grid%acmeltc , qmeltc=grid%qmeltcxy ,& + acsnbot=grid%acsnbot , qsnbot=grid%qsnbotxy ,& + acponding=grid%acponding , ponding=grid%pondingxy ,& + acrainlsm=grid%acrainlsm , rainlsm=grid%rainlsm ,& + acsnowlsm=grid%acsnowlsm , snowlsm=grid%snowlsm ,& + acrainsnow=grid%acrainsnow, isnow=grid%isnowxy ,& + acrunsb=grid%acrunsb , runsb=grid%runsbxy ,& + acrunsf=grid%acrunsf , runsf=grid%runsfxy ,& + acecan=grid%acecan , ecan=grid%ecanxy ,& + acetran=grid%acetran , etran=grid%etranxy ,& + acedir=grid%acedir , edir=grid%edirxy ,& + acetlsm=grid%acetlsm ,& + acqlat=grid%acqlat , qlat=grid%qlatxy ,& + acqrf=grid%acqrf , qrf=grid%qrfxy ,& + acrech=grid%acrech ,deeprech=grid%deeprechxy ,& + acqspring=grid%acqspring , qspring=grid%qspringxy ,& + fpice=grid%fpicexy , fveg=grid%fvegxy ,& + aceflxb=grid%aceflxb , eflxb=grid%eflxbxy ,& + accanhs=grid%accanhs , canhs=grid%canhsxy ) + + END IF NOAHMP_DIAGS + + SOLAR_FIELDS: IF (config_flags%solar_diagnostics == do_solar_output) THEN CALL wrf_debug (100 , '--> CALL DIAGNOSTICS PACKAGE: SOLAR_DIAG') diff --git a/phys/module_physics_init.F b/phys/module_physics_init.F index edf2e79779..2bc49ebeae 100644 --- a/phys/module_physics_init.F +++ b/phys/module_physics_init.F @@ -134,7 +134,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & iopt_irr, iopt_irrm, & IRNUMSI, IRNUMMI, IRNUMFI, IRWATSI, IRWATMI, & ! Optional Noah-MP IRWATFI, IRELOSS, IRSIVOL, IRMIVOL, IRFIVOL, & ! Optional Noah-MP - IRRSPLH, & + IRRSPLH, qtdrain, & gecros_state, & ! Optional gecros crop XSAIXY, LAI, & ! Optional Noah-MP T2MVXY, T2MBXY, CHSTARXY , & ! Optional Noah-MP @@ -578,6 +578,8 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & INTEGER, OPTIONAL, DIMENSION(ims:ime,jms:jme) :: IRNUMSI INTEGER, OPTIONAL, DIMENSION(ims:ime,jms:jme) :: IRNUMMI INTEGER, OPTIONAL, DIMENSION(ims:ime,jms:jme) :: IRNUMFI +! tile drainage + REAL, OPTIONAL, DIMENSION(ims:ime,jms:jme) :: qtdrain ! REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL, INTENT(INOUT ) :: qnn_curr @@ -1426,7 +1428,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & iopt_irr, iopt_irrm, & IRNUMSI, IRNUMMI, IRNUMFI, IRWATSI, IRWATMI, & ! Noah-MP Irrigation IRWATFI, IRELOSS, IRSIVOL, IRMIVOL, IRFIVOL, & ! Noah-MP Irrigation - IRRSPLH, & ! Noah-MP Irrigation + IRRSPLH, qtdrain, & ! Noah-MP Irrigation gecros_state, & ! Optional gecros crop XSAIXY, LAI, & SMOISEQ, SMCWTDXY, RECHXY, DEEPRECHXY, AREAXY, & @@ -2461,7 +2463,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & iopt_irr, iopt_irrm, & IRNUMSI, IRNUMMI, IRNUMFI, IRWATSI, IRWATMI, & ! Noah-MP Irrigation IRWATFI, IRELOSS, IRSIVOL, IRMIVOL, IRFIVOL, & ! Noah-MP Irrigation - IRRSPLH, & + IRRSPLH, qtdrain, & gecros_state, & ! Optional gecros crop XSAIXY, LAI, & SMOISEQ, SMCWTDXY, RECHXY, DEEPRECHXY, AREAXY, & @@ -2816,6 +2818,8 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & INTEGER, OPTIONAL, DIMENSION(ims:ime,jms:jme) :: IRNUMSI INTEGER, OPTIONAL, DIMENSION(ims:ime,jms:jme) :: IRNUMMI INTEGER, OPTIONAL, DIMENSION(ims:ime,jms:jme) :: IRNUMFI +! tile drainage + REAL, OPTIONAL, DIMENSION(ims:ime,jms:jme) :: qtdrain !URBAN ! REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR !Optional urban @@ -3375,7 +3379,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte & #if (EM_CORE == 1) - ,smoiseq ,smcwtdxy ,rechxy ,deeprechxy, areaxy ,dx, dy, msftx, msfty,& + ,smoiseq ,smcwtdxy ,rechxy ,deeprechxy, qtdrain, areaxy ,dx, dy, msftx, msfty,& wtddt ,stepwtd ,dt ,qrfsxy ,qspringsxy ,qslatxy, & fdepthxy ,ht ,riverbedxy ,eqzwt ,rivercondxy ,pexpxy, & rechclim, & diff --git a/phys/module_sf_noahmp_glacier.F b/phys/module_sf_noahmp_glacier.F index b9ec3c4534..8142dd8322 100644 --- a/phys/module_sf_noahmp_glacier.F +++ b/phys/module_sf_noahmp_glacier.F @@ -2255,9 +2255,9 @@ SUBROUTINE SNOWWATER_GLACIER (NSNOW ,NSOIL ,IMELT ,DT ,SFCTMP , & !in !to obtain equilibrium state of snow in glacier region - IF(SNEQV > 2000.) THEN ! 2000 mm -> maximum water depth + IF(SNEQV > 5000.0) THEN ! 5000 mm -> maximum water depth BDSNOW = SNICE(0) / DZSNSO(0) - SNOFLOW = (SNEQV - 2000.) + SNOFLOW = (SNEQV - 5000.0) SNICE(0) = SNICE(0) - SNOFLOW DZSNSO(0) = DZSNSO(0) - SNOFLOW/BDSNOW SNOFLOW = SNOFLOW / DT diff --git a/phys/module_sf_noahmp_groundwater.F b/phys/module_sf_noahmp_groundwater.F index 79edf3036e..2980039570 100644 --- a/phys/module_sf_noahmp_groundwater.F +++ b/phys/module_sf_noahmp_groundwater.F @@ -13,7 +13,7 @@ SUBROUTINE WTABLE_mmf_noahmp (NSOIL ,XLAND ,XICE ,XICE_THRESHOLD ,ISI ISLTYP ,SMOISEQ ,DZS ,WTDDT ,& !in FDEPTH ,AREA ,TOPO ,ISURBAN ,IVGTYP ,& !in RIVERCOND ,RIVERBED ,EQWTD ,PEXP ,& !in - SMOIS ,SH2OXY ,SMCWTD ,WTD ,QRF ,& !inout + SMOIS ,SH2OXY ,SMCWTD ,WTD , QLAT, QRF ,& !inout DEEPRECH ,QSPRING ,QSLAT ,QRFS ,QSPRINGS ,RECH ,& !inout ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -83,7 +83,7 @@ SUBROUTINE WTABLE_mmf_noahmp (NSOIL ,XLAND ,XICE ,XICE_THRESHOLD ,ISI REAL :: DELTAT,RCOND,TOTWATER,PSI & ,WFLUXDEEP,WCNDDEEP,DDZ,SMCWTDMID & ,WPLUS,WMINUS - REAL, DIMENSION( ims:ime, jms:jme ) :: QLAT + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: QLAT INTEGER, DIMENSION( ims:ime, jms:jme ) :: LANDMASK !-1 for water (ice or no ice) and glacial areas, 1 for land where the LSM does its soil moisture calculations. REAL :: BEXP,DKSAT,PSISAT,SMCMAX,SMCWLT diff --git a/phys/module_sf_noahmpdrv.F b/phys/module_sf_noahmpdrv.F index b2b5e4afc4..7a0f0ab510 100644 --- a/phys/module_sf_noahmpdrv.F +++ b/phys/module_sf_noahmpdrv.F @@ -17,7 +17,7 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN IDVEG, IOPT_CRS, IOPT_BTR, IOPT_RUN, IOPT_SFC, IOPT_FRZ, & ! IN : User options IOPT_INF, IOPT_RAD, IOPT_ALB, IOPT_SNF,IOPT_TBOT, IOPT_STC, & ! IN : User options IOPT_GLA, IOPT_RSF, IOPT_SOIL,IOPT_PEDO,IOPT_CROP, IOPT_IRR, & ! IN : User options - IOPT_IRRM, & ! IN : User options + IOPT_IRRM, IOPT_INFDV, IOPT_TDRN,soiltstep, & ! IN : User options IZ0TLND, SF_URBAN_PHYSICS, & ! IN : User options SOILCOMP, SOILCL1, SOILCL2, SOILCL3, SOILCL4, & ! IN : User options T3D, QV3D, U_PHY, V_PHY, SWDOWN, SWDDIR,& @@ -38,6 +38,7 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN WOODXY, STBLCPXY, FASTCPXY, XLAIXY, XSAIXY, TAUSSXY, & ! IN/OUT Noah MP only SMOISEQ, SMCWTDXY,DEEPRECHXY, RECHXY, GRAINXY, GDDXY,PGSXY, & ! IN/OUT Noah MP only GECROS_STATE, & ! IN/OUT gecros model + QTDRAIN, TD_FRACTION, & ! IN/OUT tile drainage T2MVXY, T2MBXY, Q2MVXY, Q2MBXY, & ! OUT Noah MP only TRADXY, NEEXY, GPPXY, NPPXY, FVEGXY, RUNSFXY, & ! OUT Noah MP only RUNSBXY, ECANXY, EDIRXY, ETRANXY, FSAXY, FIRAXY, & ! OUT Noah MP only @@ -46,13 +47,24 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN SHGXY, SHCXY, SHBXY, EVGXY, EVBXY, GHVXY, & ! OUT Noah MP only GHBXY, IRGXY, IRCXY, IRBXY, TRXY, EVCXY, & ! OUT Noah MP only CHLEAFXY, CHUCXY, CHV2XY, CHB2XY, RS, & ! OUT Noah MP only + QINTSXY ,QINTRXY ,QDRIPSXY ,& + QDRIPRXY ,QTHROSXY ,QTHRORXY ,& + QSNSUBXY ,QSNFROXY ,QSUBCXY ,& + QFROCXY ,QEVACXY ,QDEWCXY ,QFRZCXY ,QMELTCXY ,& + QSNBOTXY ,PONDINGXY ,PAHXY ,PAHGXY, PAHVXY, PAHBXY,& + FPICEXY,RAINLSM,SNOWLSM,FORCTLSM ,FORCQLSM,FORCPLSM,FORCZLSM,FORCWLSM,& + ACC_SSOILXY, ACC_QINSURXY, ACC_QSEVAXY, ACC_ETRANIXY, EFLXBXY, & + SOILENERGY, SNOWENERGY, CANHSXY, & + ACC_DWATERXY, ACC_PRCPXY, ACC_ECANXY, ACC_ETRANXY, ACC_EDIRXY, & ! BEXP_3D,SMCDRY_3D,SMCWLT_3D,SMCREF_3D,SMCMAX_3D, & ! placeholders to activate 3D soil ! DKSAT_3D,DWSAT_3D,PSISAT_3D,QUARTZ_3D, & ! REFDK_2D,REFKDT_2D, & -! IRR_FRAC_2D,IRR_HAR_2D,IRR_LAI_2D,IRR_MAD_2D,FILOSS_2D, & -! SPRIR_RATE_2D,MICIR_RATE_2D,FIRTFAC_2D,IR_RAIN_2D, & +! IRR_FRAC_2D,IRR_HAR_2D,IRR_LAI_2D,IRR_MAD_2D,FILOSS_2D, & +! SPRIR_RATE_2D,MICIR_RATE_2D,FIRTFAC_2D,IR_RAIN_2D, & +! BVIC_2D,AXAJ_2D,BXAJ_2D,XXAJ_2D,BDVIC_2D,GDVIC_2D,BBVIC_2D,& +! KLAT_FAC,TDSMC_FAC,TD_DC,TD_DCOEF,TD_DDRAIN,TD_RADI,TD_SPAC, & #ifdef WRF_HYDRO - sfcheadrt,INFXSRT,soldrain, & + sfcheadrt,INFXSRT,soldrain,qtiledrain,ZWATBLE2D, & #endif ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -112,6 +124,9 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN INTEGER, INTENT(IN ) :: IOPT_CROP ! crop model option (0->none; 1->Liu et al.; 2->Gecros) INTEGER, INTENT(IN ) :: IOPT_IRR ! irrigation scheme (0->none; >1 irrigation scheme ON) INTEGER, INTENT(IN ) :: IOPT_IRRM ! irrigation method + INTEGER, INTENT(IN ) :: IOPT_INFDV! infiltration options for dynamic VIC infiltration (1->Philip; 2-> Green-Ampt;3->Smith-Parlange) + INTEGER, INTENT(IN ) :: IOPT_TDRN ! tile drainage (0-> no tile drainage; 1-> simple tile drainage;2->Hooghoudt's) + REAL, INTENT(IN ) :: soiltstep ! soil timestep (s), default:0->same as main model timestep INTEGER, INTENT(IN ) :: IZ0TLND ! option of Chen adjustment of Czil (not used) INTEGER, INTENT(IN ) :: sf_urban_physics ! urban physics option REAL, DIMENSION( ims:ime, 8, jms:jme ), INTENT(IN ) :: SOILCOMP ! soil sand and clay percentage @@ -149,10 +164,14 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: PGSXY ! gecros model - REAL, DIMENSION( ims:ime, 60,jms:jme ), INTENT(INOUT) :: gecros_state ! gecros crop + REAL, DIMENSION( ims:ime, 60,jms:jme ), INTENT(INOUT) :: gecros_state ! gecros crop + +!Tile drain variables + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QTDRAIN + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TD_FRACTION #ifdef WRF_HYDRO - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfcheadrt,INFXSRT,soldrain ! for WRF-Hydro + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfcheadrt,INFXSRT,soldrain,qtiledrain,ZWATBLE2D ! for WRF-Hydro #endif ! placeholders for 3D soil ! REAL, DIMENSION( ims:ime, 1:nsoil, jms:jme ), INTENT(IN) :: BEXP_3D ! C-H B exponent @@ -166,6 +185,13 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN ! REAL, DIMENSION( ims:ime, 1:nsoil, jms:jme ), INTENT(IN) :: QUARTZ_3D ! Soil quartz content ! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: REFDK_2D ! Reference Soil Conductivity ! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: REFKDT_2D ! Soil Infiltration Parameter +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: BVIC_2D ! VIC model infiltration parameter [-] for opt_run=6 +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: AXAJ_2D ! Xinanjiang: Tension water distribution inflection parameter [-] for opt_run=7 +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: BXAJ_2D ! Xinanjiang: Tension water distribution shape parameter [-] for opt_run=7 +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XXAJ_2D ! Xinanjiang: Free water distribution shape parameter [-] for opt_run=7 +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: BDVIC_2D ! VIC model infiltration parameter [-] +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: GDVIC_2D ! Mean Capillary Drive (m) for infiltration models +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: BBVIC_2D ! DVIC heterogeniety paramater [-] ! placeholders for 2D irrigation parameters ! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: IRR_FRAC_2D ! irrigation Fraction @@ -178,6 +204,15 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN ! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FIRTFAC_2D ! flood application rate factor ! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: IR_RAIN_2D ! maximum precipitation to stop irrigation trigger +! placeholders for 2D tile drainage parameters +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: KLAT_FAC ! factor multiplier to hydraulic conductivity +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TDSMC_FAC ! factor multiplier to field capacity +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TD_DC ! drainage coefficient for simple +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TD_DCOEF ! drainge coefficient for Hooghoudt +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TD_DDRAIN ! depth of drain +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TD_RADI ! tile radius +! REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TD_SPAC ! tile spacing + ! INOUT (with generic LSM equivalent) REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TSK ! surface radiative temperature [K] @@ -252,8 +287,8 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: GPPXY ! gross primary assimilation [g/m2/s C] REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: NPPXY ! net primary productivity [g/m2/s C] REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: FVEGXY ! Noah-MP vegetation fraction [-] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: RUNSFXY ! surface runoff [mm/s] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: RUNSBXY ! subsurface runoff [mm/s] + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: RUNSFXY ! surface runoff [mm] per soil timestep + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: RUNSBXY ! subsurface runoff [mm] per soil timestep REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: ECANXY ! evaporation of intercepted water (mm/s) REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: EDIRXY ! soil surface evaporation rate (mm/s] REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: ETRANXY ! transpiration rate (mm/s) @@ -286,7 +321,50 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: CHLEAFXY ! leaf exchange coefficient REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: CHUCXY ! under canopy exchange coefficient REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: CHV2XY ! veg 2m exchange coefficient - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: CHB2XY ! bare 2m exchange coefficient + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: CHB2XY ! bare 2m exchange coefficient +! additional output variables + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: PAHXY ! precipitation advected heat + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: PAHGXY ! precipitation advected heat + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: PAHBXY ! precipitation advected heat + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: PAHVXY ! precipitation advected heat + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QINTSXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QINTRXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QDRIPSXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QDRIPRXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QTHROSXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QTHRORXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QSNSUBXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QSNFROXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QSUBCXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QFROCXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QEVACXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QDEWCXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QFRZCXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QMELTCXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: QSNBOTXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: PONDINGXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: FPICEXY !fraction of ice in precip + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: RAINLSM !rain rate (mm/s) AJN + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: SNOWLSM !liquid equivalent snow rate (mm/s) AJN + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: FORCTLSM + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: FORCQLSM + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: FORCPLSM + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: FORCZLSM + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: FORCWLSM + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ACC_SSOILXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ACC_QINSURXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ACC_QSEVAXY + REAL, DIMENSION( ims:ime, 1:NSOIL, jms:jme ), INTENT(INOUT) :: ACC_ETRANIXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: EFLXBXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: SOILENERGY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: SNOWENERGY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: CANHSXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ACC_DWATERXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ACC_PRCPXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ACC_ECANXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ACC_ETRANXY + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ACC_EDIRXY + INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ! d -> domain & ims,ime, jms,jme, kms,kme, & ! m -> memory & its,ite, jts,jte, kts,kte ! t -> tile @@ -411,6 +489,13 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN REAL :: PSAI ! stem area index REAL :: TAUSS ! non-dimensional snow age +! tile drainage + REAL :: QTLDRN ! tile drainage (mm) + REAL :: TDFRACMP ! tile drainage map +#ifdef WRF_HYDRO + REAL :: WATBLED ! water table depth for tile drainage +#endif + ! OUT (with no Noah LSM equivalent) REAL :: Z0WRF ! combined z0 sent to coupled model @@ -423,8 +508,8 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN REAL :: GPP ! gross primary assimilation [g/m2/s C] REAL :: NPP ! net primary productivity [g/m2/s C] REAL :: FVEGMP ! greenness vegetation fraction [-] - REAL :: RUNSF ! surface runoff [mm/s] - REAL :: RUNSB ! subsurface runoff [mm/s] + REAL :: RUNSF ! surface runoff [mm] per soil timestep + REAL :: RUNSB ! subsurface runoff [mm] per soil timestep REAL :: ECAN ! evaporation of intercepted water (mm/s) REAL :: ETRAN ! transpiration rate (mm/s) REAL :: ESOIL ! soil surface evaporation rate (mm/s] @@ -462,14 +547,43 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN REAL :: CHLEAF ! leaf exchange coefficient REAL :: CHUC ! under canopy exchange coefficient REAL :: CHV2 ! veg 2m exchange coefficient - REAL :: CHB2 ! bare 2m exchange coefficient - REAL :: PAHV !precipitation advected heat - vegetation net (W/m2) - REAL :: PAHG !precipitation advected heat - under canopy net (W/m2) - REAL :: PAHB !precipitation advected heat - bare ground net (W/m2) - REAL :: PAH !precipitation advected heat - total (W/m2) + REAL :: CHB2 ! bare 2m exchange coefficient + REAL :: QINTS + REAL :: QINTR + REAL :: QDRIPS + REAL :: QDRIPR + REAL :: QTHROS + REAL :: QTHROR + REAL :: QSNSUB + REAL :: QSNFRO + REAL :: QEVAC + REAL :: QDEWC + REAL :: QSUBC + REAL :: QFROC + REAL :: QFRZC + REAL :: QMELTC + REAL :: PAHV !precipitation advected heat - vegetation net (W/m2) + REAL :: PAHG !precipitation advected heat - under canopy net (W/m2) + REAL :: PAHB !precipitation advected heat - bare ground net (W/m2) + REAL :: PAH !precipitation advected heat - total (W/m2) + REAL :: RAININ !rain rate (mm/s) + REAL :: SNOWIN !liquid equivalent snow rate (mm/s) + REAL :: ACC_SSOIL + REAL :: ACC_QINSUR + REAL :: ACC_QSEVA + REAL, DIMENSION( 1:NSOIL) :: ACC_ETRANI !transpiration rate (mm/s) [+] + REAL :: EFLXB + REAL :: XMF + REAL, DIMENSION( -2:NSOIL ) :: HCPCT + REAL :: DZSNSO + REAL :: CANHS ! canopy heat storage change (w/m2) + REAL :: ACC_DWATER + REAL :: ACC_PRCP + REAL :: ACC_ECAN + REAL :: ACC_ETRAN + REAL :: ACC_EDIR ! Intermediate terms - REAL :: FPICE ! snow fraction of precip REAL :: FCEV ! canopy evaporation heat (w/m2) [+ to atm] REAL :: FGEV ! ground evaporation heat (w/m2) [+ to atm] @@ -522,11 +636,32 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN ! ---------------------------------------------------------------------- CALL NOAHMP_OPTIONS(IDVEG ,IOPT_CRS ,IOPT_BTR ,IOPT_RUN ,IOPT_SFC ,IOPT_FRZ , & - IOPT_INF ,IOPT_RAD ,IOPT_ALB ,IOPT_SNF ,IOPT_TBOT, IOPT_STC , & - IOPT_RSF ,IOPT_SOIL ,IOPT_PEDO ,IOPT_CROP ,IOPT_IRR ,IOPT_IRRM) + IOPT_INF ,IOPT_RAD ,IOPT_ALB ,IOPT_SNF ,IOPT_TBOT, IOPT_STC , & + IOPT_RSF ,IOPT_SOIL ,IOPT_PEDO ,IOPT_CROP ,IOPT_IRR , IOPT_IRRM , & + IOPT_INFDV,IOPT_TDRN ) IPRINT = .false. ! debug printout +! for using soil update timestep difference from noahmp main timestep + calculate_soil = .false. + soil_update_steps = nint(soiltstep/DT) ! 3600 = 1 hour + soil_update_steps = max(soil_update_steps,1) + if( soil_update_steps == 1 .or. & + (soil_update_steps > 1 .and. mod(itimestep,soil_update_steps) == 1) ) then + ACC_SSOILXY = 0.0 + ACC_QINSURXY = 0.0 + ACC_QSEVAXY = 0.0 + ACC_ETRANIXY = 0.0 + ACC_DWATERXY = 0.0 + ACC_PRCPXY = 0.0 + ACC_ECANXY = 0.0 + ACC_ETRANXY = 0.0 + ACC_EDIRXY = 0.0 + end if + + if (mod(itimestep,soil_update_steps) == 0) calculate_soil = .true. +! end soil timestep + YEARLEN = 365 ! find length of year for phenology (also S Hemisphere) if (mod(YR,4) == 0) then YEARLEN = 366 @@ -693,6 +828,22 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN SMCWTD = SMCWTDXY(I,J) RECH = 0. DEEPRECH = 0. + ACC_SSOIL = ACC_SSOILXY (I,J) ! surface heat flux + ACC_QSEVA = ACC_QSEVAXY (I,J) + ACC_QINSUR = ACC_QINSURXY(I,J) + ACC_ETRANI = ACC_ETRANIXY(I,:,J) + ACC_DWATER = ACC_DWATERXY(I,J) + ACC_PRCP = ACC_PRCPXY (I,J) + ACC_ECAN = ACC_ECANXY (I,J) + ACC_ETRAN = ACC_ETRANXY (I,J) + ACC_EDIR = ACC_EDIRXY (I,J) + +! tile drainage + QTLDRN = 0. ! tile drainage (mm) + TDFRACMP = TD_FRACTION(I,J) ! tile drainage map +#ifdef WRF_HYDRO + WATBLED = ZWATBLE2D (I,J) ! water table depth for tile drainage +#endif ! irrigation vars IRRFRA = IRFRACT(I,J) ! irrigation fraction @@ -777,6 +928,15 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN ! parameters%refdk = REFDK_2D (I,J) ! Reference Soil Conductivity ! parameters%refkdt = REFKDT_2D(I,J) ! Soil Infiltration Parameter +! placeholders for 2D additional runoff parameters +! parameters%BVIC = BVIC_2D(I,J) ! VIC model infiltration parameter [-] +! parameters%axaj = AXAJ_2D(I,J) ! Xinanjiang: Tension water distribution inflection parameter [-] +! parameters%bxaj = BXAJ_2D(I,J) ! Xinanjiang: Tension water distribution shape parameter [-] +! parameters%xxaj = XXAJ_2D(I,J) ! Xinanjiang: Free water distribution shape parameter [-] +! parameters%BDVIC = BDVIC_2D(I,J) ! VIC model infiltration parameter [-] +! parameters%GDVIC = GDVIC_2D(I,J) ! Mean Capillary Drive for infiltration models [m] +! parameters%BBVIC = BBVIC_2D(I,J) ! DVIC heterogeniety parameter for infiltraton [-] + ! placeholders for 2D irrigation params ! parameters%IRR_FRAC = IRR_FRAC_2D(I,J) ! irrigation Fraction ! parameters%IRR_HAR = IRR_HAR_2D(I,J) ! number of days before harvest date to stop irrigation @@ -788,6 +948,16 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN ! parameters%FIRTFAC = FIRTFAC_2D(I,J) ! flood application rate factor ! parameters%IR_RAIN = IR_RAIN_2D(I,J) ! maximum precipitation to stop irrigation trigger +! placeholders for 2D tile drainage parameters +! parameters%klat_fac = KLAT_FAC (I,J) ! factor multiplier to hydraulic conductivity +! parameters%tdsmc_fac = TDSMC_FAC(I,J) ! factor multiplier to field capacity +! parameters%td_dc = TD_DC (I,J) ! drainage coefficient for simple +! parameters%td_dcoef = TD_DCOEF (I,J) ! drainge coefficient for Hooghoudt +! parameters%td_ddrain = TD_DDRAIN(I,J) ! depth of drain +! parameters%td_radi = TD_RADI (I,J) ! tile radius +! parameters%td_spac = TD_SPAC (I,J) ! tile spacing + + CALL TRANSFER_MP_PARAMETERS(VEGTYP,SOILTYP,SLOPETYP,SOILCOLOR,CROPTYPE,parameters) if(iopt_soil == 3 .and. .not. parameters%urban_flag) then @@ -814,7 +984,7 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN parameters%GDDS5 = SEASON_GDD(I,J) / 1770.0 * parameters%GDDS5 end if - if(iopt_irr == 2) then ! based on planting and harvesting dates. + if(iopt_irr == 2) then parameters%PLTDAY = PLANTING(I,J) parameters%HSDAY = HARVEST (I,J) end if @@ -894,6 +1064,7 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN RTMASS = undefined_value STMASS = undefined_value WOOD = undefined_value + QTLDRN = undefined_value GRAIN = undefined_value GDD = undefined_value STBLCP = undefined_value @@ -906,11 +1077,11 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN GPP = undefined_value NPP = undefined_value FVEGMP = 0.0 - ECAN = undefined_value - ETRAN = undefined_value + ECAN = 0.0 + ETRAN = 0.0 APAR = undefined_value PSN = undefined_value - SAV = undefined_value + SAV = 0.0 RSSUN = undefined_value RSSHA = undefined_value RB = undefined_value @@ -922,28 +1093,52 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN TGV = undefined_value CHV = undefined_value CHB = CH - IRC = undefined_value - IRG = undefined_value - SHC = undefined_value - SHG = undefined_value - EVG = undefined_value - GHV = undefined_value + IRC = 0.0 + IRG = 0.0 + SHC = 0.0 + SHG = 0.0 + EVG = 0.0 + GHV = 0.0 + CANHS = 0.0 IRB = FIRA SHB = FSH EVB = FGEV GHB = SSOIL - TR = undefined_value - EVC = undefined_value + TR = 0.0 + EVC = 0.0 + PAH = 0.0 + PAHG = 0.0 + PAHB = 0.0 + PAHV = 0.0 CHLEAF = undefined_value CHUC = undefined_value CHV2 = undefined_value - FCEV = undefined_value - FCTR = undefined_value + FCEV = 0.0 + FCTR = 0.0 Z0WRF = 0.002 QFX(I,J) = ESOIL LH (I,J) = FGEV - - + QINTS = 0.0 + QINTR = 0.0 + QDRIPS = 0.0 + QDRIPR = 0.0 + QTHROS = PRCP * FPICE + QTHROR = PRCP * (1.0 - FPICE) + QSNSUB = MAX( ESOIL, 0.) + QSNFRO = ABS( MIN(ESOIL, 0.)) + QSUBC = 0.0 + QFROC = 0.0 + QFRZC = 0.0 + QMELTC = 0.0 + QEVAC = 0.0 + QDEWC = 0.0 + RAININ = PRCP * (1.0 - FPICE) + SNOWIN = PRCP * FPICE + CANICE = 0.0 + CANLIQ = 0.0 + QTLDRN = 0.0 + RUNSF = RUNSF * dt + RUNSB = RUNSB * dt ELSE ICE=0 ! Neither sea ice or land ice. CALL NOAHMP_SFLX (parameters, & @@ -967,7 +1162,8 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN GRAIN , GDD , PGS , & ! IN/OUT SMCWTD ,DEEPRECH , RECH , & ! IN/OUT : GECROS1D, & ! IN/OUT : - Z0WRF , & + QTLDRN , TDFRACMP, & ! IN/OUT : tile drainage + Z0WRF , & ! OUT : IRCNTSI , IRCNTMI , IRCNTFI , IRAMTSI , IRAMTMI , IRAMTFI , & ! IN/OUT : Irrigation: vars IRSIRATE, IRMIRATE, IRFIRATE, FIRR , EIRR , & ! IN/OUT : Irrigation: vars FSA , FSR , FIRA , FSH , SSOIL , FCEV , & ! OUT : @@ -980,10 +1176,16 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN BGAP , WGAP , CHV , CHB , EMISSI , & ! OUT : SHG , SHC , SHB , EVG , EVB , GHV , & ! OUT : GHB , IRG , IRC , IRB , TR , EVC , & ! OUT : - CHLEAF , CHUC , CHV2 , CHB2 , FPICE , PAHV , & - PAHG , PAHB , PAH , LAISUN , LAISHA , RB & + CHLEAF , CHUC , CHV2 , CHB2 , FPICE , PAHV , & ! OUT : + PAHG , PAHB , PAH , LAISUN , LAISHA , RB , & ! OUT : + QINTS , QINTR , QDRIPS , QDRIPR , QTHROS , QTHROR , & ! OUT : + QSNSUB , QSNFRO , QSUBC , QFROC , QFRZC , QMELTC , & ! OUT : + QEVAC , QDEWC , & ! OUT : + RAININ , SNOWIN , ACC_SSOIL, ACC_QINSUR, ACC_QSEVA , & ! OUT : + ACC_ETRANI, HCPCT , EFLXB , CANHS , & ! OUT : + ACC_DWATER, ACC_PRCP, ACC_ECAN, ACC_ETRAN, ACC_EDIR & ! INOUT #ifdef WRF_HYDRO - , sfcheadrt(i,j) & + , sfcheadrt(i,j), WATBLED & #endif ) ! OUT : @@ -995,8 +1197,10 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN #ifdef WRF_HYDRO !AD_CHANGE: Glacier cells can produce small negative subsurface runoff for mass balance. ! This will crash channel routing, so only pass along positive runoff. - soldrain(i,j) = max(RUNSB*dt, 0.) !mm , underground runoff - INFXSRT(i,j) = RUNSF*dt !mm , surface runoff + !soldrain(i,j) = max(RUNSB*dt, 0.0) !mm , underground runoff + soldrain(i,j) = max(RUNSB, 0.0) !mm , underground runoff + INFXSRT(i,j) = RUNSF !*dt !mm , surface runoff + qtiledrain (i,j) = QTLDRN !*dt !mm, tile drainage #endif @@ -1007,8 +1211,9 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN GRDFLX (I,J) = SSOIL SMSTAV (I,J) = 0.0 ! [maintained as Noah consistency] SMSTOT (I,J) = 0.0 ! [maintained as Noah consistency] - SFCRUNOFF(I,J) = SFCRUNOFF(I,J) + RUNSF * DT - UDRUNOFF (I,J) = UDRUNOFF(I,J) + RUNSB * DT + SFCRUNOFF(I,J) = SFCRUNOFF(I,J) + RUNSF !* DT + UDRUNOFF (I,J) = UDRUNOFF(I,J) + RUNSB !* DT + QTDRAIN (I,J) = QTDRAIN (I,J) + QTLDRN !* DT IF ( SALB > -999 ) THEN ALBEDO(I,J) = SALB ENDIF @@ -1057,7 +1262,6 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN TAUSSXY (I,J) = TAUSS ! OUTPUT - Z0 (I,J) = Z0WRF ZNT (I,J) = Z0WRF T2MVXY (I,J) = T2MV @@ -1109,15 +1313,68 @@ SUBROUTINE noahmplsm(ITIMESTEP, YR, JULIAN, COSZIN,XLAT,XLONG, & ! IN SHBXY (I,J) = SHB EVBXY (I,J) = EVB GHBXY (I,J) = GHB + canhsxy (I,J) = CANHS TRXY (I,J) = TR EVCXY (I,J) = EVC CHLEAFXY (I,J) = CHLEAF CHUCXY (I,J) = CHUC CHV2XY (I,J) = CHV2 CHB2XY (I,J) = CHB2 + PAHXY (I,J) = PAH + PAHGXY (I,J) = PAHG + PAHBXY (I,J) = PAHB + PAHVXY (I,J) = PAHV + QINTSXY (I,J) = QINTS + QINTRXY (I,J) = QINTR + QDRIPSXY (I,J) = QDRIPS + QDRIPRXY (I,J) = QDRIPR + QTHROSXY (I,J) = QTHROS + QTHRORXY (I,J) = QTHROR + QSNSUBXY (I,J) = QSNSUB + QSNFROXY (I,J) = QSNFRO + QSUBCXY (I,J) = QSUBC + QFROCXY (I,J) = QFROC + QEVACXY (I,J) = QEVAC + QDEWCXY (I,J) = QDEWC + QFRZCXY (I,J) = QFRZC + QMELTCXY (I,J) = QMELTC + QSNBOTXY (I,J) = QSNBOT + PONDINGXY (I,J) = PONDING + PONDING1 + PONDING2 + FPICEXY (I,J) = FPICE + RAINLSM (I,J) = RAININ + SNOWLSM (I,J) = SNOWIN + FORCTLSM (I,J) = T_ML + FORCQLSM (I,J) = Q_ML + FORCPLSM (I,J) = P_ML + FORCZLSM (I,J) = Z_ML + FORCWLSM (I,J) = SQRT(U_ML*U_ML + V_ML*V_ML) RECHXY (I,J) = RECHXY(I,J) + RECH*1.E3 !RECHARGE TO THE WATER TABLE DEEPRECHXY(I,J) = DEEPRECHXY(I,J) + DEEPRECH SMCWTDXY(I,J) = SMCWTD + ACC_SSOILXY (I,J) = ACC_SSOIL + ACC_QINSURXY(I,J) = ACC_QINSUR + ACC_QSEVAXY (I,J) = ACC_QSEVA + ACC_ETRANIXY(I,:,J) = ACC_ETRANI + ACC_DWATERXY(I,J) = ACC_DWATER + ACC_PRCPXY (I,J) = ACC_PRCP + ACC_ECANXY (I,J) = ACC_ECAN + ACC_ETRANXY (I,J) = ACC_ETRAN + ACC_EDIRXY (I,J) = ACC_EDIR + EFLXBXY (I,J) = EFLXB + SNOWENERGY(I,J) = 0.0 + SOILENERGY(I,J) = 0.0 + DO K = ISNOW+1, NSOIL + IF(K == ISNOW+1) THEN + DZSNSO = - ZSNSO(K) + ELSE + DZSNSO = ZSNSO(K-1) - ZSNSO(K) + END IF + IF(K >= 1) THEN + SOILENERGY(I,J) = SOILENERGY(I,J) + DZSNSO * HCPCT(K) * (STC(K)-273.16) * 0.001 + ELSE + SNOWENERGY(I,J) = SNOWENERGY(I,J) + DZSNSO * HCPCT(K) * (STC(K)-273.16) * 0.001 + END IF + ENDDO GRAINXY (I,J) = GRAIN !GRAIN XING GDDXY (I,J) = GDD !XING @@ -1367,10 +1624,16 @@ SUBROUTINE TRANSFER_MP_PARAMETERS(VEGTYPE,SOILTYPE,SLOPETYPE,SOILCOLOR,CROPTYPE, parameters%SMCREF(isoil) = SMCREF_TABLE (SOILTYPE(isoil)) parameters%SMCWLT(isoil) = SMCWLT_TABLE (SOILTYPE(isoil)) end do - parameters%F1 = F1_TABLE(SOILTYPE(1)) parameters%REFDK = REFDK_TABLE parameters%REFKDT = REFKDT_TABLE + parameters%BVIC = BVIC_TABLE(SOILTYPE(1)) + parameters%AXAJ = AXAJ_TABLE(SOILTYPE(1)) + parameters%BXAJ = BXAJ_TABLE(SOILTYPE(1)) + parameters%XXAJ = XXAJ_TABLE(SOILTYPE(1)) + parameters%BDVIC = BDVIC_TABLE(SOILTYPE(1)) + parameters%GDVIC = GDVIC_TABLE(SOILTYPE(1)) + parameters%BBVIC = BBVIC_TABLE(SOILTYPE(1)) !------------------------------------------------------------------------------------------! ! Transfer irrigation parameters @@ -1385,6 +1648,21 @@ SUBROUTINE TRANSFER_MP_PARAMETERS(VEGTYPE,SOILTYPE,SLOPETYPE,SOILCOLOR,CROPTYPE, parameters%FIRTFAC = FIRTFAC_TABLE ! flood application rate factor parameters%IR_RAIN = IR_RAIN_TABLE ! maximum precipitation to stop irrigation trigger +!------------------------------------------------------------------------------------------! +! Transfer tiledrain parameters +!------------------------------------------------------------------------------------------! + parameters%KLAT_FAC = KLAT_FAC_TABLE(SOILTYPE(1)) + parameters%TDSMC_FAC = TDSMCFAC_TABLE(SOILTYPE(1)) + parameters%TD_DC = TD_DC_TABLE(SOILTYPE(1)) + parameters%TD_DCOEF = TD_DCOEF_TABLE(SOILTYPE(1)) + parameters%TD_RADI = TD_RADI_TABLE(SOILTYPE(1)) + parameters%TD_SPAC = TD_SPAC_TABLE(SOILTYPE(1)) + parameters%TD_DDRAIN = TD_DDRAIN_TABLE(SOILTYPE(1)) + parameters%TD_DEPTH = TD_DEPTH_TABLE(SOILTYPE(1)) + parameters%TD_ADEPTH = TD_ADEPTH_TABLE(SOILTYPE(1)) + parameters%DRAIN_LAYER_OPT = DRAIN_LAYER_OPT_TABLE + parameters%TD_D = TD_D_TABLE(SOILTYPE(1)) + ! ---------------------------------------------------------------------- ! Transfer GENPARM parameters ! ---------------------------------------------------------------------- @@ -1550,7 +1828,7 @@ SUBROUTINE NOAHMP_INIT ( MMINLU, SNOW , SNOWH , CANWAT , ISLTYP , IVGTYP, XLAT ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & - smoiseq ,smcwtdxy ,rechxy ,deeprechxy, areaxy, dx, dy, msftx, msfty,& ! Optional groundwater + smoiseq ,smcwtdxy ,rechxy ,deeprechxy, qtdrain, areaxy, dx, dy, msftx, msfty,& ! Optional groundwater wtddt ,stepwtd ,dt ,qrfsxy ,qspringsxy , qslatxy , & ! Optional groundwater fdepthxy ,ht ,riverbedxy ,eqzwt ,rivercondxy ,pexpxy , & ! Optional groundwater rechclim, & ! Optional groundwater @@ -1631,6 +1909,7 @@ SUBROUTINE NOAHMP_INIT ( MMINLU, SNOW , SNOWH , CANWAT , ISLTYP , IVGTYP, XLAT REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fastcpxy !short-lived carbon, shallow soil [g/m2] REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: xsaixy !stem area index REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: lai !leaf area index + REAL, DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: qtdrain !tile drainage (mm) INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: cropcat REAL , DIMENSION(ims:ime,5,jms:jme), INTENT(IN ) :: croptype @@ -1704,6 +1983,7 @@ SUBROUTINE NOAHMP_INIT ( MMINLU, SNOW , SNOWH , CANWAT , ISLTYP , IVGTYP, XLAT call read_mp_rad_parameters() call read_mp_global_parameters() call read_mp_crop_parameters() + call read_tiledrain_parameters() call read_mp_optional_parameters() if(iopt_irr >= 1) call read_mp_irrigation_parameters() @@ -1726,7 +2006,7 @@ SUBROUTINE NOAHMP_INIT ( MMINLU, SNOW , SNOWH , CANWAT , ISLTYP , IVGTYP, XLAT ENDIF - ! Check if snow/snowh are consistent and cap SWE at 5000mm; + ! Check if snow/snowh are consistent and cap SWE at 2000mm; ! the Noah-MP code does it internally but if we don't do it here, problems ensue DO J = jts,jtf DO I = its,itf @@ -1735,9 +2015,9 @@ SUBROUTINE NOAHMP_INIT ( MMINLU, SNOW , SNOWH , CANWAT , ISLTYP , IVGTYP, XLAT ,i,j,snow(i,j),snowh(i,j) CALL wrf_message(err_message) ENDIF - IF ( SNOW( i,j ) > 5000. ) THEN - SNOWH(I,J) = SNOWH(I,J) * 5000. / SNOW(I,J) ! SNOW in mm and SNOWH in m - SNOW (I,J) = 5000. ! cap SNOW at 5000, maintain density + IF ( SNOW( i,j ) > 2000.0 ) THEN + SNOWH(I,J) = SNOWH(I,J) * 2000.0 / SNOW(I,J) ! SNOW in mm and SNOWH in m + SNOW (I,J) = 2000.0 ! cap SNOW at 2000, maintain density ENDIF ENDDO ENDDO @@ -1814,6 +2094,7 @@ SUBROUTINE NOAHMP_INIT ( MMINLU, SNOW , SNOWH , CANWAT , ISLTYP , IVGTYP, XLAT DO J = jts,jtf DO I = its,itf + qtdrain (I,J) = 0. tvxy (I,J) = TSK(I,J) if(snow(i,j) > 0.0 .and. tsk(i,j) > 273.15) tvxy(I,J) = 273.15 tgxy (I,J) = TSK(I,J) @@ -2130,8 +2411,9 @@ END SUBROUTINE SNOW_INIT SUBROUTINE GROUNDWATER_INIT ( & & GRID, NSOIL , DZS, ISLTYP, IVGTYP, WTDDT , & & FDEPTH, TOPO, RIVERBED, EQWTD, RIVERCOND, PEXP , AREA ,WTD , & - & SMOIS,SH2O, SMOISEQ, SMCWTDXY, DEEPRECHXY, RECHXY , & - & QSLATXY, QRFSXY, QSPRINGSXY, & + & SMOIS,SH2O, SMOISEQ, SMCWTDXY, & + & QLATXY, QSLATXY, QRFXY, QRFSXY, & + & DEEPRECHXY, RECHXY , QSPRINGXY, QSPRINGSXY, & & rechclim , & & ids,ide, jds,jde, kds,kde, & & ims,ime, jms,jme, kms,kme, & @@ -2177,7 +2459,11 @@ SUBROUTINE GROUNDWATER_INIT ( & RECHXY, & QSLATXY, & QRFSXY, & - QSPRINGSXY + QSPRINGSXY, & + QLATXY, & + QRFXY, & + QSPRINGXY + ! local INTEGER :: I,J,K,ITER,itf,jtf, NITER, NCOUNT,NS REAL :: BEXP,SMCMAX,PSISAT,SMCWLT,DWSAT,DKSAT @@ -2403,16 +2689,19 @@ SUBROUTINE GROUNDWATER_INIT ( & ELSE SMOISEQ (I,1:NSOIL,J) = SMCMAX SMCWTDXY(I,J) = SMCMAX - WTD(I,J) = 0. + WTD(I,J) = 0.0 ENDIF !zero out some arrays - DEEPRECHXY(I,J) = 0. - RECHXY(I,J) = 0. - QSLATXY(I,J) = 0. - QRFSXY(I,J) = 0. - QSPRINGSXY(I,J) = 0. + QLATXY(I,J) = 0.0 + QSLATXY(I,J) = 0.0 + QRFXY(I,J) = 0.0 + QRFSXY(I,J) = 0.0 + DEEPRECHXY(I,J) = 0.0 + RECHXY(I,J) = 0.0 + QSPRINGXY(I,J) = 0.0 + QSPRINGSXY(I,J) = 0.0 ENDDO ENDDO @@ -2690,7 +2979,7 @@ SUBROUTINE noahmp_urban(sf_urban_physics, NSOIL, IVGTYP, ITIMESTEP, chs, chs2, cqs2, & !H num_urban_ndm, urban_map_zrd, urban_map_zwd, urban_map_gd, & !I multi-layer urban urban_map_zd, urban_map_zdf, urban_map_bd, urban_map_wd, & !I multi-layer urban - urban_map_gbd, urban_map_fbd, urban_map_zgrd, & !I multi-layer urban + urban_map_gbd, urban_map_fbd, urban_map_zgrd, & !I multi-layer urban num_urban_hi, & !I multi-layer urban trb_urb4d, tw1_urb4d, tw2_urb4d, tgb_urb4d, & !H multi-layer urban tlev_urb3d, qlev_urb3d, & !H multi-layer urban diff --git a/phys/module_sf_noahmplsm.F b/phys/module_sf_noahmplsm.F index f371f15834..d41e7737ae 100644 --- a/phys/module_sf_noahmplsm.F +++ b/phys/module_sf_noahmplsm.F @@ -96,7 +96,6 @@ MODULE MODULE_SF_NOAHMPLSM ! 7 -> off (use input LAI; use FVEG = SHDFAC from input) ! 8 -> off (use input LAI; calculate FVEG) ! 9 -> off (use input LAI; use maximum vegetation fraction) - ! 10 -> crop model on (use maximum vegetation fraction) INTEGER :: OPT_CRS ! options for canopy stomatal resistance ! **1 -> Ball-Berry @@ -114,6 +113,9 @@ MODULE MODULE_SF_NOAHMPLSM ! 4 -> BATS surface and subsurface runoff (free drainage) ! 5 -> Miguez-Macho&Fan groundwater scheme (Miguez-Macho et al. 2007 JGR; Fan et al. 2007 JGR) ! (needs further testing for public use) + ! 6 -> Variable Infiltration Capacity Model surface runoff scheme (Wood et al., 1992, JGR) + ! 7 -> Xiananjiang Infiltration and surface runoff scheme ((Jayawardena and Zhou, 2000) + ! 8 -> Dynamic VIC surface runoff scheme (Liang and Xie, 2001) INTEGER :: OPT_SFC ! options for surface layer drag coeff (CH & CM) ! **1 -> M-O @@ -185,6 +187,16 @@ MODULE MODULE_SF_NOAHMPLSM ! 2 -> micro/drip irrigation ! 3 -> surface flooding + INTEGER :: OPT_INFDV! options for infiltration in dynamic VIC runoff scheme + ! **1 -> Philip scheme + ! 2 -> Green-Ampt scheme + ! 3 -> Smith-Parlange scheme + + INTEGER :: OPT_TDRN ! options for crop model (currently only tested & calibrated to work with opt_run=3) + ! **0 -> No tile drainage + ! 1 -> on (simple scheme) + ! 2 -> on (Hooghoudt's scheme) + !------------------------------------------------------------------------------------------! ! Physical Constants: ! !------------------------------------------------------------------------------------------! @@ -204,13 +216,17 @@ MODULE MODULE_SF_NOAHMPLSM REAL, PARAMETER :: TKAIR = 0.023 !thermal conductivity of air (w/m/k) (not used MB: 20140718) REAL, PARAMETER :: RAIR = 287.04 !gas constant for dry air (j/kg/k) REAL, PARAMETER :: RW = 461.269 !gas constant for water vapor (j/kg/k) - REAL, PARAMETER :: DENH2O = 1000. !density of water (kg/m3) - REAL, PARAMETER :: DENICE = 917. !density of ice (kg/m3) + REAL, PARAMETER :: DENH2O = 1000.0 !density of water (kg/m3) + REAL, PARAMETER :: DENICE = 917.0 !density of ice (kg/m3) INTEGER, PRIVATE, PARAMETER :: MBAND = 2 INTEGER, PRIVATE, PARAMETER :: NSOIL = 4 INTEGER, PRIVATE, PARAMETER :: NSTAGE = 8 +! add control for a different soil timestep capability + logical :: calculate_soil + integer :: soil_update_steps + TYPE noahmp_parameters ! define a NoahMP parameters type !------------------------------------------------------------------------------------------! @@ -223,7 +239,6 @@ MODULE MODULE_SF_NOAHMPLSM INTEGER :: ISICE INTEGER :: ISCROP INTEGER :: EBLFOREST - REAL :: CH2OP !maximum intercepted h2o per unit lai+sai (mm) REAL :: DLEAF !characteristic leaf dimension (m) REAL :: Z0MVT !momentum roughness length (m) @@ -240,7 +255,6 @@ MODULE MODULE_SF_NOAHMPLSM REAL :: DILEFW !coeficient for leaf stress death [1/s] REAL :: FRAGR !fraction of growth respiration !original was 0.3 REAL :: LTOVRC !leaf turnover [1/s] - REAL :: C3PSN !photosynthetic pathway: 0. = c4, 1. = c3 REAL :: KC25 !co2 michaelis-menten constant at 25c (pa) REAL :: AKC !q10 for kc25 @@ -257,28 +271,23 @@ MODULE MODULE_SF_NOAHMPLSM REAL :: RMR25 !root maintenance respiration at 25c (umol co2/kg bio/s) REAL :: ARM !q10 for maintenance respiration REAL :: FOLNMX !foliage nitrogen concentration when f(n)=1 (%) - REAL :: TMIN !minimum temperature for photosynthesis (k) - + REAL :: TMIN !minimum temperature for photosynthesis (k) REAL :: XL !leaf/stem orientation index REAL :: RHOL(MBAND) !leaf reflectance: 1=vis, 2=nir REAL :: RHOS(MBAND) !stem reflectance: 1=vis, 2=nir REAL :: TAUL(MBAND) !leaf transmittance: 1=vis, 2=nir REAL :: TAUS(MBAND) !stem transmittance: 1=vis, 2=nir - REAL :: MRP !microbial respiration parameter (umol co2 /kg c/ s) REAL :: CWPVT !empirical canopy wind parameter - REAL :: WRRAT !wood to non-wood ratio REAL :: WDPOOL !wood pool (switch 1 or 0) depending on woody or not [-] REAL :: TDLEF !characteristic T for leaf freezing [K] - INTEGER :: NROOT !number of soil layers with root present REAL :: RGL !Parameter used in radiation stress function REAL :: RSMIN !Minimum stomatal resistance [s m-1] REAL :: HS !Parameter used in vapor pressure deficit function REAL :: TOPT !Optimum transpiration air temperature [K] REAL :: RSMAX !Maximal stomatal resistance [s m-1] - REAL :: SLAREA REAL :: EPS(5) @@ -395,6 +404,14 @@ MODULE MODULE_SF_NOAHMPLSM REAL :: DWSAT(NSOIL) !saturated soil hydraulic diffusivity REAL :: QUARTZ(NSOIL) !soil quartz content REAL :: F1 !soil thermal diffusivity/conductivity coef (not used MB: 20140718) + REAL :: BVIC !VIC model infiltration parameter for opt_run=6 + REAL :: AXAJ !Xinanjiang: Tension water distribution inflection parameter [-] for opt_run=7 + REAL :: BXAJ !Xinanjiang: Tension water distribution shape parameter [-] for opt_run=7 + REAL :: XXAJ !Xinanjiang: Free water distribution shape parameter [-] for opt_run=7 + REAL :: BDVIC !DVIC model infiltration parameter [-] for opt_run=8 + REAL :: GDVIC !Mean Capillary Drive (m) for infiltration models for opt_run=8 + REAL :: BBVIC !DVIC heterogeniety parameter for infiltration for opt_run=8 + !------------------------------------------------------------------------------------------! ! From the GENPARM.TBL file !------------------------------------------------------------------------------------------! @@ -404,10 +421,25 @@ MODULE MODULE_SF_NOAHMPLSM REAL :: CZIL !Calculate roughness length of heat REAL :: REFDK REAL :: REFKDT - REAL :: KDT !used in compute maximum infiltration rate (in INFIL) REAL :: FRZX !used in compute maximum infiltration rate (in INFIL) +!------------------------------------------------------------------------------------------! +! From the tiledrain section of the MPTABLE.TBL file +!------------------------------------------------------------------------------------------! + REAL :: TDSMC_FAC + REAL :: TD_DC + INTEGER :: TD_DEPTH + INTEGER :: DRAIN_LAYER_OPT + REAL :: TD_DCOEF ! m d^-1, drainage coefficent + REAL :: TD_D ! m, depth to impervious layer from drain water level (D) + REAL :: TD_ADEPTH ! m, actual depth of impervious layer from land surface + REAL :: TD_RADI ! m, effective radius of drains (ro) + REAL :: TD_SPAC ! m, distance between two drain tubes or tiles (L) + REAL :: TD_DDRAIN ! m, Depth of drain + REAL :: KLAT_FAC ! multiplication factor to determine conk(j1,j) from sol_k(j1,j) for HRU + + END TYPE noahmp_parameters contains @@ -435,7 +467,8 @@ SUBROUTINE NOAHMP_SFLX (parameters, & GRAIN , GDD , PGS , & ! IN/OUT SMCWTD ,DEEPRECH , RECH , & ! IN/OUT : GECROS1D, & ! IN/OUT : - Z0WRF , & + QTLDRN , TDFRACMP, & ! IN/OUT : + Z0WRF , & ! OUT : IRCNTSI , IRCNTMI , IRCNTFI , IRAMTSI , IRAMTMI , IRAMTFI , & ! IN/OUT : Irrigation: vars IRSIRATE, IRMIRATE, IRFIRATE, FIRR , EIRR , & ! IN/OUT : Irrigation: vars FSA , FSR , FIRA , FSH , SSOIL , FCEV , & ! OUT : @@ -448,10 +481,16 @@ SUBROUTINE NOAHMP_SFLX (parameters, & BGAP , WGAP , CHV , CHB , EMISSI , & ! OUT : SHG , SHC , SHB , EVG , EVB , GHV , & ! OUT : GHB , IRG , IRC , IRB , TR , EVC , & ! OUT : - CHLEAF , CHUC , CHV2 , CHB2 , FPICE , PAHV , & - PAHG , PAHB , PAH , LAISUN , LAISHA , RB & ! OUT + CHLEAF , CHUC , CHV2 , CHB2 , FPICE , PAHV , & ! OUT : + PAHG , PAHB , PAH , LAISUN , LAISHA , RB , & ! OUT + QINTS , QINTR , QDRIPS , QDRIPR , QTHROS , QTHROR , & ! OUT : + QSNSUB , QSNFRO , QSUBC , QFROC , QFRZC , QMELTC , & ! OUT : + QEVAC , QDEWC , & ! OUT + RAIN , SNOW , ACC_SSOIL, ACC_QINSUR, ACC_QSEVA , & ! OUT + ACC_ETRANI, HCPCT , EFLXB , CANHS , & ! OUT : + ACC_DWATER, ACC_PRCP, ACC_ECAN, ACC_ETRAN, ACC_EDIR & ! INOUT #ifdef WRF_HYDRO - ,SFCHEADRT & ! IN/OUT : + ,SFCHEADRT, WATBLED & ! IN/OUT : #endif ) @@ -500,7 +539,7 @@ SUBROUTINE NOAHMP_SFLX (parameters, & !jref:start; in REAL , INTENT(IN) :: QC !cloud water mixing ratio - REAL , INTENT(INOUT) :: QSFC !mixing ratio at lowest model layer + REAL , INTENT(INOUT) :: QSFC !mixing ratio at lowest model layer REAL , INTENT(IN) :: PSFC !pressure at lowest model layer REAL , INTENT(IN) :: DZ8W !thickness of lowest layer REAL , INTENT(IN) :: DX @@ -508,7 +547,7 @@ SUBROUTINE NOAHMP_SFLX (parameters, & !jref:end #ifdef WRF_HYDRO - REAL , INTENT(INOUT) :: sfcheadrt + REAL , INTENT(INOUT) :: sfcheadrt, WATBLED #endif ! input/output : need arbitary intial values @@ -524,28 +563,39 @@ SUBROUTINE NOAHMP_SFLX (parameters, & REAL , INTENT(INOUT) :: TAUSS !non-dimensional snow age ! prognostic variables - INTEGER , INTENT(INOUT) :: ISNOW !actual no. of snow layers [-] - REAL , INTENT(INOUT) :: CANLIQ !intercepted liquid water (mm) - REAL , INTENT(INOUT) :: CANICE !intercepted ice mass (mm) - REAL , INTENT(INOUT) :: SNEQV !snow water eqv. [mm] - REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: SMC !soil moisture (ice + liq.) [m3/m3] - REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: ZSNSO !layer-bottom depth from snow surf [m] - REAL , INTENT(INOUT) :: SNOWH !snow height [m] - 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 , INTENT(INOUT) :: TV !vegetation temperature (k) - REAL , INTENT(INOUT) :: TG !ground temperature (k) - REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: STC !snow/soil temperature [k] - REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: SH2O !liquid soil moisture [m3/m3] - REAL , INTENT(INOUT) :: ZWT !depth to water table [m] - REAL , INTENT(INOUT) :: WA !water storage in aquifer [mm] - REAL , INTENT(INOUT) :: WT !water in aquifer&saturated soil [mm] - REAL , INTENT(INOUT) :: WSLAKE !lake water storage (can be neg.) (mm) - REAL, INTENT(INOUT) :: SMCWTD !soil water content between bottom of the soil and water table [m3/m3] - REAL, INTENT(INOUT) :: DEEPRECH !recharge to or from the water table when deep [m] - REAL, INTENT(INOUT) :: RECH !recharge to or from the water table when shallow [m] (diagnostic) - - REAL, DIMENSION(1:60) , INTENT(INOUT) :: gecros1d ! gecros crop + INTEGER , INTENT(INOUT) :: ISNOW !actual no. of snow layers [-] + REAL , INTENT(INOUT) :: CANLIQ !intercepted liquid water (mm) + REAL , INTENT(INOUT) :: CANICE !intercepted ice mass (mm) + REAL , INTENT(INOUT) :: SNEQV !snow water eqv. [mm] + REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: SMC !soil moisture (ice + liq.) [m3/m3] + REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: ZSNSO !layer-bottom depth from snow surf [m] + REAL , INTENT(INOUT) :: SNOWH !snow height [m] + 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 , INTENT(INOUT) :: TV !vegetation temperature (k) + REAL , INTENT(INOUT) :: TG !ground temperature (k) + REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: STC !snow/soil temperature [k] + REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: SH2O !liquid soil moisture [m3/m3] + REAL , INTENT(INOUT) :: ZWT !depth to water table [m] + REAL , INTENT(INOUT) :: WA !water storage in aquifer [mm] + REAL , INTENT(INOUT) :: WT !water in aquifer&saturated soil [mm] + REAL , INTENT(INOUT) :: WSLAKE !lake water storage (can be neg.) (mm) + REAL, INTENT(INOUT) :: SMCWTD !soil water content between bottom of the soil and water table [m3/m3] + REAL, INTENT(INOUT) :: DEEPRECH !recharge to or from the water table when deep [m] + REAL, INTENT(INOUT) :: RECH !recharge to or from the water table when shallow [m] (diagnostic) + REAL , INTENT(INOUT) :: ACC_SSOIL !ground heat flux (w/m2) [+ to soil] + REAL , INTENT(INOUT) :: ACC_QINSUR !water input on soil surface [m/s] + REAL , INTENT(INOUT) :: ACC_QSEVA !soil surface evap rate [mm/s] + REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: ACC_ETRANI !transpiration rate (mm/s) [+] + REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT( OUT) :: HCPCT !heat capacity [j/m3/k] + REAL , INTENT( OUT) :: EFLXB !energy influx from soil bottom (w/m2) + REAL , INTENT(INOUT) :: ACC_DWATER !accumulated water change for canopy, snow, soil mm/timestep(soil) + REAL , INTENT(INOUT) :: ACC_PRCP !accumulated precip mm/timestep(soil) + REAL , INTENT(INOUT) :: ACC_ECAN !accumulated net canopy evapo mm/timestep(soil) + REAL , INTENT(INOUT) :: ACC_ETRAN !accumulated transpiration mm/timestep(soil) + REAL , INTENT(INOUT) :: ACC_EDIR !accumulated net soil/snow evapo mm/timestep(soil) + + REAL, DIMENSION(1:60) , INTENT(INOUT) :: gecros1d !gecros crop ! output REAL , INTENT(OUT) :: Z0WRF !combined z0 sent to coupled model @@ -562,8 +612,8 @@ SUBROUTINE NOAHMP_SFLX (parameters, & REAL , INTENT(OUT) :: ECAN !evaporation of intercepted water (mm/s) REAL , INTENT(OUT) :: ETRAN !transpiration rate (mm/s) REAL , INTENT(OUT) :: EDIR !soil surface evaporation rate (mm/s] - REAL , INTENT(OUT) :: RUNSRF !surface runoff [mm/s] - REAL , INTENT(OUT) :: RUNSUB !baseflow (saturation excess) [mm/s] + REAL , INTENT(OUT) :: RUNSRF !surface runoff [mm] per soil timestep + REAL , INTENT(OUT) :: RUNSUB !baseflow (saturation excess) [mm] per soil timestep REAL , INTENT(OUT) :: PSN !total photosynthesis (umol co2/m2/s) [+] REAL , INTENT(OUT) :: APAR !photosyn active energy by canopy (w/m2) REAL , INTENT(OUT) :: SAV !solar rad absorbed by veg. (w/m2) @@ -649,6 +699,14 @@ SUBROUTINE NOAHMP_SFLX (parameters, & REAL, INTENT(OUT) :: PAHG !precipitation advected heat - under canopy net (W/m2) REAL, INTENT(OUT) :: PAHB !precipitation advected heat - bare ground net (W/m2) REAL, INTENT(OUT) :: PAH !precipitation advected heat - total (W/m2) + REAL, INTENT(OUT) :: QSNSUB + REAL, INTENT(OUT) :: QSNFRO + REAL, INTENT(OUT) :: QSUBC + REAL, INTENT(OUT) :: QFROC + REAL, INTENT(OUT) :: QFRZC + REAL, INTENT(OUT) :: QMELTC + REAL, INTENT(OUT) :: QEVAC + REAL, INTENT(OUT) :: QDEWC !jref:start REAL :: FSRV @@ -683,6 +741,10 @@ SUBROUTINE NOAHMP_SFLX (parameters, & REAL , INTENT(INOUT) :: GDD !growing degree days INTEGER , INTENT(INOUT) :: PGS !plant growing stage [-] +! Tile drainage + REAL , INTENT(INOUT) :: QTLDRN !tile drainage [mm] per soil timestep + REAL , INTENT(IN) :: TDFRACMP !tile drain fraction map + ! irrigation variables REAL , INTENT(IN) :: IRRFRA ! irrigation fraction REAL , INTENT(IN) :: SIFRA ! sprinkler irrigation fraction @@ -713,17 +775,17 @@ SUBROUTINE NOAHMP_SFLX (parameters, & REAL :: HETERS !organic respiration (g/m2/s C) REAL :: TROOT !root-zone averaged temperature (k) REAL :: BDFALL !bulk density of new snow (kg/m3) ! MB/AN: v3.7 - REAL :: RAIN !rain rate (mm/s) ! MB/AN: v3.7 - REAL :: SNOW !liquid equivalent snow rate (mm/s) ! MB/AN: v3.7 + REAL , INTENT(OUT) :: RAIN !rain rate (mm/s) ! MB/AN: v3.7 + REAL , INTENT(OUT) :: SNOW !liquid equivalent snow rate (mm/s) ! MB/AN: v3.7 REAL :: FP ! MB/AN: v3.7 REAL :: PRCP ! MB/AN: v3.7 !more local variables for precip heat MB - REAL :: QINTR !interception rate for rain (mm/s) - REAL :: QDRIPR !drip rate for rain (mm/s) - REAL :: QTHROR !throughfall for rain (mm/s) - REAL :: QINTS !interception (loading) rate for snowfall (mm/s) - REAL :: QDRIPS !drip (unloading) rate for intercepted snow (mm/s) - REAL :: QTHROS !throughfall of snowfall (mm/s) + REAL , INTENT(OUT) :: QINTR !interception rate for rain (mm/s) + REAL , INTENT(OUT) :: QDRIPR !drip rate for rain (mm/s) + REAL , INTENT(OUT) :: QTHROR !throughfall for rain (mm/s) + REAL , INTENT(OUT) :: QINTS !interception (loading) rate for snowfall (mm/s) + REAL , INTENT(OUT) :: QDRIPS !drip (unloading) rate for intercepted snow (mm/s) + REAL , INTENT(OUT) :: QTHROS !throughfall of snowfall (mm/s) REAL :: SNOWHIN !snow depth increasing rate (m/s) REAL :: LATHEAV !latent heat vap./sublimation (j/kg) REAL :: LATHEAG !latent heat vap./sublimation (j/kg) @@ -734,17 +796,21 @@ SUBROUTINE NOAHMP_SFLX (parameters, & LOGICAL :: CROPLU ! flag to identify croplands REAL :: SIFCUK ! Sprinkler fraction for unknown irrigation methods REAL :: FB - + +! add canopy heat storage (C.He added based on GY Niu's communication) + REAL , INTENT(OUT) :: CANHS ! canopy heat storage change w/m2 + ! INTENT (OUT) variables need to be assigned a value. These normally get assigned values ! only if DVEG == 2. - nee = 0.0 - npp = 0.0 - gpp = 0.0 - PAHV = 0. - PAHG = 0. - PAHB = 0. - PAH = 0. + nee = 0.0 + npp = 0.0 + gpp = 0.0 + PAHV = 0.0 + PAHG = 0.0 + PAHB = 0.0 + PAH = 0.0 CROPLU = .FALSE. + CANHS = 0.0 ! -------------------------------------------------------------------------------------------------- ! re-process atmospheric forcing @@ -773,12 +839,12 @@ SUBROUTINE NOAHMP_SFLX (parameters, & ENDDO ! total water storage for water balance check - + IF(IST == 1) THEN - BEG_WB = CANLIQ + CANICE + SNEQV + WA - DO IZ = 1,NSOIL - BEG_WB = BEG_WB + SMC(IZ) * DZSNSO(IZ) * 1000. - END DO + BEG_WB = CANLIQ + CANICE + SNEQV + WA + DO IZ = 1,NSOIL + BEG_WB = BEG_WB + SMC(IZ) * DZSNSO(IZ) * 1000.0 + END DO END IF ! vegetation phenology @@ -819,48 +885,54 @@ SUBROUTINE NOAHMP_SFLX (parameters, & FIFAC = FIFRA ! If OPT_IRRM = 0 and if methods are unknown for certain area, then use sprinkler irrigation method - IF((OPT_IRRM .EQ. 0) .AND. (SIFAC .EQ. 0.) .AND. (MIFAC .EQ. 0.) .AND. (FIFAC .EQ. 0.) & + IF((OPT_IRRM .EQ. 0) .AND. (SIFAC .EQ. 0.0) .AND. (MIFAC .EQ. 0.0) .AND. (FIFAC .EQ. 0.0) & .AND. (IRRFRA .GE. parameters%IRR_FRAC)) THEN SIFAC = 1.0 END IF + ! choose method based on user namelist choice IF(OPT_IRRM .EQ. 1) THEN - SIFAC = 1. - MIFAC = 0. - FIFAC = 0. + SIFAC = 1.0 + MIFAC = 0.0 + FIFAC = 0.0 ELSE IF(OPT_IRRM .EQ. 2) THEN - SIFAC = 0. - MIFAC = 1. - FIFAC = 0. + SIFAC = 0.0 + MIFAC = 1.0 + FIFAC = 0.0 ELSE IF(OPT_IRRM .EQ. 3) THEN - SIFAC = 0. - MIFAC = 0. - FIFAC = 1. + SIFAC = 0.0 + MIFAC = 0.0 + FIFAC = 1.0 END IF -! Call triggering function - IF((CROPLU .EQV. .TRUE.) .AND. (IRRFRA .GE. parameters%IRR_FRAC) .AND. & - (RAIN .LT. (parameters%IR_RAIN/3600.)) .AND. ((IRAMTSI+IRAMTMI+IRAMTFI) .EQ. 0.0) )THEN - CALL TRIGGER_IRRIGATION(parameters,NSOIL,ZSOIL,SH2O,FVEG,JULIAN,IRRFRA,LAI, & !in + +! trigger irrigation only at soil timestep to be consistent for solving soil water + if (calculate_soil) then + ! Call triggering function + IF((CROPLU .EQV. .TRUE.) .AND. (IRRFRA .GE. parameters%IRR_FRAC) .AND. & + (RAIN .LT. (parameters%IR_RAIN/3600.0)) .AND. ((IRAMTSI+IRAMTMI+IRAMTFI) .EQ. 0.0) )THEN + CALL TRIGGER_IRRIGATION(parameters,NSOIL,ZSOIL,SH2O,FVEG,JULIAN,IRRFRA,LAI, & !in SIFAC,MIFAC,FIFAC, & !in IRCNTSI,IRCNTMI,IRCNTFI, & !inout IRAMTSI,IRAMTMI,IRAMTFI) !inout - END IF -! set irrigation off if parameters%IR_RAIN mm/h for this time step and irr triggered last time step - IF((RAIN .GE. (parameters%IR_RAIN/3600.)) .OR. (IRRFRA .LT. parameters%IRR_FRAC))THEN - IRAMTSI = 0. - IRAMTMI = 0. - IRAMTFI = 0. - END IF -! call sprinkler irrigation before CANWAT/PRECIP_HEAT to have canopy interception - IF((CROPLU .EQV. .TRUE.) .AND. (IRAMTSI .GT. 0.0)) THEN + END IF + ! set irrigation off if parameters%IR_RAIN mm/h for this time step and irr triggered last time step + IF((RAIN .GE. (parameters%IR_RAIN/3600.0)) .OR. (IRRFRA .LT. parameters%IRR_FRAC))THEN + IRAMTSI = 0.0 + IRAMTMI = 0.0 + IRAMTFI = 0.0 + END IF + endif + + ! call sprinkler irrigation before CANWAT/PRECIP_HEAT to have canopy interception + IF((CROPLU .EQV. .TRUE.) .AND. (IRAMTSI .GT. 0.0)) THEN CALL SPRINKLER_IRRIGATION(parameters,NSOIL,DT,SH2O,SMC,SICE,& !in SFCTMP,UU,VV,EAIR,SIFAC, & !in IRAMTSI,IREVPLOS,IRSIRATE) !inout - RAIN = RAIN + (IRSIRATE*1000./DT) ![mm/s] + RAIN = RAIN + (IRSIRATE*1000.0/DT) ![mm/s] ! cooling and humidification due to sprinkler evaporation, per m^2 calculation - FIRR = IREVPLOS*1000.*HVAP/DT ! heat used for evaporation (W/m2) - EIRR = IREVPLOS*1000./DT ! sprinkler evaporation (mm/s) - END IF + FIRR = IREVPLOS*1000.0*HVAP/DT ! heat used for evaporation (W/m2) + EIRR = IREVPLOS*1000.0/DT ! sprinkler evaporation (mm/s) + END IF ! call for micro irrigation and flood irrigation are implemented in WATER subroutine ! end irrigation call-prasanth @@ -875,38 +947,39 @@ SUBROUTINE NOAHMP_SFLX (parameters, & ! compute energy budget (momentum & energy fluxes and phase changes) CALL ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in - ISNOW ,DT ,RHOAIR ,SFCPRS ,QAIR , & !in - SFCTMP ,THAIR ,LWDN ,UU ,VV ,ZLVL , & !in - CO2AIR ,O2AIR ,SOLAD ,SOLAI ,COSZ ,IGS , & !in - EAIR ,TBOT ,ZSNSO ,ZSOIL , & !in - ELAI ,ESAI ,FWET ,FOLN , & !in - FVEG ,PAHV ,PAHG ,PAHB , & !in - QSNOW ,DZSNSO ,LAT ,CANLIQ ,CANICE ,iloc, jloc , & !in - Z0WRF , & - IMELT ,SNICEV ,SNLIQV ,EPORE ,T2M ,FSNO , & !out - SAV ,SAG ,QMELT ,FSA ,FSR ,TAUX , & !out - TAUY ,FIRA ,FSH ,FCEV ,FGEV ,FCTR , & !out - TRAD ,PSN ,APAR ,SSOIL ,BTRANI ,BTRAN , & !out - PONDING,TS ,LATHEAV , LATHEAG , frozen_canopy,frozen_ground, & !out - TV ,TG ,STC ,SNOWH ,EAH ,TAH , & !inout - SNEQVO ,SNEQV ,SH2O ,SMC ,SNICE ,SNLIQ , & !inout - ALBOLD ,CM ,CH ,DX ,DZ8W ,Q2 , & !inout - TAUSS ,LAISUN ,LAISHA ,RB , & !inout + ISNOW ,DT ,RHOAIR ,SFCPRS ,QAIR , & !in + SFCTMP ,THAIR ,LWDN ,UU ,VV ,ZLVL , & !in + CO2AIR ,O2AIR ,SOLAD ,SOLAI ,COSZ ,IGS , & !in + EAIR ,TBOT ,ZSNSO ,ZSOIL , & !in + ELAI ,ESAI ,FWET ,FOLN , & !in + FVEG ,PAHV ,PAHG ,PAHB , & !in + QSNOW ,DZSNSO ,LAT ,CANLIQ ,CANICE ,iloc, jloc ,& !in + Z0WRF , & !out + IMELT ,SNICEV ,SNLIQV ,EPORE ,T2M ,FSNO , & !out + SAV ,SAG ,QMELT ,FSA ,FSR ,TAUX , & !out + TAUY ,FIRA ,FSH ,FCEV ,FGEV ,FCTR , & !out + TRAD ,PSN ,APAR ,SSOIL ,BTRANI ,BTRAN , & !out + PONDING,TS ,LATHEAV , LATHEAG , frozen_canopy,frozen_ground, & !out + TV ,TG ,STC ,SNOWH ,EAH ,TAH , & !inout + SNEQVO ,SNEQV ,SH2O ,SMC ,SNICE ,SNLIQ , & !inout + ALBOLD ,CM ,CH ,DX ,DZ8W ,Q2 , & !inout + TAUSS ,LAISUN ,LAISHA ,RB , & !inout !jref:start QC ,QSFC ,PSFC , & !in - T2MV ,T2MB ,FSRV , & - FSRG ,RSSUN ,RSSHA ,ALBSND ,ALBSNI, BGAP ,WGAP,TGV,TGB,& + T2MV ,T2MB ,FSRV , & !out + FSRG ,RSSUN ,RSSHA ,ALBSND ,ALBSNI, BGAP ,WGAP,TGV,TGB,& !out Q1 ,Q2V ,Q2B ,Q2E ,CHV ,CHB , & !out - EMISSI ,PAH , & + EMISSI ,PAH ,CANHS , & !out SHG,SHC,SHB,EVG,EVB,GHV,GHB,IRG,IRC,IRB,TR,EVC,CHLEAF,CHUC,CHV2,CHB2,& + EFLXB, HCPCT, ACC_SSOIL, & JULIAN, SWDOWN, PRCP, FB, GECROS1D ) !jref:end SICE(:) = MAX(0.0, SMC(:) - SH2O(:)) SNEQVO = SNEQV - QVAP = MAX( FGEV/LATHEAG, 0.) ! positive part of fgev; Barlage change to ground v3.6 - QDEW = ABS( MIN(FGEV/LATHEAG, 0.)) ! negative part of fgev + QVAP = MAX( FGEV/LATHEAG, 0.0) ! positive part of fgev; Barlage change to ground v3.6 + QDEW = ABS( MIN(FGEV/LATHEAG, 0.0)) ! negative part of fgev EDIR = QVAP - QDEW ! compute water budgets (water storages, ET components, and runoff) @@ -918,20 +991,22 @@ SUBROUTINE NOAHMP_SFLX (parameters, & FICEOLD,PONDING,TG ,IST ,FVEG ,iloc,jloc , SMCEQ , & !in BDFALL ,FP ,RAIN ,SNOW , & !in MB/AN: v3.7 QSNOW ,QRAIN ,SNOWHIN,LATHEAV,LATHEAG,frozen_canopy,frozen_ground, & !in MB + DX ,TDFRACMP, & !in PVK tile drainage ISNOW ,CANLIQ ,CANICE ,TV ,SNOWH ,SNEQV , & !inout SNICE ,SNLIQ ,STC ,ZSNSO ,SH2O ,SMC , & !inout SICE ,ZWT ,WA ,WT ,DZSNSO ,WSLAKE , & !inout SMCWTD ,DEEPRECH,RECH , & !inout IRAMTFI,IRAMTMI ,IRFIRATE ,IRMIRATE, & !inout CMC ,ECAN ,ETRAN ,FWET ,RUNSRF ,RUNSUB , & !out - QIN ,QDIS ,PONDING1 ,PONDING2,& - QSNBOT & + QIN ,QDIS ,PONDING1 ,PONDING2, & + QSNBOT ,QTLDRN , & + QSNSUB ,QSNFRO ,QSUBC ,QFROC ,QFRZC ,QMELTC , & + QEVAC ,QDEWC ,ACC_QINSUR ,ACC_QSEVA,ACC_ETRANI & #ifdef WRF_HYDRO - ,sfcheadrt & + ,sfcheadrt,WATBLED & #endif ) !out -! write(*,'(a20,10F15.5)') 'SFLX:RUNOFF=',RUNSRF*DT,RUNSUB*DT,EDIR*DT ! compute carbon budgets (carbon storages and co2 & bvoc fluxes) @@ -963,10 +1038,10 @@ SUBROUTINE NOAHMP_SFLX (parameters, & END IF ! before waterbalance check add irrigation water to precipitation -IF((CROPLU .EQV. .TRUE.) .AND. (IRRFRA .GE. parameters%IRR_FRAC))THEN - PRCP = PRCP + ((IRSIRATE+IRMIRATE+IRFIRATE)*1000./DT) ! irrigation - FSH = FSH - FIRR ! (W/m2) -END IF + IF((CROPLU .EQV. .TRUE.) .AND. (IRRFRA .GE. parameters%IRR_FRAC))THEN + PRCP = PRCP + (IRSIRATE*1000.0/DT) ! irrigation + FSH = FSH - FIRR ! (W/m2) + END IF ! water and energy balance check @@ -974,9 +1049,12 @@ SUBROUTINE NOAHMP_SFLX (parameters, & FGEV ,FCTR ,SSOIL ,BEG_WB ,CANLIQ ,CANICE , & !in SNEQV ,WA ,SMC ,DZSNSO ,PRCP ,ECAN , & !in ETRAN ,EDIR ,RUNSRF ,RUNSUB ,DT ,NSOIL , & !in - NSNOW ,IST ,ERRWAT ,ILOC , JLOC ,FVEG , & + QTLDRN , & !in + NSNOW ,IST ,ERRWAT ,ILOC ,JLOC ,FVEG , & SAV ,SAG ,FSRV ,FSRG ,ZWT ,PAH , & - PAHV ,PAHG ,PAHB ,FIRR) !in ( Except ERRWAT, which is out ) + PAHV ,PAHG ,PAHB ,FIRR ,CANHS , & + IRMIRATE, IRFIRATE, ACC_DWATER, ACC_PRCP, ACC_ECAN, & + ACC_ETRAN, ACC_EDIR ) !in ( Except ERRWAT, which is out ) ! urban - jref QFX = ETRAN + ECAN + EDIR @@ -985,12 +1063,12 @@ SUBROUTINE NOAHMP_SFLX (parameters, & Q2B = QSFC END IF - IF(SNOWH <= 1.E-6 .OR. SNEQV <= 1.E-3) THEN + IF(SNOWH <= 1.E-6 .OR. SNEQV <= 1.E-6) THEN SNOWH = 0.0 SNEQV = 0.0 END IF - IF(SWDOWN.NE.0.) THEN + IF(SWDOWN.NE.0.0) THEN ALBEDO = FSR / SWDOWN ELSE ALBEDO = -999.9 @@ -1013,7 +1091,7 @@ SUBROUTINE ATM (parameters,SFCPRS ,SFCTMP ,Q2 , ! -------------------------------------------------------------------------------------------------- ! inputs - type (noahmp_parameters), intent(in) :: parameters + type (noahmp_parameters) , INTENT(IN) :: parameters REAL , INTENT(IN) :: SFCPRS !pressure (pa) REAL , INTENT(IN) :: SFCTMP !surface air temperature [k] REAL , INTENT(IN) :: Q2 !mixing ratio (kg/kg) @@ -1070,8 +1148,8 @@ SUBROUTINE ATM (parameters,SFCPRS ,SFCTMP ,Q2 , EAIR = QAIR*SFCPRS / (0.622+0.378*QAIR) RHOAIR = (SFCPRS-0.378*EAIR) / (RAIR*SFCTMP) - IF(COSZ <= 0.) THEN - SWDOWN = 0. + IF(COSZ <= 0.0) THEN + SWDOWN = 0.0 ELSE SWDOWN = SOLDN END IF @@ -1094,8 +1172,8 @@ SUBROUTINE ATM (parameters,SFCPRS ,SFCTMP ,Q2 , ! fractional area that receives precipitation (see, Niu et al. 2005) FP = 0.0 - IF(QPRECC + QPRECL > 0.) & - FP = (QPRECC + QPRECL) / (10.*QPRECC + QPRECL) + IF(QPRECC + QPRECL > 0.0) & + FP = (QPRECC + QPRECL) / (10.0*QPRECC + QPRECL) ! partition precipitation into rain and snow. Moved from CANWAT MB/AN: v3.7 @@ -1103,12 +1181,12 @@ SUBROUTINE ATM (parameters,SFCPRS ,SFCTMP ,Q2 , IF(OPT_SNF == 1) THEN IF(SFCTMP > TFRZ+2.5)THEN - FPICE = 0. + FPICE = 0.0 ELSE IF(SFCTMP <= TFRZ+0.5)THEN FPICE = 1.0 - ELSE IF(SFCTMP <= TFRZ+2.)THEN - FPICE = 1.-(-54.632 + 0.2*SFCTMP) + ELSE IF(SFCTMP <= TFRZ+2.0)THEN + FPICE = 1.0-(-54.632 + 0.2*SFCTMP) ELSE FPICE = 0.6 ENDIF @@ -1117,7 +1195,7 @@ SUBROUTINE ATM (parameters,SFCPRS ,SFCTMP ,Q2 , IF(OPT_SNF == 2) THEN IF(SFCTMP >= TFRZ+2.2) THEN - FPICE = 0. + FPICE = 0.0 ELSE FPICE = 1.0 ENDIF @@ -1125,7 +1203,7 @@ SUBROUTINE ATM (parameters,SFCPRS ,SFCTMP ,Q2 , IF(OPT_SNF == 3) THEN IF(SFCTMP >= TFRZ) THEN - FPICE = 0. + FPICE = 0.0 ELSE FPICE = 1.0 ENDIF @@ -1134,10 +1212,10 @@ SUBROUTINE ATM (parameters,SFCPRS ,SFCTMP ,Q2 , ! Hedstrom NR and JW Pomeroy (1998), Hydrol. Processes, 12, 1611-1625 ! fresh snow density - BDFALL = MIN(120.,67.92+51.25*EXP((SFCTMP-TFRZ)/2.59)) !MB/AN: change to MIN + BDFALL = MIN(120.0,67.92+51.25*EXP((SFCTMP-TFRZ)/2.59)) !MB/AN: change to MIN IF(OPT_SNF == 4) THEN PRCP_FROZEN = PRCPSNOW + PRCPGRPL + PRCPHAIL - IF(PRCPNONC > 0. .and. PRCP_FROZEN > 0.) THEN + IF(PRCPNONC > 0.0 .and. PRCP_FROZEN > 0.0) THEN FPICE = MIN(1.0,PRCP_FROZEN/PRCPNONC) FPICE = MAX(0.0,FPICE) BDFALL = BDFALL*(PRCPSNOW/PRCP_FROZEN) + RHO_GRPL*(PRCPGRPL/PRCP_FROZEN) + & @@ -1150,14 +1228,14 @@ SUBROUTINE ATM (parameters,SFCPRS ,SFCTMP ,Q2 , ! wet-bulb scheme (Wang et al., 2019 GRL), C.He, 12/18/2020 IF(OPT_SNF == 5) THEN - TDC = MIN( 50., MAX(-50.,(SFCTMP-TFRZ)) ) !Kelvin to degree Celsius with limit -50 to +50 + TDC = MIN( 50.0, MAX(-50.0,(SFCTMP-TFRZ)) ) !Kelvin to degree Celsius with limit -50 to +50 IF (SFCTMP > TFRZ) THEN LATHEA = HVAP ELSE LATHEA = HSUB END IF GAMMA_b = CPAIR*SFCPRS/(0.622*LATHEA) - TWET = TDC - 5. ! first guess wetbulb temperature + TWET = TDC - 5.0 ! first guess wetbulb temperature DO ITER = 1, NITER ESATAIR = 610.8 * EXP((17.27*TWET)/(237.3+TWET)) TWET = TWET - (ESATAIR-EAIR)/ GAMMA_b ! Wang et al., 2019 GRL Eq.2 @@ -1165,7 +1243,7 @@ SUBROUTINE ATM (parameters,SFCPRS ,SFCTMP ,Q2 , FPICE = 1.0/(1.0+6.99E-5*exp(2.0*(TWET+3.97))) ! Wang et al., 2019 GRL Eq. 1 ENDIF - RAIN = PRCP * (1.-FPICE) + RAIN = PRCP * (1.0-FPICE) SNOW = PRCP * FPICE @@ -1218,7 +1296,7 @@ SUBROUTINE PHENOLOGY (parameters,VEGTYP ,croptype, SNOWH , TV , LAT , YEA IF ( DVEG == 1 .or. DVEG == 3 .or. DVEG == 4 ) THEN - IF (LAT >= 0.) THEN + IF (LAT >= 0.0) THEN ! Northern Hemisphere DAY = JULIAN ELSE @@ -1226,11 +1304,11 @@ SUBROUTINE PHENOLOGY (parameters,VEGTYP ,croptype, SNOWH , TV , LAT , YEA DAY = MOD ( JULIAN + ( 0.5 * YEARLEN ) , REAL(YEARLEN) ) ENDIF - T = 12. * DAY / REAL(YEARLEN) + T = 12.0 * DAY / REAL(YEARLEN) IT1 = T + 0.5 IT2 = IT1 + 1 WT1 = (IT1+0.5) - T - WT2 = 1.-WT1 + WT2 = 1.0-WT1 IF (IT1 .LT. 1) IT1 = 12 IF (IT2 .GT. 12) IT2 = 1 @@ -1248,24 +1326,24 @@ SUBROUTINE PHENOLOGY (parameters,VEGTYP ,croptype, SNOWH , TV , LAT , YEA IF ( ( VEGTYP == parameters%iswater ) .OR. ( VEGTYP == parameters%ISBARREN ) .OR. & ( VEGTYP == parameters%ISICE ) .or. ( parameters%urban_flag ) ) THEN - LAI = 0. - SAI = 0. + LAI = 0.0 + SAI = 0.0 ENDIF ENDIF ! CROPTYPE == 0 !buried by snow - DB = MIN( MAX(SNOWH - parameters%HVB,0.), parameters%HVT-parameters%HVB ) + DB = MIN( MAX(SNOWH - parameters%HVB,0.0), parameters%HVT-parameters%HVB ) FB = DB / MAX(1.E-06,parameters%HVT-parameters%HVB) - IF(parameters%HVT> 0. .AND. parameters%HVT <= 1.0) THEN !MB: change to 1.0 and 0.2 to reflect + IF(parameters%HVT> 0.0 .AND. parameters%HVT <= 1.0) THEN !MB: change to 1.0 and 0.2 to reflect SNOWHC = parameters%HVT*EXP(-SNOWH/0.2) ! changes to HVT in MPTABLE FB = MIN(SNOWH,SNOWHC)/SNOWHC ENDIF - ELAI = LAI*(1.-FB) - ESAI = SAI*(1.-FB) + ELAI = LAI*(1.0-FB) + ESAI = SAI*(1.0-FB) IF (ESAI < 0.05 .and. CROPTYPE == 0) ESAI = 0.0 ! MB: ESAI CHECK, change to 0.05 v3.6 IF ((ELAI < 0.05 .OR. ESAI == 0.0) .and. CROPTYPE == 0) ELAI = 0.0 ! MB: LAI CHECK @@ -1348,28 +1426,23 @@ SUBROUTINE PRECIP_HEAT (parameters,ILOC ,JLOC ,VEGTYP ,DT ,UU ,VV ! -------------------------------------------------------------------- ! initialization - QINTR = 0. - QDRIPR = 0. - QTHROR = 0. - QINTR = 0. - QINTS = 0. - QDRIPS = 0. - QTHROS = 0. - PAH_AC = 0. - PAH_CG = 0. - PAH_AG = 0. - PAHV = 0. - PAHG = 0. - PAHB = 0. + QINTR = 0.0 + QDRIPR = 0.0 + QTHROR = 0.0 + QINTR = 0.0 + QINTS = 0.0 + QDRIPS = 0.0 + QTHROS = 0.0 + PAH_AC = 0.0 + PAH_CG = 0.0 + PAH_AG = 0.0 + PAHV = 0.0 + PAHG = 0.0 + PAHB = 0.0 QRAIN = 0.0 QSNOW = 0.0 SNOWHIN = 0.0 ICEDRIP = 0.0 -! print*, "precip_heat begin canopy balance:",canliq+canice+(rain+snow)*dt -! print*, "precip_heat snow*3600.0:",snow*3600.0 -! print*, "precip_heat rain*3600.0:",rain*3600.0 -! print*, "precip_heat canice:",canice -! print*, "precip_heat canliq:",canliq ! --------------------------- liquid water ------------------------------ ! maximum canopy water @@ -1378,18 +1451,18 @@ SUBROUTINE PRECIP_HEAT (parameters,ILOC ,JLOC ,VEGTYP ,DT ,UU ,VV ! average interception and throughfall - IF((ELAI+ ESAI).GT.0.) THEN + IF((ELAI+ ESAI) .GT. 0.0) THEN QINTR = FVEG * RAIN * FP ! interception capability - QINTR = MIN(QINTR, (MAXLIQ - CANLIQ)/DT * (1.-EXP(-RAIN*DT/MAXLIQ)) ) - QINTR = MAX(QINTR, 0.) + QINTR = MIN(QINTR, (MAXLIQ - CANLIQ)/DT * (1.0-EXP(-RAIN*DT/MAXLIQ)) ) + QINTR = MAX(QINTR, 0.0) QDRIPR = FVEG * RAIN - QINTR - QTHROR = (1.-FVEG) * RAIN - CANLIQ=MAX(0.,CANLIQ+QINTR*DT) + QTHROR = (1.0-FVEG) * RAIN + CANLIQ=MAX(0.0,CANLIQ+QINTR*DT) ELSE - QINTR = 0. - QDRIPR = 0. + QINTR = 0.0 + QDRIPR = 0.0 QTHROR = RAIN - IF(CANLIQ > 0.) THEN ! FOR CASE OF CANOPY GETTING BURIED + IF(CANLIQ > 0.0) THEN ! FOR CASE OF CANOPY GETTING BURIED QDRIPR = QDRIPR + CANLIQ/DT CANLIQ = 0.0 END IF @@ -1400,46 +1473,42 @@ SUBROUTINE PRECIP_HEAT (parameters,ILOC ,JLOC ,VEGTYP ,DT ,UU ,VV PAH_AC = FVEG * RAIN * (CWAT/1000.0) * (SFCTMP - TV) PAH_CG = QDRIPR * (CWAT/1000.0) * (TV - TG) PAH_AG = QTHROR * (CWAT/1000.0) * (SFCTMP - TG) -! print*, "precip_heat PAH_AC:",PAH_AC -! print*, "precip_heat PAH_CG:",PAH_CG -! print*, "precip_heat PAH_AG:",PAH_AG ! --------------------------- canopy ice ------------------------------ ! for canopy ice - MAXSNO = 6.6*(0.27+46./BDFALL) * (ELAI+ ESAI) + MAXSNO = 6.6*(0.27+46.0/BDFALL) * (ELAI+ ESAI) - IF((ELAI+ ESAI).GT.0.) THEN + IF((ELAI+ ESAI) .GT. 0.0) THEN QINTS = FVEG * SNOW * FP - QINTS = MIN(QINTS, (MAXSNO - CANICE)/DT * (1.-EXP(-SNOW*DT/MAXSNO)) ) - QINTS = MAX(QINTS, 0.) + QINTS = MIN(QINTS, (MAXSNO - CANICE)/DT * (1.0-EXP(-SNOW*DT/MAXSNO)) ) + QINTS = MAX(QINTS, 0.0) FT = MAX(0.0,(TV - 270.15) / 1.87E5) FV = SQRT(UU*UU + VV*VV) / 1.56E5 ! MB: changed below to reflect the rain assumption that all precip gets intercepted - ICEDRIP = MAX(0.,CANICE) * (FV+FT) !MB: removed /DT + ICEDRIP = MAX(0.0,CANICE) * (FV+FT) !MB: removed /DT + ICEDRIP = MIN(CANICE/DT + QINTS, ICEDRIP) !C.He: add constraint to keep water balance QDRIPS = (FVEG * SNOW - QINTS) + ICEDRIP QTHROS = (1.0-FVEG) * SNOW - CANICE= MAX(0.,CANICE + (QINTS - ICEDRIP)*DT) + CANICE= MAX(0.0,CANICE + (QINTS - ICEDRIP)*DT) ELSE - QINTS = 0. - QDRIPS = 0. + QINTS = 0.0 + QDRIPS = 0.0 QTHROS = SNOW - IF(CANICE > 0.) THEN ! FOR CASE OF CANOPY GETTING BURIED + IF(CANICE > 0.0) THEN ! FOR CASE OF CANOPY GETTING BURIED QDRIPS = QDRIPS + CANICE/DT CANICE = 0.0 END IF ENDIF -! print*, "precip_heat canopy through:",3600.0*(FVEG * SNOW - QINTS) -! print*, "precip_heat canopy drip:",3600.0*MAX(0.,CANICE) * (FV+FT) ! wetted fraction of canopy - IF(CANICE.GT.0.) THEN - FWET = MAX(0.,CANICE) / MAX(MAXSNO,1.E-06) + IF(CANICE .GT. 0.0) THEN + FWET = MAX(0.0,CANICE) / MAX(MAXSNO,1.E-06) ELSE - FWET = MAX(0.,CANLIQ) / MAX(MAXLIQ,1.E-06) + FWET = MAX(0.0,CANLIQ) / MAX(MAXLIQ,1.E-06) ENDIF - FWET = MIN(FWET, 1.) ** 0.667 + FWET = MIN(FWET, 1.0) ** 0.667 ! total canopy water @@ -1473,21 +1542,6 @@ SUBROUTINE PRECIP_HEAT (parameters,ILOC ,JLOC ,VEGTYP ,DT ,UU ,VV PAHB = MAX(PAHB,-20.0) PAHB = MIN(PAHB,20.0) -! print*, 'precip_heat sfctmp,tv,tg:',sfctmp,tv,tg -! print*, 'precip_heat 3600.0*qints+qdrips+qthros:',3600.0*(qints+qdrips+qthros) -! print*, "precip_heat maxsno:",maxsno -! print*, "precip_heat PAH_AC:",PAH_AC -! print*, "precip_heat PAH_CG:",PAH_CG -! print*, "precip_heat PAH_AG:",PAH_AG - -! print*, "precip_heat PAHV:",PAHV -! print*, "precip_heat PAHG:",PAHG -! print*, "precip_heat PAHB:",PAHB -! print*, "precip_heat fveg:",fveg -! print*, "precip_heat qints*3600.0:",qints*3600.0 -! print*, "precip_heat qdrips*3600.0:",qdrips*3600.0 -! print*, "precip_heat qthros*3600.0:",qthros*3600.0 - ! rain or snow on the ground QRAIN = QDRIPR + QTHROR @@ -1495,16 +1549,9 @@ SUBROUTINE PRECIP_HEAT (parameters,ILOC ,JLOC ,VEGTYP ,DT ,UU ,VV SNOWHIN = QSNOW/BDFALL IF (IST == 2 .AND. TG > TFRZ) THEN - QSNOW = 0. - SNOWHIN = 0. + QSNOW = 0.0 + SNOWHIN = 0.0 END IF -! print*, "precip_heat qsnow*3600.0:",qsnow*3600.0 -! print*, "precip_heat qrain*3600.0:",qrain*3600.0 -! print*, "precip_heat SNOWHIN:",SNOWHIN -! print*, "precip_heat canice:",canice -! print*, "precip_heat canliq:",canliq -! print*, "precip_heat end canopy balance:",canliq+canice+(qrain+qsnow)*dt - END SUBROUTINE PRECIP_HEAT @@ -1514,9 +1561,12 @@ SUBROUTINE ERROR (parameters,SWDOWN ,FSA ,FSR ,FIRA ,FSH ,FCEV , & FGEV ,FCTR ,SSOIL ,BEG_WB ,CANLIQ ,CANICE , & SNEQV ,WA ,SMC ,DZSNSO ,PRCP ,ECAN , & ETRAN ,EDIR ,RUNSRF ,RUNSUB ,DT ,NSOIL , & + QTLDRN , & NSNOW ,IST ,ERRWAT, ILOC ,JLOC ,FVEG , & SAV ,SAG ,FSRV ,FSRG ,ZWT ,PAH , & - PAHV ,PAHG ,PAHB ,FIRR) + PAHV ,PAHG ,PAHB ,FIRR ,CANHS , & + IRMIRATE, IRFIRATE, ACC_DWATER, ACC_PRCP, ACC_ECAN, & + ACC_ETRAN, ACC_EDIR ) ! -------------------------------------------------------------------------------------------------- ! check surface energy balance and water balance ! -------------------------------------------------------------------------------------------------- @@ -1549,8 +1599,9 @@ SUBROUTINE ERROR (parameters,SWDOWN ,FSA ,FSR ,FIRA ,FSH ,FCEV , & REAL , INTENT(IN) :: ECAN !evaporation of intercepted water (mm/s) REAL , INTENT(IN) :: ETRAN !transpiration rate (mm/s) REAL , INTENT(IN) :: EDIR !soil surface evaporation rate[mm/s] - REAL , INTENT(IN) :: RUNSRF !surface runoff [mm/s] - REAL , INTENT(IN) :: RUNSUB !baseflow (saturation excess) [mm/s] + REAL , INTENT(IN) :: RUNSRF !surface runoff [mm] per soil timestep + REAL , INTENT(IN) :: RUNSUB !baseflow (saturation excess) [mm] per soil timestep + REAL , INTENT(IN) :: QTLDRN !tile drainage [mm] per soil timestep REAL , INTENT(IN) :: CANLIQ !intercepted liquid water (mm) REAL , INTENT(IN) :: CANICE !intercepted ice mass (mm) REAL , INTENT(IN) :: SNEQV !snow water eqv. [mm] @@ -1564,8 +1615,17 @@ SUBROUTINE ERROR (parameters,SWDOWN ,FSA ,FSR ,FIRA ,FSH ,FCEV , & REAL, INTENT(IN) :: PAHV !precipitation advected heat - total (W/m2) REAL, INTENT(IN) :: PAHG !precipitation advected heat - total (W/m2) REAL, INTENT(IN) :: PAHB !precipitation advected heat - total (W/m2) - REAL , INTENT(IN) :: FIRR ! latent heating due to sprinkler evaporation (w/m2) [+ to atm] + REAL , INTENT(IN) :: FIRR !latent heating due to sprinkler evaporation (w/m2) [+ to atm] + REAL , INTENT(IN) :: CANHS !canopy heat storage change (w/m2) C.He added based on GY Niu's communication + REAL , INTENT(IN) :: IRMIRATE ! micro irrigation amount m/timestep(soil) + REAL , INTENT(IN) :: IRFIRATE ! flood irrigation amount m/timestep(soil) + REAL , INTENT(INOUT) :: ACC_DWATER ! accumulated water change for canopy, snow, soil mm/timestep(soil) + REAL , INTENT(INOUT) :: ACC_PRCP ! accumulated precip mm/timestep(soil) + REAL , INTENT(INOUT) :: ACC_ECAN ! accumulated net canopy evapo mm/timestep(soil) + REAL , INTENT(INOUT) :: ACC_ETRAN ! accumulated transpiration mm/timestep(soil) + REAL , INTENT(INOUT) :: ACC_EDIR ! accumulated net soil/snow evapo mm/timestep(soil) +!local INTEGER :: IZ !do-loop index REAL :: END_WB !water storage at end of a timestep [mm] !KWM REAL :: ERRWAT !error in water balance [mm/timestep] @@ -1577,7 +1637,7 @@ SUBROUTINE ERROR (parameters,SWDOWN ,FSA ,FSR ,FIRA ,FSH ,FCEV , & !jref:start ERRSW = SWDOWN - (FSA + FSR) ! ERRSW = SWDOWN - (SAV+SAG + FSRV+FSRG) -! WRITE(*,*) "ERRSW =",ERRSW + IF (ABS(ERRSW) > 0.01) THEN ! w/m2 WRITE(*,*) "VEGETATION!" WRITE(*,*) "SWDOWN*FVEG =",SWDOWN*FVEG @@ -1599,9 +1659,9 @@ SUBROUTINE ERROR (parameters,SWDOWN ,FSA ,FSR ,FIRA ,FSH ,FCEV , & call wrf_error_fatal("Stop in Noah-MP") END IF - ERRENG = SAV+SAG-(FIRA+FSH+FCEV+FGEV+FCTR+SSOIL+FIRR) +PAH + ERRENG = SAV+SAG-(FIRA+FSH+FCEV+FGEV+FCTR+SSOIL+FIRR+CANHS) +PAH ! ERRENG = FVEG*SAV+SAG-(FIRA+FSH+FCEV+FGEV+FCTR+SSOIL) -! WRITE(*,*) "ERRENG =",ERRENG + IF(ABS(ERRENG) > 0.01) THEN write(message,*) 'ERRENG =',ERRENG,' at i,j: ',ILOC,JLOC call wrf_message(trim(message)) @@ -1621,6 +1681,8 @@ SUBROUTINE ERROR (parameters,SWDOWN ,FSA ,FSR ,FIRA ,FSH ,FCEV , & call wrf_message(trim(message)) WRITE(message,'(a17,F10.4)') "Sprinkler: ",FIRR call wrf_message(trim(message)) + WRITE(message,'(a17,F10.4)') "Canopy Heat Storage: ",CANHS + call wrf_message(trim(message)) WRITE(message,'(a17,4F10.4)') "Precip advected: ",PAH,PAHV,PAHG,PAHB call wrf_message(trim(message)) WRITE(message,'(a17,F10.4)') "Precip: ",PRCP @@ -1630,12 +1692,22 @@ SUBROUTINE ERROR (parameters,SWDOWN ,FSA ,FSR ,FIRA ,FSH ,FCEV , & call wrf_error_fatal("Energy budget problem in NOAHMP LSM") END IF - IF (IST == 1) THEN !soil - END_WB = CANLIQ + CANICE + SNEQV + WA - DO IZ = 1,NSOIL - END_WB = END_WB + SMC(IZ) * DZSNSO(IZ) * 1000. - END DO - ERRWAT = END_WB-BEG_WB-(PRCP-ECAN-ETRAN-EDIR-RUNSRF-RUNSUB)*DT +! only water balance check for soil timestep + IF (IST == 1) THEN !soil + END_WB = CANLIQ + CANICE + SNEQV + WA + DO IZ = 1,NSOIL + END_WB = END_WB + SMC(IZ) * DZSNSO(IZ) * 1000.0 + END DO + ! accumualted water change (only for canopy and snow during non-soil timestep) + ACC_DWATER = ACC_DWATER + (END_WB - BEG_WB) ! snow, canopy, and soil water change + ACC_PRCP = ACC_PRCP + PRCP * DT ! accumulated precip + ACC_ECAN = ACC_ECAN + ECAN * DT ! accumulated canopy evapo + ACC_ETRAN = ACC_ETRAN + ETRAN * DT ! accumulated transpiration + ACC_EDIR = ACC_EDIR + EDIR * DT ! accumulated soil evapo + + if (calculate_soil) then + ERRWAT = ACC_DWATER - (ACC_PRCP + IRFIRATE*1000.0 + IRMIRATE*1000.0 - ACC_ECAN - & + ACC_ETRAN - ACC_EDIR - RUNSRF - RUNSUB - QTLDRN) #ifndef WRF_HYDRO IF(ABS(ERRWAT) > 0.1) THEN @@ -1647,14 +1719,17 @@ SUBROUTINE ERROR (parameters,SWDOWN ,FSA ,FSR ,FIRA ,FSH ,FCEV , & write(message, *) 'ERRWAT =',ERRWAT, "kg m{-2} timestep{-1}" call wrf_message(trim(message)) WRITE(message, & - '(" I J END_WB BEG_WB PRCP ECAN EDIR ETRAN RUNSRF RUNSUB")') + '(" I J END-BEG PRCP IRMIRATE IRFIRATE ECAN EDIR ETRAN RUNSRF RUNSUB ZWT QTLDRN")') call wrf_message(trim(message)) - WRITE(message,'(i6,1x,i6,1x,2f15.3,9f11.5)')ILOC,JLOC,END_WB,BEG_WB,PRCP*DT,ECAN*DT,& - EDIR*DT,ETRAN*DT,RUNSRF*DT,RUNSUB*DT,ZWT + WRITE(message,'(i6,i6,f10.3,10f10.5)')ILOC,JLOC,ACC_DWATER,ACC_PRCP,IRMIRATE*1000.0,& + IRFIRATE*1000.0,ACC_ECAN,ACC_EDIR,ACC_ETRAN,RUNSRF,RUNSUB,ZWT,QTLDRN call wrf_message(trim(message)) call wrf_error_fatal("Water budget problem in NOAHMP LSM") END IF #endif + + endif ! calculate_soil + ELSE !KWM ERRWAT = 0.0 !KWM ENDIF @@ -1685,8 +1760,9 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in QC ,QSFC ,PSFC , & !in T2MV ,T2MB ,FSRV , & FSRG ,RSSUN ,RSSHA ,ALBSND ,ALBSNI,BGAP ,WGAP,TGV,TGB,& - Q1 ,Q2V ,Q2B ,Q2E ,CHV ,CHB, EMISSI,PAH ,& + Q1 ,Q2V ,Q2B ,Q2E ,CHV ,CHB, EMISSI, PAH, CANHS, & SHG,SHC,SHB,EVG,EVB,GHV,GHB,IRG,IRC,IRB,TR,EVC,CHLEAF,CHUC,CHV2,CHB2, & + EFLXB ,HCPCT ,ACC_SSOIL, & JULIAN, SWDOWN, PRCP, FB, GECROS1D ) !jref:end @@ -1811,6 +1887,8 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in REAL , INTENT(OUT) :: LATHEAG !latent heat vap./sublimation (j/kg) LOGICAL , INTENT(OUT) :: FROZEN_GROUND ! used to define latent heat pathway LOGICAL , INTENT(OUT) :: FROZEN_CANOPY ! used to define latent heat pathway + REAL , INTENT(OUT) :: EFLXB !energy influx from soil bottom (w/m2) + REAL , INTENT(INOUT) :: ACC_SSOIL !energy influx from soil bottom (w/m2) !jref:start REAL , INTENT(OUT) :: FSRV !veg. reflected solar radiation (w/m2) @@ -1828,6 +1906,8 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in REAL, DIMENSION(1:2) , INTENT(OUT) :: ALBSNI !snow albedo (diffuse) !jref:end + REAL , INTENT(OUT) :: CANHS ! canopy heat storage change (w/m2) C.He added based on GY Niu's communication + ! input & output REAL , INTENT(INOUT) :: TS !surface temperature (k) REAL , INTENT(INOUT) :: TV !vegetation temperature (k) @@ -1887,7 +1967,7 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in REAL, DIMENSION(-NSNOW+1:NSOIL) :: FACT !temporary used in phase change REAL, DIMENSION(-NSNOW+1:NSOIL) :: DF !thermal conductivity [w/m/k] - REAL, DIMENSION(-NSNOW+1:NSOIL) :: HCPCT !heat capacity [j/m3/k] + REAL, DIMENSION(-NSNOW+1:NSOIL) , INTENT(OUT) :: HCPCT !heat capacity [j/m3/k] REAL :: BDSNO !bulk density of snow (kg/m3) REAL :: FMELT !melting factor for snow cover frac REAL :: GX !temporary variable @@ -1937,54 +2017,57 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in REAL,INTENT(OUT) :: CHB2 !sensible heat conductance, canopy air to ZLVL air (m/s) REAL :: noahmpres + real :: dt_soil + real :: ssoil_avg + REAL, INTENT(IN) :: JULIAN, SWDOWN, PRCP, FB REAL,DIMENSION(1:60),INTENT(INOUT) :: GECROS1D !jref:end REAL, PARAMETER :: MPE = 1.E-6 - REAL, PARAMETER :: PSIWLT = -150. !metric potential for wilting point (m) - REAL, PARAMETER :: Z0 = 0.002 ! Bare-soil roughness length (m) (i.e., under the canopy) + REAL, PARAMETER :: PSIWLT = -150.0 !metric potential for wilting point (m) + REAL, PARAMETER :: Z0 = 0.002 ! Bare-soil roughness length (m) (i.e., under the canopy) ! --------------------------------------------------------------------------------------------------- ! initialize fluxes from veg. fraction - TAUXV = 0. - TAUYV = 0. - IRC = 0. - SHC = 0. - IRG = 0. - SHG = 0. - EVG = 0. - EVC = 0. - TR = 0. - GHV = 0. - PSNSUN = 0. - PSNSHA = 0. - T2MV = 0. - Q2V = 0. - CHV = 0. - CHLEAF = 0. - CHUC = 0. - CHV2 = 0. - RB = 0. + TAUXV = 0.0 + TAUYV = 0.0 + IRC = 0.0 + SHC = 0.0 + IRG = 0.0 + SHG = 0.0 + EVG = 0.0 + EVC = 0.0 + TR = 0.0 + GHV = 0.0 + PSNSUN = 0.0 + PSNSHA = 0.0 + T2MV = 0.0 + Q2V = 0.0 + CHV = 0.0 + CHLEAF = 0.0 + CHUC = 0.0 + CHV2 = 0.0 + RB = 0.0 ! wind speed at reference height: ur >= 1 - UR = MAX( SQRT(UU**2.+VV**2.), 1. ) + UR = MAX( SQRT(UU**2.0 + VV**2.0), 1.0 ) ! vegetated or non-vegetated VAI = ELAI + ESAI VEG = .FALSE. - IF(VAI > 0.) VEG = .TRUE. + IF(VAI > 0.0) VEG = .TRUE. ! ground snow cover fraction [Niu and Yang, 2007, JGR] - FSNO = 0. - IF(SNOWH.GT.0.) THEN + FSNO = 0.0 + IF(SNOWH .GT. 0.0) THEN BDSNO = SNEQV / SNOWH - FMELT = (BDSNO/100.)**parameters%MFSNO + FMELT = (BDSNO/100.0)**parameters%MFSNO !FSNO = TANH( SNOWH /(2.5* Z0 * FMELT)) FSNO = TANH( SNOWH /(parameters%SCFFAC * FMELT)) ! C.He: bring hard-coded 2.5*z0 to MPTABLE tunable parameter SCFFAC ENDIF @@ -2053,16 +2136,16 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in ! vegetation and ground emissivity - EMV = 1. - EXP(-(ELAI+ESAI)/1.0) + EMV = 1.0 - EXP(-(ELAI+ESAI)/1.0) IF (ICE == 1) THEN - EMG = 0.98*(1.-FSNO) + parameters%SNOW_EMIS*FSNO ! move hard-coded snow emissivity as a global parameter to MPTABLE + EMG = 0.98*(1.0-FSNO) + parameters%SNOW_EMIS*FSNO ! move hard-coded snow emissivity as a global parameter to MPTABLE ELSE - EMG = parameters%EG(IST)*(1.-FSNO) + parameters%SNOW_EMIS*FSNO + EMG = parameters%EG(IST)*(1.0-FSNO) + parameters%SNOW_EMIS*FSNO END IF ! soil moisture factor controlling stomatal resistance - BTRAN = 0. + BTRAN = 0.0 IF(IST ==1 ) THEN DO IZ = 1, parameters%NROOT @@ -2071,14 +2154,14 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in END IF IF(OPT_BTR == 2) then ! CLM PSI = MAX(PSIWLT,-parameters%PSISAT(IZ)*(MAX(0.01,SH2O(IZ))/parameters%SMCMAX(IZ))**(-parameters%BEXP(IZ)) ) - GX = (1.-PSI/PSIWLT)/(1.+parameters%PSISAT(IZ)/PSIWLT) + GX = (1.0-PSI/PSIWLT)/(1.0+parameters%PSISAT(IZ)/PSIWLT) END IF IF(OPT_BTR == 3) then ! SSiB PSI = MAX(PSIWLT,-parameters%PSISAT(IZ)*(MAX(0.01,SH2O(IZ))/parameters%SMCMAX(IZ))**(-parameters%BEXP(IZ)) ) - GX = 1.-EXP(-5.8*(LOG(PSIWLT/PSI))) + GX = 1.0-EXP(-5.8*(LOG(PSIWLT/PSI))) END IF - GX = MIN(1.,MAX(0.,GX)) + GX = MIN(1.0,MAX(0.0,GX)) BTRANI(IZ) = MAX(MPE,DZSNSO(IZ) / (-ZSOIL(parameters%NROOT)) * GX) BTRAN = BTRAN + BTRANI(IZ) END DO @@ -2091,7 +2174,7 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in BEVAP = MAX(0.0,SH2O(1)/parameters%SMCMAX(1)) IF(IST == 2) THEN - RSURF = 1. ! avoid being divided by 0 + RSURF = 1.0 ! avoid being divided by 0 RHSUR = 1.0 ELSE @@ -2103,22 +2186,22 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in D_RSURF = 2.2E-5 * parameters%SMCMAX(1) * parameters%SMCMAX(1) * ( 1.0 - parameters%SMCWLT(1) / parameters%SMCMAX(1) ) ** (2.0+3.0/parameters%BEXP(1)) RSURF = L_RSURF / D_RSURF ELSEIF(OPT_RSF == 2) THEN - RSURF = FSNO * 1. + (1.-FSNO)* EXP(8.25-4.225*BEVAP) !Sellers (1992) ! Older RSURF computations + RSURF = FSNO * 1.0 + (1.-FSNO)* EXP(8.25-4.225*BEVAP) !Sellers (1992) ! Older RSURF computations ELSEIF(OPT_RSF == 3) THEN - RSURF = FSNO * 1. + (1.-FSNO)* EXP(8.25-6.0 *BEVAP) !adjusted to decrease RSURF for wet soil + RSURF = FSNO * 1.0 + (1.-FSNO)* EXP(8.25-6.0 *BEVAP) !adjusted to decrease RSURF for wet soil ENDIF IF(OPT_RSF == 4) THEN ! AD: FSNO weighted; snow RSURF set in MPTABLE v3.8 - RSURF = 1. / (FSNO * (1./parameters%RSURF_SNOW) + (1.-FSNO) * (1./max(RSURF, 0.001))) + RSURF = 1.0 / (FSNO * (1.0/parameters%RSURF_SNOW) + (1.0-FSNO) * (1.0/max(RSURF, 0.001))) ENDIF - IF(SH2O(1) < 0.01 .and. SNOWH == 0.) RSURF = 1.E6 + IF(SH2O(1) < 0.01 .and. SNOWH == 0.0) RSURF = 1.E6 PSI = -parameters%PSISAT(1)*(MAX(0.01,SH2O(1))/parameters%SMCMAX(1))**(-parameters%BEXP(1)) - RHSUR = FSNO + (1.-FSNO) * EXP(PSI*GRAV/(RW*TG)) + RHSUR = FSNO + (1.0-FSNO) * EXP(PSI*GRAV/(RW*TG)) END IF ! urban - jref - IF (parameters%urban_flag .and. SNOWH == 0. ) THEN + IF (parameters%urban_flag .and. SNOWH == 0.0 ) THEN RSURF = 1.E6 ENDIF @@ -2170,7 +2253,7 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in CHV ,DX ,DZ8W , & !inout TAUXV ,TAUYV ,IRG ,IRC ,SHG , & !out SHC ,EVG ,EVC ,TR ,GHV , & !out - T2MV ,PSNSUN ,PSNSHA , & !out + T2MV ,PSNSUN ,PSNSHA ,CANHS , & !out !jref:start QC ,QSFC ,PSFC , & !in Q2V ,CHV2, CHLEAF, CHUC, & @@ -2243,7 +2326,7 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in FIRE = LWDN + FIRA - IF(FIRE <=0.) THEN + IF(FIRE <=0.0) THEN WRITE(6,*) 'emitted longwave <0; skin T may be wrong due to inconsistent' WRITE(6,*) 'input of SHDFAC with LAI' WRITE(6,*) ILOC, JLOC, 'SHDFAC=',FVEG,'VAI=',VAI,'TV=',TV,'TG=',TG @@ -2268,12 +2351,23 @@ SUBROUTINE ENERGY (parameters,ICE ,VEGTYP ,IST ,NSNOW ,NSOIL , & !in PSN = PSNSUN*LAISUN + PSNSHA*LAISHA ! 3L snow & 4L soil temperatures - - CALL TSNOSOI (parameters,ICE ,NSOIL ,NSNOW ,ISNOW ,IST , & !in - TBOT ,ZSNSO ,SSOIL ,DF ,HCPCT , & !in - SAG ,DT ,SNOWH ,DZSNSO , & !in - TG ,ILOC ,JLOC , & !in - STC ) !inout +! added soil timestep capability + EFLXB = 0.0 + ACC_SSOIL = ACC_SSOIL + SSOIL +! starting the soil timestep + if(calculate_soil) then + + SSOIL_avg = ACC_SSOIL / soil_update_steps + DT_soil = DT * soil_update_steps + + CALL TSNOSOI (parameters,ICE ,NSOIL ,NSNOW ,ISNOW ,IST , & !in + TBOT ,ZSNSO ,SSOIL_avg ,DF ,HCPCT , & !in + SAG ,DT_soil ,SNOWH ,DZSNSO , & !in + TG ,ILOC ,JLOC , & !in + STC ,EFLXB ) !inout + + EFLXB = EFLXB * DT_soil + end if ! adjusting snow surface temperature IF(OPT_STC == 2) THEN @@ -2349,6 +2443,9 @@ SUBROUTINE THERMOPROP (parameters,NSOIL ,NSNOW ,ISNOW ,IST ,DZSNSO , REAL, DIMENSION( 1:NSOIL) :: SICE !soil ice content ! -------------------------------------------------------------------------------------------------- + HCPCT = 0.0 + DF = 0.0 + ! compute snow thermal conductivity and heat capacity CALL CSNOW (parameters,ISNOW ,NSNOW ,NSOIL ,SNICE ,SNLIQ ,DZSNSO , & !in @@ -2448,8 +2545,8 @@ SUBROUTINE CSNOW (parameters,ISNOW ,NSNOW ,NSOIL ,SNICE ,SNLIQ ,DZSNSO ! thermal capacity of snow DO IZ = ISNOW+1, 0 - SNICEV(IZ) = MIN(1., SNICE(IZ)/(DZSNSO(IZ)*DENICE) ) - EPORE(IZ) = 1. - SNICEV(IZ) + SNICEV(IZ) = MIN(1.0, SNICE(IZ)/(DZSNSO(IZ)*DENICE) ) + EPORE(IZ) = 1.0 - SNICEV(IZ) SNLIQV(IZ) = MIN(EPORE(IZ),SNLIQ(IZ)/(DZSNSO(IZ)*DENH2O)) ENDDO @@ -2462,7 +2559,7 @@ SUBROUTINE CSNOW (parameters,ISNOW ,NSNOW ,NSOIL ,SNICE ,SNLIQ ,DZSNSO ! thermal conductivity of snow DO IZ = ISNOW+1, 0 - TKSNO(IZ) = 3.2217E-6*BDSNOI(IZ)**2. ! Stieglitz(yen,1965) + TKSNO(IZ) = 3.2217E-6*BDSNOI(IZ)**2.0 ! Stieglitz(yen,1965) ! TKSNO(IZ) = 2E-2+2.5E-6*BDSNOI(IZ)*BDSNOI(IZ) ! Anderson, 1976 ! TKSNO(IZ) = 0.35 ! constant ! TKSNO(IZ) = 2.576E-6*BDSNOI(IZ)**2. + 0.074 ! Verseghy (1991) @@ -2537,22 +2634,22 @@ SUBROUTINE TDFCND (parameters, ISOIL, DF, SMC, SH2O) THKQTZ = 7.7 ! UNFROZEN FRACTION (FROM 1., i.e., 100%LIQUID, TO 0. (100% FROZEN)) - THKS = (THKQTZ ** parameters%QUARTZ(ISOIL))* (THKO ** (1. - parameters%QUARTZ(ISOIL))) + THKS = (THKQTZ ** parameters%QUARTZ(ISOIL))* (THKO ** (1.0 - parameters%QUARTZ(ISOIL))) ! UNFROZEN VOLUME FOR SATURATION (POROSITY*XUNFROZ) XUNFROZ = 1.0 ! Prevent divide by zero (suggested by D. Mocko) - IF(SMC > 0.) XUNFROZ = SH2O / SMC + IF(SMC > 0.0) XUNFROZ = SH2O / SMC ! SATURATED THERMAL CONDUCTIVITY XU = XUNFROZ * parameters%SMCMAX(ISOIL) ! DRY DENSITY IN KG/M3 - THKSAT = THKS ** (1. - parameters%SMCMAX(ISOIL))* TKICE ** (parameters%SMCMAX(ISOIL) - XU)* THKW ** & + THKSAT = THKS ** (1.0 - parameters%SMCMAX(ISOIL))* TKICE ** (parameters%SMCMAX(ISOIL) - XU)* THKW ** & (XU) ! DRY THERMAL CONDUCTIVITY IN W.M-1.K-1 - GAMMD = (1. - parameters%SMCMAX(ISOIL))*2700. + GAMMD = (1.0 - parameters%SMCMAX(ISOIL))*2700.0 - THKDRY = (0.135* GAMMD+ 64.7)/ (2700. - 0.947* GAMMD) + THKDRY = (0.135* GAMMD+ 64.7)/ (2700.0 - 0.947* GAMMD) ! FROZEN IF ( (SH2O + 0.0005) < SMC ) THEN AKE = SATRATIO @@ -2667,7 +2764,7 @@ SUBROUTINE RADIATION (parameters,VEGTYP ,IST ,ICE ,NSOIL , & !in REAL :: FSHA !shaded fraction of canopy REAL :: VAI !total LAI + stem area index, one sided - REAL,PARAMETER :: MPE = 1.E-6 + REAL,PARAMETER :: MPE = 1.0E-6 LOGICAL VEG !true: vegetated for surface temperature calculation ! -------------------------------------------------------------------------------------------------- @@ -2687,11 +2784,11 @@ SUBROUTINE RADIATION (parameters,VEGTYP ,IST ,ICE ,NSOIL , & !in ! surface radiation - FSHA = 1.-FSUN + FSHA = 1.0-FSUN LAISUN = ELAI*FSUN LAISHA = ELAI*FSHA VAI = ELAI+ ESAI - IF (VAI .GT. 0.) THEN + IF (VAI .GT. 0.0) THEN VEG = .TRUE. ELSE VEG = .FALSE. @@ -2802,25 +2899,25 @@ SUBROUTINE ALBEDO (parameters,VEGTYP ,IST ,ICE ,NSOIL , & !in ! -------------------------------------------------------------------------------------------------- NBAND = 2 - MPE = 1.E-06 - BGAP = 0. - WGAP = 0. + MPE = 1.0E-06 + BGAP = 0.0 + WGAP = 0.0 ! initialize output because solar radiation only done if COSZ > 0 DO IB = 1, NBAND - ALBD(IB) = 0. - ALBI(IB) = 0. - ALBGRD(IB) = 0. - ALBGRI(IB) = 0. - ALBSND(IB) = 0. - ALBSNI(IB) = 0. - FABD(IB) = 0. - FABI(IB) = 0. - FTDD(IB) = 0. - FTID(IB) = 0. - FTII(IB) = 0. - IF (IB.EQ.1) FSUN = 0. + ALBD(IB) = 0.0 + ALBI(IB) = 0.0 + ALBGRD(IB) = 0.0 + ALBGRI(IB) = 0.0 + ALBSND(IB) = 0.0 + ALBSNI(IB) = 0.0 + FABD(IB) = 0.0 + FABI(IB) = 0.0 + FTDD(IB) = 0.0 + FTID(IB) = 0.0 + FTII(IB) = 0.0 + IF (IB.EQ.1) FSUN = 0.0 END DO IF(COSZ <= 0) GOTO 100 @@ -2877,12 +2974,12 @@ SUBROUTINE ALBEDO (parameters,VEGTYP ,IST ,ICE ,NSOIL , & !in ! sunlit fraction of canopy. set FSUN = 0 if FSUN < 0.01. - EXT = GDIR/COSZ * SQRT(1.-RHO(1)-TAU(1)) - FSUN = (1.-EXP(-EXT*VAI)) / MAX(EXT*VAI,MPE) + EXT = GDIR/COSZ * SQRT(1.0-RHO(1)-TAU(1)) + FSUN = (1.0-EXP(-EXT*VAI)) / MAX(EXT*VAI,MPE) EXT = FSUN IF (EXT .LT. 0.01) THEN - WL = 0. + WL = 0.0 ELSE WL = EXT END IF @@ -2965,9 +3062,9 @@ SUBROUTINE SURRAD (parameters,MPE ,FSUN ,FSHA ,ELAI ,VAI , & !i ! zero summed solar fluxes - SAG = 0. - SAV = 0. - FSA = 0. + SAG = 0.0 + SAV = 0.0 + FSA = 0.0 ! loop over nband wavebands @@ -2987,7 +3084,7 @@ SUBROUTINE SURRAD (parameters,MPE ,FSUN ,FSHA ,ELAI ,VAI , & !i ! solar radiation absorbed by ground surface - ABS = TRD*(1.-ALBGRD(IB)) + TRI*(1.-ALBGRI(IB)) + ABS = TRD*(1.0-ALBGRD(IB)) + TRI*(1.0-ALBGRI(IB)) SAG = SAG + ABS FSA = FSA + ABS END DO @@ -2996,11 +3093,11 @@ SUBROUTINE SURRAD (parameters,MPE ,FSUN ,FSHA ,ELAI ,VAI , & !i ! to get average absorbed par for sunlit and shaded leaves LAIFRA = ELAI / MAX(VAI,MPE) - IF (FSUN .GT. 0.) THEN + IF (FSUN .GT. 0.0) THEN PARSUN = (CAD(1)+FSUN*CAI(1)) * LAIFRA / MAX(LAISUN,MPE) PARSHA = (FSHA*CAI(1))*LAIFRA / MAX(LAISHA,MPE) ELSE - PARSUN = 0. + PARSUN = 0.0 PARSHA = (CAD(1)+CAI(1))*LAIFRA /MAX(LAISHA,MPE) ENDIF @@ -3051,21 +3148,21 @@ SUBROUTINE SNOW_AGE (parameters,DT,TG,SNEQVO,SNEQV,TAUSS,FAGE) !--------------------------------------------------------------------------------------------------- IF(SNEQV.LE.0.0) THEN - TAUSS = 0. + TAUSS = 0.0 ELSE DELA0 = DT/parameters%TAU0 - ARG = parameters%GRAIN_GROWTH*(1./TFRZ-1./TG) + ARG = parameters%GRAIN_GROWTH*(1.0/TFRZ-1.0/TG) AGE1 = EXP(ARG) - AGE2 = EXP(AMIN1(0.,parameters%EXTRA_GROWTH*ARG)) + AGE2 = EXP(AMIN1(0.0,parameters%EXTRA_GROWTH*ARG)) AGE3 = parameters%DIRT_SOOT TAGE = AGE1+AGE2+AGE3 DELA = DELA0*TAGE DELS = AMAX1(0.0,SNEQV-SNEQVO) / parameters%SWEMX SGE = (TAUSS+DELA)*(1.0-DELS) - TAUSS = AMAX1(0.,SGE) + TAUSS = AMAX1(0.0,SGE) ENDIF - FAGE= TAUSS/(TAUSS+1.) + FAGE= TAUSS/(TAUSS+1.0) END SUBROUTINE SNOW_AGE @@ -3105,22 +3202,22 @@ SUBROUTINE SNOWALB_BATS (parameters,NBAND,FSNO,COSZ,FAGE,ALBSND,ALBSNI) ! --------------------------------------------------------------------------------------------- ! zero albedos for all points - ALBSND(1: NBAND) = 0. - ALBSNI(1: NBAND) = 0. + ALBSND(1: NBAND) = 0.0 + ALBSNI(1: NBAND) = 0.0 ! when cosz > 0 SL=parameters%BATS_COSZ - SL1=1./SL - SL2=2.*SL - CF1=((1.+SL1)/(1.+SL2*COSZ)-SL1) - FZEN=AMAX1(CF1,0.) + SL1=1.0/SL + SL2=2.0*SL + CF1=((1.0+SL1)/(1.0+SL2*COSZ)-SL1) + FZEN=AMAX1(CF1,0.0) - ALBSNI(1)=parameters%BATS_VIS_NEW*(1.-parameters%BATS_VIS_AGE*FAGE) - ALBSNI(2)=parameters%BATS_NIR_NEW*(1.-parameters%BATS_NIR_AGE*FAGE) + ALBSNI(1)=parameters%BATS_VIS_NEW*(1.0-parameters%BATS_VIS_AGE*FAGE) + ALBSNI(2)=parameters%BATS_NIR_NEW*(1.0-parameters%BATS_NIR_AGE*FAGE) - ALBSND(1)=ALBSNI(1)+parameters%BATS_VIS_DIR*FZEN*(1.-ALBSNI(1)) ! vis direct - ALBSND(2)=ALBSNI(2)+parameters%BATS_VIS_DIR*FZEN*(1.-ALBSNI(2)) ! nir direct + ALBSND(1)=ALBSNI(1)+parameters%BATS_VIS_DIR*FZEN*(1.0-ALBSNI(1)) ! vis direct + ALBSND(2)=ALBSNI(2)+parameters%BATS_NIR_DIR*FZEN*(1.0-ALBSNI(2)) ! nir direct END SUBROUTINE SNOWALB_BATS @@ -3156,17 +3253,17 @@ SUBROUTINE SNOWALB_CLASS (parameters,NBAND,QSNOW,DT,ALB,ALBOLD,ALBSND,ALBSNI,ILO ! --------------------------------------------------------------------------------------------- ! zero albedos for all points - ALBSND(1: NBAND) = 0. - ALBSNI(1: NBAND) = 0. + ALBSND(1: NBAND) = 0.0 + ALBSNI(1: NBAND) = 0.0 ! when cosz > 0 - ALB = 0.55 + (ALBOLD-0.55) * EXP(-0.01*DT/3600.) + ALB = 0.55 + (ALBOLD-0.55) * EXP(-0.01*DT/3600.0) ! 1 mm fresh snow(SWE) -- 10mm snow depth, assumed the fresh snow density 100kg/m3 ! here assume 1cm snow depth will fully cover the old snow - IF (QSNOW > 0.) then + IF (QSNOW > 0.0) then ALB = ALB + MIN(QSNOW,parameters%SWEMX/DT) * (0.84-ALB)/(parameters%SWEMX/DT) ENDIF @@ -3216,7 +3313,7 @@ SUBROUTINE GROUNDALB (parameters,NSOIL ,NBAND ,ICE ,IST , & !in ! -------------------------------------------------------------------------------------------------- DO IB = 1, NBAND - INC = MAX(0.11-0.40*SMC(1), 0.) + INC = MAX(0.11-0.40*SMC(1), 0.0) IF (IST .EQ. 1) THEN !soil ALBSOD = MIN(parameters%ALBSAT(IB)+INC,parameters%ALBDRY(IB)) ALBSOI = ALBSOD @@ -3228,13 +3325,6 @@ SUBROUTINE GROUNDALB (parameters,NSOIL ,NBAND ,ICE ,IST , & !in ALBSOI = ALBSOD END IF -! increase desert and semi-desert albedos - -! IF (IST .EQ. 1 .AND. ISC .EQ. 9) THEN -! ALBSOD = ALBSOD + 0.10 -! ALBSOI = ALBSOI + 0.10 -! end if - ALBGRD(IB) = ALBSOD*(1.-FSNO) + ALBSND(IB)*FSNO ALBGRI(IB) = ALBSOI*(1.-FSNO) + ALBSNI(IB)*FSNO END DO @@ -3375,17 +3465,17 @@ SUBROUTINE TWOSTREAM (parameters,IB ,IC ,VEGTYP ,COSZ ,VAI , & ! CHIL = MIN( MAX(parameters%XL, -0.4), 0.6) IF (ABS(CHIL) .LE. 0.01) CHIL = 0.01 PHI1 = 0.5 - 0.633*CHIL - 0.330*CHIL*CHIL - PHI2 = 0.877 * (1.-2.*PHI1) + PHI2 = 0.877 * (1.0-2.0*PHI1) GDIR = PHI1 + PHI2*COSZI EXT = GDIR/COSZI - AVMU = ( 1. - PHI1/PHI2 * LOG((PHI1+PHI2)/PHI1) ) / PHI2 + AVMU = ( 1.0 - PHI1/PHI2 * LOG((PHI1+PHI2)/PHI1) ) / PHI2 OMEGAL = RHO(IB) + TAU(IB) TMP0 = GDIR + PHI2*COSZI TMP1 = PHI1*COSZI - ASU = 0.5*OMEGAL*GDIR/TMP0 * ( 1.-TMP1/TMP0*LOG((TMP1+TMP0)/TMP1) ) - BETADL = (1.+AVMU*EXT)/(OMEGAL*AVMU*EXT)*ASU + ASU = 0.5*OMEGAL*GDIR/TMP0 * ( 1.0-TMP1/TMP0*LOG((TMP1+TMP0)/TMP1) ) + BETADL = (1.0+AVMU*EXT)/(OMEGAL*AVMU*EXT)*ASU BETAIL = 0.5 * ( RHO(IB)+TAU(IB) + (RHO(IB)-TAU(IB)) & - * ((1.+CHIL)/2.)**2 ) / OMEGAL + * ((1.0+CHIL)/2.0)**2 ) / OMEGAL ! adjust omega, betad, and betai for intercepted snow @@ -3394,9 +3484,9 @@ SUBROUTINE TWOSTREAM (parameters,IB ,IC ,VEGTYP ,COSZ ,VAI , & ! TMP1 = BETADL TMP2 = BETAIL ELSE - TMP0 = (1.-FWET)*OMEGAL + FWET*parameters%OMEGAS(IB) - TMP1 = ( (1.-FWET)*OMEGAL*BETADL + FWET*parameters%OMEGAS(IB)*parameters%BETADS ) / TMP0 - TMP2 = ( (1.-FWET)*OMEGAL*BETAIL + FWET*parameters%OMEGAS(IB)*parameters%BETAIS ) / TMP0 + TMP0 = (1.0-FWET)*OMEGAL + FWET*parameters%OMEGAS(IB) + TMP1 = ( (1.0-FWET)*OMEGAL*BETADL + FWET*parameters%OMEGAS(IB)*parameters%BETADS ) / TMP0 + TMP2 = ( (1.0-FWET)*OMEGAL*BETAIL + FWET*parameters%OMEGAS(IB)*parameters%BETAIS ) / TMP0 END IF OMEGA = TMP0 @@ -3405,15 +3495,15 @@ SUBROUTINE TWOSTREAM (parameters,IB ,IC ,VEGTYP ,COSZ ,VAI , & ! ! absorbed, reflected, transmitted fluxes per unit incoming radiation - B = 1. - OMEGA + OMEGA*BETAI + B = 1.0 - OMEGA + OMEGA*BETAI C = OMEGA*BETAI TMP0 = AVMU*EXT D = TMP0 * OMEGA*BETAD - F = TMP0 * OMEGA*(1.-BETAD) + F = TMP0 * OMEGA*(1.0-BETAD) TMP1 = B*B - C*C H = SQRT(TMP1) / AVMU SIGMA = TMP0*TMP0 - TMP1 - if ( ABS (SIGMA) < 1.e-6 ) SIGMA = SIGN(1.e-6,SIGMA) + if ( ABS (SIGMA) < 1.0e-6 ) SIGMA = SIGN(1.0e-6,SIGMA) P1 = B + AVMU*H P2 = B - AVMU*H P3 = B + TMP0 @@ -3457,7 +3547,7 @@ SUBROUTINE TWOSTREAM (parameters,IB ,IC ,VEGTYP ,COSZ ,VAI , & ! FTDS = S2 *(1.0-GAP) + GAP FTIS = (H4*S2/SIGMA + H5*S1 + H6/S1)*(1.0-GAP) ELSE - FTDS = 0. + FTDS = 0.0 FTIS = (H9*S1 + H10/S1)*(1.0-KOPEN) + KOPEN END IF FTD(IB) = FTDS @@ -3481,44 +3571,40 @@ SUBROUTINE TWOSTREAM (parameters,IB ,IC ,VEGTYP ,COSZ ,VAI , & ! ! flux absorbed by vegetation - FAB(IB) = 1. - FRE(IB) - (1.-ALBGRD(IB))*FTD(IB) & - - (1.-ALBGRI(IB))*FTI(IB) + FAB(IB) = 1.0 - FRE(IB) - (1.0-ALBGRD(IB))*FTD(IB) & + - (1.0-ALBGRI(IB))*FTI(IB) -!if(iloc == 1.and.jloc == 2) then -! write(*,'(a7,2i2,5(a6,f8.4),2(a9,f8.4))') "ib,ic: ",ib,ic," GAP: ",GAP," FTD: ",FTD(IB)," FTI: ",FTI(IB)," FRE: ", & -! FRE(IB)," FAB: ",FAB(IB)," ALBGRD: ",ALBGRD(IB)," ALBGRI: ",ALBGRI(IB) -!end if END SUBROUTINE TWOSTREAM !== begin vege_flux ================================================================================ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & !in - DT ,SAV ,SAG ,LWDN ,UR , & !in - UU ,VV ,SFCTMP ,THAIR ,QAIR , & !in - EAIR ,RHOAIR ,SNOWH ,VAI ,GAMMAV ,GAMMAG, & !in - FWET ,LAISUN ,LAISHA ,CWP ,DZSNSO , & !in - ZLVL ,ZPD ,Z0M ,FVEG , & !in - Z0MG ,EMV ,EMG ,CANLIQ ,FSNO, & !in - CANICE ,STC ,DF ,RSSUN ,RSSHA , & !in - RSURF ,LATHEAV ,LATHEAG ,PARSUN ,PARSHA ,IGS , & !in - FOLN ,CO2AIR ,O2AIR ,BTRAN ,SFCPRS , & !in - RHSUR ,ILOC ,JLOC ,Q2 ,PAHV ,PAHG , & !in - EAH ,TAH ,TV ,TG ,CM , & !inout - CH ,DX ,DZ8W , & ! - TAUXV ,TAUYV ,IRG ,IRC ,SHG , & !out - SHC ,EVG ,EVC ,TR ,GH , & !out - T2MV ,PSNSUN ,PSNSHA , & !out - QC ,QSFC ,PSFC , & !in - Q2V ,CAH2 ,CHLEAF ,CHUC, & !inout - SH2O,JULIAN, SWDOWN, PRCP, FB, FSR, GECROS1D) ! Gecros + DT ,SAV ,SAG ,LWDN ,UR , & !in + UU ,VV ,SFCTMP ,THAIR ,QAIR , & !in + EAIR ,RHOAIR ,SNOWH ,VAI ,GAMMAV ,GAMMAG, & !in + FWET ,LAISUN ,LAISHA ,CWP ,DZSNSO , & !in + ZLVL ,ZPD ,Z0M ,FVEG , & !in + Z0MG ,EMV ,EMG ,CANLIQ ,FSNO, & !in + CANICE ,STC ,DF ,RSSUN ,RSSHA , & !in + RSURF ,LATHEAV ,LATHEAG ,PARSUN ,PARSHA ,IGS , & !in + FOLN ,CO2AIR ,O2AIR ,BTRAN ,SFCPRS , & !in + RHSUR ,ILOC ,JLOC ,Q2 ,PAHV ,PAHG , & !in + EAH ,TAH ,TV ,TG ,CM , & !inout + CH ,DX ,DZ8W , & !inout + TAUXV ,TAUYV ,IRG ,IRC ,SHG , & !out + SHC ,EVG ,EVC ,TR ,GH , & !out + T2MV ,PSNSUN ,PSNSHA ,CANHS , & !out + QC ,QSFC ,PSFC , & !in + Q2V ,CAH2 ,CHLEAF ,CHUC, & !inout + SH2O ,JULIAN, SWDOWN, PRCP, FB, FSR, GECROS1D) ! Gecros ! -------------------------------------------------------------------------------------------------- ! use newton-raphson iteration to solve for vegetation (tv) and ! ground (tg) temperatures that balance the surface energy budgets ! vegetated: -! -SAV + IRC[TV] + SHC[TV] + EVC[TV] + TR[TV] = 0 +! -SAV + IRC[TV] + SHC[TV] + EVC[TV] + TR[TV] + CANHS[TV] = 0 ! -SAG + IRG[TG] + SHG[TG] + EVG[TG] + GH[TG] = 0 ! -------------------------------------------------------------------------------------------------- IMPLICIT NONE @@ -3601,7 +3687,7 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & REAL, INTENT(INOUT) :: CH !sensible heat exchange coefficient ! output -! -FSA + FIRA + FSH + (FCEV + FCTR + FGEV) + FCST + SSOIL = 0 +! -FSA + FIRA + FSH + (FCEV + FCTR + FGEV) + FCST + SSOIL + CANHS = 0 REAL, INTENT(OUT) :: TAUXV !wind stress: e-w (n/m2) REAL, INTENT(OUT) :: TAUYV !wind stress: n-s (n/m2) REAL, INTENT(OUT) :: IRC !net longwave radiation (w/m2) [+= to atm] @@ -3617,7 +3703,7 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & REAL, INTENT(OUT) :: PSNSHA !shaded leaf photosynthesis (umolco2/m2/s) REAL, INTENT(OUT) :: CHLEAF !leaf exchange coefficient REAL, INTENT(OUT) :: CHUC !under canopy exchange coefficient - + REAL, INTENT(OUT) :: CANHS ! canopy heat storage change (w/m2) C.He added based on GY Niu's communication REAL, INTENT(OUT) :: Q2V REAL :: CAH !sensible heat conductance, canopy air to ZLVL air (m/s) REAL :: U10V !10 m wind speed in eastward dir (m/s) @@ -3695,9 +3781,9 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & REAL :: CH2V !exchange coefficient for 2m over vegetation. REAL :: CQ2V !exchange coefficient for 2m over vegetation. REAL :: EAH2 !2m vapor pressure over canopy - REAL :: QFX !moisture flux + REAL :: QFX !moisture flux REAL :: E1 - + REAL :: HCV !canopy heat capacity j/m2/k, C.He added REAL :: VAIE !total leaf area index + stem area index,effective REAL :: LAISUNE !sunlit leaf area index, one-sided (m2/m2),effective @@ -3728,7 +3814,7 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & character(len=80) :: message - TDC(T) = MIN( 50., MAX(-50.,(T-TFRZ)) ) + TDC(T) = MIN( 50.0, MAX(-50.0,(T-TFRZ)) ) ! --------------------------------------------------------------------------------------------- MPE = 1E-6 @@ -3738,27 +3824,27 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & ! --------------------------------------------------------------------------------------------- ! initialization variables that do not depend on stability iteration ! --------------------------------------------------------------------------------------------- - DTV = 0. - DTG = 0. - MOZ = 0. + DTV = 0.0 + DTG = 0.0 + MOZ = 0.0 MOZSGN = 0 - MOZOLD = 0. - FH2 = 0. - HG = 0. - H = 0. - QFX = 0. + MOZOLD = 0.0 + FH2 = 0.0 + HG = 0.0 + H = 0.0 + QFX = 0.0 ! limit LAI - VAIE = MIN(6.,VAI ) - LAISUNE = MIN(6.,LAISUN) - LAISHAE = MIN(6.,LAISHA) + VAIE = MIN(6.0,VAI ) + LAISUNE = MIN(6.0,LAISUN) + LAISHAE = MIN(6.0,LAISHA) ! saturation vapor pressure at ground temperature T = TDC(TG) CALL ESAT(T, ESATW, ESATI, DSATW, DSATI) - IF (T .GT. 0.) THEN + IF (T .GT. 0.0) THEN ESTG = ESATW ELSE ESTG = ESATI @@ -3773,7 +3859,7 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & HCAN = parameters%HVT UC = UR*LOG(HCAN/Z0M)/LOG(ZLVL/Z0M) UC = UR*LOG((HCAN-ZPD+Z0M)/Z0M)/LOG(ZLVL/Z0M) ! MB: add ZPD v3.7 - IF((HCAN-ZPD) <= 0.) THEN + IF((HCAN-ZPD) <= 0.0) THEN WRITE(message,*) "CRITICAL PROBLEM: HCAN <= ZPD" call wrf_message ( message ) WRITE(message,*) 'i,j point=',ILOC, JLOC @@ -3789,8 +3875,8 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & ! prepare for longwave rad. - AIR = -EMV*(1.+(1.-EMV)*(1.-EMG))*LWDN - EMV*EMG*SB*TG**4 - CIR = (2.-EMV*(1.-EMG))*EMV*SB + AIR = -EMV*(1.0+(1.0-EMV)*(1.0-EMG))*LWDN - EMV*EMG*SB*TG**4 + CIR = (2.0-EMV*(1.0-EMG))*EMV*SB ! --------------------------------------------------------------------------------------------- loop1: DO ITER = 1, NITERC ! begin stability iteration @@ -3823,8 +3909,8 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & CM = CM / UR ENDIF - RAMC = MAX(1.,1./(CM*UR)) - RAHC = MAX(1.,1./(CH*UR)) + RAMC = MAX(1.0,1.0/(CM*UR)) + RAHC = MAX(1.0,1.0/(CH*UR)) RAWC = RAHC ! aerodyn resistance between heights z0g and d+z0v, RAG, and leaf @@ -3840,7 +3926,7 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & T = TDC(TV) CALL ESAT(T, ESATW, ESATI, DSATW, DSATI) - IF (T .GT. 0.) THEN + IF (T .GT. 0.0) THEN ESTV = ESATW DESTV = DSATW ELSE @@ -3873,16 +3959,16 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & ! Call Gecros IF (opt_crop == 2) then - IF ((GECROS1D(41).GT.0).and.(GECROS1D(42).LT.0.)) then !Gecros - Thickness = 0. + IF ((GECROS1D(41) .GT. 0).and.(GECROS1D(42) .LT. 0.0)) then !Gecros + Thickness = 0.0 NROOT = 0 ROOTD = GECROS1D(33) - WUL = 0. - WLL = 0. + WUL = 0.0 + WLL = 0.0 DO J = 1,NSOIL Thickness = Thickness + DZSNSO (J) - if (Thickness.lt.ROOTD/100.) then + if (Thickness .lt. ROOTD/100.0) then NROOT = NROOT + 1 endif ENDDO @@ -3890,19 +3976,19 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & NROOT = NROOT + 1 NROOT = MAX(1,NROOT) - Thickness = 0. + Thickness = 0.0 DO J = 1,NROOT Thickness = Thickness + DZSNSO (J) - if (Thickness.gt.ROOTD/100.) then - WUL = WUL + ((ROOTD/100.-Thickness+DZSNSO(J))*1000.*(SH2O(J)-parameters%SMCWLT(J))) + if (Thickness .gt. ROOTD/100.0) then + WUL = WUL + ((ROOTD/100.0-Thickness+DZSNSO(J))*1000.0*(SH2O(J)-parameters%SMCWLT(J))) else - WUL = WUL + (DZSNSO(J)*1000.*(SH2O(J)-parameters%SMCWLT(J))) + WUL = WUL + (DZSNSO(J)*1000.0*(SH2O(J)-parameters%SMCWLT(J))) endif ENDDO DO J = 1,NSOIL - WLL = WLL + (DZSNSO(J)*1000.*(SH2O(J)-parameters%SMCWLT(J))) + WLL = WLL + (DZSNSO(J)*1000.0*(SH2O(J)-parameters%SMCWLT(J))) ENDDO WLL = WLL - WUL @@ -3916,8 +4002,8 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & TLAI = GECROS1D(50) ! effective LAIs - TLAIE = MIN(6.,TLAI / FVEG) - GLAIE = MIN(6.,GLAI / FVEG) + TLAIE = MIN(6.0,TLAI / FVEG) + GLAIE = MIN(6.0,GLAI / FVEG) ENDIF ENDIF @@ -3925,31 +4011,31 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & ! prepare for sensible heat flux above veg. - CAH = 1./RAHC - CVH = 2.*VAIE/RB - CGH = 1./RAHG + CAH = 1.0/RAHC + CVH = 2.0*VAIE/RB + CGH = 1.0/RAHG COND = CAH + CVH + CGH ATA = (SFCTMP*CAH + TG*CGH) / COND BTA = CVH/COND - CSH = (1.-BTA)*RHOAIR*CPAIR*CVH + CSH = (1.0-BTA)*RHOAIR*CPAIR*CVH ! prepare for latent heat flux above veg. - CAW = 1./RAWC + CAW = 1.0/RAWC CEW = FWET*VAIE/RB IF (OPT_CROP /= 2) THEN - CTW = (1.-FWET)*(LAISUNE/(RB+RSSUN) + LAISHAE/(RB+RSSHA)) + CTW = (1.0-FWET)*(LAISUNE/(RB+RSSUN) + LAISHAE/(RB+RSSHA)) ELSE !RSSUN and RSSHA are in resistance per unit LAI in the Jarvis and Ball-Berry!. RSSUN and RSSHA of Gecros are in s/m - CTW = (1.-FWET)*(1./(RB/(FRSU*GLAIE)+RSSUN) + 1./(RB/((1.-FRSU)*GLAIE)+RSSHA)) !transpiration conductance leaf to canopy air + CTW = (1.0-FWET)*(1.0/(RB/(FRSU*GLAIE)+RSSUN) + 1.0/(RB/((1.0-FRSU)*GLAIE)+RSSHA)) !transpiration conductance leaf to canopy air ENDIF - CGW = 1./(RAWG+RSURF) + CGW = 1.0/(RAWG+RSURF) COND = CAW + CEW + CTW + CGW AEA = (EAIR*CAW + ESTG*CGW) / COND BEA = (CEW+CTW)/COND - CEV = (1.-BEA)*CEW*RHOAIR*CPAIR/GAMMAV ! Barlage: change to vegetation v3.6 - CTR = (1.-BEA)*CTW*RHOAIR*CPAIR/GAMMAV + CEV = (1.0-BEA)*CEW*RHOAIR*CPAIR/GAMMAV ! Barlage: change to vegetation v3.6 + CTR = (1.0-BEA)*CTW*RHOAIR*CPAIR/GAMMAV ! evaluate surface fluxes with current temperature and solve for dts @@ -3965,15 +4051,19 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & ELSE EVC = MIN(CANICE*LATHEAV/DT,EVC) END IF + ! canopy heat capacity + HCV = 0.02*VAIE*CWAT + CANLIQ*CWAT/DENH2O + CANICE*CICE/DENICE !j/m2/k B = SAV-IRC-SHC-EVC-TR+PAHV !additional w/m2 - A = FVEG*(4.*CIR*TV**3 + CSH + (CEV+CTR)*DESTV) !volumetric heat capacity +! A = FVEG*(4.0*CIR*TV**3 + CSH + (CEV+CTR)*DESTV) !volumetric heat capacity + A = FVEG*(4.0*CIR*TV**3 + CSH + (CEV+CTR)*DESTV) + HCV/DT ! total volumetric heat capacity, add canopy heat capacity, more stable DTV = B/A - IRC = IRC + FVEG*4.*CIR*TV**3*DTV + IRC = IRC + FVEG*4.0*CIR*TV**3*DTV SHC = SHC + FVEG*CSH*DTV EVC = EVC + FVEG*CEV*DESTV*DTV TR = TR + FVEG*CTR*DESTV*DTV + CANHS = DTV * HCV/DT ! w/m2 canopy heat storage change ! update vegetation surface temperature TV = TV + DTV @@ -3997,17 +4087,17 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & ! under-canopy fluxes and tg - AIR = - EMG*(1.-EMV)*LWDN - EMG*EMV*SB*TV**4 + AIR = - EMG*(1.0-EMV)*LWDN - EMG*EMV*SB*TV**4 CIR = EMG*SB CSH = RHOAIR*CPAIR/RAHG CEV = RHOAIR*CPAIR / (GAMMAG*(RAWG+RSURF)) ! Barlage: change to ground v3.6 - CGH = 2.*DF(ISNOW+1)/DZSNSO(ISNOW+1) + CGH = 2.0*DF(ISNOW+1)/DZSNSO(ISNOW+1) loop2: DO ITER = 1, NITERG T = TDC(TG) CALL ESAT(T, ESATW, ESATI, DSATW, DSATI) - IF (T .GT. 0.) THEN + IF (T .GT. 0.0) THEN ESTG = ESATW DESTG = DSATW ELSE @@ -4021,10 +4111,10 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & GH = CGH * (TG - STC(ISNOW+1)) B = SAG-IRG-SHG-EVG-GH+PAHG - A = 4.*CIR*TG**3+CSH+CEV*DESTG+CGH + A = 4.0*CIR*TG**3+CSH+CEV*DESTG+CGH DTG = B/A - IRG = IRG + 4.*CIR*TG**3*DTG + IRG = IRG + 4.0*CIR*TG**3*DTG SHG = SHG + CSH*DTG EVG = EVG + CEV*DESTG*DTG GH = GH + CGH*DTG @@ -4039,8 +4129,8 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & IF(OPT_STC == 1 .OR. OPT_STC == 3) THEN IF (SNOWH > 0.05 .AND. TG > TFRZ) THEN IF(OPT_STC == 1) TG = TFRZ - IF(OPT_STC == 3) TG = (1.-FSNO)*TG + FSNO*TFRZ ! MB: allow TG>0C during melt v3.7 - IRG = CIR*TG**4 - EMG*(1.-EMV)*LWDN - EMG*EMV*SB*TV**4 + IF(OPT_STC == 3) TG = (1.0-FSNO)*TG + FSNO*TFRZ ! MB: allow TG>0C during melt v3.7 + IRG = CIR*TG**4 - EMG*(1.0-EMV)*LWDN - EMG*EMV*SB*TV**4 SHG = CSH * (TG - TAH) EVG = CEV * (ESTG*RHSUR - EAH) GH = SAG+PAHG - (IRG+SHG+EVG) @@ -4062,24 +4152,24 @@ SUBROUTINE VEGE_FLUX(parameters,NSNOW ,NSOIL ,ISNOW ,VEGTYP ,VEG , & ! 2m temperature over vegetation ( corrected for low CQ2V values ) IF (OPT_SFC == 1 .OR. OPT_SFC == 2) THEN ! CAH2 = FV*1./VKC*LOG((2.+Z0H)/Z0H) - CAH2 = FV*VKC/LOG((2.+Z0H)/Z0H) - CAH2 = FV*VKC/(LOG((2.+Z0H)/Z0H)-FH2) + CAH2 = FV*VKC/LOG((2.0+Z0H)/Z0H) + CAH2 = FV*VKC/(LOG((2.0+Z0H)/Z0H)-FH2) CQ2V = CAH2 - IF (CAH2 .LT. 1.E-5 ) THEN + IF (CAH2 .LT. 1.0E-5 ) THEN T2MV = TAH ! Q2V = (EAH*0.622/(SFCPRS - 0.378*EAH)) Q2V = QSFC ELSE - T2MV = TAH - (SHG+SHC/FVEG)/(RHOAIR*CPAIR) * 1./CAH2 + T2MV = TAH - (SHG+SHC/FVEG)/(RHOAIR*CPAIR) * 1.0/CAH2 ! Q2V = (EAH*0.622/(SFCPRS - 0.378*EAH))- QFX/(RHOAIR*FV)* 1./VKC * LOG((2.+Z0H)/Z0H) - Q2V = QSFC - ((EVC+TR)/FVEG+EVG)/(LATHEAV*RHOAIR) * 1./CQ2V + Q2V = QSFC - ((EVC+TR)/FVEG+EVG)/(LATHEAV*RHOAIR) * 1.0/CQ2V ENDIF ENDIF ! update CH for output CH = CAH CHLEAF = CVH - CHUC = 1./RAHG + CHUC = 1.0/RAHG END SUBROUTINE VEGE_FLUX @@ -4243,23 +4333,23 @@ SUBROUTINE BARE_FLUX (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,SAG , & DATA NITERB /5/ SAVE NITERB REAL :: T, TDC !Kelvin to degree Celsius with limit -50 to +50 - TDC(T) = MIN( 50., MAX(-50.,(T-TFRZ)) ) + TDC(T) = MIN( 50.0, MAX(-50.0,(T-TFRZ)) ) ! ----------------------------------------------------------------- ! initialization variables that do not depend on stability iteration ! ----------------------------------------------------------------- MPE = 1E-6 - DTG = 0. - MOZ = 0. + DTG = 0.0 + MOZ = 0.0 MOZSGN = 0 - MOZOLD = 0. - FH2 = 0. - H = 0. - QFX = 0. + MOZOLD = 0.0 + FH2 = 0.0 + H = 0.0 + QFX = 0.0 FV = 0.1 CIR = EMG*SB - CGH = 2.*DF(ISNOW+1)/DZSNSO(ISNOW+1) + CGH = 2.0*DF(ISNOW+1)/DZSNSO(ISNOW+1) ! ----------------------------------------------------------------- loop3: DO ITER = 1, NITERB ! begin stability iteration @@ -4287,26 +4377,26 @@ SUBROUTINE BARE_FLUX (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,SAG , & ! applies to exchange coefficients CH and CM: CH = CH / UR CM = CM / UR - IF(SNOWH > 0.) THEN + IF(SNOWH > 0.0) THEN CM = MIN(0.01,CM) ! CM & CH are too large, causing CH = MIN(0.01,CH) ! computational instability END IF ENDIF - RAMB = MAX(1.,1./(CM*UR)) - RAHB = MAX(1.,1./(CH*UR)) + RAMB = MAX(1.0,1.0/(CM*UR)) + RAHB = MAX(1.0,1.0/(CH*UR)) RAWB = RAHB !jref - variables for diagnostics - EMB = 1./RAMB - EHB = 1./RAHB + EMB = 1.0/RAMB + EHB = 1.0/RAHB ! es and d(es)/dt evaluated at tg T = TDC(TGB) CALL ESAT(T, ESATW, ESATI, DSATW, DSATI) - IF (T .GT. 0.) THEN + IF (T .GT. 0.0) THEN ESTG = ESATW DESTG = DSATW ELSE @@ -4325,10 +4415,10 @@ SUBROUTINE BARE_FLUX (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,SAG , & GHB = CGH * (TGB - STC(ISNOW+1)) B = SAG-IRB-SHB-EVB-GHB+PAHB - A = 4.*CIR*TGB**3 + CSH + CEV*DESTG + CGH + A = 4.0*CIR*TGB**3 + CSH + CEV*DESTG + CGH DTG = B/A - IRB = IRB + 4.*CIR*TGB**3*DTG + IRB = IRB + 4.0*CIR*TGB**3*DTG SHB = SHB + CSH*DTG EVB = EVB + CEV*DESTG*DTG GHB = GHB + CGH*DTG @@ -4341,7 +4431,7 @@ SUBROUTINE BARE_FLUX (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,SAG , & T = TDC(TGB) CALL ESAT(T, ESATW, ESATI, DSATW, DSATI) - IF (T .GT. 0.) THEN + IF (T .GT. 0.0) THEN ESTG = ESATW ELSE ESTG = ESATI @@ -4358,7 +4448,7 @@ SUBROUTINE BARE_FLUX (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,SAG , & IF(OPT_STC == 1 .OR. OPT_STC == 3) THEN IF (SNOWH > 0.05 .AND. TGB > TFRZ) THEN IF(OPT_STC == 1) TGB = TFRZ - IF(OPT_STC == 3) TGB = (1.-FSNO)*TGB + FSNO*TFRZ ! MB: allow TG>0C during melt v3.7 + IF(OPT_STC == 3) TGB = (1.0-FSNO)*TGB + FSNO*TFRZ ! MB: allow TG>0C during melt v3.7 IRB = CIR * TGB**4 - EMG*LWDN SHB = CSH * (TGB - SFCTMP) EVB = CEV * (ESTG*RHSUR - EAIR ) !ESTG reevaluate ? @@ -4374,15 +4464,15 @@ SUBROUTINE BARE_FLUX (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,SAG , & !jref:start; errors in original equation corrected. ! 2m air temperature IF(OPT_SFC == 1 .OR. OPT_SFC ==2) THEN - EHB2 = FV*VKC/LOG((2.+Z0H)/Z0H) - EHB2 = FV*VKC/(LOG((2.+Z0H)/Z0H)-FH2) + EHB2 = FV*VKC/LOG((2.0+Z0H)/Z0H) + EHB2 = FV*VKC/(LOG((2.0+Z0H)/Z0H)-FH2) CQ2B = EHB2 - IF (EHB2.lt.1.E-5 ) THEN + IF (EHB2 .lt. 1.0E-5 ) THEN T2MB = TGB Q2B = QSFC ELSE - T2MB = TGB - SHB/(RHOAIR*CPAIR) * 1./EHB2 - Q2B = QSFC - EVB/(LATHEA*RHOAIR)*(1./CQ2B + RSURF) + T2MB = TGB - SHB/(RHOAIR*CPAIR) * 1.0/EHB2 + Q2B = QSFC - EVB/(LATHEA*RHOAIR)*(1.0/CQ2B + RSURF) ENDIF IF (parameters%urban_flag) Q2B = QSFC END IF @@ -4448,20 +4538,20 @@ SUBROUTINE RAGRB(parameters,ITER ,VAI ,RHOAIR ,HG ,TAH , & !in ! -------------------------------------------------------------------------------------------------- ! stability correction to below canopy resistance - MOZG = 0. - MOLG = 0. + MOZG = 0.0 + MOLG = 0.0 IF(ITER > 1) THEN TMP1 = VKC * (GRAV/TAH) * HG/(RHOAIR*CPAIR) IF (ABS(TMP1) .LE. MPE) TMP1 = MPE - MOLG = -1. * FV**3 / TMP1 - MOZG = MIN( (ZPD-Z0MG)/MOLG, 1.) + MOLG = -1.0 * FV**3 / TMP1 + MOZG = MIN( (ZPD-Z0MG)/MOLG, 1.0) END IF - IF (MOZG < 0.) THEN - FHGNEW = (1. - 15.*MOZG)**(-0.25) + IF (MOZG < 0.0) THEN + FHGNEW = (1.0 - 15.0*MOZG)**(-0.25) ELSE - FHGNEW = 1.+ 4.7*MOZG + FHGNEW = 1.0+ 4.7*MOZG ENDIF IF (ITER == 1) THEN @@ -4480,13 +4570,13 @@ SUBROUTINE RAGRB(parameters,ITER ,VAI ,RHOAIR ,HG ,TAH , & !in ! aerodynamic resistances raw and rah between heights zpd+z0h and z0hg. KH = MAX ( VKC*FV*(HCAN-ZPD), MPE ) - RAMG = 0. + RAMG = 0.0 RAHG = TMPRAH2 / KH RAWG = RAHG ! leaf boundary layer resistance - TMPRB = CWPC*50. / (1. - EXP(-CWPC/2.)) + TMPRB = CWPC*50.0 / (1.0 - EXP(-CWPC/2.0)) RB = TMPRB * SQRT(parameters%DLEAF/UC) RB = MIN(MAX(RB, 5.0),50.0) ! limit RB to 5-50, typically RB<50 @@ -4574,44 +4664,44 @@ SUBROUTINE SFCDIF1(parameters,ITER ,SFCTMP ,RHOAIR ,H ,QAIR , & !in MOL = 0.0 MOZ2 = 0.0 ELSE - TVIR = (1. + 0.61*QAIR) * SFCTMP + TVIR = (1.0 + 0.61*QAIR) * SFCTMP TMP1 = VKC * (GRAV/TVIR) * H/(RHOAIR*CPAIR) IF (ABS(TMP1) .LE. MPE) TMP1 = MPE - MOL = -1. * FV**3 / TMP1 - MOZ = MIN( (ZLVL-ZPD)/MOL, 1.) - MOZ2 = MIN( (2.0 + Z0H)/MOL, 1.) + MOL = -1.0 * FV**3 / TMP1 + MOZ = MIN( (ZLVL-ZPD)/MOL, 1.0) + MOZ2 = MIN( (2.0 + Z0H)/MOL, 1.0) ENDIF ! accumulate number of times moz changes sign. - IF (MOZOLD*MOZ .LT. 0.) MOZSGN = MOZSGN+1 + IF (MOZOLD*MOZ .LT. 0.0) MOZSGN = MOZSGN+1 IF (MOZSGN .GE. 2) THEN - MOZ = 0. - FM = 0. - FH = 0. - MOZ2 = 0. - FM2 = 0. - FH2 = 0. + MOZ = 0.0 + FM = 0.0 + FH = 0.0 + MOZ2 = 0.0 + FM2 = 0.0 + FH2 = 0.0 ENDIF ! evaluate stability-dependent variables using moz from prior iteration - IF (MOZ .LT. 0.) THEN - TMP1 = (1. - 16.*MOZ)**0.25 - TMP2 = LOG((1.+TMP1*TMP1)/2.) - TMP3 = LOG((1.+TMP1)/2.) - FMNEW = 2.*TMP3 + TMP2 - 2.*ATAN(TMP1) + 1.5707963 + IF (MOZ .LT. 0.0) THEN + TMP1 = (1.0 - 16.0*MOZ)**0.25 + TMP2 = LOG((1.0+TMP1*TMP1)/2.0) + TMP3 = LOG((1.0+TMP1)/2.0) + FMNEW = 2.0*TMP3 + TMP2 - 2.0*ATAN(TMP1) + 1.5707963 FHNEW = 2*TMP2 ! 2-meter - TMP12 = (1. - 16.*MOZ2)**0.25 - TMP22 = LOG((1.+TMP12*TMP12)/2.) - TMP32 = LOG((1.+TMP12)/2.) - FM2NEW = 2.*TMP32 + TMP22 - 2.*ATAN(TMP12) + 1.5707963 + TMP12 = (1.0 - 16.0*MOZ2)**0.25 + TMP22 = LOG((1.0+TMP12*TMP12)/2.0) + TMP32 = LOG((1.0+TMP12)/2.0) + FM2NEW = 2.0*TMP32 + TMP22 - 2.0*ATAN(TMP12) + 1.5707963 FH2NEW = 2*TMP22 ELSE - FMNEW = -5.*MOZ + FMNEW = -5.0*MOZ FHNEW = FMNEW - FM2NEW = -5.*MOZ2 + FM2NEW = -5.0*MOZ2 FH2NEW = FM2NEW ENDIF @@ -4702,11 +4792,11 @@ SUBROUTINE SFCDIF2(parameters,ITER ,Z0 ,THZ0 ,THLM ,SFCSPD , & !in REAL, PARAMETER :: ELFC = VKRM * BTG REAL, PARAMETER :: WOLD = 0.15 REAL, PARAMETER :: WNEW = 1.0 - WOLD - REAL, PARAMETER :: PIHF = 3.14159265 / 2. - REAL, PARAMETER :: EPSU2 = 1.E-4 + REAL, PARAMETER :: PIHF = 3.14159265 / 2.0 + REAL, PARAMETER :: EPSU2 = 1.0E-4 REAL, PARAMETER :: EPSUST = 0.07 - REAL, PARAMETER :: EPSIT = 1.E-4 - REAL, PARAMETER :: EPSA = 1.E-8 + REAL, PARAMETER :: EPSIT = 1.0E-4 + REAL, PARAMETER :: EPSA = 1.0E-8 REAL, PARAMETER :: ZTMIN = -5.0 REAL, PARAMETER :: ZTMAX = 1.0 REAL, PARAMETER :: HPBL = 1000.0 @@ -4722,16 +4812,16 @@ SUBROUTINE SFCDIF2(parameters,ITER ,Z0 ,THZ0 ,THLM ,SFCSPD , & !in ! ---------------------------------------------------------------------- ! LECH'S SURFACE FUNCTIONS PSLMU (ZZ)= -0.96* log (1.0-4.5* ZZ) - PSLMS (ZZ)= ZZ * RRIC -2.076* (1. -1./ (ZZ +1.)) + PSLMS (ZZ)= ZZ * RRIC -2.076* (1.0 -1.0/ (ZZ +1.0)) PSLHU (ZZ)= -0.96* log (1.0-4.5* ZZ) - PSLHS (ZZ)= ZZ * RFAC -2.076* (1. -1./ (ZZ +1.)) + PSLHS (ZZ)= ZZ * RFAC -2.076* (1.0 -1.0/ (ZZ +1.0)) ! PAULSON'S SURFACE FUNCTIONS - PSPMU (XX)= -2.* log ( (XX +1.)*0.5) - log ( (XX * XX +1.)*0.5) & - & +2.* ATAN (XX) & + PSPMU (XX)= -2.0* log ( (XX +1.0)*0.5) - log ( (XX * XX +1.0)*0.5) & + & +2.0* ATAN (XX) & &- PIHF - PSPMS (YY)= 5.* YY - PSPHU (XX)= -2.* log ( (XX * XX +1.)*0.5) - PSPHS (YY)= 5.* YY + PSPMS (YY)= 5.0* YY + PSPHU (XX)= -2.0* log ( (XX * XX +1.0)*0.5) + PSPHS (YY)= 5.0* YY ! THIS ROUTINE SFCDIF CAN HANDLE BOTH OVER OPEN WATER (SEA, OCEAN) AND ! OVER SOLID SURFACE (LAND, SEA-ICE). @@ -4745,7 +4835,7 @@ SUBROUTINE SFCDIF2(parameters,ITER ,Z0 ,THZ0 ,THLM ,SFCSPD , & !in ! ---------------------------------------------------------------------- ZILFC = - parameters%CZIL * VKRM * SQVISC ZU = Z0 - RDZ = 1./ ZLM + RDZ = 1.0/ ZLM CXCH = EXCM * RDZ DTHV = THLM - THZ0 @@ -4755,7 +4845,7 @@ SUBROUTINE SFCDIF2(parameters,ITER ,Z0 ,THZ0 ,THLM ,SFCSPD , & !in IF(ITER == 1) THEN IF (BTGH * AKHS * DTHV .ne. 0.0) THEN - WSTAR2 = WWST2* ABS (BTGH * AKHS * DTHV)** (2./3.) + WSTAR2 = WWST2* ABS (BTGH * AKHS * DTHV)** (2.0/3.0) ELSE WSTAR2 = 0.0 END IF @@ -4764,7 +4854,7 @@ SUBROUTINE SFCDIF2(parameters,ITER ,Z0 ,THZ0 ,THLM ,SFCSPD , & !in END IF ! ZILITINKEVITCH APPROACH FOR ZT - ZT = MAX(1.E-6,EXP (ZILFC * SQRT (USTAR * Z0))* Z0) + ZT = MAX(1.0E-6,EXP (ZILFC * SQRT (USTAR * Z0))* Z0) ZSLU = ZLM + ZU ZSLT = ZLM + ZT RLOGU = log (ZSLU / ZU) @@ -4780,11 +4870,11 @@ SUBROUTINE SFCDIF2(parameters,ITER ,Z0 ,THZ0 ,THLM ,SFCSPD , & !in ZETAT = ZT * RLMO IF (ILECH .eq. 0) THEN - IF (RLMO .lt. 0.)THEN - XLU4 = 1. -16.* ZETALU - XLT4 = 1. -16.* ZETALT - XU4 = 1. -16.* ZETAU - XT4 = 1. -16.* ZETAT + IF (RLMO .lt. 0.0)THEN + XLU4 = 1.0 -16.0* ZETALU + XLT4 = 1.0 -16.0* ZETALT + XU4 = 1.0 -16.0* ZETAU + XT4 = 1.0 -16.0* ZETAT XLU = SQRT (SQRT (XLU4)) XLT = SQRT (SQRT (XLT4)) XU = SQRT (SQRT (XU4)) @@ -4808,7 +4898,7 @@ SUBROUTINE SFCDIF2(parameters,ITER ,Z0 ,THZ0 ,THLM ,SFCSPD , & !in ! LECH'S FUNCTIONS ! ---------------------------------------------------------------------- ELSE - IF (RLMO .lt. 0.)THEN + IF (RLMO .lt. 0.0)THEN PSMZ = PSLMU (ZETAU) SIMM = PSLMU (ZETALU) - PSMZ + RLOGU PSHZ = PSLHU (ZETAT) @@ -4830,21 +4920,21 @@ SUBROUTINE SFCDIF2(parameters,ITER ,Z0 ,THZ0 ,THLM ,SFCSPD , & !in USTAR = MAX (SQRT (AKMS * SQRT (DU2+ WSTAR2)),EPSUST) ! ZILITINKEVITCH FIX FOR ZT - ZT = MAX(1.E-6,EXP (ZILFC * SQRT (USTAR * Z0))* Z0) + ZT = MAX(1.0E-6,EXP (ZILFC * SQRT (USTAR * Z0))* Z0) ZSLT = ZLM + ZT !----------------------------------------------------------------------- RLOGT = log (ZSLT / ZT) USTARK = USTAR * VKRM - IF(SIMM < 1.e-6) SIMM = 1.e-6 ! Limit stability function + IF(SIMM < 1.0e-6) SIMM = 1.0e-6 ! Limit stability function AKMS = MAX (USTARK / SIMM,CXCH) !----------------------------------------------------------------------- ! IF STATEMENTS TO AVOID TANGENT LINEAR PROBLEMS NEAR ZERO !----------------------------------------------------------------------- - IF(SIMH < 1.e-6) SIMH = 1.e-6 ! Limit stability function + IF(SIMH < 1.0e-6) SIMH = 1.0e-6 ! Limit stability function AKHS = MAX (USTARK / SIMH,CXCH) IF (BTGH * AKHS * DTHV .ne. 0.0) THEN - WSTAR2 = WWST2* ABS (BTGH * AKHS * DTHV)** (2./3.) + WSTAR2 = WWST2* ABS (BTGH * AKHS * DTHV)** (2.0/3.0) ELSE WSTAR2 = 0.0 END IF @@ -4857,7 +4947,6 @@ SUBROUTINE SFCDIF2(parameters,ITER ,Z0 ,THZ0 ,THLM ,SFCSPD , & !in !----------------------------------------------------------------------- RLMO = RLMA -! write(*,'(a20,10f15.6)')'SFCDIF: RLMO=',RLMO,RLMN,ELFC , AKHS , DTHV , USTAR ! END DO ! ---------------------------------------------------------------------- END SUBROUTINE SFCDIF2 @@ -4908,10 +4997,10 @@ SUBROUTINE ESAT(T, ESW, ESI, DESW, DESI) D4=3.005693132E-07, D5=2.158542548E-09, & D6=7.131097725E-12) - ESW = 100.*(A0+T*(A1+T*(A2+T*(A3+T*(A4+T*(A5+T*A6)))))) - ESI = 100.*(B0+T*(B1+T*(B2+T*(B3+T*(B4+T*(B5+T*B6)))))) - DESW = 100.*(C0+T*(C1+T*(C2+T*(C3+T*(C4+T*(C5+T*C6)))))) - DESI = 100.*(D0+T*(D1+T*(D2+T*(D3+T*(D4+T*(D5+T*D6)))))) + ESW = 100.0*(A0+T*(A1+T*(A2+T*(A3+T*(A4+T*(A5+T*A6)))))) + ESI = 100.0*(B0+T*(B1+T*(B2+T*(B3+T*(B4+T*(B5+T*B6)))))) + DESW = 100.0*(C0+T*(C1+T*(C2+T*(C3+T*(C4+T*(C5+T*C6)))))) + DESI = 100.0*(D0+T*(D1+T*(D2+T*(D3+T*(D4+T*(D5+T*D6)))))) END SUBROUTINE ESAT @@ -4983,19 +5072,19 @@ SUBROUTINE STOMATA (parameters,VEGTYP ,MPE ,APAR ,FOLN ,ILOC , JLO REAL :: CEA !constrain ea or else model blows up REAL :: CF !s m2/umol -> s/m - F1(AB,BC) = AB**((BC-25.)/10.) - F2(AB) = 1. + EXP((-2.2E05+710.*(AB+273.16))/(8.314*(AB+273.16))) + F1(AB,BC) = AB**((BC-25.0)/10.0) + F2(AB) = 1.0 + EXP((-2.2E05+710.0*(AB+273.16))/(8.314*(AB+273.16))) REAL :: T ! --------------------------------------------------------------------------------------------- ! initialize RS=RSMAX and PSN=0 because will only do calculations ! for APAR > 0, in which case RS <= RSMAX and PSN >= 0 - CF = SFCPRS/(8.314*SFCTMP)*1.e06 - RS = 1./parameters%BP * CF - PSN = 0. + CF = SFCPRS/(8.314*SFCTMP)*1.0e06 + RS = 1.0/parameters%BP * CF + PSN = 0.0 - IF (APAR .LE. 0.) RETURN + IF (APAR .LE. 0.0) RETURN FNF = MIN( FOLN/MAX(MPE,parameters%FOLNMX), 1.0 ) TC = TV-TFRZ @@ -5003,13 +5092,13 @@ SUBROUTINE STOMATA (parameters,VEGTYP ,MPE ,APAR ,FOLN ,ILOC , JLO J = PPF*parameters%QE25 KC = parameters%KC25 * F1(parameters%AKC,TC) KO = parameters%KO25 * F1(parameters%AKO,TC) - AWC = KC * (1.+O2/KO) + AWC = KC * (1.0+O2/KO) CP = 0.5*KC/KO*O2*0.21 VCMX = parameters%VCMX25 / F2(TC) * FNF * BTRAN * F1(parameters%AVCMX,TC) ! first guess ci - CI = 0.7*CO2*parameters%C3PSN + 0.4*CO2*(1.-parameters%C3PSN) + CI = 0.7*CO2*parameters%C3PSN + 0.4*CO2*(1.0-parameters%C3PSN) ! rb: s/m -> s m**2 / umol @@ -5017,29 +5106,29 @@ SUBROUTINE STOMATA (parameters,VEGTYP ,MPE ,APAR ,FOLN ,ILOC , JLO ! constrain ea - CEA = MAX(0.25*EI*parameters%C3PSN+0.40*EI*(1.-parameters%C3PSN), MIN(EA,EI) ) + CEA = MAX(0.25*EI*parameters%C3PSN+0.40*EI*(1.0-parameters%C3PSN), MIN(EA,EI) ) ! ci iteration !jref: C3PSN is equal to 1 for all veg types. DO ITER = 1, NITER - WJ = MAX(CI-CP,0.)*J/(CI+2.*CP)*parameters%C3PSN + J*(1.-parameters%C3PSN) - WC = MAX(CI-CP,0.)*VCMX/(CI+AWC)*parameters%C3PSN + VCMX*(1.-parameters%C3PSN) - WE = 0.5*VCMX*parameters%C3PSN + 4000.*VCMX*CI/SFCPRS*(1.-parameters%C3PSN) + WJ = MAX(CI-CP,0.0)*J/(CI+2.0*CP)*parameters%C3PSN + J*(1.0-parameters%C3PSN) + WC = MAX(CI-CP,0.0)*VCMX/(CI+AWC)*parameters%C3PSN + VCMX*(1.0-parameters%C3PSN) + WE = 0.5*VCMX*parameters%C3PSN + 4000.0*VCMX*CI/SFCPRS*(1.0-parameters%C3PSN) PSN = MIN(WJ,WC,WE) * IGS CS = MAX( CO2-1.37*RLB*SFCPRS*PSN, MPE ) A = parameters%MP*PSN*SFCPRS*CEA / (CS*EI) + parameters%BP - B = ( parameters%MP*PSN*SFCPRS/CS + parameters%BP ) * RLB - 1. + B = ( parameters%MP*PSN*SFCPRS/CS + parameters%BP ) * RLB - 1.0 C = -RLB - IF (B .GE. 0.) THEN - Q = -0.5*( B + SQRT(B*B-4.*A*C) ) + IF (B .GE. 0.0) THEN + Q = -0.5*( B + SQRT(B*B-4.0*A*C) ) ELSE - Q = -0.5*( B - SQRT(B*B-4.*A*C) ) + Q = -0.5*( B - SQRT(B*B-4.0*A*C) ) END IF R1 = Q/A R2 = C/Q RS = MAX(R1,R2) - CI = MAX( CS-PSN*SFCPRS*1.65*RS, 0. ) + CI = MAX( CS-PSN*SFCPRS*1.65*RS, 0.0 ) END DO ! rs, rb: s m**2 / umol -> s/m @@ -5122,7 +5211,7 @@ SUBROUTINE CANRES (parameters,PAR ,SFCTMP,RCSOIL ,EAH ,SFCPRS , & !in ! contribution due to vapor pressure deficit - RCQ = 1.0/ (1.0+ parameters%HS * MAX(0.,Q2SAT-Q2)) + RCQ = 1.0/ (1.0+ parameters%HS * MAX(0.0,Q2SAT-Q2)) RCQ = MAX (RCQ,0.01) ! determine canopy resistance due to all factors @@ -5134,7 +5223,7 @@ END SUBROUTINE CANRES !== begin calhum =================================================================================== - SUBROUTINE CALHUM(parameters,SFCTMP, SFCPRS, Q2SAT, DQSDT2) + SUBROUTINE CALHUM(parameters,SFCTMP, SFCPRS, Q2SAT, DQSDT2) IMPLICIT NONE @@ -5147,21 +5236,21 @@ SUBROUTINE CALHUM(parameters,SFCTMP, SFCPRS, Q2SAT, DQSDT2) REAL :: ES, SFCPRSX ! Q2SAT: saturated mixing ratio - ES = E0 * EXP ( ELWV/RV*(1./A3 - 1./SFCTMP) ) + ES = E0 * EXP ( ELWV/RV*(1.0/A3 - 1.0/SFCTMP) ) ! convert SFCPRS from Pa to KPa - SFCPRSX = SFCPRS*1.E-3 + SFCPRSX = SFCPRS*1.0E-3 Q2SAT = EPSILON * ES / (SFCPRSX-ES) ! convert from g/g to g/kg - Q2SAT = Q2SAT * 1.E3 + Q2SAT = Q2SAT * 1.0E3 ! Q2SAT is currently a 'mixing ratio' ! DQSDT2 is calculated assuming Q2SAT is a specific humidity DQSDT2=(Q2SAT/(1+Q2SAT))*A23M4/(SFCTMP-A4)**2 ! DG Q2SAT needs to be in g/g when returned for SFLX - Q2SAT = Q2SAT / 1.E3 + Q2SAT = Q2SAT / 1.0E3 - END SUBROUTINE CALHUM + END SUBROUTINE CALHUM !== begin tsnosoi ================================================================================== @@ -5169,7 +5258,7 @@ SUBROUTINE TSNOSOI (parameters,ICE ,NSOIL ,NSNOW ,ISNOW ,IST , & ! TBOT ,ZSNSO ,SSOIL ,DF ,HCPCT , & !in SAG ,DT ,SNOWH ,DZSNSO , & !in TG ,ILOC ,JLOC , & !in - STC ) !inout + STC ,EFLXB ) !inout ! -------------------------------------------------------------------------------------------------- ! Compute snow (up to 3L) and soil (4L) temperature. Note that snow temperatures ! during melting season may exceed melting point (TFRZ) but later in PHASECHANGE @@ -5198,17 +5287,15 @@ SUBROUTINE TSNOSOI (parameters,ICE ,NSOIL ,NSNOW ,ISNOW ,IST , & ! REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(IN) :: DZSNSO !snow/soil layer thickness (m) REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(IN) :: DF !thermal conductivity REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(IN) :: HCPCT !heat capacity (J/m3/k) + REAL, INTENT(OUT) :: EFLXB !energy influx from soil bottom (w/m2) !input and output - REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: STC !local - INTEGER :: IZ REAL :: ZBOTSNO !ZBOT from snow surface REAL, DIMENSION(-NSNOW+1:NSOIL) :: AI, BI, CI, RHSTS - REAL :: EFLXB !energy influx from soil bottom (w/m2) REAL, DIMENSION(-NSNOW+1:NSOIL) :: PHI !light through water (w/m2) REAL, DIMENSION(-NSNOW+1:NSOIL) :: TBEG @@ -5219,7 +5306,7 @@ SUBROUTINE TSNOSOI (parameters,ICE ,NSOIL ,NSNOW ,ISNOW ,IST , & ! ! ---------------------------------------------------------------------- ! compute solar penetration through water, needs more work - PHI(ISNOW+1:NSOIL) = 0. + PHI(ISNOW+1:NSOIL) = 0.0 ! adjust ZBOT from soil surface to ZBOTSNO from snow surface @@ -5247,7 +5334,7 @@ SUBROUTINE TSNOSOI (parameters,ICE ,NSOIL ,NSNOW ,ISNOW ,IST , & ! ! otherwise, it would break the surface energy balance IF(OPT_TBOT == 1) THEN - EFLXB2 = 0. + EFLXB2 = 0.0 ELSE IF(OPT_TBOT == 2) THEN EFLXB2 = DF(NSOIL)*(TBOT-STC(NSOIL)) / & (0.5*(ZSNSO(NSOIL-1)+ZSNSO(NSOIL)) - ZBOTSNO) @@ -5271,7 +5358,7 @@ SUBROUTINE TSNOSOI (parameters,ICE ,NSOIL ,NSNOW ,ISNOW ,IST , & ! ERR_EST = ERR_EST - (SSOIL2+EFLXB2) ENDIF - IF (ABS(ERR_EST) > 1.) THEN ! W/m2 + IF (ABS(ERR_EST) > 1.0) THEN ! W/m2 WRITE(message,*) 'TSNOSOI is losing(-)/gaining(+) false energy',ERR_EST,' W/m2' call wrf_message(trim(message)) WRITE(message,'(i6,1x,i6,1x,i3,F18.13,5F20.12)') & @@ -5350,7 +5437,7 @@ SUBROUTINE HRT (parameters,NSNOW ,NSOIL ,ISNOW ,ZSNSO , & DENOM(K) = (ZSNSO(K-1) - ZSNSO(K)) * HCPCT(K) TEMP1 = ZSNSO(K-1) - ZSNSO(K) IF(OPT_TBOT == 1) THEN - BOTFLX = 0. + BOTFLX = 0.0 END IF IF(OPT_TBOT == 2) THEN DTSDZ(K) = (STC(K) - TBOT) / ( 0.5*(ZSNSO(K-1)+ZSNSO(K)) - ZBOT) @@ -5416,10 +5503,10 @@ SUBROUTINE HSTEP (parameters,NSNOW ,NSOIL ,ISNOW ,DT , & ! ---------------------------------------------------------------------- DO K = ISNOW+1,NSOIL - RHSTS(K) = RHSTS(K) * DT - AI(K) = AI(K) * DT - BI(K) = 1. + BI(K) * DT - CI(K) = CI(K) * DT + RHSTS(K) = RHSTS(K) * DT + AI(K) = AI(K) * DT + BI(K) = 1.0 + BI(K) * DT + CI(K) = CI(K) * DT END DO ! copy values for input variables before call to rosr12 @@ -5563,9 +5650,9 @@ SUBROUTINE PHASECHANGE (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,FACT , ! ---------------------------------------------------------------------- ! Initialization - QMELT = 0. - PONDING = 0. - XMF = 0. + QMELT = 0.0 + PONDING = 0.0 + XMF = 0.0 DO J = -NSNOW+1, NSOIL SUPERCOOL(J) = 0.0 @@ -5577,14 +5664,14 @@ SUBROUTINE PHASECHANGE (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,FACT , END DO DO J = 1, NSOIL ! soil - MLIQ(J) = SH2O(J) * DZSNSO(J) * 1000. - MICE(J) = (SMC(J) - SH2O(J)) * DZSNSO(J) * 1000. + MLIQ(J) = SH2O(J) * DZSNSO(J) * 1000.0 + MICE(J) = (SMC(J) - SH2O(J)) * DZSNSO(J) * 1000.0 END DO DO J = ISNOW+1,NSOIL ! all layers IMELT(J) = 0 - HM(J) = 0. - XM(J) = 0. + HM(J) = 0.0 + XM(J) = 0.0 WICE0(J) = MICE(J) WLIQ0(J) = MLIQ(J) WMASS0(J) = MICE(J) + MLIQ(J) @@ -5595,19 +5682,21 @@ SUBROUTINE PHASECHANGE (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,FACT , IF (OPT_FRZ == 1) THEN IF(STC(J) < TFRZ) THEN SMP = HFUS*(TFRZ-STC(J))/(GRAV*STC(J)) !(m) - SUPERCOOL(J) = parameters%SMCMAX(J)*(SMP/parameters%PSISAT(J))**(-1./parameters%BEXP(J)) - SUPERCOOL(J) = SUPERCOOL(J)*DZSNSO(J)*1000. !(mm) + SUPERCOOL(J) = parameters%SMCMAX(J)*(SMP/parameters%PSISAT(J))**(-1.0/parameters%BEXP(J)) + SUPERCOOL(J) = SUPERCOOL(J)*DZSNSO(J)*1000.0 !(mm) END IF END IF IF (OPT_FRZ == 2) THEN + IF(STC(J) < TFRZ) THEN CALL FRH2O (parameters,J,SUPERCOOL(J),STC(J),SMC(J),SH2O(J)) - SUPERCOOL(J) = SUPERCOOL(J)*DZSNSO(J)*1000. !(mm) + SUPERCOOL(J) = SUPERCOOL(J)*DZSNSO(J)*1000.0 !(mm) + END IF END IF ENDDO end if DO J = ISNOW+1,NSOIL - IF (MICE(J) > 0. .AND. STC(J) >= TFRZ) THEN !melting + IF (MICE(J) > 0.0 .AND. STC(J) >= TFRZ) THEN !melting IMELT(J) = 1 ENDIF IF (MLIQ(J) > SUPERCOOL(J) .AND. STC(J) < TFRZ) THEN @@ -5615,7 +5704,7 @@ SUBROUTINE PHASECHANGE (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,FACT , 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 (ISNOW == 0 .AND. SNEQV > 0.0 .AND. J == 1) THEN IF (STC(J) >= TFRZ) THEN IMELT(J) = 1 ENDIF @@ -5630,12 +5719,12 @@ SUBROUTINE PHASECHANGE (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,FACT , STC(J) = TFRZ ENDIF - IF (IMELT(J) == 1 .AND. HM(J) < 0.) THEN - HM(J) = 0. + IF (IMELT(J) == 1 .AND. HM(J) < 0.0) THEN + HM(J) = 0.0 IMELT(J) = 0 ENDIF - IF (IMELT(J) == 2 .AND. HM(J) > 0.) THEN - HM(J) = 0. + IF (IMELT(J) == 2 .AND. HM(J) > 0.0) THEN + HM(J) = 0.0 IMELT(J) = 0 ENDIF XM(J) = HM(J)*DT/HFUS @@ -5643,21 +5732,21 @@ SUBROUTINE PHASECHANGE (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,FACT , ! The rate of melting and freezing for snow without a layer, needs more work. - IF (ISNOW == 0 .AND. SNEQV > 0. .AND. XM(1) > 0.) THEN + IF (ISNOW == 0 .AND. SNEQV > 0.0 .AND. XM(1) > 0.0) THEN TEMP1 = SNEQV - SNEQV = MAX(0.,TEMP1-XM(1)) + SNEQV = MAX(0.0,TEMP1-XM(1)) PROPOR = SNEQV/TEMP1 - SNOWH = MAX(0.,PROPOR * SNOWH) + SNOWH = MAX(0.0,PROPOR * SNOWH) SNOWH = MIN(MAX(SNOWH,SNEQV/500.0),SNEQV/50.0) ! limit adjustment to a reasonable density HEATR = HM(1) - HFUS*(TEMP1-SNEQV)/DT - IF (HEATR > 0.) THEN + IF (HEATR > 0.0) THEN XM(1) = HEATR*DT/HFUS HM(1) = HEATR ELSE - XM(1) = 0. - HM(1) = 0. + XM(1) = 0.0 + HM(1) = 0.0 ENDIF - QMELT = MAX(0.,(TEMP1-SNEQV))/DT + QMELT = MAX(0.0,(TEMP1-SNEQV))/DT XMF = HFUS*QMELT PONDING = TEMP1-SNEQV ENDIF @@ -5665,18 +5754,18 @@ SUBROUTINE PHASECHANGE (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,FACT , ! The rate of melting and freezing for snow and soil DO J = ISNOW+1,NSOIL - IF (IMELT(J) > 0 .AND. ABS(HM(J)) > 0.) THEN + IF (IMELT(J) > 0 .AND. ABS(HM(J)) > 0.0) THEN - HEATR = 0. - IF (XM(J) > 0.) THEN - MICE(J) = MAX(0., WICE0(J)-XM(J)) + HEATR = 0.0 + IF (XM(J) > 0.0) THEN + MICE(J) = MAX(0.0, WICE0(J)-XM(J)) HEATR = HM(J) - HFUS*(WICE0(J)-MICE(J))/DT - ELSE IF (XM(J) < 0.) THEN + ELSE IF (XM(J) < 0.0) THEN IF (J <= 0) THEN ! snow MICE(J) = MIN(WMASS0(J), WICE0(J)-XM(J)) ELSE ! soil IF (WMASS0(J) < SUPERCOOL(J)) THEN - MICE(J) = 0. + MICE(J) = 0.0 ELSE MICE(J) = MIN(WMASS0(J) - SUPERCOOL(J),WICE0(J)-XM(J)) MICE(J) = MAX(MICE(J),0.0) @@ -5685,13 +5774,13 @@ SUBROUTINE PHASECHANGE (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,FACT , HEATR = HM(J) - HFUS*(WICE0(J)-MICE(J))/DT ENDIF - MLIQ(J) = MAX(0.,WMASS0(J)-MICE(J)) + MLIQ(J) = MAX(0.0,WMASS0(J)-MICE(J)) - IF (ABS(HEATR) > 0.) THEN + IF (ABS(HEATR) > 0.0) THEN STC(J) = STC(J) + FACT(J)*HEATR IF (J <= 0) THEN ! snow - IF (MLIQ(J)*MICE(J)>0.) STC(J) = TFRZ - IF (MICE(J) == 0.) THEN ! BARLAGE + IF (MLIQ(J)*MICE(J)>0.0) STC(J) = TFRZ + IF (MICE(J) == 0.0) THEN ! BARLAGE STC(J) = TFRZ ! BARLAGE HM(J+1) = HM(J+1) + HEATR ! BARLAGE XM(J+1) = HM(J+1)*DT/HFUS ! BARLAGE @@ -5702,7 +5791,7 @@ SUBROUTINE PHASECHANGE (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,FACT , XMF = XMF + HFUS * (WICE0(J)-MICE(J))/DT IF (J < 1) THEN - QMELT = QMELT + MAX(0.,(WICE0(J)-MICE(J)))/DT + QMELT = QMELT + MAX(0.0,(WICE0(J)-MICE(J)))/DT ENDIF ENDIF ENDDO @@ -5713,8 +5802,8 @@ SUBROUTINE PHASECHANGE (parameters,NSNOW ,NSOIL ,ISNOW ,DT ,FACT , END DO DO J = 1, NSOIL ! soil - SH2O(J) = MLIQ(J) / (1000. * DZSNSO(J)) - SMC(J) = (MLIQ(J) + MICE(J)) / (1000. * DZSNSO(J)) + SH2O(J) = MLIQ(J) / (1000.0 * DZSNSO(J)) + SMC(J) = (MLIQ(J) + MICE(J)) / (1000.0 * DZSNSO(J)) END DO END SUBROUTINE PHASECHANGE @@ -5779,7 +5868,7 @@ SUBROUTINE FRH2O (parameters,ISOIL,FREE,TKELV,SMC,SH2O) ! IF TEMPERATURE NOT SIGNIFICANTLY BELOW FREEZING (TFRZ), SH2O = SMC ! ---------------------------------------------------------------------- KCOUNT = 0 - IF (TKELV > (TFRZ- 1.E-3)) THEN + IF (TKELV > (TFRZ- 1.0E-3)) THEN FREE = SMC ELSE @@ -5797,20 +5886,20 @@ SUBROUTINE FRH2O (parameters,ISOIL,FREE,TKELV,SMC,SH2O) ! ---------------------------------------------------------------------- ! START OF ITERATIONS ! ---------------------------------------------------------------------- - IF (SWL < 0.) SWL = 0. + IF (SWL < 0.0) SWL = 0.0 1001 Continue IF (.NOT.( (NLOG < 10) .AND. (KCOUNT == 0))) goto 1002 NLOG = NLOG +1 - DF = ALOG ( ( parameters%PSISAT(ISOIL) * GRAV / HFUS ) * ( ( 1. + CK * SWL )**2.) * & + DF = ALOG ( ( parameters%PSISAT(ISOIL) * GRAV / HFUS ) * ( ( 1.0 + CK * SWL )**2.0) * & ( parameters%SMCMAX(ISOIL) / (SMC - SWL) )** BX) - ALOG ( - ( & TKELV - TFRZ)/ TKELV) - DENOM = 2. * CK / ( 1. + CK * SWL ) + BX / ( SMC - SWL ) + DENOM = 2.0 * CK / ( 1.0 + CK * SWL ) + BX / ( SMC - SWL ) SWLK = SWL - DF / DENOM ! ---------------------------------------------------------------------- ! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION. ! ---------------------------------------------------------------------- IF (SWLK > (SMC -0.02)) SWLK = SMC - 0.02 - IF (SWLK < 0.) SWLK = 0. + IF (SWLK < 0.0) SWLK = 0.0 ! ---------------------------------------------------------------------- ! MATHEMATICAL SOLUTION BOUNDS APPLIED. @@ -5844,7 +5933,7 @@ SUBROUTINE FRH2O (parameters,ISOIL,FREE,TKELV,SMC,SH2O) write(message, '("Flerchinger used in NEW version. Iterations=", I6)') NLOG call wrf_message(trim(message)) FK = ( ( (HFUS / (GRAV * ( - parameters%PSISAT(ISOIL))))* & - ( (TKELV - TFRZ)/ TKELV))** ( -1/ BX))* parameters%SMCMAX(ISOIL) + ( (TKELV - TFRZ)/ TKELV))** ( -1.0/ BX))* parameters%SMCMAX(ISOIL) IF (FK < 0.02) FK = 0.02 FREE = MIN (FK, SMC) ! ---------------------------------------------------------------------- @@ -5868,6 +5957,7 @@ SUBROUTINE WATER (parameters,VEGTYP ,NSNOW ,NSOIL ,IMELT ,DT ,UU , & FICEOLD,PONDING,TG ,IST ,FVEG ,ILOC ,JLOC ,SMCEQ , & !in BDFALL ,FP ,RAIN ,SNOW, & !in MB/AN: v3.7 QSNOW ,QRAIN ,SNOWHIN,LATHEAV,LATHEAG,frozen_canopy,frozen_ground, & !in MB + DX ,TDFRACMP, & ISNOW ,CANLIQ ,CANICE ,TV ,SNOWH ,SNEQV , & !inout SNICE ,SNLIQ ,STC ,ZSNSO ,SH2O ,SMC , & !inout SICE ,ZWT ,WA ,WT ,DZSNSO ,WSLAKE , & !inout @@ -5875,9 +5965,11 @@ SUBROUTINE WATER (parameters,VEGTYP ,NSNOW ,NSOIL ,IMELT ,DT ,UU , & IRAMTFI,IRAMTMI ,IRFIRATE ,IRMIRATE, & !inout CMC ,ECAN ,ETRAN ,FWET ,RUNSRF ,RUNSUB , & !out QIN ,QDIS ,PONDING1 ,PONDING2, & - QSNBOT & + QSNBOT ,QTLDRN , & + QSNSUB ,QSNFRO ,QSUBC ,QFROC ,QFRZC ,QMELTC , & + QEVAC ,QDEWC ,ACC_QINSUR,ACC_QSEVA ,ACC_ETRANI & #ifdef WRF_HYDRO - ,sfcheadrt & + ,sfcheadrt ,WATBLED & #endif ) !out ! ---------------------------------------------------------------------- @@ -5910,7 +6002,6 @@ SUBROUTINE WATER (parameters,VEGTYP ,NSNOW ,NSOIL ,IMELT ,DT ,UU , & REAL, DIMENSION( 1:NSOIL), INTENT(IN) :: ZSOIL !depth of layer-bottom from soil surface REAL, DIMENSION( 1:NSOIL), INTENT(IN) :: BTRANI !soil water stress factor (0 to 1) REAL, DIMENSION(-NSNOW+1: 0), INTENT(IN) :: FICEOLD !ice fraction at last timestep -! REAL , INTENT(IN) :: PONDING ![mm] REAL , INTENT(IN) :: TG !ground temperature (k) REAL , INTENT(IN) :: FVEG !greeness vegetation fraction (-) REAL , INTENT(IN) :: BDFALL !bulk density of snowfall (kg/m3) ! MB/AN: v3.7 @@ -5946,14 +6037,17 @@ SUBROUTINE WATER (parameters,VEGTYP ,NSNOW ,NSOIL ,IMELT ,DT ,UU , & REAL, INTENT(INOUT) :: SMCWTD !soil water content between bottom of the soil and water table [m3/m3] REAL, INTENT(INOUT) :: DEEPRECH !recharge to or from the water table when deep [m] REAL, INTENT(INOUT) :: RECH !recharge to or from the water table when shallow [m] (diagnostic) + REAL, INTENT(INOUT) :: QTLDRN !tile drainage (mm) per soil timestep + REAL, INTENT(IN) :: DX + REAL, INTENT(IN) :: TDFRACMP !tile drain fraction map ! output REAL, INTENT(OUT) :: CMC !intercepted water per ground area (mm) REAL, INTENT(OUT) :: ECAN !evap of intercepted water (mm/s) [+] REAL, INTENT(OUT) :: ETRAN !transpiration rate (mm/s) [+] REAL, INTENT(OUT) :: FWET !wetted/snowed fraction of canopy (-) - REAL, INTENT(OUT) :: RUNSRF !surface runoff [mm/s] - REAL, INTENT(OUT) :: RUNSUB !baseflow (sturation excess) [mm/s] + REAL, INTENT(OUT) :: RUNSRF !surface runoff [mm] per soil timestep + REAL, INTENT(OUT) :: RUNSUB !baseflow (sturation excess) [mm] per soil timestep REAL, INTENT(OUT) :: QIN !groundwater recharge [mm/s] REAL, INTENT(OUT) :: QDIS !groundwater discharge [mm/s] REAL, INTENT(OUT) :: PONDING1 @@ -5963,6 +6057,15 @@ SUBROUTINE WATER (parameters,VEGTYP ,NSNOW ,NSOIL ,IMELT ,DT ,UU , & REAL , INTENT(IN) :: LATHEAG !latent heat vap./sublimation (j/kg) LOGICAL , INTENT(IN) :: FROZEN_GROUND ! used to define latent heat pathway LOGICAL , INTENT(IN) :: FROZEN_CANOPY ! used to define latent heat pathway + REAL, INTENT(OUT) :: QEVAC !evaporation rate (mm/s) + REAL, INTENT(OUT) :: QDEWC !dew rate (mm/s) + REAL, INTENT(OUT) :: QFROC !frost rate (mm/s) + REAL, INTENT(OUT) :: QSUBC !sublimation rate (mm/s) + REAL, INTENT(OUT) :: QMELTC !melting rate of canopy snow (mm/s) + REAL, INTENT(OUT) :: QFRZC !refreezing rate of canopy liquid water (mm/s) + REAL, INTENT(INOUT) :: ACC_QINSUR !water input on soil surface [m/s] + REAL, INTENT(INOUT) :: ACC_QSEVA !soil surface evap rate [mm/s] + REAL, DIMENSION( 1:NSOIL) , INTENT(INOUT):: ACC_ETRANI !transpiration rate (mm/s) [+] ! irrigation REAL, INTENT(IN) :: IRRFRA ! irrigation fraction @@ -5986,20 +6089,26 @@ SUBROUTINE WATER (parameters,VEGTYP ,NSNOW ,NSOIL ,IMELT ,DT ,UU , & REAL :: QDRAIN !soil-bottom free drainage [mm/s] REAL :: SNOFLOW !glacier flow [mm/s] REAL :: FCRMAX !maximum of FCR (-) + real :: dt_soil + real :: qinsur_avg + real :: qseva_avg + real, dimension(1:nsoil) :: etrani_avg - REAL, PARAMETER :: WSLMAX = 5000. !maximum lake water storage (mm) + REAL, PARAMETER :: WSLMAX = 5000.0 !maximum lake water storage (mm) #ifdef WRF_HYDRO - REAL , INTENT(INOUT) :: sfcheadrt + REAL , INTENT(INOUT) :: sfcheadrt, WATBLED #endif ! ---------------------------------------------------------------------- ! initialize - ETRANI(1:NSOIL) = 0. - SNOFLOW = 0. - RUNSUB = 0. - QINSUR = 0. + ETRANI(1:NSOIL) = 0.0 + SNOFLOW = 0.0 + RUNSUB = 0.0 + RUNSRF = 0.0 + QINSUR = 0.0 + QTLDRN = 0.0 ! canopy-intercepted snowfall/rainfall, drips, and throughfall @@ -6009,18 +6118,18 @@ SUBROUTINE WATER (parameters,VEGTYP ,NSNOW ,NSOIL ,IMELT ,DT ,UU , & BDFALL ,FROZEN_CANOPY , & !in CANLIQ ,CANICE ,TV , & !inout CMC ,ECAN ,ETRAN , & !out - FWET ) !out + FWET , QSUBC, QFROC, QFRZC, QMELTC, QEVAC, QDEWC ) !out ! sublimation, frost, evaporation, and dew - QSNSUB = 0. - IF (SNEQV > 0.) THEN + QSNSUB = 0.0 + IF (SNEQV > 0.0) THEN QSNSUB = MIN(QVAP, SNEQV/DT) ENDIF QSEVA = QVAP-QSNSUB - QSNFRO = 0. - IF (SNEQV > 0.) THEN + QSNFRO = 0.0 + IF (SNEQV > 0.0) THEN QSNFRO = QDEW ENDIF QSDEW = QDEW - QSNFRO @@ -6033,20 +6142,20 @@ SUBROUTINE WATER (parameters,VEGTYP ,NSNOW ,NSOIL ,IMELT ,DT ,UU , & & QSNBOT ,SNOFLOW,PONDING1 ,PONDING2) !out IF(FROZEN_GROUND) THEN - SICE(1) = SICE(1) + (QSDEW-QSEVA)*DT/(DZSNSO(1)*1000.) + SICE(1) = SICE(1) + (QSDEW-QSEVA)*DT/(DZSNSO(1)*1000.0) QSDEW = 0.0 QSEVA = 0.0 - IF(SICE(1) < 0.) THEN + IF(SICE(1) < 0.0) THEN SH2O(1) = SH2O(1) + SICE(1) - SICE(1) = 0. + SICE(1) = 0.0 END IF + SMC(1) = SH2O(1) + SICE(1) END IF ! convert units (mm/s -> m/s) !PONDING: melting water from snow when there is no layer QINSUR = (PONDING+PONDING1+PONDING2)/DT * 0.001 -! QINSUR = PONDING/DT * 0.001 IF(ISNOW == 0) THEN QINSUR = QINSUR+(QSNBOT + QSDEW + QRAIN) * 0.001 @@ -6064,64 +6173,89 @@ SUBROUTINE WATER (parameters,VEGTYP ,NSNOW ,NSOIL ,IMELT ,DT ,UU , & QINSUR = QINSUR+sfcheadrt/DT*0.001 !sfcheadrt units (m) #endif -! irrigation: call flood irrigation-pvk - IF((CROPLU .EQV. .TRUE.) .AND. (IRAMTFI .GT. 0.0))THEN - ! call flood irrigation and add to QINSUR - CALL FLOOD_IRRIGATION(parameters,NSOIL,DT,SH2O,SMC,SICE,FIFAC,& !in - IRAMTFI,IRFIRATE) !inout - QINSUR = QINSUR + (IRFIRATE/DT) ![m/s] - END IF -! irrigation: call micro irrigation-pvk - IF((CROPLU .EQV. .TRUE.) .AND. (IRAMTMI .GT. 0.0))THEN - ! call micro irrigation, assuming we implement drip in first layer - ! of the Noah-MP. Change layer 1 moisture wrt to MI rate-pvk - CALL MICRO_IRRIGATION(parameters,NSOIL,DT,SH2O,SMC,SICE,MIFAC, & !in - IRAMTMI,IRMIRATE) !inout - SH2O(1) = SH2O(1) + (IRMIRATE/(-1*ZSOIL(1))) - END IF +! added soil timestep capability + ACC_QINSUR = ACC_QINSUR + QINSUR + ACC_QSEVA = ACC_QSEVA + QSEVA + ACC_ETRANI = ACC_ETRANI + ETRANI -! lake/soil water balances - - IF (IST == 2) THEN ! lake - RUNSRF = 0. - IF(WSLAKE >= WSLMAX) RUNSRF = QINSUR*1000. !mm/s - WSLAKE = WSLAKE + (QINSUR-QSEVA)*1000.*DT -RUNSRF*DT !mm - ELSE ! soil - CALL SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in - QINSUR ,QSEVA ,ETRANI ,SICE ,ILOC , JLOC , & !in - SH2O ,SMC ,ZWT ,VEGTYP , & !inout - SMCWTD, DEEPRECH , & !inout - RUNSRF ,QDRAIN ,RUNSUB ,WCND ,FCRMAX ) !out - - IF(OPT_RUN == 1) THEN - CALL GROUNDWATER (parameters,NSNOW ,NSOIL ,DT ,SICE ,ZSOIL , & !in - STC ,WCND ,FCRMAX ,ILOC ,JLOC , & !in - SH2O ,ZWT ,WA ,WT , & !inout - QIN ,QDIS ) !out - RUNSUB = QDIS !mm/s + ! start soil calculation timestep + if(calculate_soil) then + + DT_soil = DT * soil_update_steps + + ! irrigation: call flood irrigation-pvk + IF((CROPLU .EQV. .TRUE.) .AND. (IRAMTFI .GT. 0.0))THEN + ! call flood irrigation and add to QINSUR + CALL FLOOD_IRRIGATION(parameters,NSOIL,DT_soil,SH2O,SMC,SICE,FIFAC,& !in + IRAMTFI,IRFIRATE) !inout + ACC_QINSUR = ACC_QINSUR + IRFIRATE/Dt_soil * soil_update_steps END IF - IF(OPT_RUN == 3 .or. OPT_RUN == 4) THEN - RUNSUB = RUNSUB + QDRAIN !mm/s + ! irrigation: call micro irrigation-pvk + IF((CROPLU .EQV. .TRUE.) .AND. (IRAMTMI .GT. 0.0))THEN + ! call micro irrigation, assuming we implement drip in first layer + ! of the Noah-MP. Change layer 1 moisture wrt to MI rate-pvk + CALL MICRO_IRRIGATION(parameters,NSOIL,DT_soil,SH2O,SMC,SICE,MIFAC, & !in + IRAMTMI,IRMIRATE) !inout + SH2O(1) = SH2O(1) + (IRMIRATE/(-1*ZSOIL(1))) END IF - DO IZ = 1,NSOIL - SMC(IZ) = SH2O(IZ) + SICE(IZ) - ENDDO + QSEVA_avg = ACC_QSEVA / soil_update_steps + QINSUR_avg = ACC_QINSUR / soil_update_steps + ETRANI_avg = ACC_ETRANI / soil_update_steps + + ! lake/soil water balances + IF (IST == 2) THEN ! lake + RUNSRF = 0.0 + IF(WSLAKE >= WSLMAX) RUNSRF = QINSUR_avg*1000.0*Dt_soil ! mm per soil timestep + WSLAKE = WSLAKE + (QINSUR_avg-QSEVA_avg)*1000.0*Dt_soil - RUNSRF !mm per soil timestep + ELSE ! soil + CALL SOILWATER (parameters,NSOIL ,NSNOW ,DT_soil ,ZSOIL ,DZSNSO , & !in + QINSUR_avg,QSEVA_avg,ETRANI_avg,SICE ,ILOC , JLOC , & !in + TDFRACMP,DX , & !in + SH2O ,SMC ,ZWT ,VEGTYP , & !inout + SMCWTD, DEEPRECH, & !inout + RUNSRF ,QDRAIN ,RUNSUB ,WCND ,FCRMAX, QTLDRN & !out +#ifdef WRF_HYDRO + ,WATBLED & !in for tile drainage +#endif + ) + + IF(OPT_RUN == 1) THEN + CALL GROUNDWATER (parameters,NSNOW ,NSOIL ,DT_soil ,SICE ,ZSOIL , & !in + STC ,WCND ,FCRMAX ,ILOC ,JLOC , & !in + SH2O ,ZWT ,WA ,WT , & !inout + QIN ,QDIS ) !out + RUNSUB = QDIS !mm/s + END IF + + IF(OPT_RUN == 3 .or. OPT_RUN == 4 .or. & + OPT_RUN == 6 .or. OPT_RUN == 7 .or. OPT_RUN == 8) THEN + RUNSUB = RUNSUB + QDRAIN !mm/s + END IF + + DO IZ = 1,NSOIL + SMC(IZ) = SH2O(IZ) + SICE(IZ) + ENDDO - IF(OPT_RUN == 5) THEN - CALL SHALLOWWATERTABLE (parameters,NSNOW ,NSOIL, ZSOIL, DT , & !in - DZSNSO ,SMCEQ ,ILOC , JLOC , & !in - SMC ,ZWT ,SMCWTD ,RECH, QDRAIN ) !inout - - SH2O(NSOIL) = SMC(NSOIL) - SICE(NSOIL) - RUNSUB = RUNSUB + QDRAIN !it really comes from subroutine watertable, which is not called with the same frequency as the soil routines here - WA = 0. + IF(OPT_RUN == 5) THEN + CALL SHALLOWWATERTABLE (parameters,NSNOW ,NSOIL, ZSOIL, DT_soil , & !in + DZSNSO ,SMCEQ ,ILOC , JLOC , & !in + SMC ,ZWT ,SMCWTD ,RECH, QDRAIN ) !inout + + SH2O(NSOIL) = SMC(NSOIL) - SICE(NSOIL) + RUNSUB = RUNSUB + QDRAIN !it really comes from subroutine watertable, which is not called with the same frequency as the soil routines here + WA = 0.0 + ENDIF + + RUNSRF = RUNSRF * dt_soil + RUNSUB = RUNSUB * dt_soil + QTLDRN = QTLDRN * dt_soil ENDIF - ENDIF + endif ! soil calculation timestep - RUNSUB = RUNSUB + SNOFLOW !mm/s + RUNSUB = RUNSUB + SNOFLOW*DT !mm/s END SUBROUTINE WATER @@ -6133,7 +6267,7 @@ SUBROUTINE CANWATER (parameters,VEGTYP ,DT , & !in BDFALL ,FROZEN_CANOPY , & !in CANLIQ ,CANICE ,TV , & !inout CMC ,ECAN ,ETRAN , & !out - FWET ) !out + FWET , QSUBC, QFROC, QFRZC, QMELTC, QEVAC, QDEWC ) !out ! ------------------------ code history ------------------------------ ! canopy hydrology @@ -6170,12 +6304,12 @@ SUBROUTINE CANWATER (parameters,VEGTYP ,DT , & !in ! ------------------------ local variables --------------------------- REAL :: MAXSNO !canopy capacity for snow interception (mm) REAL :: MAXLIQ !canopy capacity for rain interception (mm) - REAL :: QEVAC !evaporation rate (mm/s) - REAL :: QDEWC !dew rate (mm/s) - REAL :: QFROC !frost rate (mm/s) - REAL :: QSUBC !sublimation rate (mm/s) - REAL :: QMELTC !melting rate of canopy snow (mm/s) - REAL :: QFRZC !refreezing rate of canopy liquid water (mm/s) + REAL, INTENT(OUT) :: QEVAC !evaporation rate (mm/s) + REAL, INTENT(OUT) :: QDEWC !dew rate (mm/s) + REAL, INTENT(OUT) :: QFROC !frost rate (mm/s) + REAL, INTENT(OUT) :: QSUBC !sublimation rate (mm/s) + REAL, INTENT(OUT) :: QMELTC !melting rate of canopy snow (mm/s) + REAL, INTENT(OUT) :: QFRZC !refreezing rate of canopy liquid water (mm/s) REAL :: CANMAS !total canopy mass (kg/m2) ! -------------------------------------------------------------------- ! initialization @@ -6190,61 +6324,62 @@ SUBROUTINE CANWATER (parameters,VEGTYP ,DT , & !in ! evaporation, transpiration, and dew IF (.NOT.FROZEN_CANOPY) THEN ! Barlage: change to frozen_canopy - ETRAN = MAX( FCTR/HVAP, 0. ) - QEVAC = MAX( FCEV/HVAP, 0. ) - QDEWC = ABS( MIN( FCEV/HVAP, 0. ) ) - QSUBC = 0. - QFROC = 0. + ETRAN = MAX( FCTR/HVAP, 0.0 ) + QEVAC = MAX( FCEV/HVAP, 0.0 ) + QDEWC = ABS( MIN( FCEV/HVAP, 0.0 ) ) + QSUBC = 0.0 + QFROC = 0.0 ELSE - ETRAN = MAX( FCTR/HSUB, 0. ) - QEVAC = 0. - QDEWC = 0. - QSUBC = MAX( FCEV/HSUB, 0. ) - QFROC = ABS( MIN( FCEV/HSUB, 0. ) ) + ETRAN = MAX( FCTR/HSUB, 0.0 ) + QEVAC = 0.0 + QDEWC = 0.0 + QSUBC = MAX( FCEV/HSUB, 0.0 ) + QFROC = ABS( MIN( FCEV/HSUB, 0.0 ) ) ENDIF ! canopy water balance. for convenience allow dew to bring CANLIQ above ! maxh2o or else would have to re-adjust drip QEVAC = MIN(CANLIQ/DT,QEVAC) - CANLIQ=MAX(0.,CANLIQ+(QDEWC-QEVAC)*DT) - IF(CANLIQ <= 1.E-06) CANLIQ = 0.0 + CANLIQ=MAX(0.0,CANLIQ+(QDEWC-QEVAC)*DT) + IF(CANLIQ <= 1.0E-06) CANLIQ = 0.0 ! --------------------------- canopy ice ------------------------------ ! for canopy ice - MAXSNO = 6.6*(0.27+46./BDFALL) * (ELAI+ ESAI) + MAXSNO = 6.6*(0.27+46.0/BDFALL) * (ELAI+ ESAI) QSUBC = MIN(CANICE/DT,QSUBC) - CANICE= MAX(0.,CANICE + (QFROC-QSUBC)*DT) - IF(CANICE.LE.1.E-6) CANICE = 0. + CANICE= MAX(0.0,CANICE + (QFROC-QSUBC)*DT) + IF(CANICE .LE. 1.0E-6) CANICE = 0.0 ! wetted fraction of canopy - IF(CANICE.GT.0.) THEN - FWET = MAX(0.,CANICE) / MAX(MAXSNO,1.E-06) + IF( (CANICE .GT. 0.0) .AND. (CANICE .GE. CANLIQ) ) THEN + FWET = MAX(0.0,CANICE) / MAX(MAXSNO,1.0E-06) ELSE - FWET = MAX(0.,CANLIQ) / MAX(MAXLIQ,1.E-06) + FWET = MAX(0.0,CANLIQ) / MAX(MAXLIQ,1.0E-06) ENDIF - FWET = MIN(FWET, 1.) ** 0.667 + FWET = MIN(FWET, 1.0) ** 0.667 ! phase change - QMELTC = 0. - QFRZC = 0. + QMELTC = 0.0 + QFRZC = 0.0 + CMC = CANLIQ + CANICE - IF(CANICE.GT.1.E-6.AND.TV.GT.TFRZ) THEN + IF(CANICE .GT. 1.0E-6 .AND. TV .GT. TFRZ) THEN QMELTC = MIN(CANICE/DT,(TV-TFRZ)*CICE*CANICE/DENICE/(DT*HFUS)) - CANICE = MAX(0.,CANICE - QMELTC*DT) - CANLIQ = MAX(0.,CANLIQ + QMELTC*DT) - TV = FWET*TFRZ + (1.-FWET)*TV + CANICE = MAX(0.0, CANICE - QMELTC*DT) + CANLIQ = MAX(0.0, CMC - CANICE) + TV = FWET*TFRZ + (1.0-FWET)*TV ENDIF - IF(CANLIQ.GT.1.E-6.AND.TV.LT.TFRZ) THEN + IF(CANLIQ .GT. 1.0E-6 .AND. TV .LT. TFRZ) THEN QFRZC = MIN(CANLIQ/DT,(TFRZ-TV)*CWAT*CANLIQ/DENH2O/(DT*HFUS)) - CANLIQ = MAX(0.,CANLIQ - QFRZC*DT) - CANICE = MAX(0.,CANICE + QFRZC*DT) - TV = FWET*TFRZ + (1.-FWET)*TV + CANLIQ = MAX(0.0, CANLIQ - QFRZC*DT) + CANICE = MAX(0.0, CMC - CANLIQ) + TV = FWET*TFRZ + (1.0-FWET)*TV ENDIF ! total canopy water @@ -6342,18 +6477,18 @@ SUBROUTINE SNOWWATER (parameters,NSNOW ,NSOIL ,IMELT ,DT ,ZSOIL , & !in !set empty snow layers to zero do iz = -nsnow+1, isnow - snice(iz) = 0. - snliq(iz) = 0. - stc(iz) = 0. - dzsnso(iz)= 0. - zsnso(iz) = 0. + 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.) THEN ! 5000 mm -> maximum water depth + IF(SNEQV > 5000.0) THEN ! 5000 mm -> maximum water depth BDSNOW = SNICE(0) / DZSNSO(0) - SNOFLOW = (SNEQV - 5000.) + SNOFLOW = (SNEQV - 5000.0) SNICE(0) = SNICE(0) - SNOFLOW DZSNSO(0) = DZSNSO(0) - SNOFLOW/BDSNOW SNOFLOW = SNOFLOW / DT @@ -6362,7 +6497,7 @@ SUBROUTINE SNOWWATER (parameters,NSNOW ,NSOIL ,IMELT ,DT ,ZSOIL , & !in ! sum up snow mass for layered snow IF(ISNOW < 0) THEN ! MB: only do for multi-layer - SNEQV = 0. + SNEQV = 0.0 DO IZ = ISNOW+1,0 SNEQV = SNEQV + SNICE(IZ) + SNLIQ(IZ) ENDDO @@ -6388,6 +6523,14 @@ SUBROUTINE SNOWWATER (parameters,NSNOW ,NSOIL ,IMELT ,DT ,ZSOIL , & !in DZSNSO(IZ) = -DZSNSO(IZ) END DO +! C.He: update SNOWH for multi-layer snow + IF ( ISNOW < 0 ) THEN + SNOWH = 0.0 + DO IZ = ISNOW+1, 0 + SNOWH = SNOWH + DZSNSO(IZ) + ENDDO + END IF + END SUBROUTINE SNOWWATER !== begin snowfall ================================================================================= @@ -6432,27 +6575,28 @@ SUBROUTINE SNOWFALL (parameters,NSOIL ,NSNOW ,DT ,QSNOW ,SNOWHIN , & !in ! shallow snow / no layer - IF(ISNOW == 0 .and. QSNOW > 0.) THEN + IF(ISNOW == 0 .and. QSNOW > 0.0) THEN SNOWH = SNOWH + SNOWHIN * DT SNEQV = SNEQV + QSNOW * DT END IF ! creating a new layer - - IF(ISNOW == 0 .AND. QSNOW>0. .AND. SNOWH >= 0.025) THEN !MB: change limit -! IF(ISNOW == 0 .AND. QSNOW>0. .AND. SNOWH >= 0.05) THEN + +! IF(ISNOW == 0 .AND. QSNOW>0. .AND. SNOWH >= 0.05) THEN +! IF(ISNOW == 0 .AND. QSNOW>0.0 .AND. SNOWH >= 0.025) THEN !MB: change limit + IF(ISNOW == 0 .AND. SNOWH >= 0.025) THEN ! C.He: remove QSNOW>0 to allow adjusting ISNOW based on SNOWH when no snowfall. ISNOW = -1 NEWNODE = 1 DZSNSO(0)= SNOWH - SNOWH = 0. + SNOWH = 0.0 STC(0) = MIN(273.16, SFCTMP) ! temporary setup SNICE(0) = SNEQV - SNLIQ(0) = 0. + SNLIQ(0) = 0.0 END IF ! snow with layers - IF(ISNOW < 0 .AND. NEWNODE == 0 .AND. QSNOW > 0.) then + IF(ISNOW < 0 .AND. NEWNODE == 0 .AND. QSNOW > 0.0) then SNICE(ISNOW+1) = SNICE(ISNOW+1) + QSNOW * DT DZSNSO(ISNOW+1) = DZSNSO(ISNOW+1) + SNOWHIN * DT ENDIF @@ -6508,7 +6652,7 @@ SUBROUTINE COMBINE (parameters,NSNOW ,NSOIL ,ILOC ,JLOC , & !in ISNOW_OLD = ISNOW DO J = ISNOW_OLD+1,0 - IF (SNICE(J) <= .1) THEN + 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) @@ -6519,14 +6663,14 @@ SUBROUTINE COMBINE (parameters,NSNOW ,NSOIL ,ILOC ,JLOC , & !in SNICE(J-1) = SNICE(J-1) + SNICE(J) DZSNSO(J-1) = DZSNSO(J-1) + DZSNSO(J) ELSE - IF(SNICE(J) >= 0.) THEN + 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.) THEN ! IF SNICE AND SNLIQ SUBLIMATES REMOVE FROM SOIL - SICE(1) = MAX(0.0,SICE(1)+PONDING1/(DZSNSO(1)*1000.)) + IF(PONDING1 < 0.0) THEN ! IF SNICE AND SNLIQ SUBLIMATES REMOVE FROM SOIL + SICE(1) = MAX(0.0,SICE(1)+PONDING1/(DZSNSO(1)*1000.0)) PONDING1 = 0.0 END IF SNEQV = 0.0 @@ -6536,8 +6680,8 @@ SUBROUTINE COMBINE (parameters,NSNOW ,NSOIL ,ILOC ,JLOC , & !in SNICE(J) = 0.0 DZSNSO(J) = 0.0 ENDIF -! SH2O(1) = SH2O(1)+SNLIQ(J)/(DZSNSO(1)*1000.) -! SICE(1) = SICE(1)+SNICE(J)/(DZSNSO(1)*1000.) +! 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. @@ -6555,17 +6699,17 @@ SUBROUTINE COMBINE (parameters,NSNOW ,NSOIL ,ILOC ,JLOC , & !in ! to conserve water in case of too large surface sublimation - IF(SICE(1) < 0.) THEN + IF(SICE(1) < 0.0) THEN SH2O(1) = SH2O(1) + SICE(1) - SICE(1) = 0. + SICE(1) = 0.0 END IF IF(ISNOW ==0) RETURN ! MB: get out if no longer multi-layer - SNEQV = 0. - SNOWH = 0. - ZWICE = 0. - ZWLIQ = 0. + SNEQV = 0.0 + SNOWH = 0.0 + ZWICE = 0.0 + ZWLIQ = 0.0 DO J = ISNOW+1,0 SNEQV = SNEQV + SNICE(J) + SNLIQ(J) @@ -6581,16 +6725,10 @@ SUBROUTINE COMBINE (parameters,NSNOW ,NSOIL ,ILOC ,JLOC , & !in ! IF (SNOWH < 0.05 .AND. ISNOW < 0 ) THEN ISNOW = 0 SNEQV = ZWICE - PONDING2 = ZWLIQ ! LIMIT OF ISNOW < 0 MEANS INPUT PONDING - IF(SNEQV <= 0.) SNOWH = 0. ! SHOULD BE ZERO; SEE ABOVE + PONDING2 = ZWLIQ ! LIMIT OF ISNOW < 0 MEANS INPUT PONDING + IF(SNEQV <= 0.0) SNOWH = 0.0 ! SHOULD BE ZERO; SEE ABOVE END IF -! IF (SNOWH < 0.05 ) THEN -! ISNOW = 0 -! SNEQV = ZWICE -! SH2O(1) = SH2O(1) + ZWLIQ / (DZSNSO(1) * 1000.) -! IF(SNEQV <= 0.) SNOWH = 0. -! END IF ! check the snow depth - snow layers combined @@ -6699,9 +6837,9 @@ SUBROUTINE DIVIDE (parameters,NSNOW ,NSOIL , & !in ! Specify a new snow layer IF (DZ(1) > 0.05) THEN MSNO = 2 - DZ(1) = DZ(1)/2. - SWICE(1) = SWICE(1)/2. - SWLIQ(1) = SWLIQ(1)/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) @@ -6727,18 +6865,18 @@ SUBROUTINE DIVIDE (parameters,NSNOW ,NSOIL , & !in 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.) - DZ(2) = DZ(2)/2. - SWICE(2) = SWICE(2)/2. - SWLIQ(2) = SWLIQ(2)/2. + 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. + 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. + TSNO(2) = TSNO(2) + DTDZ*DZ(2)/2.0 ENDIF END IF @@ -6815,7 +6953,7 @@ SUBROUTINE COMBO(parameters,DZ, WLIQ, WICE, T, DZ2, WLIQ2, WICE2, T2) H2= (CICE*WICE2+CWAT*WLIQ2) * (T2-TFRZ)+HFUS*WLIQ2 HC = H + H2 - IF(HC < 0.)THEN + IF(HC < 0.0)THEN TC = TFRZ + HC/(CICE*WICEC + CWAT*WLIQC) ELSE IF (HC.LE.HFUS*WLIQC) THEN TC = TFRZ @@ -6858,13 +6996,14 @@ SUBROUTINE COMPACT (parameters,NSNOW ,NSOIL ,DT ,STC ,SNICE , & !in REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(INOUT) :: ZSNSO ! depth of snow/soil layer-bottom ! local - REAL, PARAMETER :: C2 = 21.e-3 ![m3/kg] ! default 21.e-3 + 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] +! 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. @@ -6886,12 +7025,12 @@ SUBROUTINE COMPACT (parameters,NSNOW ,NSOIL ,DT ,STC ,SNICE , & !in WX = SNICE(J) + SNLIQ(J) FICE(J) = SNICE(J) / WX - VOID = 1. - (SNICE(J)/DENICE + SNLIQ(J)/DENH2O) / DZSNSO(J) + 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.,TFRZ-STC(J)) + TD = MAX(0.0,TFRZ-STC(J)) DEXPF = EXP(-C4*TD) ! Settling as a result of destructive metamorphism @@ -6911,10 +7050,10 @@ SUBROUTINE COMPACT (parameters,NSNOW ,NSOIL ,DT ,STC ,SNICE , & !in ! Compaction occurring during melt IF (IMELT(J) == 1) THEN - DDZ3 = MAX(0.,(FICEOLD(J) - FICE(J))/MAX(1.E-6,FICEOLD(J))) + DDZ3 = MAX(0.0,(FICEOLD(J) - FICE(J))/MAX(1.0E-6,FICEOLD(J))) DDZ3 = - DDZ3/DT ! sometimes too large ELSE - DDZ3 = 0. + DDZ3 = 0.0 END IF ! Time rate of fractional change in DZ (units of s-1) @@ -6924,8 +7063,12 @@ SUBROUTINE COMPACT (parameters,NSNOW ,NSOIL ,DT ,STC ,SNICE , & !in ! The change in DZ due to compaction - DZSNSO(J) = DZSNSO(J)*(1.+PDZDTC) + 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 @@ -6993,11 +7136,11 @@ SUBROUTINE SNOWH2O (parameters,NSNOW ,NSOIL ,DT ,QSNFRO ,QSNSUB , & !in !for the case when SNEQV becomes '0' after 'COMBINE' - IF(SNEQV == 0.) THEN - SICE(1) = SICE(1) + (QSNFRO-QSNSUB)*DT/(DZSNSO(1)*1000.) ! Barlage: SH2O->SICE v3.6 - IF(SICE(1) < 0.) THEN + IF(SNEQV == 0.0) THEN + SICE(1) = SICE(1) + (QSNFRO-QSNSUB)*DT/(DZSNSO(1)*1000.0) ! Barlage: SH2O->SICE v3.6 + IF(SICE(1) < 0.0) THEN SH2O(1) = SH2O(1) + SICE(1) - SICE(1) = 0. + SICE(1) = 0.0 END IF END IF @@ -7006,25 +7149,25 @@ SUBROUTINE SNOWH2O (parameters,NSNOW ,NSOIL ,DT ,QSNFRO ,QSNSUB , & !in ! excessive sublimation is used to reduce soil water. Smaller time steps would tend ! to aviod this problem. - IF(ISNOW == 0 .and. SNEQV > 0.) THEN + IF(ISNOW == 0 .and. SNEQV > 0.0) THEN TEMP = SNEQV SNEQV = SNEQV - QSNSUB*DT + QSNFRO*DT PROPOR = SNEQV/TEMP - SNOWH = MAX(0.,PROPOR * SNOWH) + SNOWH = MAX(0.0,PROPOR * SNOWH) SNOWH = MIN(MAX(SNOWH,SNEQV/500.0),SNEQV/50.0) ! limit adjustment to a reasonable density - IF(SNEQV < 0.) THEN - SICE(1) = SICE(1) + SNEQV/(DZSNSO(1)*1000.) - SNEQV = 0. - SNOWH = 0. + IF(SNEQV < 0.0) THEN + SICE(1) = SICE(1) + SNEQV/(DZSNSO(1)*1000.0) + SNEQV = 0.0 + SNOWH = 0.0 END IF - IF(SICE(1) < 0.) THEN + IF(SICE(1) < 0.0) THEN SH2O(1) = SH2O(1) + SICE(1) - SICE(1) = 0. + SICE(1) = 0.0 END IF END IF - IF(SNOWH <= 1.E-8 .OR. SNEQV <= 1.E-6) THEN + IF(SNOWH <= 1.0E-8 .OR. SNEQV <= 1.0E-6) THEN SNOWH = 0.0 SNEQV = 0.0 END IF @@ -7035,7 +7178,7 @@ SUBROUTINE SNOWH2O (parameters,NSNOW ,NSOIL ,DT ,QSNFRO ,QSNSUB , & !in WGDIF = SNICE(ISNOW+1) - QSNSUB*DT + QSNFRO*DT SNICE(ISNOW+1) = WGDIF - IF (WGDIF < 1.e-6 .and. ISNOW <0) THEN + IF (WGDIF < 1.0e-6 .and. ISNOW <0) THEN CALL COMBINE (parameters,NSNOW ,NSOIL ,ILOC, JLOC , & !in ISNOW ,SH2O ,STC ,SNICE ,SNLIQ , & !inout DZSNSO ,SICE ,SNOWH ,SNEQV , & !inout @@ -7044,7 +7187,7 @@ SUBROUTINE SNOWH2O (parameters,NSNOW ,NSOIL ,DT ,QSNFRO ,QSNSUB , & !in !KWM: Subroutine COMBINE can change ISNOW to make it 0 again? IF ( ISNOW < 0 ) THEN !KWM added this IF statement to prevent out-of-bounds array references SNLIQ(ISNOW+1) = SNLIQ(ISNOW+1) + QRAIN * DT - SNLIQ(ISNOW+1) = MAX(0., SNLIQ(ISNOW+1)) + SNLIQ(ISNOW+1) = MAX(0.0, SNLIQ(ISNOW+1)) ENDIF ENDIF !KWM -- Can the ENDIF be moved toward the end of the subroutine (Just set QSNBOT=0)? @@ -7052,17 +7195,17 @@ SUBROUTINE SNOWH2O (parameters,NSNOW ,NSOIL ,DT ,QSNFRO ,QSNSUB , & !in ! Porosity and partial volume DO J = ISNOW+1, 0 - VOL_ICE(J) = MIN(1., SNICE(J)/(DZSNSO(J)*DENICE)) - EPORE(J) = 1. - VOL_ICE(J) + VOL_ICE(J) = MIN(1.0, SNICE(J)/(DZSNSO(J)*DENICE)) + EPORE(J) = 1.0 - VOL_ICE(J) END DO - QIN = 0. - QOUT = 0. + QIN = 0.0 + QOUT = 0.0 DO J = ISNOW+1, 0 SNLIQ(J) = SNLIQ(J) + QIN VOL_LIQ(J) = SNLIQ(J)/(DZSNSO(J)*DENH2O) - QOUT = MAX(0.,(VOL_LIQ(J)-parameters%SSI*EPORE(J))*DZSNSO(J)) + QOUT = MAX(0.0,(VOL_LIQ(J)-parameters%SSI*EPORE(J))*DZSNSO(J)) IF(J == 0) THEN QOUT = MAX((VOL_LIQ(J)- EPORE(J))*DZSNSO(J) , parameters%SNOW_RET_FAC*DT*QOUT) END IF @@ -7087,11 +7230,16 @@ END SUBROUTINE SNOWH2O !== begin soilwater ================================================================================ - SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in + SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in QINSUR ,QSEVA ,ETRANI ,SICE ,ILOC , JLOC, & !in - SH2O ,SMC ,ZWT ,VEGTYP ,& !inout - SMCWTD, DEEPRECH ,& !inout - RUNSRF ,QDRAIN ,RUNSUB ,WCND ,FCRMAX ) !out + TDFRACMP, DX , & !in + SH2O ,SMC ,ZWT ,VEGTYP , & !inout + SMCWTD, DEEPRECH, & !inout + RUNSRF ,QDRAIN ,RUNSUB ,WCND ,FCRMAX, QTLDRN & !out +#ifdef WRF_HYDRO + ,WATBLED & !in for tile drainage +#endif + ) ! ---------------------------------------------------------------------- ! calculate surface runoff and soil moisture. @@ -7111,8 +7259,9 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL !depth of soil layer-bottom [m] REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ETRANI !evapotranspiration from soil layers [mm/s] REAL, DIMENSION(-NSNOW+1:NSOIL), INTENT(IN) :: DZSNSO !snow/soil layer depth [m] - REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SICE !soil ice content [m3/m3] - + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SICE !soil ice content [m3/m3] + REAL, INTENT(IN) :: DX + REAL, INTENT(IN) :: TDFRACMP! tile drainage map(fraction) INTEGER, INTENT(IN) :: VEGTYP ! input & output @@ -7121,11 +7270,15 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in REAL, INTENT(INOUT) :: ZWT !water table depth [m] REAL, INTENT(INOUT) :: SMCWTD !soil moisture between bottom of the soil and the water table [m3/m3] REAL , INTENT(INOUT) :: DEEPRECH + REAL , INTENT(INOUT) :: QTLDRN ! tile drainage (mm) per soil timestep +#ifdef WRF_HYDRO + REAL , INTENT(INOUT) :: WATBLED!in for tile drainage +#endif ! output REAL, INTENT(OUT) :: QDRAIN !soil-bottom free drainage [mm/s] - REAL, INTENT(OUT) :: RUNSRF !surface runoff [mm/s] - REAL, INTENT(OUT) :: RUNSUB !subsurface runoff [mm/s] + REAL, INTENT(OUT) :: RUNSRF !surface runoff [mm] per soil timestep + REAL, INTENT(OUT) :: RUNSUB !subsurface runoff [mm] per soil timestep REAL, INTENT(OUT) :: FCRMAX !maximum of FCR (-) REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: WCND !hydraulic conductivity (m/s) @@ -7159,6 +7312,7 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in INTEGER :: NITER !iteration times soil moisture (-) REAL :: SMCTOT !2-m averaged soil moisture (m3/m3) REAL :: DZTOT !2-m soil depth (m) + REAL :: FACC !accumulated infiltration rate (m/s) REAL, PARAMETER :: A = 4.0 ! ---------------------------------------------------------------------- RUNSRF = 0.0 @@ -7168,8 +7322,8 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in ! for the case when snowmelt water is too large DO K = 1,NSOIL - EPORE = MAX ( 1.E-4 , ( parameters%SMCMAX(K) - SICE(K) ) ) - RSAT = RSAT + MAX(0.,SH2O(K)-EPORE)*DZSNSO(K) + EPORE = MAX ( 1.0E-4 , ( parameters%SMCMAX(K) - SICE(K) ) ) + RSAT = RSAT + MAX(0.0,SH2O(K)-EPORE)*DZSNSO(K) SH2O(K) = MIN(EPORE,SH2O(K)) END DO @@ -7207,9 +7361,11 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in IF ( parameters%urban_flag ) FCR(1)= 0.95 IF(OPT_RUN == 1) THEN - FFF = 6.0 - FSAT = parameters%FSATMX*EXP(-0.5*FFF*(ZWT-2.0)) - IF(QINSUR > 0.) THEN +! FFF = 6.0 + FFF = parameters%BEXP(1) / 3.0 ! calibratable, C.He changed based on GY Niu's update +! FSAT = parameters%FSATMX*EXP(-0.5*FFF*(ZWT-2.0)) + FSAT = parameters%FSATMX*EXP(-0.5*FFF*ZWT) ! C.He changed based on GY Niu's update + IF(QINSUR > 0.0) THEN RUNSRF = QINSUR * ( (1.0-FCR(1))*FSAT + FCR(1) ) PDDUM = QINSUR - RUNSRF ! m/s END IF @@ -7217,7 +7373,7 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in IF(OPT_RUN == 5) THEN FFF = 6.0 - FSAT = parameters%FSATMX*EXP(-0.5*FFF*MAX(-2.0-ZWT,0.)) + FSAT = parameters%FSATMX*EXP(-0.5*FFF*MAX(-2.0-ZWT,0.0)) IF(QINSUR > 0.) THEN RUNSRF = QINSUR * ( (1.0-FCR(1))*FSAT + FCR(1) ) PDDUM = QINSUR - RUNSRF ! m/s @@ -7227,7 +7383,7 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in IF(OPT_RUN == 2) THEN FFF = 2.0 FSAT = parameters%FSATMX*EXP(-0.5*FFF*ZWT) - IF(QINSUR > 0.) THEN + IF(QINSUR > 0.0) THEN RUNSRF = QINSUR * ( (1.0-FCR(1))*FSAT + FCR(1) ) PDDUM = QINSUR - RUNSRF ! m/s END IF @@ -7240,22 +7396,35 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in END IF IF(OPT_RUN == 4) THEN - SMCTOT = 0. - DZTOT = 0. + SMCTOT = 0.0 + DZTOT = 0.0 DO K = 1,NSOIL DZTOT = DZTOT + DZSNSO(K) SMCTOT = SMCTOT + SMC(K)/parameters%SMCMAX(K)*DZSNSO(K) IF(DZTOT >= 2.0) EXIT END DO SMCTOT = SMCTOT/DZTOT - FSAT = MAX(0.01,SMCTOT) ** 4. !BATS + FSAT = MAX(0.01,SMCTOT) ** 4.0 !BATS - IF(QINSUR > 0.) THEN + IF(QINSUR > 0.0) THEN RUNSRF = QINSUR * ((1.0-FCR(1))*FSAT+FCR(1)) PDDUM = QINSUR - RUNSRF ! m/s END IF END IF + IF (OPT_RUN == 6) THEN + CALL COMPUTE_VIC_SURFRUNOFF(parameters,DT,NSOIL,SMC,ZSOIL,QINSUR,FSAT,RUNSRF,PDDUM) + END IF + + IF (OPT_RUN == 7) THEN + CALL COMPUTE_XAJ_SURFRUNOFF(parameters,DT,FCR,NSOIL,SMC,ZSOIL,QINSUR,RUNSRF,PDDUM) + END IF + + IF(OPT_RUN == 8)THEN + FACC = 1E-06 + CALL DYNAMIC_VIC(parameters,DT,SMC,SH2O,SICE,SICEMAX,NSOIL,ZSOIL,QINSUR,FACC,PDDUM,RUNSRF) + END IF + ! determine iteration times and finer time step NITER = 1 @@ -7270,16 +7439,32 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in DTFINE = DT / NITER ! solve soil moisture - + FACC = 1E-06 QDRAIN_SAVE = 0.0 RUNSRF_SAVE = 0.0 + DO ITER = 1, NITER - IF(QINSUR > 0. .and. OPT_RUN == 3) THEN + IF(QINSUR > 0.0 .and. OPT_RUN == 3) THEN CALL INFIL (parameters,NSOIL ,DTFINE ,ZSOIL ,SH2O ,SICE , & !in SICEMAX,QINSUR , & !in PDDUM ,RUNSRF ) !out END IF + IF(QINSUR > 0.0 .and. OPT_RUN == 6) THEN + CALL COMPUTE_VIC_SURFRUNOFF(parameters,DTFINE,NSOIL,SMC,ZSOIL,QINSUR,& !in + FSAT,RUNSRF,PDDUM) !out + END IF + + IF (QINSUR > 0.0 .AND. OPT_RUN == 7) THEN + CALL COMPUTE_XAJ_SURFRUNOFF(parameters,DTFINE,FCR,NSOIL,SMC,ZSOIL,QINSUR,& ! in + RUNSRF,PDDUM) ! out + END IF + + IF(QINSUR > 0.0 .and. OPT_RUN == 8) THEN + CALL DYNAMIC_VIC(parameters,DTFINE,SMC,SH2O,SICE,SICEMAX,NSOIL,& + ZSOIL,QINSUR,FACC,PDDUM,RUNSRF) + END IF + CALL SRT (parameters,NSOIL ,ZSOIL ,DTFINE ,PDDUM ,ETRANI , & !in QSEVA ,SH2O ,SMC ,ZWT ,FCR , & !in SICEMAX,FCRMAX ,ILOC ,JLOC ,SMCWTD , & !in @@ -7299,8 +7484,22 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in QDRAIN = QDRAIN_SAVE/NITER RUNSRF = RUNSRF_SAVE/NITER - RUNSRF = RUNSRF * 1000. + RSAT * 1000./DT ! m/s -> mm/s - QDRAIN = QDRAIN * 1000. + RUNSRF = RUNSRF * 1000.0 + RSAT * 1000.0/DT ! m/s -> mm/s + QDRAIN = QDRAIN * 1000.0 + +! Calling tile drainage ! pvk + IF (OPT_TDRN == 1 .AND. TDFRACMP .GT. 0.3 .AND. OPT_RUN == 3) THEN + print*, "simple tile drain scheme is on" + CALL TILE_DRAIN (parameters,NSOIL,SH2O,SMC,SICE,ZSOIL,QTLDRN,DT) + ELSE IF (OPT_TDRN == 2 .AND. TDFRACMP .GT. 0.1 .AND. OPT_RUN == 3) THEN + print*, "Hooghoudt tile drain scheme is on" + CALL TILE_HOOGHOUDT (parameters,WCND,NSOIL,NSNOW,SH2O,SMC,SICE,& + ZSOIL,DZSNSO,DT,DX,QTLDRN,ZWT & +#ifdef WRF_HYDRO + ,WATBLED & +#endif + ) + END IF !WRF_HYDRO_DJG... !yw INFXSRT = RUNSRF * DT !mm/s -> mm @@ -7308,14 +7507,14 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in ! removal of soil water due to groundwater flow (option 2) IF(OPT_RUN == 2) THEN - WTSUB = 0. + WTSUB = 0.0 DO K = 1, NSOIL WTSUB = WTSUB + WCND(K)*DZSNSO(K) END DO DO K = 1, NSOIL MH2O = RUNSUB*DT*(WCND(K)*DZSNSO(K))/WTSUB ! mm - SH2O(K) = SH2O(K) - MH2O/(DZSNSO(K)*1000.) + SH2O(K) = SH2O(K) - MH2O/(DZSNSO(K)*1000.0) END DO END IF @@ -7324,15 +7523,15 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in IF(OPT_RUN /= 1) THEN DO IZ = 1, NSOIL - MLIQ(IZ) = SH2O(IZ)*DZSNSO(IZ)*1000. + MLIQ(IZ) = SH2O(IZ)*DZSNSO(IZ)*1000.0 END DO WATMIN = 0.01 ! mm DO IZ = 1, NSOIL-1 - IF (MLIQ(IZ) .LT. 0.) THEN + IF (MLIQ(IZ) .LT. 0.0) THEN XS = WATMIN-MLIQ(IZ) ELSE - XS = 0. + XS = 0.0 END IF MLIQ(IZ ) = MLIQ(IZ ) + XS MLIQ(IZ+1) = MLIQ(IZ+1) - XS @@ -7342,14 +7541,14 @@ SUBROUTINE SOILWATER (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in IF (MLIQ(IZ) .LT. WATMIN) THEN XS = WATMIN-MLIQ(IZ) ELSE - XS = 0. + XS = 0.0 END IF MLIQ(IZ) = MLIQ(IZ) + XS RUNSUB = RUNSUB - XS/DT - IF(OPT_RUN == 5)DEEPRECH = DEEPRECH - XS*1.E-3 + IF(OPT_RUN == 5)DEEPRECH = DEEPRECH - XS*1.0E-3 DO IZ = 1, NSOIL - SH2O(IZ) = MLIQ(IZ) / (DZSNSO(IZ)*1000.) + SH2O(IZ) = MLIQ(IZ) / (DZSNSO(IZ)*1000.0) END DO END IF @@ -7387,7 +7586,7 @@ SUBROUTINE ZWTEQ (parameters,NSOIL ,NSNOW ,ZSOIL ,DZSNSO ,SH2O ,ZWT) REAL, DIMENSION(1:NFINE) :: ZFINE !layer-bottom depth of the 100-L soil layers to 6.0 m ! ---------------------------------------------------------------------- - WD1 = 0. + WD1 = 0.0 DO K = 1,NSOIL WD1 = WD1 + (parameters%SMCMAX(1)-SH2O(K)) * DZSNSO(K) ! [m] ENDDO @@ -7397,13 +7596,13 @@ SUBROUTINE ZWTEQ (parameters,NSOIL ,NSNOW ,ZSOIL ,DZSNSO ,SH2O ,ZWT) ZFINE(K) = FLOAT(K) * DZFINE ENDDO - ZWT = -3.*ZSOIL(NSOIL) - 0.001 ! initial value [m] + ZWT = -3.0*ZSOIL(NSOIL) - 0.001 ! initial value [m] - WD2 = 0. + WD2 = 0.0 DO K = 1,NFINE - TEMP = 1. + (ZWT-ZFINE(K))/parameters%PSISAT(1) - WD2 = WD2 + parameters%SMCMAX(1)*(1.-TEMP**(-1./parameters%BEXP(1)))*DZFINE - IF(ABS(WD2-WD1).LE.0.01) THEN + TEMP = 1.0 + (ZWT-ZFINE(K))/parameters%PSISAT(1) + WD2 = WD2 + parameters%SMCMAX(1)*(1.0-TEMP**(-1.0/parameters%BEXP(1)))*DZFINE + IF(ABS(WD2-WD1) .LE. 0.01) THEN ZWT = ZFINE(K) EXIT ENDIF @@ -7453,7 +7652,7 @@ SUBROUTINE INFIL (parameters,NSOIL ,DT ,ZSOIL ,SH2O ,SICE , & !in ! -------------------------------------------------------------------------------- IF (QINSUR > 0.0) THEN - DT1 = DT /86400. + DT1 = DT /86400.0 SMCAV = parameters%SMCMAX(1) - parameters%SMCWLT(1) ! maximum infiltration rate @@ -7471,17 +7670,17 @@ SUBROUTINE INFIL (parameters,NSOIL ,DT ,ZSOIL ,SH2O ,SICE , & !in DD = DD + DMAX(K) END DO - VAL = (1. - EXP ( - parameters%KDT * DT1)) + VAL = (1.0 - EXP ( - parameters%KDT * DT1)) DDT = DD * VAL - PX = MAX(0.,QINSUR * DT) + PX = MAX(0.0,QINSUR * DT) INFMAX = (PX * (DDT / (PX + DDT)))/ DT ! impermeable fraction due to frozen soil - FCR = 1. - IF (DICE > 1.E-2) THEN + FCR = 1.0 + IF (DICE > 1.0E-2) THEN ACRT = CVFRZ * parameters%FRZX / DICE - SUM = 1. + SUM = 1.0 IALP1 = CVFRZ - 1 DO J = 1,IALP1 K = 1 @@ -7490,7 +7689,7 @@ SUBROUTINE INFIL (parameters,NSOIL ,DT ,ZSOIL ,SH2O ,SICE , & !in END DO SUM = SUM + (ACRT ** (CVFRZ - J)) / FLOAT(K) END DO - FCR = 1. - EXP (-ACRT) * SUM + FCR = 1.0 - EXP (-ACRT) * SUM END IF ! correction of infiltration limitation @@ -7504,7 +7703,7 @@ SUBROUTINE INFIL (parameters,NSOIL ,DT ,ZSOIL ,SH2O ,SICE , & !in INFMAX = MAX (INFMAX,WCND) INFMAX = MIN (INFMAX,PX) - RUNSRF= MAX(0., QINSUR - INFMAX) + RUNSRF= MAX(0.0, QINSUR - INFMAX) PDDUM = QINSUR - RUNSRF END IF @@ -7601,9 +7800,9 @@ SUBROUTINE SRT (parameters,NSOIL ,ZSOIL ,DT ,PDDUM ,ETRANI , & !in ELSE DENOM(K) = (ZSOIL(K-1) - ZSOIL(K)) IF(OPT_RUN == 1 .or. OPT_RUN == 2) THEN - QDRAIN = 0. + QDRAIN = 0.0 END IF - IF(OPT_RUN == 3) THEN + IF(OPT_RUN == 3 .OR. OPT_RUN == 6 .OR. OPT_RUN == 7 .OR. OPT_RUN == 8) THEN QDRAIN = parameters%SLOPE*WCND(K) END IF IF(OPT_RUN == 4) THEN @@ -7613,13 +7812,14 @@ SUBROUTINE SRT (parameters,NSOIL ,ZSOIL ,DT ,PDDUM ,ETRANI , & !in TEMP1 = 2.0 * DENOM(K) IF(ZWT < ZSOIL(NSOIL)-DENOM(NSOIL))THEN !gmm interpolate from below, midway to the water table, to the middle of the auxiliary layer below the soil bottom - SMXBOT = SMX(K) - (SMX(K)-SMXWTD) * DENOM(K) * 2./ (DENOM(K) + ZSOIL(K) - ZWT) + SMXBOT = SMX(K) - (SMX(K)-SMXWTD) * DENOM(K) * 2.0/ (DENOM(K) + ZSOIL(K) - ZWT) ELSE SMXBOT = SMXWTD ENDIF DSMDZ(K) = 2.0 * (SMX(K) - SMXBOT) / TEMP1 QDRAIN = WDF(K ) * DSMDZ(K ) + WCND(K ) - END IF + END IF + WFLUX(K) = -(WDF(K-1)*DSMDZ(K-1))-WCND(K-1)+ETRANI(K) + QDRAIN END IF END DO @@ -7695,10 +7895,10 @@ SUBROUTINE SSTEP (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in WPLUS = 0.0 DO K = 1,NSOIL - RHSTT (K) = RHSTT(K) * DT - AI (K) = AI(K) * DT - BI (K) = 1. + BI(K) * DT - CI (K) = CI(K) * DT + RHSTT (K) = RHSTT(K) * DT + AI (K) = AI(K) * DT + BI (K) = 1.0 + BI(K) * DT + CI (K) = CI(K) * DT END DO ! copy values for input variables before calling rosr12 @@ -7730,9 +7930,9 @@ SUBROUTINE SSTEP (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in ELSE SMCWTD = SMCWTD + DT * QDRAIN / DZSNSO(NSOIL) WPLUS = MAX((SMCWTD-parameters%SMCMAX(NSOIL)), 0.0) * DZSNSO(NSOIL) - WMINUS = MAX((1.E-4-SMCWTD), 0.0) * DZSNSO(NSOIL) + WMINUS = MAX((1.0E-4-SMCWTD), 0.0) * DZSNSO(NSOIL) - SMCWTD = MAX( MIN(SMCWTD,parameters%SMCMAX(NSOIL)) , 1.E-4) + SMCWTD = MAX( MIN(SMCWTD,parameters%SMCMAX(NSOIL)) , 1.0E-4) SH2O(NSOIL) = SH2O(NSOIL) + WPLUS/DZSNSO(NSOIL) !reduce fluxes at the bottom boundaries accordingly @@ -7743,26 +7943,26 @@ SUBROUTINE SSTEP (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in ENDIF DO K = NSOIL,2,-1 - EPORE = MAX ( 1.E-4 , ( parameters%SMCMAX(K) - SICE(K) ) ) + EPORE = MAX ( 1.0E-4 , ( parameters%SMCMAX(K) - SICE(K) ) ) WPLUS = MAX((SH2O(K)-EPORE), 0.0) * DZSNSO(K) SH2O(K) = MIN(EPORE,SH2O(K)) SH2O(K-1) = SH2O(K-1) + WPLUS/DZSNSO(K-1) END DO - EPORE = MAX ( 1.E-4 , ( parameters%SMCMAX(1) - SICE(1) ) ) + EPORE = MAX ( 1.0E-4 , ( parameters%SMCMAX(1) - SICE(1) ) ) WPLUS = MAX((SH2O(1)-EPORE), 0.0) * DZSNSO(1) SH2O(1) = MIN(EPORE,SH2O(1)) IF(WPLUS > 0.0) THEN SH2O(2) = SH2O(2) + WPLUS/DZSNSO(2) DO K = 2,NSOIL-1 - EPORE = MAX ( 1.E-4 , ( parameters%SMCMAX(K) - SICE(K) ) ) + EPORE = MAX ( 1.0E-4 , ( parameters%SMCMAX(K) - SICE(K) ) ) WPLUS = MAX((SH2O(K)-EPORE), 0.0) * DZSNSO(K) SH2O(K) = MIN(EPORE,SH2O(K)) SH2O(K+1) = SH2O(K+1) + WPLUS/DZSNSO(K+1) END DO - EPORE = MAX ( 1.E-4 , ( parameters%SMCMAX(NSOIL) - SICE(NSOIL) ) ) + EPORE = MAX ( 1.0E-4 , ( parameters%SMCMAX(NSOIL) - SICE(NSOIL) ) ) WPLUS = MAX((SH2O(NSOIL)-EPORE), 0.0) * DZSNSO(NSOIL) SH2O(NSOIL) = MIN(EPORE,SH2O(NSOIL)) END IF @@ -7771,6 +7971,1182 @@ SUBROUTINE SSTEP (parameters,NSOIL ,NSNOW ,DT ,ZSOIL ,DZSNSO , & !in END SUBROUTINE SSTEP +!==begin VIC subroutines ========================================================================== + + SUBROUTINE COMPUTE_VIC_SURFRUNOFF(parameters,DT,NSOIL,SMC,ZSOIL,QINSUR,ASAT,RUNSRF,PDDUM) + +! ---------------------------------------------------------------------- +! Calculate the saturated area and runoff based on VIC runoff scheme. +! This scheme adopted from VIC model +! Author: Prasanth Valayamkunnath +! ---------------------------------------------------------------------- + IMPLICIT NONE +! ---------------------------------------------------------------------- + +! Inputs + TYPE (noahmp_parameters), INTENT(IN) :: parameters + INTEGER, INTENT(IN) :: NSOIL + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL + REAL , INTENT(IN) :: QINSUR + REAL , INTENT(IN) :: DT + REAL , INTENT(OUT) :: ASAT +! Output + REAL , INTENT(INOUT):: RUNSRF + REAL , INTENT(INOUT):: PDDUM +!------------------------------------------------------------------------ +!local + REAL :: EX, I_0, I_MAX, BASIS, TOP_MOIST, TOP_MAX_MOIST + INTEGER :: IZ + +! Initialize Variables + EX = 0.0 + ASAT = 0.0 + I_MAX = 0.0 + I_0 = 0.0 + BASIS = 0.0 + TOP_MOIST = 0.0 + TOP_MAX_MOIST = 0.0 + RUNSRF = 0.0 + + DO IZ=1,NSOIL-2 + TOP_MOIST = TOP_MOIST + (SMC(IZ)*-1.0*ZSOIL(IZ)) ! m + TOP_MAX_MOIST = TOP_MAX_MOIST + (parameters%SMCMAX(IZ)*-1.0*ZSOIL(IZ)) ! m + END DO + + ! Saturated area from soil moisture + EX = parameters%BVIC/(1.0+parameters%BVIC) + ASAT = 1.0 - (( max(0.0,(1.0 - (TOP_MOIST/TOP_MAX_MOIST))))**EX) ! + ASAT = MAX(0.0, ASAT) + ASAT = MIN(1.0, ASAT) + + ! Infiltration for the previous time-step soil moisture based on ASAT + I_MAX = (1.0 + parameters%BVIC)*TOP_MAX_MOIST ! m + I_0 = I_MAX*(1.0 - (1.0 - ASAT)**(1.0/parameters%BVIC)) !m + + ! Solve for surface runoff + IF(QINSUR .EQ. 0.0) THEN + RUNSRF = 0.0 + ELSE IF(I_MAX .EQ. 0.0) THEN + RUNSRF = QINSUR*DT + ELSE IF( (I_0 + (QINSUR*DT)) .GT. I_MAX ) THEN + RUNSRF = (QINSUR*DT) - TOP_MAX_MOIST + TOP_MOIST + ELSE + BASIS = 1.0 - ((I_0 + (QINSUR*DT))/I_MAX) + RUNSRF = (QINSUR*DT) - TOP_MAX_MOIST + TOP_MOIST + & + TOP_MAX_MOIST*(basis**(1.0+parameters%BVIC)) + END IF + + RUNSRF = RUNSRF/(DT) ! m/s + IF (RUNSRF .LT. 0.0) RUNSRF = 0.0 + IF (RUNSRF .GT. QINSUR)RUNSRF = QINSUR + + PDDUM = QINSUR - RUNSRF ! m/s + + END SUBROUTINE COMPUTE_VIC_SURFRUNOFF + +! End VIC subroutines + +!== begin xinanjiag================================================================================= + + SUBROUTINE COMPUTE_XAJ_SURFRUNOFF(parameters,DT,FCR,NSOIL,SMC,ZSOIL,QINSUR,RUNSRF,PDDUM) + +! ---------------------------------------------------------------------- +! Calculate the saturated area and runoff based on Xinanjiag runoff scheme. +! Reference: Knoben, W. J., Freer, J. E., Fowler, K. J., Peel, M. C., & Woods, R. A. (2019). +! Modular Assessment of Rainfall-Runoff Models Toolbox (MARRMoT) v1. 2: +! an open-source, extendable framework providing implementations of 46 conceptual +! hydrologic models as continuous state-space formulations. +! ---------------------------------------------------------------------- +! Author: Prasanth Valayamkunnath +! Date: August 03, 2020 +! ---------------------------------------------------------------------- + + IMPLICIT NONE +! ---------------------------------------------------------------------- +! Inputs + TYPE (noahmp_parameters), INTENT(IN) :: parameters + INTEGER, INTENT(IN) :: NSOIL + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: FCR !fraction of imperviousness (-) = IMP + REAL , INTENT(IN) :: QINSUR + REAL , INTENT(IN) :: DT +! Output + REAL , INTENT(INOUT):: RUNSRF + REAL , INTENT(INOUT):: PDDUM +! local + REAL :: WM,WM_MAX,SM,SM_MAX,IRUNOFF,PRUNOFF + INTEGER :: IZ +!------------------------------------------------------------------------ + +!initialize + WM = 0.0 + WM_MAX = 0.0 + SM = 0.0 + SM_MAX = 0.0 + IRUNOFF = 0.0 + PRUNOFF = 0.0 + RUNSRF = 0.0 + + DO IZ=1,NSOIL-2 + IF ((SMC(IZ)-parameters%SMCREF(IZ)) .GT. 0.0) THEN ! soil moisture greater than field capacity + SM = SM + (SMC(IZ) - parameters%SMCREF(IZ) )*-1.0*ZSOIL(IZ) !m + WM = WM + (parameters%SMCREF(IZ)*-1.0*ZSOIL(IZ)) !m + ELSE + WM = WM + (SMC(IZ)*-1.0*ZSOIL(IZ)) + END IF + WM_MAX = WM_MAX + (parameters%SMCREF(IZ)*-1.0*ZSOIL(IZ)) + SM_MAX = SM_MAX + (parameters%SMCMAX(IZ) - parameters%SMCREF(IZ))*-1.0*ZSOIL(IZ) + END DO + WM = MIN(WM,WM_MAX) ! tension water (m) + SM = MIN(SM,SM_MAX) ! free water (m) + +! impervious surface runoff R_IMP + IRUNOFF = FCR(1)*QINSUR*DT + +! solve pervious surface runoff (m) based on Eq. (310) + IF ((WM/WM_MAX) .LE. (0.5-parameters%AXAJ))THEN + PRUNOFF = (1.0-FCR(1))*QINSUR*DT*((0.5-parameters%AXAJ)**(1.0-parameters%BXAJ))*((WM/WM_MAX)**parameters%BXAJ) + ELSE + PRUNOFF = (1.0-FCR(1))*QINSUR*DT*(1.0-(((0.5+parameters%AXAJ)**(1.0-parameters%BXAJ))*((1.0-(WM/WM_MAX))**parameters%BXAJ))) + END IF + +! estimate surface runoff based on Eq. (313) + IF(QINSUR .EQ. 0.0) THEN + RUNSRF = 0.0 + ELSE + RUNSRF = PRUNOFF*(1.0-((1.0-(SM/SM_MAX))**parameters%XXAJ))+IRUNOFF + END IF + RUNSRF = RUNSRF/DT !m/s + RUNSRF = MAX(0.0, RUNSRF) + RUNSRF = MIN(QINSUR, RUNSRF) + PDDUM = QINSUR - RUNSRF + + END SUBROUTINE COMPUTE_XAJ_SURFRUNOFF + +!== end xinanjiag ================================================================================== + +!== begin dynamic VIC ============================================================================== + + SUBROUTINE DYNAMIC_VIC(parameters,DT,SMC,SH2O,SICE,SICEMAX,NSOIL,ZSOIL,QINSUR,FACC,PDDUM,RUNSRF) + +! -------------------------------------------------------------------------------- +! compute inflitration rate at soil surface and estimate surface runoff based on +! Liang, X., & Xie, Z. (2001). A new surface runoff parameterization with subgrid-scale +! soil heterogeneity for land surface models. Advances in Water Resources, 24(9-10), 1173-1193. +! Author: Prasanth Valayamkunnath +! Date : August 3, 2020 +! -------------------------------------------------------------------------------- + + IMPLICIT NONE +! -------------------------------------------------------------------------------- +! inputs + type (noahmp_parameters), intent(in) :: parameters + INTEGER, INTENT(IN) :: NSOIL !no. of soil layers + REAL, INTENT(IN) :: DT !time step (sec) + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL !depth of soil layer-bottom [m] + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SH2O !soil liquid water content [m3/m3] + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SICE !soil ice content [m3/m3] + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC !soil moisture content [m3/m3] + REAL, INTENT(IN) :: QINSUR !water input on soil surface [m/s] + REAL, INTENT(IN) :: SICEMAX !maximum soil ice content (m3/m3) +! inouts + REAL, INTENT(INOUT) :: FACC !accumulated infiltration (m) +! outputs + REAL, INTENT(OUT) :: RUNSRF !surface runoff [mm/s] + REAL, INTENT(OUT) :: PDDUM !infiltration rate at surface +! locals + REAL :: BB !B parameter for infiltration scaling curve + REAL :: TOP_MOIST !actual water depth in top layers (m) + REAL :: TOP_MAX_MOIST !water depth in top layers (m) + REAL :: DP !water input on soil surface (m) + REAL :: I_0 !initial water depth (m) + REAL :: I_MAX !maximum water depth (m) + REAL :: FSUR !surface infiltration rate (m/s) + REAL :: FMAX !maximum infiltration rate (m/s) + REAL :: RUNOFFSAT !saturation excess runoff (m/s) + REAL :: RUNOFFINF !infiltration excess runoff (m/s) + REAL :: INFILTRTN !infiltration (m/s) + REAL :: TEMPR1 !temporary saturation excess runoff (m/s) + REAL :: TEMPR2 !temporary infiltration excess runoff (m/s) + REAL :: R1 !saturation excess runoff (m/s) + REAL :: R2 !infiltration excess runoff (m/s) + REAL :: YD !initial depth Y (m) + REAL :: YD_OLD !initial depth Y (m) + REAL :: YD0 !initial depth Y (m) + REAL :: TEMP1, ERROR + INTEGER :: IZ, IZMAX, INFLMAX +!--------------------------------------------------------------------------------- + + TOP_MOIST = 0.0 + TOP_MAX_MOIST = 0.0 + BB = 1.0 + DP = 0.0 + I_MAX = 0.0 + I_0 = 0.0 + RUNOFFSAT = 0.0 + RUNOFFINF = 0.0 + INFILTRTN = 0.0 + RUNSRF = 0.0 + IZMAX = 20 + ERROR = 1.388889E-07*DT ! 0.5 mm per hour time step + BB = parameters%BBVIC + + DO IZ=1,NSOIL-2 + TOP_MOIST = TOP_MOIST + (SMC(IZ)*-1.0*ZSOIL(IZ)) ! actual moisture in top layers, [m] + TOP_MAX_MOIST = TOP_MAX_MOIST + (parameters%SMCMAX(IZ)*-1.0*ZSOIL(IZ)) ! maximum moisture in top layers, [m] + END DO + + IF(TOP_MOIST .GT. TOP_MAX_MOIST) TOP_MOIST = TOP_MAX_MOIST + DP = QINSUR * DT ! precipitation depth, [m] + I_MAX = TOP_MAX_MOIST * (parameters%BDVIC+1.0) ! maximum infiltration capacity, im, [m], Eq. 14 + I_0 = I_MAX * (1.0-(1.0-(TOP_MOIST/TOP_MAX_MOIST)**(1.0/(1.0+parameters%BDVIC)))) ! infiltration capacity, i [m] in the Eq. 1 + ! I_MAX = CAP_minf ; I_0 = A + INFLMAX = 0 + + IF (OPT_INFDV .EQ. 1) THEN + CALL PHILIP_INFIL(parameters,NSOIL,SMC,SICE,QINSUR,DT,FACC,FSUR,INFLMAX) + ELSE IF (OPT_INFDV .EQ. 2) THEN + CALL GREEN_AMPT_INFIL(parameters,NSOIL,ZSOIL,SMC,SICE,QINSUR,FACC,FSUR,INFLMAX) + ELSE IF (OPT_INFDV .EQ. 3) THEN + CALL SMITH_PARLANGE_INFIL(parameters,NSOIL,ZSOIL,SMC,SICE,QINSUR,FACC,FSUR,INFLMAX) + END IF + + ! I_MM = FSUR; I_M = FMAX + FMAX = (BB+1.0)*FSUR + IF(DP .LE. 0.0) THEN + RUNOFFSAT = 0.0 + RUNOFFINF = 0.0 + INFILTRTN = 0.0 + GOTO 2001 + ELSE + IF((TOP_MOIST .GE. TOP_MAX_MOIST) .AND. (I_0 .GE. I_MAX)) THEN + TOP_MOIST = TOP_MAX_MOIST + I_0 = I_MAX + RUNOFFSAT = DP + RUNOFFINF = 0.0 + INFILTRTN = 0.0 + GOTO 2001 + ELSE + I_0 = I_MAX * (1.0-(1.0-(TOP_MOIST/TOP_MAX_MOIST)**(1.0/(1.0+parameters%BDVIC)))) + IF((DP+I_0) .GT. I_MAX)THEN + IF((FMAX*DT) .GE. DP) THEN + YD = I_MAX - I_0 + TEMPR1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + TEMP1 = I_MAX-I_0-TEMPR1-((FSUR*DT) * (1.0 - (1.0-((DP-TEMPR1)/(FMAX*DT))**(BB+1.0)))) + IF(TEMP1 .LE. 0.0) THEN + YD = I_MAX - I_0 + INFILTRTN = TOP_MAX_MOIST - TOP_MOIST + RUNOFFSAT = DP - INFILTRTN + RUNOFFINF = 0.0 + TOP_MOIST = TOP_MAX_MOIST + I_0 = I_MAX + GOTO 2001 + ELSE + YD = 0.0 + + DO IZ = 1,IZMAX ! loop : IITERATION1 + YD_OLD = YD + TEMPR1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + YD = TEMPR1 + ((FSUR*DT) * (1.0 - (1.0-((DP-TEMPR1)/(FMAX*DT))**(BB+1.0)))) + IF ((ABS(YD-YD_OLD) .LE. ERROR) .OR. (IZ .EQ. IZMAX)) THEN + GOTO 1003 + END IF + END DO + END IF + ELSE + TEMPR1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + IF((TEMPR1+(FMAX*DT)) .LE. DP) THEN + IF((I_MAX-I_0-TEMPR1-(FMAX*DT)) .LE. 0.0)THEN + YD = I_MAX - I_0 + INFILTRTN = TOP_MAX_MOIST - TOP_MOIST + RUNOFFSAT = DP - INFILTRTN + RUNOFFINF = 0.0 + TOP_MOIST = TOP_MAX_MOIST + I_0 = I_MAX + GOTO 2001 + ELSE + YD = 0.0 + + DO IZ = 1,IZMAX ! loop : IITERATION2 + YD_OLD = YD + TEMPR1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + YD = TEMPR1 + (FSUR*DT) + IF ((ABS(YD-YD_OLD) .LE. ERROR) .OR. (IZ .EQ. IZMAX)) THEN + GOTO 1003 + END IF + END DO + END IF + + ELSE + + YD = DP/2.0 + DO IZ = 1,IZMAX ! loop : IITERATION30 + YD_OLD = YD + TEMPR1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + YD = YD - TEMPR1 - (FSUR*DT) + DP + IF (YD .LE. 0.0) YD = 0.0 + IF (YD .GE. DP) YD = DP + IF ((ABS(YD-YD_OLD) .LE. ERROR) .OR. (IZ .EQ. IZMAX)) THEN + YD0 = YD + EXIT + END IF + END DO + DO IZ = 1,IZMAX ! loop : IITERATION3 + YD_OLD = YD + TEMPR1 = 0.0 + TEMPR2 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + CALL RR2(YD,YD0,TEMPR1,FMAX,FSUR,DT,DP,BB,TEMPR2) + YD = DP - TEMPR2 + IF ((ABS(YD-YD_OLD) .LE. ERROR) .OR. (IZ .EQ. IZMAX)) THEN + GOTO 1003 + END IF + END DO +1003 IF(YD .LE. 0.0) YD = 0.0 + IF(YD .GE. DP) YD = DP + CALL RR1(parameters,I_0,I_MAX,YD,R1) + RUNOFFSAT = R1 + RUNOFFINF = DP - YD + INFILTRTN = YD - RUNOFFSAT + TOP_MOIST = TOP_MOIST + INFILTRTN + YD = I_0+YD + IF (TOP_MOIST .LE. 0.0) TOP_MOIST=0.0 + IF (TOP_MOIST .GE. TOP_MAX_MOIST) TOP_MOIST = TOP_MAX_MOIST + I_0 = I_MAX * (1.0-(1.0-(TOP_MOIST/TOP_MAX_MOIST)**(1.0/(1.0+parameters%BDVIC)))) + GOTO 2001 + END IF + END IF + + ELSE + IF((FMAX*DT) .GE. DP) THEN + YD = DP/2.0 + DO IZ = 1,IZMAX ! ITERATION1 + YD_OLD = YD + TEMPR1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + YD = TEMPR1 + ((FSUR*DT) * (1.0 - (1.0-((DP-TEMPR1)/(FMAX*DT))**(BB+1.0)))) + !print*,'YD=',YD,'YD_OLD=',YD_OLD,'ERROR=',ABS(YD - YD_OLD),'IZ=',IZ,'ERROR2=',ERROR,'DT=',DT + IF ((ABS(YD - YD_OLD) .LE. ERROR) .OR. (IZ .EQ. IZMAX)) THEN + GOTO 1004 + END IF + END DO + ELSE + TEMPR1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + IF((TEMPR1+(FMAX*DT)) .LE. DP)THEN + YD = DP/2.0 + DO IZ = 1,IZMAX ! ITERATION2 + YD_OLD = YD + TEMPR1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + YD = TEMPR1+(FSUR*DT) + IF((ABS(YD - YD_OLD) .LE. ERROR) .OR. (IZ .EQ. IZMAX)) THEN + GOTO 1004 + END IF + END DO + ELSE + YD = 0.0 + DO IZ = 1,IZMAX ! ITERATION30 + YD_OLD = YD + TEMPR1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + YD = (DP - (FMAX*DT)) + YD - TEMPR1 + IF(YD .LE. 0.0) YD = 0.0 + IF(YD .GE. DP) YD = DP + TEMPR1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + IF ((ABS(TEMPR1+(FMAX*DT)-DP) .LE. ERROR) .OR. (IZ .EQ. IZMAX)) THEN + YD0 = YD + EXIT + END IF + END DO + DO IZ = 1,IZMAX ! ITERATION3 + YD_OLD = YD + TEMPR1 = 0.0 + TEMPR2 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,TEMPR1) + CALL RR2(YD,YD0,TEMPR1,FMAX,FSUR,DT,DP,BB,TEMPR2) + YD = DP - TEMPR2 + IF ((ABS(YD-YD_OLD) .LE. ERROR) .OR. (IZ .EQ. IZMAX)) THEN + GOTO 1004 + END IF + END DO + END IF + END IF +1004 IF(YD .LE. 0.0) YD = 0.0 + IF(YD .GE. DP) YD = DP + R1 = 0.0 + CALL RR1(parameters,I_0,I_MAX,YD,R1) + RUNOFFSAT = R1 + RUNOFFINF = DP - YD + INFILTRTN = YD - RUNOFFSAT + TOP_MOIST = TOP_MOIST + INFILTRTN + IF (TOP_MOIST .LE. 0.0) TOP_MOIST=0.0 + IF (TOP_MOIST .GE. TOP_MAX_MOIST) TOP_MOIST = TOP_MAX_MOIST + I_0 = I_MAX * (1.0-(1.0-(TOP_MOIST/TOP_MAX_MOIST)**(1.0/(1.0+parameters%BDVIC)))) + END IF + END IF + END IF + +2001 RUNSRF = (RUNOFFSAT + RUNOFFINF)/DT + RUNSRF = MIN(RUNSRF,QINSUR) + RUNSRF = MAX(RUNSRF,0.0) + PDDUM = QINSUR - RUNSRF + + END SUBROUTINE DYNAMIC_VIC + +! --------------------------- Runoff subroutines for dynamic VIC ---------------------------- + + SUBROUTINE RR1 (parameters,I_0,I_MAX,YD,R1) +!--------------------------------------------------------------------------------------------- +! This subroutine estimate saturation excess runoff, R1 +! Author: Prasanth Valayamkunnath +!--------------------------------------------------------------------------------------------- + IMPLICIT NONE +! -------------------------------------------------------------------------------------------- + type (noahmp_parameters), intent(in) :: parameters + REAL, INTENT(IN) :: I_0,I_MAX,YD + REAL, INTENT(OUT):: R1 + REAL :: TDEPTH +!------------------------------------------------------ + + TDEPTH = I_0 + YD + IF(TDEPTH .GT. I_MAX) TDEPTH = I_MAX + + !Saturation excess runoff , Eq 5. + R1 = YD - ( (I_MAX/(parameters%BDVIC+1.0)) * ( ((1.0 - (I_0/I_MAX))**(parameters%BDVIC+1.0)) & + - ((1.0 - (TDEPTH/I_MAX))**(parameters%BDVIC+1.0)))) + + IF (R1 .LT. 0.0) R1 = 0.0 + + END SUBROUTINE RR1 + +!--------------------------------------------------------------------------------------------- + SUBROUTINE RR2 (YD,Y0,R1,FMAX,FSUR,DT,DP,BB,R2) +!--------------------------------------------------------------------------------------------- +! This subroutine estimate infiltration excess runoff, R1 +! Author: Prasanth Valayamkunnath +!--------------------------------------------------------------------------------------------- + IMPLICIT NONE +! -------------------------------------------------------------------------------------------- + REAL, INTENT(IN) :: YD,Y0,R1,FMAX,FSUR,DT,DP,BB + REAL, INTENT(OUT):: R2 +!------------------------------------------------------ + + IF(YD .GE. Y0)THEN + R2 = DP - R1 - (FMAX*DT* (1.0 - ((1.0 - (DP-R1)/(FMAX*DT))**(BB+1.0)))) + ELSE + R2 = DP - R1 - (FMAX*DT) + END IF + + IF(R2 .LT. 0.0) R2 =0.0 + +END SUBROUTINE RR2 + +!== end dynamic VIC ================================================================================ + +!== begin smith-parlange infiltration =============================================================== + + SUBROUTINE SMITH_PARLANGE_INFIL(parameters,NSOIL,ZSOIL,SMC,SICE,QINSUR,FACC,FSUR,INFLMAX) + +!--------------------------------------------------------------------------------------------- +! This function estimate infiltration rate based on Smith-Parlange equation. We use its three +! parameter version of the equation (Eq. 6.25) from Smith, R.E. (2002) Infiltration Theory for +! Hydrologic Applications, Water Resources Monograph 15, AGU. +! Author: Prasanth Valayamkunnath +!--------------------------------------------------------------------------------------------- + IMPLICIT NONE +! -------------------------------------------------------------------------------------------- + type (noahmp_parameters), intent(in) :: parameters + INTEGER, INTENT(IN) :: NSOIL !no of soil layers (4) + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL !depth of soil layer-bottom [m] + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC !soil moisture content [m3/m3] + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SICE !soil ice content [m3/m3] + REAL, INTENT(IN) :: QINSUR !water input on soil surface [m/s] + INTEGER, INTENT(IN) :: INFLMAX!check for maximum infiltration at SMCWLT +! in outs + REAL, INTENT(INOUT) :: FACC !accumulated infiltration rate (m/s) +! outputs + REAL, INTENT(OUT) :: FSUR !surface infiltration rate (m/s) +! local variables + REAL :: WDF ! soil water diffusivity + REAL :: WCND ! soil water conductivity[m/s] + REAL :: GAM ! smith-parlang weighing parameter[-] + REAL :: JJ ! dummy variable + INTEGER :: ISOIL +!--------------------------------------------------------------------------------- + + ! smith-parlang weighing parameter, GAMMA + GAM = 0.82 + ISOIL = 1 + ! check whether we are estimating infiltration for current SMC or SMCWLT + IF (INFLMAX .EQ. 1)THEN ! not active for now as the maximum infiltration is estimated based on table values + + ! estimate initial soil hydraulic conductivty (Ki in the equation), WCND (m/s) + CALL WDFCND2 (parameters,WDF,WCND,parameters%SMCWLT(ISOIL),0.0,ISOIL) + + ! Maximum infiltrability based on the Eq. 6.25. (m/s) + JJ = parameters%GDVIC * (parameters%SMCMAX(ISOIL) - parameters%SMCWLT(ISOIL)) * -1.0 * ZSOIL(ISOIL) + FSUR = parameters%DKSAT(ISOIL) + (GAM * (parameters%DKSAT(ISOIL) - WCND) / (EXP(GAM * FACC / JJ) -1.0)) + + ! infiltration rate at surface + IF(parameters%DKSAT(ISOIL) .LT. QINSUR)THEN + FSUR = MIN(QINSUR,FSUR) + ELSE + FSUR = QINSUR + END IF + IF(FSUR .LT. 0.0) FSUR = WCND + + ELSE + + ! estimate initial soil hydraulic conductivty (Ki in the equation), WCND (m/s) + CALL WDFCND2 (parameters,WDF,WCND,SMC(ISOIL),SICE(ISOIL),ISOIL) + + ! Maximum infiltrability based on the Eq. 6.25. (m/s) + JJ = parameters%GDVIC * max(0.0,(parameters%SMCMAX(ISOIL) - SMC(ISOIL))) * -1.0 * ZSOIL(ISOIL) + + IF(JJ == 0.0)THEN ! infiltration at surface == saturated hydraulic conductivity + FSUR = WCND + ELSE + FSUR = parameters%DKSAT(ISOIL) + (GAM * (parameters%DKSAT(ISOIL) - WCND) / (EXP(GAM * FACC / JJ) -1.0)) + END IF + + ! infiltration rate at surface + IF(parameters%DKSAT(ISOIL) .LT. QINSUR)THEN + FSUR = MIN(QINSUR,FSUR) + ELSE + FSUR = QINSUR + END IF + + ! accumulated infiltration function + FACC = FACC + FSUR + + END IF + + END SUBROUTINE SMITH_PARLANGE_INFIL + +!== end smith-parlang infiltration ================================================================= + +!== begin Green_Ampt infiltration ================================================================== + + SUBROUTINE GREEN_AMPT_INFIL(parameters,NSOIL,ZSOIL,SMC,SICE,QINSUR,FACC,FSUR,INFLMAX) + +!------------------------------------------------------------------------------------------------- +! This function estimate infiltration rate based on Green-Ampt equation. We use its three +! parameter version of the smith-parlage equation (Eq. 6.25) from Smith, R.E. (2002) Infiltration Theory for +! Hydrologic Applications, Water Resources Monograph 15, AGU. Where gamma = 0, Eq 6.25 = Green-Ampt. +! Author: Prasanth Valayamkunnath +!------------------------------------------------------------------------------------------------- + IMPLICIT NONE +! ------------------------------------------------------------------------------------------------ + type (noahmp_parameters), intent(in) :: parameters + INTEGER, INTENT(IN) :: NSOIL !no of soil layers (4) + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL !depth of soil layer-bottom [m] + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC !soil moisture content [m3/m3] + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SICE !soil ice content [m3/m3] + REAL, INTENT(IN) :: QINSUR !water input on soil surface [m/s] + INTEGER, INTENT(IN) :: INFLMAX!check for maximum infiltration at SMCWLT +! in outs + REAL, INTENT(INOUT) :: FACC !accumulated infiltration rate (m/s) +! outputs + REAL, INTENT(OUT) :: FSUR !surface infiltration rate (m/s) +! local variables + REAL :: WDF ! soil water diffusivity + REAL :: WCND ! soil water conductivity[m/s] + REAL :: JJ ! dummy variable + INTEGER :: ISOIL +!--------------------------------------------------------------------------------- + + ISOIL = 1 + IF(INFLMAX .EQ. 1)THEN + + ! estimate initial soil hydraulic conductivty (Ki in the equation), WCND (m/s) + CALL WDFCND2 (parameters,WDF,WCND,parameters%SMCWLT(ISOIL),0.0,ISOIL) + + ! Maximum infiltrability based on the Eq. 6.25. (m/s) + JJ = parameters%GDVIC * (parameters%SMCMAX(ISOIL) - parameters%SMCWLT(ISOIL)) * -1.0 * ZSOIL(ISOIL) + FSUR = parameters%DKSAT(ISOIL) + ((JJ/1E-05) * (parameters%DKSAT(ISOIL) - WCND)) + + !maximum infiltration rate at surface + IF(FSUR .LT. 0.0) FSUR = WCND + + ELSE + + ! estimate initial soil hydraulic conductivty (Ki in the equation), WCND (m/s) + CALL WDFCND2 (parameters,WDF,WCND,SMC(ISOIL),SICE(ISOIL),ISOIL) + + ! Maximum infiltrability based on the Eq. 6.25. (m/s) + JJ = parameters%GDVIC * max(0.0,(parameters%SMCMAX(ISOIL) - SMC(ISOIL))) * -1.0 * ZSOIL(ISOIL) + FSUR = parameters%DKSAT(ISOIL) + ((JJ/FACC) * (parameters%DKSAT(ISOIL) - WCND)) + + ! infiltration rate at surface + IF(parameters%DKSAT(ISOIL) .LT. QINSUR)THEN + FSUR = MIN(QINSUR,FSUR) + ELSE + FSUR = QINSUR + END IF + ! accumulated infiltration function + FACC = FACC + FSUR + + END IF + + END SUBROUTINE GREEN_AMPT_INFIL + +!== end Green-Ampt infiltration ==================================================================== + +!== begin Philip's infiltration ==================================================================== + + SUBROUTINE PHILIP_INFIL(parameters,NSOIL,SMC,SICE,QINSUR,DT,FACC,FSUR,INFLMAX) + +!------------------------------------------------------------------------------------------------------- +! This function estimate infiltration rate based on Philip's two parameter equation (Eq. 2) presented in +! Valiantzas (2010). New linearized two-parameter infiltration equation for direct determination +! of conductivity and sorptivity, J. Hydrology. +! Author: Prasanth Valayamkunnath +!--------------------------------------------------------------------------------------------- + IMPLICIT NONE +! -------------------------------------------------------------------------------------------- + type (noahmp_parameters), intent(in) :: parameters + INTEGER, INTENT(IN) :: NSOIL !no of soil layers (4) + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC !soil moisture content [m3/m3] + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SICE !soil ice content [m3/m3] + REAL, INTENT(IN) :: QINSUR !water input on soil surface [m/s] + REAL, INTENT(IN) :: DT !time-step (sec) + INTEGER, INTENT(IN) :: INFLMAX!check for maximum infiltration at SMCWLT +! in outs + REAL, INTENT(INOUT) :: FACC !accumulated infiltration rate (m/s) +! outputs + REAL, INTENT(OUT) :: FSUR !surface infiltration rate (m/s) +! local variables + REAL :: WDF ! soil water diffusivity (m2/s) + REAL :: WCND ! soil water conductivity[m/s] + REAL :: SP ! sorptivity (LT^-1/2) + REAL :: AP ! intial hydraulic conductivity (m/s,L/T) + REAL :: FMAX ! Maximum infiltration (m/s) + INTEGER :: ISOIL +!--------------------------------------------------------------------------------- + + ISOIL = 1 + IF (INFLMAX .EQ. 1) THEN + + ! estimate initial soil hydraulic conductivty and diffusivity (Ki, D(theta) in the equation) + CALL WDFCND2 (parameters,WDF,WCND,parameters%SMCWLT(ISOIL),0.0,ISOIL) + + ! Sorptivity based on Eq. 10b from Kutílek, Miroslav, and Jana Valentová (1986) + ! Sorptivity approximations. Transport in Porous Media 1.1, 57-62. + SP = SQRT(2.0 * (parameters%SMCMAX(ISOIL) - parameters%SMCWLT(ISOIL)) * (parameters%DWSAT(ISOIL) - WDF)) + + ! Parameter A in Eq. 9 of Valiantzas (2010) is given by + AP = MIN(WCND, (2.0/3.0)*parameters%DKSAT(ISOIL)) + AP = MAX(AP, (1.0/3.0)*parameters%DKSAT(ISOIL)) + + ! Maximun infiltration rate, m + FSUR = (1.0/2.0)*SP*(DT**(-1.0/2.0))+AP ! m/s + IF(FSUR .LT. 0.0) FSUR = WCND + + ELSE + + ! estimate initial soil hydraulic conductivty and diffusivity (Ki, D(theta) in the equation) + CALL WDFCND2 (parameters,WDF,WCND,SMC(ISOIL),SICE(ISOIL),ISOIL) + + ! Sorptivity based on Eq. 10b from Kutílek, Miroslav, and Jana Valentová (1986) + ! Sorptivity approximations. Transport in Porous Media 1.1, 57-62. + SP = SQRT(2.0 * max(0.0,(parameters%SMCMAX(ISOIL) - SMC(ISOIL))) * (parameters%DWSAT(ISOIL) - WDF)) + + ! Parameter A in Eq. 9 of Valiantzas (2010) is given by + AP = MIN(WCND, (2.0/3.0)*parameters%DKSAT(ISOIL)) + AP = MAX(AP, (1.0/3.0)*parameters%DKSAT(ISOIL)) + + ! Maximun infiltration rate, m + FSUR = (1.0/2.0)*SP*(DT**(-1.0/2.0))+AP ! m/s + + ! infiltration rate at surface + IF(parameters%DKSAT(ISOIL) .LT. QINSUR)THEN + FSUR = MIN(QINSUR,FSUR) + ELSE + FSUR = QINSUR + END IF + ! accumulated infiltration function + FACC = FACC + FSUR + + END IF + + END SUBROUTINE PHILIP_INFIL + +!== end Phillips infiltration ====================================================================== + +!== begin tile_drain =============================================================================== + + SUBROUTINE TILE_DRAIN (parameters,NSOIL,SH2O,SMC,SICE,ZSOIL,QTLDRN,DT) + +! ---------------------------------------------------------------------- +! Calculate tile drainage discharge (mm) based on simple model ! pvk +! ---------------------------------------------------------------------- + IMPLICIT NONE +! ---------------------------------------------------------------------- +! inout + type (noahmp_parameters), intent(in) :: parameters + INTEGER,INTENT(IN) :: NSOIL + REAL, INTENT(IN) :: DT + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SH2O + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SMC + REAL,INTENT(INOUT) :: QTLDRN +! input + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SICE + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL +! local + INTEGER :: K + REAL :: TDRVOL ! temp variable for drainage volume (mm) + REAL,DIMENSION(1:NSOIL) :: OVRFC ! temp variable for volume of water above field capacity + REAL,DIMENSION(1:NSOIL) :: AVFC ! Available field capacity = FC - SICE (m3/m3) + REAL,DIMENSION(1:NSOIL) :: ZLAYER ! thickness of soil layer + REAL,DIMENSION(1:NSOIL) :: TDFRAC + REAL :: TDDC + REAL :: TDSUM +! ---------------------------------------------------------------------- + + TDRVOL = 0.0 + OVRFC = 0.0 + QTLDRN = 0.0 + ZLAYER = 0.0 + AVFC = 0.0 + TDSUM = 0.0 + TDFRAC = 0.0 + TDDC = parameters%TD_DC * DT/(24.0*3600.0) + + DO K = 1, NSOIL + IF (K == 1) THEN + ZLAYER(K) = -1.0 * ZSOIL(K) + ELSE + ZLAYER(K) = (ZSOIL(K-1)-ZSOIL(K)) + END IF + END DO + IF (parameters%DRAIN_LAYER_OPT == 0) THEN ! drainage from one specified layer in MPTABLE.TBL + !print*, "CASE = 1" + K = parameters%TD_DEPTH + AVFC(K) = parameters%SMCREF(K) - SICE (K) + OVRFC(K) = (SH2O(K) - (parameters%TDSMC_FAC*AVFC(K))) * ZLAYER(K) * 1000.0 ! mm + IF (OVRFC(K) > 0.0) THEN + IF (OVRFC(K) > TDDC) OVRFC(K) = TDDC + TDRVOL = TDRVOL + OVRFC(K) + SH2O(K) = SH2O(K) - (OVRFC(K)/(ZLAYER(K) * 1000.0)) + SMC(K) = SH2O(K) + SICE (K) + END IF + ELSE IF (parameters%DRAIN_LAYER_OPT == 1) THEN + !print*, "CASE = 2. Draining from layer 1 and 2" + DO K = 1, 2 + AVFC(K) = parameters%SMCREF(K) - SICE (K) + OVRFC(K) = (SH2O(K) - (parameters%TDSMC_FAC*AVFC(K))) * ZLAYER(K) * 1000.0 ! mm + IF(OVRFC(K) < 0.0) OVRFC(K) = 0.0 + TDSUM = TDSUM + OVRFC(K) + END DO + DO K = 1, 2 + IF(OVRFC(K) .NE. 0.0) THEN + TDFRAC(K) = OVRFC(K)/TDSUM + END IF + END DO + IF (TDSUM > 0.0) THEN + IF (TDSUM > TDDC) TDSUM = TDDC + TDRVOL = TDRVOL + TDSUM + DO K = 1, 2 + OVRFC(K) = TDFRAC(K)*TDSUM + SH2O(K) = SH2O(K) - (OVRFC(K)/(ZLAYER(K) * 1000.0)) + SMC(K) = SH2O(K) + SICE (K) + END DO + END IF + ELSE IF (parameters%DRAIN_LAYER_OPT == 2) THEN + !print*, "CASE = 3. Draining from layer 1 2 and 3" + DO K = 1, 3 + AVFC(K) = parameters%SMCREF(K) - SICE (K) + OVRFC(K) = (SH2O(K) - (parameters%TDSMC_FAC*AVFC(K))) * ZLAYER(K) * 1000.0 ! mm + IF(OVRFC(K) < 0.0) OVRFC(K) = 0.0 + TDSUM = TDSUM + OVRFC(K) + END DO + DO K = 1, 3 + IF(OVRFC(K) .NE. 0.0) THEN + TDFRAC(K) = OVRFC(K)/TDSUM + END IF + END DO + IF (TDSUM > 0.0) THEN + IF (TDSUM > TDDC) TDSUM = TDDC + TDRVOL = TDRVOL + TDSUM + DO K = 1, 3 + OVRFC(K) = TDFRAC(K)*TDSUM + SH2O(K) = SH2O(K) - (OVRFC(K)/(ZLAYER(K) * 1000.0)) + SMC(K) = SH2O(K) + SICE (K) + END DO + END IF + + ELSE IF (parameters%DRAIN_LAYER_OPT == 3) THEN + !print*, "CASE = 3. Draining from layer 2 and 3" + DO K = 2, 3 + AVFC(K) = parameters%SMCREF(K) - SICE (K) + OVRFC(K) = (SH2O(K) - (parameters%TDSMC_FAC*AVFC(K))) * ZLAYER(K) * 1000.0 ! mm + IF(OVRFC(K) < 0.0) OVRFC(K) = 0.0 + TDSUM = TDSUM + OVRFC(K) + END DO + DO K = 2, 3 + IF(OVRFC(K) .NE. 0.0) THEN + TDFRAC(K) = OVRFC(K)/TDSUM + END IF + END DO + IF (TDSUM > 0.0) THEN + IF (TDSUM > TDDC) TDSUM = TDDC + TDRVOL = TDRVOL + TDSUM + DO K = 2, 3 + OVRFC(K) = TDFRAC(K)*TDSUM + SH2O(K) = SH2O(K) - (OVRFC(K)/(ZLAYER(K) * 1000.0)) + SMC(K) = SH2O(K) + SICE (K) + END DO + END IF + ELSE IF (parameters%DRAIN_LAYER_OPT == 4) THEN + + !print*, "CASE = 4. Draining from layer 3 and 4" + DO K = 3, 4 + AVFC(K) = parameters%SMCREF(K) - SICE (K) + OVRFC(K) = (SH2O(K) - (parameters%TDSMC_FAC*AVFC(K))) * ZLAYER(K) * 1000.0 ! mm + IF(OVRFC(K) < 0.0) OVRFC(K) = 0.0 + TDSUM = TDSUM + OVRFC(K) + END DO + DO K = 3, 4 + IF(OVRFC(K) .NE. 0.0) THEN + TDFRAC(K) = OVRFC(K)/TDSUM + END IF + END DO + + + IF (TDSUM > 0.0) THEN + IF (TDSUM > TDDC) TDSUM = TDDC + TDRVOL = TDRVOL + TDSUM + + DO K = 3, 4 + OVRFC(K) = TDFRAC(K)*TDSUM + SH2O(K) = SH2O(K) - (OVRFC(K)/(ZLAYER(K) * 1000.0)) + SMC(K) = SH2O(K) + SICE (K) + END DO + END IF + + ELSE IF (parameters%DRAIN_LAYER_OPT == 5) THEN ! from all the four layers + + !print*, "CASE = 5 Draining from all four layers" + DO K = 1, 4 + AVFC(K) = parameters%SMCREF(K) - SICE (K) + OVRFC(K) = (SH2O(K) - (parameters%TDSMC_FAC*AVFC(K))) * ZLAYER(K) * 1000.0 ! mm + IF(OVRFC(K) < 0.0) OVRFC(K) = 0.0 + TDSUM = TDSUM + OVRFC(K) + END DO + DO K = 1, 4 + IF(OVRFC(K) .NE. 0.0) THEN + TDFRAC(K) = OVRFC(K)/TDSUM + END IF + END DO + + IF (TDSUM > 0.0) THEN + IF (TDSUM > TDDC) TDSUM = TDDC + TDRVOL = TDRVOL + TDSUM + DO K = 1, 4 + OVRFC(K) = TDFRAC(K)*TDSUM + SH2O(K) = SH2O(K) - (OVRFC(K)/(ZLAYER(K) * 1000.0)) + SMC(K) = SH2O(K) + SICE (K) + END DO + END IF + END IF + + QTLDRN = TDRVOL / DT + + END SUBROUTINE TILE_DRAIN + +!=================================================================================================== + + SUBROUTINE TILE_HOOGHOUDT (parameters,WCND,NSOIL,NSNOW,SH2O,SMC,SICE, & + ZSOIL,DZSNSO,DT,DX,QTLDRN,ZWT & +#ifdef WRF_HYDRO + ,WATBLED & +#endif + ) + +!------------------------------------------------------------------------------------------ +! calculate tile drainage discharge (mm) based on Hooghoudt's equation ! pvk +!------------------------------------------------------------------------------------------ + IMPLICIT NONE +!------------------------------------------------------------------------------------------ +! Definitions +!TD_SATZ = Thickness of saturated zone in layer considered ~ W +!TD_SPAC = Tile Drain SPACing ~ SDRAIN +!TD_HAIL = Height of water table in the drain Above Impermeable Layer (de) - +! HDRAIN +!TD_HEMD = Effective Height between water level in the drains to the water +! table MiDpoint ~ EM +!ZLAYER(K) = Thickness of layer K ~DZ(I) +!TD_DTWT = Depth To Water Table (cm) ~ TD_DTWT +!TD_FLUX = Drainge Flux cm/hr~ DFLUX +!TD_DEPTH = Effective Depth to impermeable layer from soil surface~ DEPTH +!TD_TTSZ = Total Thickness of Saturated Zone ~ DEEP +!KLAT = Lateral hydraulic conductivity, CONE +!KLATK = Lateral hydraulic conductivity of a specific layer ~ CONK +!DTOPL = Depth of top of the layer considered~ ABOVE +!TD_DC = Drainage Coefficient ~ DC +!TD_DDRN = Depth of drain ~ DDRAIN +!TD_ADEPTH = Actual depth to impermeable layer form surface. ADEPTH >= TD_DEPTH +!------------------------------------------------------------------------------------------ +! inout + type (noahmp_parameters), intent(in) :: parameters + INTEGER,INTENT(IN) :: NSOIL + INTEGER,INTENT(IN) :: NSNOW + REAL, INTENT(IN) :: DT + REAL, INTENT(IN) :: DX + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SICE + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: DZSNSO + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: WCND + + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SH2O + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SMC + REAL, INTENT(INOUT) :: QTLDRN ! tile drain discharge mm/s + REAL, INTENT(INOUT) :: ZWT ! water table depth + +! local + INTEGER :: K + REAL, DIMENSION(1:NSOIL) :: TD_SATZ ! thickness of saturated zone + REAL, DIMENSION(1:NSOIL) :: KLATK ! lateral hydraulic ocnductivity kth layer + REAL :: TD_TTSZ ! total satutation thickness + REAL :: TD_LQ ! lateral flow + REAL :: DTOPL ! depth to top of the layer + REAL :: XX + REAL :: YY + REAL :: KLAT ! average lateral hydruaic conductivity + REAL :: TD_HAIL + REAL :: TD_DEPTH + REAL :: TD_HEMD + REAL,DIMENSION(1:NSOIL) :: ZLAYER + REAL,DIMENSION(1:NSOIL) :: OVRFC + INTEGER :: NDRAINS + REAL :: TDDC + REAL,DIMENSION(1:NSOIL) :: RMSH2O + REAL :: QTLDRN1 + REAL :: TD_DD + REAL :: OVRFCS +#ifdef WRF_HYDRO + REAL :: WATBLED ! water table depth estimated in WRF-Hydro fine grids +#endif +!---------------------------------------------------------------------------- + + TD_SATZ = 0.0 + DTOPL = 0.0 + TD_LQ = 0.0 + TD_TTSZ = 0.0 + TDDC = parameters%TD_DCOEF* 1000.0 * DT/(24.0 * 3600.0) ! m per day to mm per timestep + +! Thickness of soil layers + DO K = 1, NSOIL + IF (K == 1) THEN + ZLAYER(K) = -1.0 * ZSOIL(K) + ELSE + ZLAYER(K) = (ZSOIL(K-1)-ZSOIL(K)) + END IF + END DO + +#ifdef WRF_HYDRO +! Depth to water table, m + YY = WATBLED +#else + CALL TD_FINDZWAT(parameters,NSOIL,SMC,SH2O,SICE,ZSOIL,ZLAYER,ZWT) + !CALL ZWTEQ (parameters,NSOIL, NSNOW, ZSOIL, DZSNSO, SH2O, ZWT) +! Depth to water table, m + YY = ZWT +#endif + IF (YY .GT. parameters%TD_ADEPTH) YY = parameters%TD_ADEPTH + +! Depth of saturated zone + DO K=1, NSOIL + IF (YY .GT. (-1.0*ZSOIL(K))) THEN + TD_SATZ(K) = 0.0 + ELSE + TD_SATZ(K) = (-1.0*ZSOIL(K)) - YY + XX = (-1.0*ZSOIL(K)) - DTOPL + IF(TD_SATZ(K) .GT. XX) TD_SATZ(K) = XX + END IF + + DTOPL = -1.0*ZSOIL(K) + END DO +! amount of water over field capacity + OVRFCS = 0.0 + DO K=1, NSOIL + OVRFC(K) = (SH2O(K) - (parameters%SMCREF(K)-SICE(K))) * ZLAYER(K) * 1000.0 !mm + IF(OVRFC(K) .LT. 0.0)OVRFC(K) = 0.0 + OVRFCS = OVRFCS + OVRFC(K) + END DO + +! lateral hydr. conductivity and total lateral flow + DO K=1, NSOIL + KLATK(K)= WCND(K)*parameters%KLAT_FAC * DT ! m/s to m/timestep + TD_LQ = TD_LQ + (TD_SATZ(K) * KLATK(K)) + TD_TTSZ = TD_TTSZ + TD_SATZ(K) + END DO + + IF (TD_TTSZ .LT. 0.001) TD_TTSZ = 0.001 ! unit is m + IF (TD_LQ .LT. 0.001) TD_LQ = 0.0 ! unit is m + + KLAT = TD_LQ/TD_TTSZ ! lateral hydraulic conductivity per timestep + + TD_DD = parameters%TD_ADEPTH - parameters%TD_DDRAIN + + CALL TD_EQUIVALENT_DEPTH (TD_DD, & + parameters%TD_SPAC, & + parameters%TD_RADI, & + TD_HAIL) + + TD_DEPTH= TD_HAIL + parameters%TD_DDRAIN + TD_HEMD = parameters%TD_DDRAIN - YY + + IF (TD_HEMD .LE. 0.0) THEN + QTLDRN = 0.0 + ELSE + QTLDRN = ((8.0*KLAT*TD_HAIL*TD_HEMD) + (4.0*KLAT*TD_HEMD*TD_HEMD))& ! m per timestep + /(parameters%TD_SPAC*parameters%TD_SPAC) + END IF + + QTLDRN = QTLDRN * 1000.0 ! m per timestep to mm/timestep /one tile + + IF(QTLDRN .LE. 0.0) QTLDRN = 0.0 + IF(QTLDRN .GT. TDDC) QTLDRN = TDDC + + NDRAINS = INT(DX/parameters%TD_SPAC) + QTLDRN = QTLDRN * NDRAINS + IF(QTLDRN .GT. OVRFCS) QTLDRN = OVRFCS + +! update soil moisture after drainage: moisture drains from top to bottom + + QTLDRN1 = QTLDRN + + DO K=1, NSOIL + IF(QTLDRN1 .GT. 0.0) THEN + IF((TD_SATZ(K) .GT. 0.0) .AND. (OVRFC(K) .GT. 0.0)) THEN + + RMSH2O(K) = OVRFC(K) - QTLDRN1 ! remaining water after tile drain + + IF (RMSH2O(K) .GT. 0.0) THEN + SH2O(K) = (parameters%SMCREF(K) - SICE (K)) + RMSH2O(K)/(ZLAYER(K) * 1000.0) + SMC(K) = SH2O(K) + SICE (K) + EXIT + ELSE + SH2O(K) = (parameters%SMCREF(K) - SICE (K)) + SMC(K) = SH2O(K) + SICE (K) + QTLDRN1 = QTLDRN1 - OVRFC(K) + END IF + + END IF + END IF + END DO + + QTLDRN = QTLDRN/DT ![mm/s] + + END SUBROUTINE TILE_HOOGHOUDT + +!----------------------------------------------------------------------- + + SUBROUTINE TD_EQUIVALENT_DEPTH (TD_D,TD_L,TD_RD,TD_DE) + +! ---------------------------------------------------------------------- +! calculate tile drainage equivalent depth from d. +! ---------------------------------------------------------------------- + IMPLICIT NONE +! ---------------------------------------------------------------------- + REAL, INTENT(IN) :: TD_D + REAL, INTENT(IN) :: TD_L + REAL, INTENT(IN) :: TD_RD + REAL, INTENT(OUT) :: TD_DE + REAL :: PII = 22.0/7.0 + REAL :: TD_X + REAL :: TD_FX, EX,TERM + INTEGER :: I +!------------------------------------- + + TD_FX = 0.0 + EX = 0.0 + TERM = 0.0 + + TD_X = (2.0*PII*TD_D)/TD_L + + IF (TD_X .GT. 0.5) THEN + DO I=1,45,2 + EX = EXP(-2.0*I*TD_X) + TERM = (4.0*EX)/(I*(1.0-EX)) + TD_FX = TD_FX + TERM + IF(TERM .LT. 1.0E-6) THEN + TD_DE = ((PII*TD_L)/8.0)/(LOG(TD_L/(PII*TD_RD))+TD_FX) + EXIT + END IF + END DO + ELSE IF (TD_X .LT. 1.0E-8) THEN + TD_DE = TD_D + ELSE + TD_FX = ((PII*PII)/(4.0*TD_X))+(LOG(TD_X/(2.0*PII))) + TD_DE = ((PII*TD_L)/8.0)/(LOG(TD_L/(PII*TD_RD))+TD_FX) + END IF + + IF (TD_DE .LT. 0.0 .AND. I .LE. 2) TD_DE = TD_D + + END SUBROUTINE TD_EQUIVALENT_DEPTH + +!---------------------------------------------------------------------------- + + SUBROUTINE TD_FINDZWAT(parameters,NSOIL,SMC,SH2O,SICE,ZSOIL,SLDPTH,WATBLED) + +!---------------------------------------------------------------------------- +! Calculate watertable depth as on WRF-Hydro/NWM +!---------------------------------------------------------------------------- + IMPLICIT NONE + +!-------- DECLARATIONS ------------------------ + type (noahmp_parameters), intent(in) :: parameters + INTEGER, INTENT(IN) :: NSOIL + REAL, INTENT(IN), DIMENSION(NSOIL) :: SMC,SH2O,SICE + REAL, INTENT(IN), DIMENSION(NSOIL) :: ZSOIL + REAL, INTENT(IN), DIMENSION(NSOIL) :: SLDPTH + REAL, INTENT(OUT) :: WATBLED + REAL :: CWATAVAIL + INTEGER :: SATLYRCHK + +! Local Variables + INTEGER :: K,i,j +!------------------------------------------------------------ + + SATLYRCHK = 0 !set flag for sat. layers + CWATAVAIL = 0.0 !set wat avail for subsfc rtng = 0. + + DO K=NSOIL,1,-1 + IF ( (SMC(K).GE.parameters%SMCREF(K)).AND.& + (parameters%SMCREF(K) .GT.parameters%SMCWLT(K)) ) THEN + IF((SATLYRCHK .EQ.K+1) .OR. (K.EQ.NSOIL)) SATLYRCHK = K + END IF + END DO + + IF (SATLYRCHK .NE. 0) THEN + IF (SATLYRCHK .NE. 1) then ! soil column is partially sat. + WATBLED = -ZSOIL(SATLYRCHK-1) + ELSE ! soil column is fully saturated to sfc. + WATBLED = 0.0 + END IF + DO K = SATLYRCHK,NSOIL + CWATAVAIL = CWATAVAIL+(SMC(K)-parameters%SMCREF(K))*SLDPTH(K) + END DO + ELSE ! no saturated layers... + WATBLED = -ZSOIL(NSOIL) + SATLYRCHK = NSOIL + 1 + END IF + + END SUBROUTINE TD_FINDZWAT + +!== end tile drainage subroutines ================================================================== + !== begin wdfcnd1 ================================================================================== SUBROUTINE WDFCND1 (parameters,WDF,WCND,SMC,FCR,ISOIL) @@ -7843,7 +9219,7 @@ SUBROUTINE WDFCND2 (parameters,WDF,WCND,SMC,SICE,ISOIL) WDF = parameters%DWSAT(ISOIL) * FACTR2 ** EXPON IF (SICE > 0.0) THEN - VKWGT = 1./ (1. + (500.* SICE)**3.) + VKWGT = 1.0/ (1.0 + (500.0* SICE)**3.0) WDF = VKWGT * WDF + (1.-VKWGT)*parameters%DWSAT(ISOIL)*(FACTR1)**EXPON END IF @@ -7919,8 +9295,8 @@ SUBROUTINE TRIGGER_IRRIGATION(parameters,NSOIL,ZSOIL,SH2O,FVEG, SMCAVL = 0.0 SMCLIM = 0.0 ! estimate available water and field capacity for the root zone - SMCAVL = (SH2O(1)-parameters%SMCWLT(1))*(-1)*ZSOIL(1) ! current soil water (m) - SMCLIM = (parameters%SMCREF(1)-parameters%SMCWLT(1))*(-1)*ZSOIL(1) ! available water (m) + SMCAVL = (SH2O(1)-parameters%SMCWLT(1))*-1.0*ZSOIL(1) ! current soil water (m) + SMCLIM = (parameters%SMCREF(1)-parameters%SMCWLT(1))*-1.0*ZSOIL(1) ! available water (m) DO K = 2, parameters%NROOT SMCAVL = SMCAVL + (SH2O(K)-parameters%SMCWLT(K))*(ZSOIL(K-1) - ZSOIL(K)) SMCLIM = SMCLIM + (parameters%SMCREF(K)-parameters%SMCWLT(K))*(ZSOIL(K-1) - ZSOIL(K)) @@ -7955,11 +9331,11 @@ SUBROUTINE TRIGGER_IRRIGATION(parameters,NSOIL,ZSOIL,SH2O,FVEG, ! another, surface layers will be saturated. ! flood irrigation amount (m) based on 2D FIFAC IF((IRAMTFI .EQ. 0.0) .AND. (FIFAC .GT. 0.0) .AND. (OPT_IRRM .EQ. 0)) THEN - IRAMTFI = FIFAC*(IRRWATAMT)*(parameters%FILOSS+1) + IRAMTFI = FIFAC*(IRRWATAMT)*(1.0/(1.0-parameters%FILOSS)) IRCNTFI = IRCNTFI + 1 !flood irrigation amount (m) based on namelist choice ELSE IF((IRAMTFI .EQ. 0.0) .AND. (OPT_IRRM .EQ. 3)) THEN - IRAMTFI = (IRRWATAMT)*(parameters%FILOSS+1) + IRAMTFI = (IRRWATAMT)*(1.0/(1.0-parameters%FILOSS)) IRCNTFI = IRCNTFI + 1 END IF ELSE @@ -8013,7 +9389,7 @@ SUBROUTINE SPRINKLER_IRRIGATION(parameters,NSOIL,DT,SH2O,SMC,SICE,& !in ! estimate infiltration rate based on Philips Eq. CALL IRR_PHILIP_INFIL(parameters,SMC,SH2O,SICE,DT,NSOIL,FSUR) ! irrigation rate of sprinkler - TEMP_RATE = parameters%SPRIR_RATE*(1/1000.)*DT/3600. !NRCS rate/time step - calibratable + TEMP_RATE = parameters%SPRIR_RATE*(1/1000.0)*DT/3600.0 !NRCS rate/time step - calibratable IRSIRATE = MIN(FSUR*DT,IRAMTSI,TEMP_RATE) !Limit the application rate to minimum of infiltration rate !and to the NRCS recommended rate, (m) @@ -8027,11 +9403,10 @@ SUBROUTINE SPRINKLER_IRRIGATION(parameters,NSOIL,DT,SH2O,SMC,SICE,& !in ELSE ! Equation (4) IRRLOSS = 4.337*(EXP(0.077*WINDSPEED))*(((ESAT1-EAIR)*0.01)**(-0.098)) ! [%] END IF - - ! PGI Fortran compiler does not support ISNAN - IF ( isnan_lsm(IRRLOSS)) IRRLOSS=4.0 ! In case if IRRLOSS is NaN + ! Old PGI Fortran compiler does not support ISNAN + IF ( isnan_lsm(IRRLOSS) ) IRRLOSS=4.0 ! In case if IRRLOSS is NaN IF ( (IRRLOSS .GT. 100.0) .OR. (IRRLOSS .LT. 0.0) ) IRRLOSS=4.0 ! In case if IRRLOSS is out of range - + ! Sprinkler water (m) for sprinkler fraction IRSIRATE = IRSIRATE * SIFAC IF(IRSIRATE .GE. IRAMTSI)THEN @@ -8040,17 +9415,18 @@ SUBROUTINE SPRINKLER_IRRIGATION(parameters,NSOIL,DT,SH2O,SMC,SICE,& !in ELSE IRAMTSI = IRAMTSI - IRSIRATE END IF - IREVPLOS = IRSIRATE*IRRLOSS*(1./100.) + IREVPLOS = IRSIRATE*IRRLOSS*(1.0/100.0) IRSIRATE = IRSIRATE-IREVPLOS END SUBROUTINE SPRINKLER_IRRIGATION - logical function isnan_lsm(arg1) - real,intent(in) :: arg1 - isnan_lsm = (arg1 .ne. arg1) - return - end function isnan_lsm + logical function isnan_lsm(arg1) + real,intent(in) :: arg1 + isnan_lsm = (arg1 .ne. arg1) + return + end function isnan_lsm !============================================================================================================ + SUBROUTINE MICRO_IRRIGATION(parameters,NSOIL,DT,SH2O,SMC,SICE,MIFAC, & !in IRAMTMI,IRMIRATE) !inout !--------------------------------------------------------------------------------------------- @@ -8081,7 +9457,7 @@ SUBROUTINE MICRO_IRRIGATION(parameters,NSOIL,DT,SH2O,SMC,SICE,MIFAC, & !in ! estimate infiltration rate based on Philips Eq. CALL IRR_PHILIP_INFIL(parameters,SMC,SH2O,SICE,DT,NSOIL,FSUR) ! irrigation rate of micro irrigation - TEMP_RATE = parameters%MICIR_RATE*(1./1000.)*DT/3600. !NRCS rate/time step - calibratable + TEMP_RATE = parameters%MICIR_RATE*(1.0/1000.0)*DT/3600.0 !NRCS rate/time step - calibratable IRMIRATE = MIN(0.5*FSUR*DT,IRAMTMI,TEMP_RATE) !Limit the application rate to minimum !of 0.5*infiltration rate !and to the NRCS recommended rate, (m) @@ -8181,7 +9557,7 @@ SUBROUTINE IRR_PHILIP_INFIL(parameters,SMC,SH2O,SICE,DT,NSOIL, & ! in ! sorptivity based on Eq. 10b from Kutilek, Miroslav, and Jana Valentova (1986) ! sorptivity approximations. Transport in Porous Media 1.1, 57-62. - SP = SQRT(2.0 * (parameters%SMCMAX(ISOIL) - SMC(ISOIL)) * (parameters%DWSAT(ISOIL) - WDF)) + SP = SQRT(2.0 * max(0.0,(parameters%SMCMAX(ISOIL) - SMC(ISOIL))) * (parameters%DWSAT(ISOIL) - WDF)) ! parameter A in Eq. 9 of Valiantzas (2010) is given by AP = MIN(WCND,(2.0/3.0)*parameters%DKSAT(ISOIL)) @@ -8189,10 +9565,6 @@ SUBROUTINE IRR_PHILIP_INFIL(parameters,SMC,SH2O,SICE,DT,NSOIL, & ! in ! maximun infiltration rate, m FSUR = 0.5*SP*((DT)**(-0.5))+AP ! m/s - !PRINT*,'SP=',SP - !PRINT*,'AP=',AP - !PRINT*,'FSUR=',FSUR - !PRINT*,'WCND=',WCND FSUR = MAX(0.0,FSUR) !FSUR = MIN(WCND,FSUR) @@ -8254,8 +9626,9 @@ SUBROUTINE GROUNDWATER(parameters,NSNOW ,NSOIL ,DT ,SICE ,ZSOIL , & !in REAL :: WATMIN!minimum soil vol soil moisture [m3/m3] REAL :: XS !excessive water above saturation [mm] REAL, PARAMETER :: ROUS = 0.2 !specific yield [-] - REAL, PARAMETER :: CMIC = 0.20 !microprore content (0.0-1.0) +! REAL, PARAMETER :: CMIC = 0.20 !microprore content (0.0-1.0) !0.0-close to free drainage + REAL, PARAMETER :: CMIC = 0.80 ! calibratable, C.He changed based on GY Niu's update ! ------------------------------------------------------------- QDIS = 0.0 QIN = 0.0 @@ -8263,14 +9636,14 @@ SUBROUTINE GROUNDWATER(parameters,NSNOW ,NSOIL ,DT ,SICE ,ZSOIL , & !in ! Derive layer-bottom depth in [mm] !KWM: Derive layer thickness in mm - DZMM(1) = -ZSOIL(1)*1.E3 + DZMM(1) = -ZSOIL(1)*1.0E3 DO IZ = 2, NSOIL - DZMM(IZ) = 1.E3 * (ZSOIL(IZ - 1) - ZSOIL(IZ)) + DZMM(IZ) = 1.0E3 * (ZSOIL(IZ - 1) - ZSOIL(IZ)) ENDDO ! Derive node (middle) depth in [m] !KWM: Positive number, depth below ground surface in m - ZNODE(1) = -ZSOIL(1) / 2. + ZNODE(1) = -ZSOIL(1) / 2.0 DO IZ = 2, NSOIL ZNODE(IZ) = -ZSOIL(IZ-1) + 0.5 * (ZSOIL(IZ-1) - ZSOIL(IZ)) ENDDO @@ -8281,7 +9654,7 @@ SUBROUTINE GROUNDWATER(parameters,NSNOW ,NSOIL ,DT ,SICE ,ZSOIL , & !in SMC(IZ) = SH2O(IZ) + SICE(IZ) MLIQ(IZ) = SH2O(IZ) * DZMM(IZ) EPORE(IZ) = MAX(0.01,parameters%SMCMAX(IZ) - SICE(IZ)) - HK(IZ) = 1.E3*WCND(IZ) + HK(IZ) = 1.0E3*WCND(IZ) ENDDO ! The layer index of the first unsaturated layer, @@ -8297,26 +9670,30 @@ SUBROUTINE GROUNDWATER(parameters,NSNOW ,NSOIL ,DT ,SICE ,ZSOIL , & !in ! Groundwater discharge [mm/s] - FFF = 6.0 - RSBMX = 5.0 +! FFF = 6.0 +! RSBMX = 5.0 + FFF = parameters%BEXP(IWT) / 3.0 ! calibratable, C.He changed based on GY Niu's update + RSBMX = HK(IWT) * 1.0e3 * EXP(3.0) ! mm/s, calibratable, C.He changed based on GY Niu's update - QDIS = (1.0-FCRMAX)*RSBMX*EXP(-parameters%TIMEAN)*EXP(-FFF*(ZWT-2.0)) +! QDIS = (1.0-FCRMAX)*RSBMX*EXP(-parameters%TIMEAN)*EXP(-FFF*(ZWT-2.0)) + QDIS = (1.0-FCRMAX)*RSBMX*EXP(-parameters%TIMEAN)*EXP(-FFF*ZWT) ! C.He changed based on GY Niu's update ! Matric potential at the layer above the water table S_NODE = MIN(1.0,SMC(IWT)/parameters%SMCMAX(IWT) ) S_NODE = MAX(S_NODE,REAL(0.01,KIND=8)) - SMPFZ = -parameters%PSISAT(IWT)*1000.*S_NODE**(-parameters%BEXP(IWT)) ! m --> mm + SMPFZ = -parameters%PSISAT(IWT)*1000.0*S_NODE**(-parameters%BEXP(IWT)) ! m --> mm SMPFZ = MAX(-120000.0,CMIC*SMPFZ) ! Recharge rate qin to groundwater - KA = HK(IWT) +! KA = HK(IWT) + KA = 2.0*(HK(IWT)*parameters%DKSAT(IWT)*1.0e3) / (HK(IWT)+parameters%DKSAT(IWT)*1.0e3) ! harmonic average, C.He changed based on GY Niu's update - WH_ZWT = - ZWT * 1.E3 !(mm) - WH = SMPFZ - ZNODE(IWT)*1.E3 !(mm) - QIN = - KA * (WH_ZWT-WH) /((ZWT-ZNODE(IWT))*1.E3) - QIN = MAX(-10.0/DT,MIN(10./DT,QIN)) + WH_ZWT = - ZWT * 1.0E3 !(mm) + WH = SMPFZ - ZNODE(IWT)*1.0E3 !(mm) + QIN = - KA * (WH_ZWT-WH) /((ZWT-ZNODE(IWT))*1.0E3) + QIN = MAX(-10.0/DT,MIN(10.0/DT,QIN)) ! Water storage in the aquifer + saturated soil @@ -8325,26 +9702,26 @@ SUBROUTINE GROUNDWATER(parameters,NSNOW ,NSOIL ,DT ,SICE ,ZSOIL , & !in IF(IWT.EQ.NSOIL) THEN WA = WA + (QIN - QDIS) * DT !(mm) WT = WA - ZWT = (-ZSOIL(NSOIL) + 25.) - WA/1000./ROUS !(m) + ZWT = (-ZSOIL(NSOIL) + 25.0) - WA/1000.0/ROUS !(m) MLIQ(NSOIL) = MLIQ(NSOIL) - QIN * DT ! [mm] - MLIQ(NSOIL) = MLIQ(NSOIL) + MAX(0.,(WA - 5000.)) - WA = MIN(WA, 5000.) + MLIQ(NSOIL) = MLIQ(NSOIL) + MAX(0.0,(WA - 5000.0)) + WA = MIN(WA, 5000.0) ELSE IF (IWT.EQ.NSOIL-1) THEN ZWT = -ZSOIL(NSOIL) & - - (WT-ROUS*1000*25.) / (EPORE(NSOIL))/1000. + - (WT-ROUS*1000*25.0) / (EPORE(NSOIL))/1000.0 ELSE - WS = 0. ! water used to fill soil air pores + WS = 0.0 ! water used to fill soil air pores DO IZ = IWT+2,NSOIL WS = WS + EPORE(IZ) * DZMM(IZ) ENDDO ZWT = -ZSOIL(IWT+1) & - - (WT-ROUS*1000.*25.-WS) /(EPORE(IWT+1))/1000. + - (WT-ROUS*1000.0*25.0-WS) /(EPORE(IWT+1))/1000.0 ENDIF - WTSUB = 0. + WTSUB = 0.0 DO IZ = 1, NSOIL WTSUB = WTSUB + HK(IZ)*DZMM(IZ) END DO @@ -8362,10 +9739,10 @@ SUBROUTINE GROUNDWATER(parameters,NSNOW ,NSOIL ,DT ,SICE ,ZSOIL , & !in ! WATMIN = 0.01 DO IZ = 1, NSOIL-1 - IF (MLIQ(IZ) .LT. 0.) THEN + IF (MLIQ(IZ) .LT. 0.0) THEN XS = WATMIN-MLIQ(IZ) ELSE - XS = 0. + XS = 0.0 END IF MLIQ(IZ ) = MLIQ(IZ ) + XS MLIQ(IZ+1) = MLIQ(IZ+1) - XS @@ -8375,7 +9752,7 @@ SUBROUTINE GROUNDWATER(parameters,NSNOW ,NSOIL ,DT ,SICE ,ZSOIL , & !in IF (MLIQ(IZ) .LT. WATMIN) THEN XS = WATMIN-MLIQ(IZ) ELSE - XS = 0. + XS = 0.0 END IF MLIQ(IZ) = MLIQ(IZ) + XS WA = WA - XS @@ -8427,11 +9804,11 @@ SUBROUTINE SHALLOWWATERTABLE (parameters,NSNOW ,NSOIL ,ZSOIL, DT , & !in ZSOIL0(1:NSOIL) = ZSOIL(1:NSOIL) -ZSOIL0(0) = 0. +ZSOIL0(0) = 0.0 !find the layer where the water table is DO IZ=NSOIL,1,-1 - IF(WTD + 1.E-6 < ZSOIL0(IZ)) EXIT + IF(WTD + 1.0E-6 < ZSOIL0(IZ)) EXIT ENDDO IWTD=IZ @@ -8487,7 +9864,7 @@ SUBROUTINE SHALLOWWATERTABLE (parameters,NSNOW ,NSOIL ,ZSOIL, DT , & !in ! QDRAIN = QDRAIN - 1000 * (SMCEQ(NSOIL)-SMC(NSOIL)) * DZSNSO(NSOIL) / DT ! SMC(NSOIL)=SMCEQ(NSOIL) !adjust wtd in the ficticious layer below - SMCEQDEEP = parameters%SMCMAX(NSOIL) * ( -parameters%PSISAT(NSOIL) / ( -parameters%PSISAT(NSOIL) - DZSNSO(NSOIL) ) ) ** (1./parameters%BEXP(NSOIL)) + SMCEQDEEP = parameters%SMCMAX(NSOIL) * ( -parameters%PSISAT(NSOIL) / ( -parameters%PSISAT(NSOIL) - DZSNSO(NSOIL) ) ) ** (1.0/parameters%BEXP(NSOIL)) WTD = MIN( ( SMCWTD*DZSNSO(NSOIL) & - SMCEQDEEP*ZSOIL0(NSOIL) + parameters%SMCMAX(NSOIL)*(ZSOIL0(NSOIL)-DZSNSO(NSOIL)) ) / & ( parameters%SMCMAX(NSOIL)-SMCEQDEEP ) , ZSOIL0(NSOIL) ) @@ -8499,7 +9876,7 @@ SUBROUTINE SHALLOWWATERTABLE (parameters,NSNOW ,NSOIL ,ZSOIL, DT , & !in ELSEIF(WTD.GE.ZSOIL0(NSOIL)-DZSNSO(NSOIL))THEN !if wtd was already below the bottom of the resolved soil crust WTDOLD=WTD - SMCEQDEEP = parameters%SMCMAX(NSOIL) * ( -parameters%PSISAT(NSOIL) / ( -parameters%PSISAT(NSOIL) - DZSNSO(NSOIL) ) ) ** (1./parameters%BEXP(NSOIL)) + SMCEQDEEP = parameters%SMCMAX(NSOIL) * ( -parameters%PSISAT(NSOIL) / ( -parameters%PSISAT(NSOIL) - DZSNSO(NSOIL) ) ) ** (1.0/parameters%BEXP(NSOIL)) IF(SMCWTD.GT.SMCEQDEEP)THEN WTD = MIN( ( SMCWTD*DZSNSO(NSOIL) & - SMCEQDEEP*ZSOIL0(NSOIL) + parameters%SMCMAX(NSOIL)*(ZSOIL0(NSOIL)-DZSNSO(NSOIL)) ) / & @@ -8518,9 +9895,9 @@ SUBROUTINE SHALLOWWATERTABLE (parameters,NSNOW ,NSOIL ,ZSOIL, DT , & !in ENDIF -IF(IWTD.LT.NSOIL .AND. IWTD.GT.0) THEN +IF(IWTD .LT. NSOIL .AND. IWTD .GT. 0) THEN SMCWTD=parameters%SMCMAX(IWTD) -ELSEIF(IWTD.LT.NSOIL .AND. IWTD.LE.0) THEN +ELSEIF(IWTD .LT. NSOIL .AND. IWTD .LE. 0) THEN SMCWTD=parameters%SMCMAX(1) END IF @@ -8599,32 +9976,32 @@ SUBROUTINE CARBON (parameters,NSNOW ,NSOIL ,VEGTYP ,DT ,ZSOIL , & !in IF ( ( VEGTYP == parameters%iswater ) .OR. ( VEGTYP == parameters%ISBARREN ) .OR. & ( VEGTYP == parameters%ISICE ) .or. (parameters%urban_flag) ) THEN - XLAI = 0. - XSAI = 0. - GPP = 0. - NPP = 0. - NEE = 0. - AUTORS = 0. - HETERS = 0. - TOTSC = 0. - TOTLB = 0. - LFMASS = 0. - RTMASS = 0. - STMASS = 0. - WOOD = 0. - STBLCP = 0. - FASTCP = 0. + XLAI = 0.0 + XSAI = 0.0 + GPP = 0.0 + NPP = 0.0 + NEE = 0.0 + AUTORS = 0.0 + HETERS = 0.0 + TOTSC = 0.0 + TOTLB = 0.0 + LFMASS = 0.0 + RTMASS = 0.0 + STMASS = 0.0 + WOOD = 0.0 + STBLCP = 0.0 + FASTCP = 0.0 RETURN END IF - LAPM = parameters%SLA / 1000. ! m2/kg -> m2/g + LAPM = parameters%SLA / 1000.0 ! m2/kg -> m2/g ! water stress - WSTRES = 1.- BTRAN + WSTRES = 1.0- BTRAN - WROOT = 0. + WROOT = 0.0 DO J=1,parameters%NROOT WROOT = WROOT + SMC(J)/parameters%SMCMAX(J) * DZSNSO(J) / (-ZSOIL(parameters%NROOT)) ENDDO @@ -8782,25 +10159,25 @@ SUBROUTINE CO2FLUX (parameters,NSNOW ,NSOIL ,VEGTYP ,IGS ,DT , & !in ! respiration - IF(IGS .EQ. 0.) THEN + IF(IGS .EQ. 0.0) THEN RF = 0.5 ELSE RF = 1.0 ENDIF - FNF = MIN( FOLN/MAX(1.E-06,parameters%FOLNMX), 1.0 ) - TF = parameters%ARM**( (TV-298.16)/10. ) + FNF = MIN( FOLN/MAX(1.0E-06,parameters%FOLNMX), 1.0 ) + TF = parameters%ARM**( (TV-298.16)/10.0 ) RESP = parameters%RMF25 * TF * FNF * XLAI * RF * (1.-WSTRES) ! umol/m2/s - RSLEAF = MIN((LFMASS-LFMSMN)/DT,RESP*12.e-6) ! g/m2/s + RSLEAF = MIN((LFMASS-LFMSMN)/DT,RESP*12.0e-6) ! g/m2/s - RSROOT = parameters%RMR25*(RTMASS*1E-3)*TF *RF* 12.e-6 ! g/m2/s - RSSTEM = parameters%RMS25*((STMASS-STMSMN)*1E-3)*TF *RF* 12.e-6 ! g/m2/s + RSROOT = parameters%RMR25*(RTMASS*1E-3)*TF *RF* 12.0e-6 ! g/m2/s + RSSTEM = parameters%RMS25*((STMASS-STMSMN)*1E-3)*TF *RF* 12.0e-6 ! g/m2/s RSWOOD = RSWOODC * R(TV) * WOOD*parameters%WDPOOL ! carbon assimilation ! 1 mole -> 12 g carbon or 44 g CO2; 1 umol -> 12.e-6 g carbon; - CARBFX = PSN * 12.e-6 ! umol co2 /m2/ s -> g/m2/s carbon + CARBFX = PSN * 12.0e-6 ! umol co2 /m2/ s -> g/m2/s carbon ! fraction of carbon into leaf versus nonleaf @@ -8813,29 +10190,29 @@ SUBROUTINE CO2FLUX (parameters,NSNOW ,NSOIL ,VEGTYP ,IGS ,DT , & !in ! fraction of carbon into wood versus root - IF(WOOD > 1.e-6) THEN - WOODF = (1.-EXP(-BF*(parameters%WRRAT*RTMASS/WOOD))/BF)*parameters%WDPOOL + IF(WOOD > 1.0e-6) THEN + WOODF = (1.0-EXP(-BF*(parameters%WRRAT*RTMASS/WOOD))/BF)*parameters%WDPOOL ELSE WOODF = parameters%WDPOOL ENDIF - ROOTPT = NONLEF*(1.-WOODF) + ROOTPT = NONLEF*(1.0-WOODF) WOODPT = NONLEF*WOODF ! leaf and root turnover per time step - LFTOVR = parameters%LTOVRC*5.E-7*LFMASS - STTOVR = parameters%LTOVRC*5.E-7*STMASS + LFTOVR = parameters%LTOVRC*5.0E-7*LFMASS + STTOVR = parameters%LTOVRC*5.0E-7*STMASS RTTOVR = RTOVRC*RTMASS WDTOVR = 9.5E-10*WOOD ! seasonal leaf die rate dependent on temp and water stress ! water stress is set to 1 at permanent wilting point - SC = EXP(-0.3*MAX(0.,TV-parameters%TDLEF)) * (LFMASS/120.) + SC = EXP(-0.3*MAX(0.0,TV-parameters%TDLEF)) * (LFMASS/120.0) SD = EXP((WSTRES-1.)*WSTRC) - DIELF = LFMASS*1.E-6*(parameters%DILEFW * SD + parameters%DILEFC*SC) - DIEST = STMASS*1.E-6*(parameters%DILEFW * SD + parameters%DILEFC*SC) + DIELF = LFMASS*1.0E-6*(parameters%DILEFW * SD + parameters%DILEFC*SC) + DIEST = STMASS*1.0E-6*(parameters%DILEFW * SD + parameters%DILEFC*SC) ! calculate growth respiration for leaf, rtmass and wood @@ -8846,12 +10223,12 @@ SUBROUTINE CO2FLUX (parameters,NSNOW ,NSOIL ,VEGTYP ,IGS ,DT , & !in ! Impose lower T limit for photosynthesis - ADDNPPLF = MAX(0.,LEAFPT*CARBFX - GRLEAF-RSLEAF) - ADDNPPST = MAX(0.,STEMPT*CARBFX - GRSTEM-RSSTEM) + ADDNPPLF = MAX(0.0,LEAFPT*CARBFX - GRLEAF-RSLEAF) + ADDNPPST = MAX(0.0,STEMPT*CARBFX - GRSTEM-RSSTEM) ! ADDNPPLF = LEAFPT*CARBFX - GRLEAF-RSLEAF ! MB: test Kjetil ! ADDNPPST = STEMPT*CARBFX - GRSTEM-RSSTEM ! MB: test Kjetil - IF(TV.LT.parameters%TMIN) ADDNPPLF =0. - IF(TV.LT.parameters%TMIN) ADDNPPST =0. + IF(TV .LT. parameters%TMIN) ADDNPPLF =0.0 + IF(TV .LT. parameters%TMIN) ADDNPPST =0.0 ! update leaf, root, and wood carbon ! avoid reducing leaf mass below its minimum value but conserve mass @@ -8884,9 +10261,9 @@ SUBROUTINE CO2FLUX (parameters,NSNOW ,NSOIL ,VEGTYP ,IGS ,DT , & !in FASTCP = FASTCP + (RTTOVR+LFTOVR+STTOVR+WDTOVR+DIELF+DIEST)*DT ! MB: add DIEST v3.7 - FST = 2.0**( (STC(1)-283.16)/10. ) + FST = 2.0**( (STC(1)-283.16)/10.0 ) FSW = WROOT / (0.20+WROOT) * 0.23 / (0.23+WROOT) - RSSOIL = FSW * FST * parameters%MRP* MAX(0.,FASTCP*1.E-3)*12.E-6 + RSSOIL = FSW * FST * parameters%MRP* MAX(0.0,FASTCP*1.0E-3)*12.0E-6 STABLC = 0.1*RSSOIL FASTCP = FASTCP - (RSSOIL + STABLC)*DT @@ -8904,7 +10281,7 @@ SUBROUTINE CO2FLUX (parameters,NSNOW ,NSOIL ,VEGTYP ,IGS ,DT , & !in AUTORS = RSROOT + RSWOOD + RSLEAF + RSSTEM + & !g/m2/s C MB: add RSSTEM, GRSTEM v3.7 GRLEAF + GRROOT + GRWOOD + GRSTEM !g/m2/s C MB: add 0.9* v3.7 HETERS = 0.9*RSSOIL !g/m2/s C - NEE = (AUTORS + HETERS - GPP)*44./12. !g/m2/s CO2 + NEE = (AUTORS + HETERS - GPP)*44.0/12.0 !g/m2/s CO2 TOTSC = FASTCP + STBLCP !g/m2 C TOTLB = LFMASS + RTMASS +STMASS + WOOD !g/m2 C MB: add STMASS v3.7 @@ -8985,31 +10362,31 @@ SUBROUTINE CARBON_CROP (parameters,NSNOW ,NSOIL ,VEGTYP ,DT ,ZSOIL ,JULIA ! ------------------------------------------------------------------------------------------ IF ( ( VEGTYP == parameters%iswater ) .OR. ( VEGTYP == parameters%ISBARREN ) .OR. & ( VEGTYP == parameters%ISICE ) .or. (parameters%urban_flag) ) THEN - XLAI = 0. - XSAI = 0. - GPP = 0. - NPP = 0. - NEE = 0. - AUTORS = 0. - HETERS = 0. - TOTSC = 0. - TOTLB = 0. - LFMASS = 0. - RTMASS = 0. - STMASS = 0. - WOOD = 0. - STBLCP = 0. - FASTCP = 0. - GRAIN = 0. + XLAI = 0.0 + XSAI = 0.0 + GPP = 0.0 + NPP = 0.0 + NEE = 0.0 + AUTORS = 0.0 + HETERS = 0.0 + TOTSC = 0.0 + TOTLB = 0.0 + LFMASS = 0.0 + RTMASS = 0.0 + STMASS = 0.0 + WOOD = 0.0 + STBLCP = 0.0 + FASTCP = 0.0 + GRAIN = 0.0 RETURN END IF ! water stress - WSTRES = 1.- BTRAN + WSTRES = 1.0- BTRAN - WROOT = 0. + WROOT = 0.0 DO J=1,parameters%NROOT WROOT = WROOT + SMC(J)/parameters%SMCMAX(J) * DZSNSO(J) / (-ZSOIL(parameters%NROOT)) ENDDO @@ -9164,7 +10541,7 @@ SUBROUTINE CO2FLUX_CROP (parameters, LAIMIN = 0.05 XSAMIN = 0.05 - SAPM = 3.*0.001 ! m2/kg -->m2/g + SAPM = 3.0*0.001 ! m2/kg -->m2/g LFMSMN = laimin/0.035 STMSMN = xsamin/sapm ! --------------------------------------------------------------------------------- @@ -9172,17 +10549,17 @@ SUBROUTINE CO2FLUX_CROP (parameters, ! carbon assimilation ! 1 mole -> 12 g carbon or 44 g CO2 or 30 g CH20 - CARBFX = PSN*12.e-6!*IPA !umol co2 /m2/ s -> g/m2/s C - CBHYDRAFX = PSN*30.e-6!*IPA + CARBFX = PSN*12.0e-6!*IPA !umol co2 /m2/ s -> g/m2/s C + CBHYDRAFX = PSN*30.0e-6!*IPA ! mainteinance respiration - FNF = MIN( FOLN/MAX(1.E-06,parameters%FOLN_MX), 1.0 ) - TF = parameters%Q10MR**( (TV-298.16)/10. ) + FNF = MIN( FOLN/MAX(1.0E-06,parameters%FOLN_MX), 1.0 ) + TF = parameters%Q10MR**( (TV-298.16)/10.0 ) RESP = parameters%LFMR25 * TF * FNF * XLAI * (1.-WSTRES) ! umol/m2/s - RSLEAF = MIN((LFMASS-LFMSMN)/DT,RESP*30.e-6) ! g/m2/s - RSROOT = parameters%RTMR25*(RTMASS*1E-3)*TF * 30.e-6 ! g/m2/s - RSSTEM = parameters%STMR25*(STMASS*1E-3)*TF * 30.e-6 ! g/m2/s - RSGRAIN = parameters%GRAINMR25*(GRAIN*1E-3)*TF * 30.e-6 ! g/m2/s + RSLEAF = MIN((LFMASS-LFMSMN)/DT,RESP*30.0e-6) ! g/m2/s + RSROOT = parameters%RTMR25*(RTMASS*1E-3)*TF * 30.0e-6 ! g/m2/s + RSSTEM = parameters%STMR25*(STMASS*1E-3)*TF * 30.0e-6 ! g/m2/s + RSGRAIN = parameters%GRAINMR25*(GRAIN*1E-3)*TF * 30.0e-6 ! g/m2/s ! calculate growth respiration for leaf, rtmass and grain @@ -9194,19 +10571,19 @@ SUBROUTINE CO2FLUX_CROP (parameters, ! leaf turnover, stem turnover, root turnover and leaf death caused by soil ! water and soil temperature stress - LFTOVR = parameters%LF_OVRC(PGS)*1.E-6*LFMASS - RTTOVR = parameters%RT_OVRC(PGS)*1.E-6*RTMASS - STTOVR = parameters%ST_OVRC(PGS)*1.E-6*STMASS - SC = EXP(-0.3*MAX(0.,TV-parameters%LEFREEZ)) * (LFMASS/120.) - SD = EXP((WSTRES-1.)*WSTRC) - DIELF = LFMASS*1.E-6*(parameters%DILE_FW(PGS) * SD + parameters%DILE_FC(PGS)*SC) + LFTOVR = parameters%LF_OVRC(PGS)*1.0E-6*LFMASS + RTTOVR = parameters%RT_OVRC(PGS)*1.0E-6*RTMASS + STTOVR = parameters%ST_OVRC(PGS)*1.0E-6*STMASS + SC = EXP(-0.3*MAX(0.0,TV-parameters%LEFREEZ)) * (LFMASS/120.0) + SD = EXP((WSTRES-1.0)*WSTRC) + DIELF = LFMASS*1.0E-6*(parameters%DILE_FW(PGS) * SD + parameters%DILE_FC(PGS)*SC) ! Allocation of CBHYDRAFX to leaf, stem, root and grain at each growth stage - ADDNPPLF = MAX(0.,parameters%LFPT(PGS)*CBHYDRAFX - GRLEAF-RSLEAF) + ADDNPPLF = MAX(0.0,parameters%LFPT(PGS)*CBHYDRAFX - GRLEAF-RSLEAF) ADDNPPLF = parameters%LFPT(PGS)*CBHYDRAFX - GRLEAF-RSLEAF - ADDNPPST = MAX(0.,parameters%STPT(PGS)*CBHYDRAFX - GRSTEM-RSSTEM) + ADDNPPST = MAX(0.0,parameters%STPT(PGS)*CBHYDRAFX - GRSTEM-RSSTEM) ADDNPPST = parameters%STPT(PGS)*CBHYDRAFX - GRSTEM-RSSTEM @@ -9270,9 +10647,9 @@ SUBROUTINE CO2FLUX_CROP (parameters, ! ELSE FASTCP = FASTCP + (RTTOVR+LFTOVR+STTOVR+DIELF)*DT ! END IF - FST = 2.0**( (STC-283.16)/10. ) + FST = 2.0**( (STC-283.16)/10.0 ) FSW = WROOT / (0.20+WROOT) * 0.23 / (0.23+WROOT) - RSSOIL = FSW * FST * parameters%MRP* MAX(0.,FASTCP*1.E-3)*12.E-6 + RSSOIL = FSW * FST * parameters%MRP* MAX(0.0,FASTCP*1.0E-3)*12.0E-6 STABLC = 0.1*RSSOIL FASTCP = FASTCP - (RSSOIL + STABLC)*DT @@ -9293,7 +10670,7 @@ SUBROUTINE CO2FLUX_CROP (parameters, GRLEAF + GRROOT + GRGRAIN !g/m2/s C HETERS = RSSOIL !g/m2/s C - NEE = (AUTORS + HETERS - GPP)*44./30. !g/m2/s CO2 + NEE = (AUTORS + HETERS - GPP)*44.0/30.0 !g/m2/s CO2 TOTSC = FASTCP + STBLCP !g/m2 C TOTLB = LFMASS + RTMASS + GRAIN @@ -9312,7 +10689,7 @@ SUBROUTINE CO2FLUX_CROP (parameters, ! END IF ! IF(PGS == 1 .OR. PGS == 2 .OR. PGS == 8) THEN - IF(PGS == 8 .and. (GRAIN > 0. .or. LFMASS > 0 .or. STMASS > 0 .or. RTMASS > 0)) THEN + IF(PGS == 8 .and. (GRAIN > 0.0 .or. LFMASS > 0 .or. STMASS > 0 .or. RTMASS > 0)) THEN XLAI = 0.05 XSAI = 0.05 LFMASS = LFMSMN @@ -9629,17 +11006,15 @@ SUBROUTINE EMERG(DT, TSOIL, DD, TBEM, EMA, EMB, STATE_GECROS) IF ((TSOIL-273.15).LT.TBEM) THEN ELSE - STATE_GECROS(43) = STATE_GECROS(43) + (TSOIL-273.15-TBEM)/(86400./DT) + STATE_GECROS(43) = STATE_GECROS(43) + (TSOIL-273.15-TBEM)/(86400.0/DT) ENDIF EMTH = EMA + EMB*DD IF (STATE_GECROS(43).GT.EMTH) THEN - STATE_GECROS(41)=1. -! write(*,*) 'Crop emerged on ', nowdate -! read(*,*) + STATE_GECROS(41)=1.0 ELSE - STATE_GECROS(41)=-1. + STATE_GECROS(41)=-1.0 ENDIF RETURN @@ -9650,9 +11025,10 @@ END SUBROUTINE EMERG !== begin noahmp_options =========================================================================== - subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & - iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc, & - iopt_rsf , iopt_soil, iopt_pedo, iopt_crop, iopt_irr, iopt_irrm) + subroutine noahmp_options( idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & + iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot ,iopt_stc , & + iopt_rsf ,iopt_soil ,iopt_pedo ,iopt_crop ,iopt_irr ,iopt_irrm, & + iopt_infdv, iopt_tdrn) implicit none @@ -9682,6 +11058,8 @@ subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ! 1 -> sprinkler ON ! 2 -> micro/drip ON ! 3 -> flood irrigation ON + INTEGER, INTENT(IN) :: iopt_infdv!infiltration options for dynamic VIC (1->Philip; 2-> Green-Ampt;3->Smith-Parlange) + INTEGER, INTENT(IN) :: iopt_tdrn !tile drainage (0->none; 1-> simple 2->Hooghoudt's) ! ------------------------------------------------------------------------------------------------- dveg = idveg @@ -9703,7 +11081,9 @@ subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc opt_crop = iopt_crop opt_irr = iopt_irr opt_irrm = iopt_irrm - + opt_infdv= iopt_infdv + opt_tdrn = iopt_tdrn + end subroutine noahmp_options END MODULE MODULE_SF_NOAHMPLSM @@ -9799,16 +11179,23 @@ MODULE NOAHMP_TABLES INTEGER :: SLCATS - REAL :: BEXP_TABLE(MAX_SOILTYP) !maximum intercepted h2o per unit lai+sai (mm) + REAL :: BEXP_TABLE(MAX_SOILTYP) !maximum intercepted h2o per unit lai+sai (mm) REAL :: SMCDRY_TABLE(MAX_SOILTYP) !characteristic leaf dimension (m) - REAL :: F1_TABLE(MAX_SOILTYP) !momentum roughness length (m) + REAL :: F1_TABLE(MAX_SOILTYP) !momentum roughness length (m) REAL :: SMCMAX_TABLE(MAX_SOILTYP) !top of canopy (m) REAL :: SMCREF_TABLE(MAX_SOILTYP) !bottom of canopy (m) REAL :: PSISAT_TABLE(MAX_SOILTYP) !tree density (no. of trunks per m2) REAL :: DKSAT_TABLE(MAX_SOILTYP) !tree crown radius (m) REAL :: DWSAT_TABLE(MAX_SOILTYP) !monthly stem area index, one-sided REAL :: SMCWLT_TABLE(MAX_SOILTYP) !monthly leaf area index, one-sided - REAL :: QUARTZ_TABLE(MAX_SOILTYP) !single-side leaf area per Kg [m2/kg] + REAL :: QUARTZ_TABLE(MAX_SOILTYP) !single-side leaf area per Kg [m2/kg] + REAL :: BVIC_TABLE(MAX_SOILTYP) !VIC model infiltration parameter (-) for opt_run=6 + REAL :: AXAJ_TABLE(MAX_SOILTYP) !Xinanjiang: Tension water distribution inflection parameter [-] for opt_run=7 + REAL :: BXAJ_TABLE(MAX_SOILTYP) !Xinanjiang: Tension water distribution shape parameter [-] for opt_run=7 + REAL :: XXAJ_TABLE(MAX_SOILTYP) !Xinanjiang: Free water distribution shape parameter [-] for opt_run=7 + REAL :: BDVIC_TABLE(MAX_SOILTYP) !VIC model infiltration parameter (-) + REAL :: GDVIC_TABLE(MAX_SOILTYP) !mean capilary drive (m) + REAL :: BBVIC_TABLE(MAX_SOILTYP) !heterogeniety parameter for DVIC infiltration [-] ! GENPARM.TBL parameters @@ -9932,6 +11319,19 @@ MODULE NOAHMP_TABLES REAL :: RTCT_TABLE(NCROP,NSTAGE) ! root to grain REAL :: BIO2LAI_TABLE(NCROP) ! leaf are per living leaf biomass [m^2/kg] +! tile drainage parameters + REAL :: TDSMCFAC_TABLE(MAX_SOILTYP) + REAL :: TD_DC_TABLE(MAX_SOILTYP) + INTEGER :: TD_DEPTH_TABLE(MAX_SOILTYP) + INTEGER :: DRAIN_LAYER_OPT_TABLE + REAL :: TD_DCOEF_TABLE(MAX_SOILTYP) + REAL :: TD_D_TABLE(MAX_SOILTYP) + REAL :: TD_ADEPTH_TABLE(MAX_SOILTYP) + REAL :: TD_RADI_TABLE(MAX_SOILTYP) + REAL :: TD_SPAC_TABLE(MAX_SOILTYP) + REAL :: TD_DDRAIN_TABLE(MAX_SOILTYP) + REAL :: KLAT_FAC_TABLE(MAX_SOILTYP) + ! MPTABLE.TBL optional parameters REAL :: sr2006_theta_1500t_a ! sand coefficient @@ -10046,55 +11446,55 @@ subroutine read_mp_veg_parameters(DATASET_IDENTIFIER) RHOL_VIS, RHOL_NIR, RHOS_VIS, RHOS_NIR, TAUL_VIS, TAUL_NIR, TAUS_VIS, TAUS_NIR, SLAREA, EPS1, EPS2, EPS3, EPS4, EPS5 ! Initialize our variables to bad values, so that if the namelist read fails, we come to a screeching halt as soon as we try to use anything. - CH2OP_TABLE = -1.E36 - DLEAF_TABLE = -1.E36 - Z0MVT_TABLE = -1.E36 - HVT_TABLE = -1.E36 - HVB_TABLE = -1.E36 - DEN_TABLE = -1.E36 - RC_TABLE = -1.E36 - MFSNO_TABLE = -1.E36 - SCFFAC_TABLE = -1.E36 - RHOL_TABLE = -1.E36 - RHOS_TABLE = -1.E36 - TAUL_TABLE = -1.E36 - TAUS_TABLE = -1.E36 - XL_TABLE = -1.E36 - CWPVT_TABLE = -1.E36 - C3PSN_TABLE = -1.E36 - KC25_TABLE = -1.E36 - AKC_TABLE = -1.E36 - KO25_TABLE = -1.E36 - AKO_TABLE = -1.E36 - AVCMX_TABLE = -1.E36 - AQE_TABLE = -1.E36 - LTOVRC_TABLE = -1.E36 - DILEFC_TABLE = -1.E36 - DILEFW_TABLE = -1.E36 - RMF25_TABLE = -1.E36 - SLA_TABLE = -1.E36 - FRAGR_TABLE = -1.E36 - TMIN_TABLE = -1.E36 - VCMX25_TABLE = -1.E36 - TDLEF_TABLE = -1.E36 - BP_TABLE = -1.E36 - MP_TABLE = -1.E36 - QE25_TABLE = -1.E36 - RMS25_TABLE = -1.E36 - RMR25_TABLE = -1.E36 - ARM_TABLE = -1.E36 - FOLNMX_TABLE = -1.E36 - WDPOOL_TABLE = -1.E36 - WRRAT_TABLE = -1.E36 - MRP_TABLE = -1.E36 - SAIM_TABLE = -1.E36 - LAIM_TABLE = -1.E36 - NROOT_TABLE = -1.E36 - RGL_TABLE = -1.E36 - RS_TABLE = -1.E36 - HS_TABLE = -1.E36 - TOPT_TABLE = -1.E36 - RSMAX_TABLE = -1.E36 + CH2OP_TABLE = -1.0E36 + DLEAF_TABLE = -1.0E36 + Z0MVT_TABLE = -1.0E36 + HVT_TABLE = -1.0E36 + HVB_TABLE = -1.0E36 + DEN_TABLE = -1.0E36 + RC_TABLE = -1.0E36 + MFSNO_TABLE = -1.0E36 + SCFFAC_TABLE = -1.0E36 + RHOL_TABLE = -1.0E36 + RHOS_TABLE = -1.0E36 + TAUL_TABLE = -1.0E36 + TAUS_TABLE = -1.0E36 + XL_TABLE = -1.0E36 + CWPVT_TABLE = -1.0E36 + C3PSN_TABLE = -1.0E36 + KC25_TABLE = -1.0E36 + AKC_TABLE = -1.0E36 + KO25_TABLE = -1.0E36 + AKO_TABLE = -1.0E36 + AVCMX_TABLE = -1.0E36 + AQE_TABLE = -1.0E36 + LTOVRC_TABLE = -1.0E36 + DILEFC_TABLE = -1.0E36 + DILEFW_TABLE = -1.0E36 + RMF25_TABLE = -1.0E36 + SLA_TABLE = -1.0E36 + FRAGR_TABLE = -1.0E36 + TMIN_TABLE = -1.0E36 + VCMX25_TABLE = -1.0E36 + TDLEF_TABLE = -1.0E36 + BP_TABLE = -1.0E36 + MP_TABLE = -1.0E36 + QE25_TABLE = -1.0E36 + RMS25_TABLE = -1.0E36 + RMR25_TABLE = -1.0E36 + ARM_TABLE = -1.0E36 + FOLNMX_TABLE = -1.0E36 + WDPOOL_TABLE = -1.0E36 + WRRAT_TABLE = -1.0E36 + MRP_TABLE = -1.0E36 + SAIM_TABLE = -1.0E36 + LAIM_TABLE = -1.0E36 + NROOT_TABLE = -1.0E36 + RGL_TABLE = -1.0E36 + RS_TABLE = -1.0E36 + HS_TABLE = -1.0E36 + TOPT_TABLE = -1.0E36 + RSMAX_TABLE = -1.0E36 ISURBAN_TABLE = -99999 ISWATER_TABLE = -99999 ISBARREN_TABLE = -99999 @@ -10251,23 +11651,30 @@ subroutine read_mp_soil_parameters() ! Initialize our variables to bad values, so that if the namelist read fails, we come to a screeching halt as soon as we try to use anything. - BEXP_TABLE = -1.E36 - SMCDRY_TABLE = -1.E36 - F1_TABLE = -1.E36 - SMCMAX_TABLE = -1.E36 - SMCREF_TABLE = -1.E36 - PSISAT_TABLE = -1.E36 - DKSAT_TABLE = -1.E36 - DWSAT_TABLE = -1.E36 - SMCWLT_TABLE = -1.E36 - QUARTZ_TABLE = -1.E36 - SLOPE_TABLE = -1.E36 - CSOIL_TABLE = -1.E36 - REFDK_TABLE = -1.E36 - REFKDT_TABLE = -1.E36 - FRZK_TABLE = -1.E36 - ZBOT_TABLE = -1.E36 - CZIL_TABLE = -1.E36 + BEXP_TABLE = -1.0E36 + SMCDRY_TABLE = -1.0E36 + F1_TABLE = -1.0E36 + SMCMAX_TABLE = -1.0E36 + SMCREF_TABLE = -1.0E36 + PSISAT_TABLE = -1.0E36 + DKSAT_TABLE = -1.0E36 + DWSAT_TABLE = -1.0E36 + SMCWLT_TABLE = -1.0E36 + QUARTZ_TABLE = -1.0E36 + SLOPE_TABLE = -1.0E36 + CSOIL_TABLE = -1.0E36 + REFDK_TABLE = -1.0E36 + REFKDT_TABLE = -1.0E36 + FRZK_TABLE = -1.0E36 + ZBOT_TABLE = -1.0E36 + CZIL_TABLE = -1.0E36 + BVIC_TABLE = -1.0E36 + AXAJ_TABLE = -1.0E36 + BXAJ_TABLE = -1.0E36 + XXAJ_TABLE = -1.0E36 + BDVIC_TABLE = -1.0E36 + GDVIC_TABLE = -1.0E36 + BBVIC_TABLE = -1.0E36 ! !-----READ IN SOIL PROPERTIES FROM SOILPARM.TBL @@ -10292,9 +11699,10 @@ subroutine read_mp_soil_parameters() CALL wrf_message ( message ) DO LC=1,SLCATS - READ (21,*) ITMP,BEXP_TABLE(LC),SMCDRY_TABLE(LC),F1_TABLE(LC),SMCMAX_TABLE(LC), & + READ (21,*) ITMP,BEXP_TABLE(LC),SMCDRY_TABLE(LC),F1_TABLE(LC),SMCMAX_TABLE(LC), & SMCREF_TABLE(LC),PSISAT_TABLE(LC),DKSAT_TABLE(LC), DWSAT_TABLE(LC), & - SMCWLT_TABLE(LC), QUARTZ_TABLE(LC) + SMCWLT_TABLE(LC), QUARTZ_TABLE(LC),BVIC_TABLE(LC), AXAJ_TABLE(LC), & + BXAJ_TABLE(LC),XXAJ_TABLE(LC),BDVIC_TABLE(LC),BBVIC_TABLE(LC),GDVIC_TABLE(LC) ENDDO CLOSE (21) @@ -10364,14 +11772,14 @@ subroutine read_mp_rad_parameters() ! Initialize our variables to bad values, so that if the namelist read fails, we come to a screeching halt as soon as we try to use anything. - ALBSAT_TABLE = -1.E36 - ALBDRY_TABLE = -1.E36 - ALBICE_TABLE = -1.E36 - ALBLAK_TABLE = -1.E36 - OMEGAS_TABLE = -1.E36 - BETADS_TABLE = -1.E36 - BETAIS_TABLE = -1.E36 - EG_TABLE = -1.E36 + ALBSAT_TABLE = -1.0E36 + ALBDRY_TABLE = -1.0E36 + ALBICE_TABLE = -1.0E36 + ALBLAK_TABLE = -1.0E36 + OMEGAS_TABLE = -1.0E36 + BETADS_TABLE = -1.0E36 + BETAIS_TABLE = -1.0E36 + EG_TABLE = -1.0E36 inquire( file='MPTABLE.TBL', exist=file_named ) if ( file_named ) then @@ -10418,28 +11826,28 @@ subroutine read_mp_global_parameters() ! Initialize our variables to bad values, so that if the namelist read fails, we come to a screeching halt as soon as we try to use anything. - CO2_TABLE = -1.E36 - O2_TABLE = -1.E36 - TIMEAN_TABLE = -1.E36 - FSATMX_TABLE = -1.E36 - Z0SNO_TABLE = -1.E36 - SSI_TABLE = -1.E36 -SNOW_RET_FAC_TABLE = -1.E36 - SNOW_EMIS_TABLE = -1.E36 - SWEMX_TABLE = -1.E36 - TAU0_TABLE = -1.E36 -GRAIN_GROWTH_TABLE = -1.E36 -EXTRA_GROWTH_TABLE = -1.E36 - DIRT_SOOT_TABLE = -1.E36 - BATS_COSZ_TABLE = -1.E36 -BATS_VIS_NEW_TABLE = -1.E36 -BATS_NIR_NEW_TABLE = -1.E36 -BATS_VIS_AGE_TABLE = -1.E36 -BATS_NIR_AGE_TABLE = -1.E36 -BATS_VIS_DIR_TABLE = -1.E36 -BATS_NIR_DIR_TABLE = -1.E36 -RSURF_SNOW_TABLE = -1.E36 - RSURF_EXP_TABLE = -1.E36 + CO2_TABLE = -1.0E36 + O2_TABLE = -1.0E36 + TIMEAN_TABLE = -1.0E36 + FSATMX_TABLE = -1.0E36 + Z0SNO_TABLE = -1.0E36 + SSI_TABLE = -1.0E36 +SNOW_RET_FAC_TABLE = -1.0E36 + SNOW_EMIS_TABLE = -1.0E36 + SWEMX_TABLE = -1.0E36 + TAU0_TABLE = -1.0E36 +GRAIN_GROWTH_TABLE = -1.0E36 +EXTRA_GROWTH_TABLE = -1.0E36 + DIRT_SOOT_TABLE = -1.0E36 + BATS_COSZ_TABLE = -1.0E36 +BATS_VIS_NEW_TABLE = -1.0E36 +BATS_NIR_NEW_TABLE = -1.0E36 +BATS_VIS_AGE_TABLE = -1.0E36 +BATS_NIR_AGE_TABLE = -1.0E36 +BATS_VIS_DIR_TABLE = -1.0E36 +BATS_NIR_DIR_TABLE = -1.0E36 +RSURF_SNOW_TABLE = -1.0E36 + RSURF_EXP_TABLE = -1.0E36 inquire( file='MPTABLE.TBL', exist=file_named ) if ( file_named ) then @@ -10570,56 +11978,56 @@ subroutine read_mp_crop_parameters() DEFAULT_CROP_TABLE = -99999 PLTDAY_TABLE = -99999 HSDAY_TABLE = -99999 - PLANTPOP_TABLE = -1.E36 - IRRI_TABLE = -1.E36 - GDDTBASE_TABLE = -1.E36 - GDDTCUT_TABLE = -1.E36 - GDDS1_TABLE = -1.E36 - GDDS2_TABLE = -1.E36 - GDDS3_TABLE = -1.E36 - GDDS4_TABLE = -1.E36 - GDDS5_TABLE = -1.E36 - C3PSNI_TABLE = -1.E36 ! parameter from PSN copied from stomata ! Zhe Zhang 2020-07-13 - KC25I_TABLE = -1.E36 - AKCI_TABLE = -1.E36 - KO25I_TABLE = -1.E36 - AKOI_TABLE = -1.E36 - AVCMXI_TABLE = -1.E36 - VCMX25I_TABLE = -1.E36 - BPI_TABLE = -1.E36 - MPI_TABLE = -1.E36 - FOLNMXI_TABLE = -1.E36 - QE25I_TABLE = -1.E36 ! ends here + PLANTPOP_TABLE = -1.0E36 + IRRI_TABLE = -1.0E36 + GDDTBASE_TABLE = -1.0E36 + GDDTCUT_TABLE = -1.0E36 + GDDS1_TABLE = -1.0E36 + GDDS2_TABLE = -1.0E36 + GDDS3_TABLE = -1.0E36 + GDDS4_TABLE = -1.0E36 + GDDS5_TABLE = -1.0E36 + C3PSNI_TABLE = -1.0E36 ! parameter from PSN copied from stomata ! Zhe Zhang 2020-07-13 + KC25I_TABLE = -1.0E36 + AKCI_TABLE = -1.0E36 + KO25I_TABLE = -1.0E36 + AKOI_TABLE = -1.0E36 + AVCMXI_TABLE = -1.0E36 + VCMX25I_TABLE = -1.0E36 + BPI_TABLE = -1.0E36 + MPI_TABLE = -1.0E36 + FOLNMXI_TABLE = -1.0E36 + QE25I_TABLE = -1.0E36 ! ends here C3C4_TABLE = -99999 - AREF_TABLE = -1.E36 - PSNRF_TABLE = -1.E36 - I2PAR_TABLE = -1.E36 - TASSIM0_TABLE = -1.E36 - TASSIM1_TABLE = -1.E36 - TASSIM2_TABLE = -1.E36 - K_TABLE = -1.E36 - EPSI_TABLE = -1.E36 - Q10MR_TABLE = -1.E36 - FOLN_MX_TABLE = -1.E36 - LEFREEZ_TABLE = -1.E36 - DILE_FC_TABLE = -1.E36 - DILE_FW_TABLE = -1.E36 - FRA_GR_TABLE = -1.E36 - LF_OVRC_TABLE = -1.E36 - ST_OVRC_TABLE = -1.E36 - RT_OVRC_TABLE = -1.E36 - LFMR25_TABLE = -1.E36 - STMR25_TABLE = -1.E36 - RTMR25_TABLE = -1.E36 - GRAINMR25_TABLE = -1.E36 - LFPT_TABLE = -1.E36 - STPT_TABLE = -1.E36 - RTPT_TABLE = -1.E36 - GRAINPT_TABLE = -1.E36 - LFCT_TABLE = -1.E36 ! convert start - STCT_TABLE = -1.E36 - RTCT_TABLE = -1.E36 ! convert end - BIO2LAI_TABLE = -1.E36 + AREF_TABLE = -1.0E36 + PSNRF_TABLE = -1.0E36 + I2PAR_TABLE = -1.0E36 + TASSIM0_TABLE = -1.0E36 + TASSIM1_TABLE = -1.0E36 + TASSIM2_TABLE = -1.0E36 + K_TABLE = -1.0E36 + EPSI_TABLE = -1.0E36 + Q10MR_TABLE = -1.0E36 + FOLN_MX_TABLE = -1.0E36 + LEFREEZ_TABLE = -1.0E36 + DILE_FC_TABLE = -1.0E36 + DILE_FW_TABLE = -1.0E36 + FRA_GR_TABLE = -1.0E36 + LF_OVRC_TABLE = -1.0E36 + ST_OVRC_TABLE = -1.0E36 + RT_OVRC_TABLE = -1.0E36 + LFMR25_TABLE = -1.0E36 + STMR25_TABLE = -1.0E36 + RTMR25_TABLE = -1.0E36 + GRAINMR25_TABLE = -1.0E36 + LFPT_TABLE = -1.0E36 + STPT_TABLE = -1.0E36 + RTPT_TABLE = -1.0E36 + GRAINPT_TABLE = -1.0E36 + LFCT_TABLE = -1.0E36 ! convert start + STCT_TABLE = -1.0E36 + RTCT_TABLE = -1.0E36 ! convert end + BIO2LAI_TABLE = -1.0E36 inquire( file='MPTABLE.TBL', exist=file_named ) @@ -10795,15 +12203,15 @@ subroutine read_mp_irrigation_parameters() NAMELIST / noahmp_irrigation_parameters / IRR_FRAC, IRR_HAR, IRR_LAI, IRR_MAD, FILOSS, & SPRIR_RATE, MICIR_RATE, FIRTFAC, IR_RAIN - IRR_FRAC_TABLE = -1.E36 ! irrigation Fraction + IRR_FRAC_TABLE = -1.0E36 ! irrigation Fraction IRR_HAR_TABLE = 0 ! number of days before harvest date to stop irrigation - IRR_LAI_TABLE = -1.E36 ! Minimum lai to trigger irrigation - IRR_MAD_TABLE = -1.E36 ! management allowable deficit (0-1) - FILOSS_TABLE = -1.E36 ! fraction of flood irrigation loss (0-1) - SPRIR_RATE_TABLE = -1.E36 ! mm/h, sprinkler irrigation rate - MICIR_RATE_TABLE = -1.E36 ! mm/h, micro irrigation rate - FIRTFAC_TABLE = -1.E36 ! flood application rate factor - IR_RAIN_TABLE = -1.E36 ! maximum precipitation to stop irrigation trigger + IRR_LAI_TABLE = -1.0E36 ! Minimum lai to trigger irrigation + IRR_MAD_TABLE = -1.0E36 ! management allowable deficit (0-1) + FILOSS_TABLE = -1.0E36 ! fraction of flood irrigation loss (0-1) + SPRIR_RATE_TABLE = -1.0E36 ! mm/h, sprinkler irrigation rate + MICIR_RATE_TABLE = -1.0E36 ! mm/h, micro irrigation rate + FIRTFAC_TABLE = -1.0E36 ! flood application rate factor + IR_RAIN_TABLE = -1.0E36 ! maximum precipitation to stop irrigation trigger inquire( file='MPTABLE.TBL', exist=file_named ) if ( file_named ) then @@ -10820,6 +12228,11 @@ subroutine read_mp_irrigation_parameters() read(15,noahmp_irrigation_parameters) close(15) + if (FILOSS < 0.0 .or. FILOSS > 0.99 ) then + write(*,'("WARNING: FILOSS should be >0.0 and <0.99")') + call wrf_error_fatal("STOP in NoahMP_irrigation_parameters") + endif + IRR_FRAC_TABLE = IRR_FRAC ! irrigation Fraction IRR_HAR_TABLE = IRR_HAR ! number of days before harvest date to stop irrigation IRR_LAI_TABLE = IRR_LAI ! Minimum lai to trigger irrigation @@ -10832,6 +12245,64 @@ subroutine read_mp_irrigation_parameters() end subroutine read_mp_irrigation_parameters + subroutine read_tiledrain_parameters() + implicit none + integer :: ierr + logical :: file_named + REAL, DIMENSION(MAX_SOILTYP) :: TDSMC_FAC + INTEGER, DIMENSION(MAX_SOILTYP) :: TD_DEPTH + REAL, DIMENSION(MAX_SOILTYP) :: TD_DC + INTEGER :: DRAIN_LAYER_OPT + REAL, DIMENSION(MAX_SOILTYP) :: TD_DCOEF + REAL, DIMENSION(MAX_SOILTYP) :: TD_D + REAL, DIMENSION(MAX_SOILTYP) :: TD_ADEPTH + REAL, DIMENSION(MAX_SOILTYP) :: TD_RADI + REAL, DIMENSION(MAX_SOILTYP) :: TD_SPAC + REAL, DIMENSION(MAX_SOILTYP) :: TD_DDRAIN + REAL, DIMENSION(MAX_SOILTYP) :: KLAT_FAC + NAMELIST / noahmp_tiledrain_parameters /DRAIN_LAYER_OPT,TDSMC_FAC,TD_DEPTH,TD_DC,& + TD_DCOEF,TD_D,TD_ADEPTH,TD_RADI,TD_SPAC,TD_DDRAIN,& + KLAT_FAC + ! Initialize our variables to bad values, so that if the namelist read fails, we come to a screeching halt as soon as we try to use anything. + TDSMCFAC_TABLE = -99999 + TD_DEPTH_TABLE = -99999 + TD_DC_TABLE = -99999 + DRAIN_LAYER_OPT_TABLE = -99999 + TD_DCOEF_TABLE = -99999 + TD_D_TABLE = -99999 + TD_ADEPTH_TABLE = -99999 + TD_RADI_TABLE = -99999 + TD_SPAC_TABLE = -99999 + TD_DDRAIN_TABLE = -99999 + KLAT_FAC_TABLE = -99999 + + inquire( file='MPTABLE.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="MPTABLE.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if (ierr /= 0) then + write(*,'("WARNING: Cannot find file MPTABLE.TBL")') + call wrf_error_fatal("STOP in Noah-MP read_tiledrain_parameters") + endif + read(15,noahmp_tiledrain_parameters) + close(15) + TDSMCFAC_TABLE = TDSMC_FAC + TD_DEPTH_TABLE = TD_DEPTH + DRAIN_LAYER_OPT_TABLE = DRAIN_LAYER_OPT + TD_DC_TABLE = TD_DC + + TD_DCOEF_TABLE = TD_DCOEF + TD_D_TABLE = TD_D + TD_ADEPTH_TABLE = TD_ADEPTH + TD_RADI_TABLE = TD_RADI + TD_SPAC_TABLE = TD_SPAC + TD_DDRAIN_TABLE = TD_DDRAIN + KLAT_FAC_TABLE = KLAT_FAC + + end subroutine read_tiledrain_parameters + subroutine read_mp_optional_parameters() implicit none integer :: ierr @@ -10871,7 +12342,6 @@ subroutine read_mp_optional_parameters() read(15,noahmp_optional_parameters) close(15) - end subroutine read_mp_optional_parameters END MODULE NOAHMP_TABLES diff --git a/phys/module_surface_driver.F b/phys/module_surface_driver.F index 72b812f762..cb34aa1df9 100644 --- a/phys/module_surface_driver.F +++ b/phys/module_surface_driver.F @@ -5,6 +5,7 @@ MODULE module_surface_driver SUBROUTINE surface_driver( & & HYDRO_dt,sfcheadrt,INFXSRT,soldrain, & + & qtiledrain,ZWATBLE2D, & ! tile drainage for WRF-Hydro & acgrdflx,achfx,aclhf & & ,acsnom,acsnow,snowfallac,akhs,akms,albedo,br,canwat & & ,chklowq,dt,dx,dx2d,area2d,dz8w,dzs,glw & @@ -44,7 +45,7 @@ SUBROUTINE surface_driver( & & ,idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz & & ,iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot ,iopt_stc & & ,iopt_gla ,iopt_rsf ,iopt_soil ,iopt_pedo ,iopt_crop ,iopt_irr & - & ,iopt_irrm & + & ,iopt_irrm,iopt_infdv,iopt_tdrn ,soiltstep & & ,soilcomp , soilcl1, soilcl2, soilcl3, soilcl4 & & ,isnowxy ,tvxy ,tgxy ,canicexy ,canliqxy ,eahxy & & ,tahxy ,cmxy ,chxy ,fwetxy ,sneqvoxy ,alboldxy & @@ -61,13 +62,24 @@ SUBROUTINE surface_driver( & & ,shgxy ,shcxy ,shbxy ,evgxy ,evbxy ,ghvxy & & ,ghbxy ,irgxy ,ircxy ,irbxy ,trxy ,evcxy & & ,chleafxy ,chucxy ,chv2xy ,chb2xy ,chstarxy & + ! Noah-MP extra output fields + & ,qintsxy ,qintrxy ,qdripsxy ,qdriprxy ,qthrosxy ,qthrorxy & + & ,qsnsubxy ,qsnfroxy ,qsubcxy ,qfrocxy ,qevacxy ,qdewcxy & + & ,qfrzcxy ,qmeltcxy ,qsnbotxy ,pondingxy ,PAHXY ,PAHGXY & + & ,PAHVXY ,PAHBXY & + & ,fpicexy ,RAINLSM ,SNOWLSM ,forctlsm ,forcqlsm ,forcplsm & + & ,forczlsm ,forcwlsm ,acc_ssoil,acc_qinsur,acc_qseva ,acc_etrani & + & ,eflxbxy ,soilenergy,snowenergy, canhsxy & + & ,ACC_DWATERXY, ACC_PRCPXY, ACC_ECANXY, ACC_ETRANXY, ACC_EDIRXY & ! Noah-MP irrigation & ,IRFRACT ,SIFRACT ,MIFRACT ,FIFRACT ,IRNUMSI ,IRNUMMI & & ,IRNUMFI ,IRWATSI ,IRWATMI ,IRWATFI ,IRELOSS ,IRSIVOL & - & ,IRMIVOL ,IRFIVOL ,IRRSPLH & + & ,IRMIVOL ,IRFIVOL ,IRRSPLH & + ! Noah-MP tile drainage + & ,QTDRAIN ,TD_FRACTION & ! Noah-MP ground water & ,smcwtdxy ,rechxy ,deeprechxy,fdepthxy,areaxy ,rivercondxy, riverbedxy & - & ,eqzwt ,pexpxy ,qrfxy ,qspringxy,qslatxy ,qrfsxy ,qspringsxy & + & ,eqzwt ,pexpxy ,qrfxy ,qspringxy,qslatxy ,qrfsxy, qlatxy, qspringsxy & & ,smoiseq ,wtddt ,stepwtd & ,gecros_state & ! Optional gecros crop & ,opt_thcnd & @@ -631,6 +643,7 @@ SUBROUTINE surface_driver( & !added by Wei Yu for WRF_HYDRO real :: HYDRO_dt REAL, DIMENSION( ims:ime , jms:jme ):: sfcheadrt,INFXSRT, soldrain + REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: qtiledrain,ZWATBLE2D ! NoahMP tile drainage REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SMOIS REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: TSLB @@ -849,7 +862,8 @@ SUBROUTINE surface_driver( & INTEGER, OPTIONAL, INTENT(IN) :: idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc , iopt_frz, & iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, iopt_stc, & iopt_gla, iopt_rsf, iopt_soil,iopt_pedo,iopt_crop, iopt_irr, & - iopt_irrm + iopt_irrm,iopt_infdv,iopt_tdrn + REAL, OPTIONAL, INTENT(IN) :: soiltstep ! NoahMP soil timestep (s) REAL, OPTIONAL, DIMENSION(ims:ime ,8, jms:jme), INTENT(IN) :: SOILCOMP REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme) , INTENT(IN) :: SOILCL1,SOILCL2,SOILCL3,SOILCL4 @@ -865,6 +879,18 @@ SUBROUTINE surface_driver( & SAVXY, SAGXY, RSSUNXY, RSSHAXY, BGAPXY, WGAPXY, TGVXY, TGBXY, CHVXY, CHBXY, SHGXY, & SHCXY, SHBXY, EVGXY, EVBXY, GHVXY, GHBXY, IRGXY, IRCXY, IRBXY, TRXY, EVCXY, & CHLEAFXY, CHUCXY, CHV2XY, CHB2XY,CHSTARXY + REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme) , INTENT(INOUT) :: acc_ssoil,acc_qinsur,acc_qseva + REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme) , INTENT(INOUT) :: ACC_DWATERXY, ACC_PRCPXY, & + ACC_ECANXY, ACC_ETRANXY, ACC_EDIRXY + REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme) , INTENT( OUT) :: eflxbxy,soilenergy, snowenergy + REAL, OPTIONAL, DIMENSION(ims:ime , 1:num_soil_layers, jms:jme), INTENT(INOUT) :: acc_etrani + REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: & + qintsxy ,qintrxy ,qdripsxy ,& + qdriprxy ,qthrosxy ,qthrorxy ,& + qsnsubxy ,qsnfroxy ,qsubcxy ,& + qfrocxy ,qevacxy ,qdewcxy,qfrzcxy ,qmeltcxy ,& + qsnbotxy ,pondingxy, PAHXY ,PAHGXY, PAHVXY, PAHBXY,& + fpicexy,RAINLSM,SNOWLSM,forctlsm,forcqlsm,forcplsm,forczlsm,forcwlsm,canhsxy INTEGER, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(IN) :: CROPCAT REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(IN) :: PLANTING REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(IN) :: HARVEST @@ -875,6 +901,9 @@ SUBROUTINE surface_driver( & REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: IRWATSI, IRWATMI, IRWATFI, IRELOSS, & IRSIVOL, IRMIVOL, IRFIVOL, IRRSPLH INTEGER, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: IRNUMSI, IRNUMMI, IRNUMFI +! NoahMP tiledrainage + REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(IN) :: TD_FRACTION + REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: QTDRAIN ! NoahMP specific fields - runoff option 5 @@ -883,7 +912,7 @@ SUBROUTINE surface_driver( & REAL, OPTIONAL, DIMENSION(ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: smoiseq REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: & SMCWTDXY, RECHXY, DEEPRECHXY, FDEPTHXY, AREAXY, RIVERCONDXY, RIVERBEDXY, & - EQZWT, PEXPXY, QRFXY, QSPRINGXY, QSLATXY, QRFSXY, QSPRINGSXY + EQZWT, PEXPXY, QRFXY, QSPRINGXY, QSLATXY, QRFSXY, QSPRINGSXY, QLATXY REAL, OPTIONAL, DIMENSION(ims:ime,60,jms:jme) :: gecros_state ! Optional gecros crop @@ -3048,7 +3077,7 @@ SUBROUTINE surface_driver( & IDVEG, IOPT_CRS, IOPT_BTR, IOPT_RUN, IOPT_SFC, IOPT_FRZ, & IOPT_INF, IOPT_RAD, IOPT_ALB, IOPT_SNF, IOPT_TBOT, IOPT_STC, & IOPT_GLA, IOPT_RSF, IOPT_SOIL,IOPT_PEDO,IOPT_CROP, IOPT_IRR, & - IOPT_IRRM, & + IOPT_IRRM, IOPT_INFDV, IOPT_TDRN, soiltstep, & IZ0TLND, SF_URBAN_PHYSICS, & SOILCOMP, SOILCL1, SOILCL2, SOILCL3, SOILCL4, & T_PHY, QV_CURR, U_PHY, V_PHY, SWDOWN, SWDDIR, & @@ -3069,6 +3098,7 @@ SUBROUTINE surface_driver( & WOODXY, STBLCPXY, FASTCPXY, LAI, XSAIXY, TAUSSXY, & SMOISEQ, SMCWTDXY,DEEPRECHXY, RECHXY, GRAINXY, GDDXY,PGSXY, & ! IN/OUT Noah MP only GECROS_STATE, & ! IN/OUT gecros model + QTDRAIN, TD_FRACTION, & ! IN/OUT tile drainage T2MVXY, T2MBXY, Q2MVXY, Q2MBXY, & TRADXY, NEEXY, GPPXY, NPPXY, FVEGXY, RUNSFXY, & RUNSBXY, ECANXY, EDIRXY, ETRANXY, FSAXY, FIRAXY, & @@ -3077,8 +3107,16 @@ SUBROUTINE surface_driver( & SHGXY, SHCXY, SHBXY, EVGXY, EVBXY, GHVXY, & GHBXY, IRGXY, IRCXY, IRBXY, TRXY, EVCXY, & CHLEAFXY, CHUCXY, CHV2XY, CHB2XY, RS, & + qintsxy ,qintrxy ,qdripsxy ,& + qdriprxy ,qthrosxy ,qthrorxy ,& + qsnsubxy ,qsnfroxy ,qsubcxy ,& + qfrocxy ,qevacxy ,qdewcxy ,qfrzcxy ,qmeltcxy ,& + qsnbotxy ,pondingxy ,PAHXY ,PAHGXY, PAHVXY, PAHBXY,& + fpicexy,RAINLSM,SNOWLSM,forctlsm,forcqlsm,forcplsm,forczlsm,forcwlsm,& + acc_ssoil, acc_qinsur, acc_qseva, acc_etrani, eflxbxy, soilenergy, snowenergy, canhsxy,& + ACC_DWATERXY, ACC_PRCPXY, ACC_ECANXY, ACC_ETRANXY, ACC_EDIRXY, & #ifdef WRF_HYDRO - sfcheadrt,INFXSRT,soldrain, & !O + sfcheadrt,INFXSRT,soldrain,qtiledrain,ZWATBLE2D, & !O #endif ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -3155,7 +3193,7 @@ SUBROUTINE surface_driver( & isltyp,smoiseq,dzs,wtddt, & fdepthxy,areaxy,ht,isurban,ivgtyp, & rivercondxy,riverbedxy,eqzwt,pexpxy, & - smois,sh2o,smcwtdxy,zwtxy,qrfxy,deeprechxy,qspringxy, & + smois,sh2o,smcwtdxy,zwtxy,qlatxy,qrfxy,deeprechxy,qspringxy, & qslatxy,qrfsxy,qspringsxy,rechxy, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & diff --git a/run/MPTABLE.TBL b/run/MPTABLE.TBL index 8653f8bc87..54bdbb3439 100644 --- a/run/MPTABLE.TBL +++ b/run/MPTABLE.TBL @@ -373,12 +373,12 @@ &noahmp_irrigation_parameters IRR_FRAC = 0.10 ! irrigation Fraction IRR_HAR = 20 ! number of days before harvest date to stop irrigation -IRR_LAI = 0.50 ! Minimum lai to trigger irrigation -IRR_MAD = 0.60 ! management allowable deficit (0-1) -FILOSS = 0.10 ! fraction of flood irrigation loss (0-1) +IRR_LAI = 0.10 ! Minimum lai to trigger irrigation +IRR_MAD = 0.60 ! management allowable deficit (0.0-1.0) +FILOSS = 0.50 ! flood irrigation loss fraction (0.0-0.99) SPRIR_RATE = 6.40 ! mm/h, sprinkler irrigation rate MICIR_RATE = 1.38 ! mm/h, micro irrigation rate -FIRTFAC = 1.00 ! flood application rate factor +FIRTFAC = 1.20 ! flood application rate factor IR_RAIN = 1.00 ! maximum precipitation to stop irrigation trigger / @@ -476,19 +476,19 @@ RT_OVRC_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of root tunrove RT_OVRC_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages RT_OVRC_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, RT_OVRC_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, -RT_OVRC_S5 = 0.12, 0.12, 0.12, 0.12, 0.12, -RT_OVRC_S6 = 0.06, 0.06, 0.06, 0.06, 0.06, +RT_OVRC_S5 = 0.12, 0.12, 0.12, 0.12, 0.12, +RT_OVRC_S6 = 0.06, 0.06, 0.06, 0.06, 0.06, RT_OVRC_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, RT_OVRC_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, LFMR25 = 0.8, 1.0, 1.0, 1.0, 1.0, ! leaf maintenance respiration at 25C [umol CO2/m**2 /s] -STMR25 = 0.05, 0.05, 0.1, 0.1, 0.1, ! stem maintenance respiration at 25C [umol CO2/kg bio/s] -RTMR25 = 0.05, 0.05, 0.0, 0.0, 0.0, ! root maintenance respiration at 25C [umol CO2/kg bio/s] +STMR25 = 0.05, 0.05, 0.1, 0.1, 0.1, ! stem maintenance respiration at 25C [umol CO2/kg bio/s] +RTMR25 = 0.05, 0.05, 0.0, 0.0, 0.0, ! root maintenance respiration at 25C [umol CO2/kg bio/s] GRAINMR25 = 0.0, 0.0, 0.1, 0.1, 0.1, ! grain maintenance respiration at 25C [umol CO2/kg bio/s] LFPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to leaf LFPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages -LFPT_S3 = 0.36, 0.4, 0.4, 0.4, 0.4, +LFPT_S3 = 0.36, 0.4, 0.4, 0.4, 0.4, LFPT_S4 = 0.1, 0.2, 0.2, 0.2, 0.2, LFPT_S5 = 0.0, 0.0, 0.0, 0.0, 0.0, LFPT_S6 = 0.0, 0.0, 0.0, 0.0, 0.0, @@ -497,7 +497,7 @@ LFPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, STPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to stem STPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages -STPT_S3 = 0.24, 0.2, 0.2, 0.2, 0.2, +STPT_S3 = 0.24, 0.2, 0.2, 0.2, 0.2, STPT_S4 = 0.6, 0.5, 0.5, 0.5, 0.5, STPT_S5 = 0.0, 0.0, 0.15, 0.15, 0.15, STPT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, @@ -508,7 +508,7 @@ RTPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate RTPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages RTPT_S3 = 0.4, 0.4, 0.4, 0.4, 0.4, RTPT_S4 = 0.3, 0.3, 0.3, 0.3, 0.3, -RTPT_S5 = 0.05, 0.05, 0.05, 0.05, 0.05, +RTPT_S5 = 0.05, 0.05, 0.05, 0.05, 0.05, RTPT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, RTPT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, RTPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, @@ -517,15 +517,15 @@ GRAINPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate GRAINPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages GRAINPT_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, GRAINPT_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, -GRAINPT_S5 = 0.95, 0.95, 0.8, 0.8, 0.8, +GRAINPT_S5 = 0.95, 0.95, 0.8, 0.8, 0.8, GRAINPT_S6 = 1.0, 1.0, 0.9, 0.9, 0.9, GRAINPT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, GRAINPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, LFCT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! carbohydrate translocation LFCT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, -LFCT_S3 = 0.0, 0., 0.4, 0.4, 0.4, -LFCT_S4 = 0.0, 0., 0.3, 0.3, 0.3, +LFCT_S3 = 0.0, 0.0, 0.4, 0.4, 0.4, +LFCT_S4 = 0.0, 0.0, 0.3, 0.3, 0.3, LFCT_S5 = 0.0, 0.0, 0.05, 0.05, 0.05, LFCT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, LFCT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, @@ -533,24 +533,57 @@ LFCT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, STCT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! carbohydrate translocation STCT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, -STCT_S3 = 0.0, 0., 0.4, 0.4, 0.4, -STCT_S4 = 0.0, 0., 0.3, 0.3, 0.3, -STCT_S5 = 0.0, 0., 0.05, 0.05, 0.05, +STCT_S3 = 0.0, 0.0, 0.4, 0.4, 0.4, +STCT_S4 = 0.0, 0.0, 0.3, 0.3, 0.3, +STCT_S5 = 0.0, 0.0, 0.05, 0.05, 0.05, STCT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, STCT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, STCT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, RTCT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! carbohydrate translocation RTCT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, -RTCT_S3 = 0.0, 0., 0.4, 0.4, 0.4, -RTCT_S4 = 0.0, 0., 0.3, 0.3, 0.3, -RTCT_S5 = 0.0, 0., 0.05, 0.05, 0.05, +RTCT_S3 = 0.0, 0.0, 0.4, 0.4, 0.4, +RTCT_S4 = 0.0, 0.0, 0.3, 0.3, 0.3, +RTCT_S5 = 0.0, 0.0, 0.05, 0.05, 0.05, RTCT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, RTCT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, RTCT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, BIO2LAI = 0.015, 0.030, 0.015, 0.015, 0.015, ! leaf are per living leaf biomass [m^2/kg] +/ + +&noahmp_tiledrain_parameters +!-----------------------------------! +! For simple drainage model ! +!-----------------------------------! +DRAIN_LAYER_OPT = 4 + ! 0 - from one specified layer by TD_DEPTH, + ! 1 - from layers 1 & 2, + ! 2 - from layer layers 1, 2, and 3 + ! 3 - from layer 2 and 3 + ! 4 - from layer layers 3, 4 + ! 5 - from all the four layers +!-------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! +! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 ! +!-------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! +TDSMC_FAC = 0.90, 0.90, 0.90, 0.90, 0.90, 1.25, 0.90, 1.0, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90 ! corresponds to number of soil types SOILPARAM.TBL +TD_DEPTH = 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 ! depth of drain tube from the soil surface +TD_DC = 20., 20., 20., 20., 20., 20., 20., 20., 20., 20., 20., 20., 20., 20., 20., 20., 20., 20., 20. ! drainage coefficient (mm d^-1) +!-------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! +! +!-------------------------------------! +! For Hooghoudt tile drain model ! +!-------------------------------------! +!-------------------------------------------------------------------------------------------------------------------------------------------------------------------- +TD_DCOEF = 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07 ! m d^-1, drainage coefficent +TD_D = 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 ! m, depth to impe layer from drain water level (D) +TD_ADEPTH = 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00 ! m, actual depth of imp layer from land surface +TD_RADI = 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07 ! m, effective radius of drains (ro) +TD_SPAC = 60.0, 55.0, 45.0, 20.0, 25.0, 30.0, 40.0, 16.0, 18.0, 50.0, 15.0, 10.0, 35.0, 10.0, 60.0, 60.0, 10.0, 60.0, 60.0 ! m, distance between two drain tubes or tiles (L) +TD_DDRAIN = 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20 ! m, Depth of drain +KLAT_FAC = 1.30, 1.80, 2.10, 2.60, 2.90, 2.50, 2.30, 3.00, 2.70, 2.00, 3.10, 3.30, 2.50, 1.00, 1.00, 1.80, 4.00, 1.00, 1.30 ! multiplication factor to lateral hyd.cond +!-------------------------------------------------------------------------------------------------------------------------------------------------------------------- / diff --git a/run/README.namelist b/run/README.namelist index 633a237a4a..c996c9983f 100644 --- a/run/README.namelist +++ b/run/README.namelist @@ -1248,6 +1248,13 @@ Options for use with the Noah-MP Land Surface Model: 4 = BATS surface and subsurface runoff (free drainage) 5 = Miguez-Macho & Fan groundwater scheme (Miguez-Macho et al. 2007 JGR; Fan et al. 2007 JGR) geogrid must have been run with GEOGRID.TBL.ARW.noahmp, use with caution + 6 = Variable Infiltration Capacity Model surface runoff scheme (Wood et al., 1992, JGR) + 7 = Xiananjiang Infiltration and surface runoff scheme ((Jayawardena and Zhou, 2000) + 8 = Dynamic VIC surface runoff scheme (Liang and Xie, 2001) + opt_infdv = 0, ! Noah-MP infiltration option in dynamic VIC runoff scheme (only works for opt_run=8) + 1 = Philip scheme + 2 = Green-Ampt scheme + 3 = Smith-Parlange scheme opt_frz = 1, ! Noah-MP Supercooled Liquid Water option 1 = No iteration 2 = Koren's iteration @@ -1278,37 +1285,49 @@ Options for use with the Noah-MP Land Surface Model: 1 = includes phase change 2 = slab ice (Noah) opt_rsf = 1, ! Noah-MP surface evaporation resistance option (new in 3.8) - 1 -> Sakaguchi and Zeng, 2009 - 2 -> Sellers (1992) - 3 -> adjusted Sellers to decrease RSURF for wet soil - 4 -> option 1 for non-snow; rsurf = rsurf_snow for snow (set in MPTABLE) + 1 = Sakaguchi and Zeng, 2009 + 2 = Sellers (1992) + 3 = adjusted Sellers to decrease RSURF for wet soil + 4 = option 1 for non-snow; rsurf = rsurf_snow for snow (set in MPTABLE) opt_soil = 1, ! Noah-MP options for defining soil properties geogrid must have been run with GEOGRID.TBL.ARW.noahmp, use with caution - 1 -> use input dominant soil texture - 2 -> use input soil texture that varies with depth - 3 -> use soil composition (sand, clay, orgm) and pedotransfer functions (OPT_PEDO) - 4 -> use input soil properties (BEXP_3D, SMCMAX_3D, etc.) (not valid in WRF) + 1 = use input dominant soil texture + 2 = use input soil texture that varies with depth + 3 = use soil composition (sand, clay, orgm) and pedotransfer functions (OPT_PEDO) + 4 = use input soil properties (BEXP_3D, SMCMAX_3D, etc.) (not valid in WRF) opt_pedo = 1, ! Noah-MP options for pedotransfer functions (used when OPT_SOIL = 3) geogrid must have been run with GEOGRID.TBL.ARW.noahmp, use with caution - 1 -> Saxton and Rawls (2006) - opt_crop = 0, ! options for crop model + 1 = Saxton and Rawls (2006) + opt_crop = 0, ! options for crop model geogrid must have been run with GEOGRID.TBL.ARW.noahmp, use with caution - 0 -> No crop model, will run default dynamic vegetation - 1 -> Liu, et al. 2016 - 2 -> Gecros (Genotype-by-Environment interaction on CROp growth Simulator) Yin and van Laar, 2005 + 0 = No crop model, will run default dynamic vegetation + 1 = Liu, et al. 2016 + 2 = Gecros (Genotype-by-Environment interaction on CROp growth Simulator) Yin and van Laar, 2005 opt_irr = 0, ! options for irrigation scheme geogrid must have been run with GEOGRID.TBL.ARW.noahmp, use with caution - 0 -> No irrigation - 1 -> Irrigation ON - 2 -> irrigation trigger based on crop season Planting and harvesting dates - 3 -> irrigation trigger based on LAI threshold + 0 = No irrigation + 1 = Irrigation ON + 2 = irrigation trigger based on crop season Planting and harvesting dates + 3 = irrigation trigger based on LAI threshold opt_irrm = 0, ! options for irrigation method (only if opt_irr > 0) geogrid must have been run with GEOGRID.TBL.ARW.noahmp, use with caution - 0 -> method based on geo_em fractions (all three methods are ON) - 1 -> sprinkler method - 2 -> micro/drip irrigation - 3 -> surface flooding + 0 = method based on geo_em fractions (all three methods are ON) + 1 = sprinkler method + 2 = micro/drip irrigation + 3 = surface flooding + opt_tdrn = 0, ! Noah-MP tile drainage option (currently only tested and works with opt_run=3) + geogrid must have been run with GEOGRID.TBL.ARW.noahmp, use with caution + 0 = No tile drainage + 1 = Simple drainage + 2 = Hooghoudt's equation based tile drainage + soiltstep = 0.0, ! Noah-MP soil process timestep (seconds) for solving soil water and temperature + 0 = default, the same as main NoahMP model timestep + N * dt_noahmp, typically 15min or 30min + noahmp_output = 1, ! Noah-MP output levels + 1 = standard output + 3 = standard output with additional water and energy budget term output + noahmp_acc_dt = 0.0, ! Noah-MP bucket reset time interval (minutes) between outputs for accumulation (works when noahmp_output=3) / &fdda diff --git a/run/SOILPARM.TBL b/run/SOILPARM.TBL index b7e499f2df..c5a97c95c7 100644 --- a/run/SOILPARM.TBL +++ b/run/SOILPARM.TBL @@ -1,45 +1,45 @@ Soil Parameters STAS -19,1 'BB DRYSMC F11 MAXSMC REFSMC SATPSI SATDK SATDW WLTSMC QTZ ' -1, 2.79, 0.010, -0.472, 0.339, 0.192, 0.069, 4.66E-5, 2.65E-5, 0.010, 0.92, 'SAND' -2, 4.26, 0.028, -1.044, 0.421, 0.283, 0.036, 1.41E-5, 5.14E-6, 0.028, 0.82, 'LOAMY SAND' -3, 4.74, 0.047, -0.569, 0.434, 0.312, 0.141, 5.23E-6, 8.05E-6, 0.047, 0.60, 'SANDY LOAM' -4, 5.33, 0.084, 0.162, 0.476, 0.360, 0.759, 2.81E-6, 2.39E-5, 0.084, 0.25, 'SILT LOAM' -5, 3.86, 0.061, 0.162, 0.484, 0.347, 0.955, 2.18E-6, 1.66E-5, 0.061, 0.10, 'SILT' -6, 5.25, 0.066, -0.327, 0.439, 0.329, 0.355, 3.38E-6, 1.43E-5, 0.066, 0.40, 'LOAM' -7, 6.77, 0.069, -1.491, 0.404, 0.315, 0.135, 4.45E-6, 1.01E-5, 0.069, 0.60, 'SANDY CLAY LOAM' -8, 8.72, 0.120, -1.118, 0.464, 0.387, 0.617, 2.03E-6, 2.35E-5, 0.120, 0.10, 'SILTY CLAY LOAM' -9, 8.17, 0.103, -1.297, 0.465, 0.382, 0.263, 2.45E-6, 1.13E-5, 0.103, 0.35, 'CLAY LOAM' -10, 10.73, 0.100, -3.209, 0.406, 0.338, 0.098, 7.22E-6, 1.87E-5, 0.100, 0.52, 'SANDY CLAY' -11, 10.39, 0.126, -1.916, 0.468, 0.404, 0.324, 1.34E-6, 9.64E-6, 0.126, 0.10, 'SILTY CLAY' -12, 11.55, 0.138, -2.138, 0.468, 0.412, 0.468, 9.74E-7, 1.12E-5, 0.138, 0.25, 'CLAY' -13, 5.25, 0.066, -0.327, 0.439, 0.329, 0.355, 3.38E-6, 1.43E-5, 0.066, 0.05, 'ORGANIC MATERIAL' -14, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.60, 'WATER' -15, 2.79, 0.006, -1.111, 0.20, 0.17, 0.069, 1.41E-4, 1.36E-4, 0.006, 0.07, 'BEDROCK' -16, 4.26, 0.028, -1.044, 0.421, 0.283, 0.036, 1.41E-5, 5.14E-6, 0.028, 0.25, 'OTHER(land-ice)' -17, 11.55, 0.030, -10.472, 0.468, 0.454, 0.468, 9.74E-7, 1.12E-5, 0.030, 0.60, 'PLAYA' -18, 2.79, 0.006, -0.472, 0.200, 0.17, 0.069, 1.41E-4, 1.36E-4, 0.006, 0.52, 'LAVA' -19, 2.79, 0.01, -0.472, 0.339, 0.192, 0.069, 4.66E-5, 2.65E-5, 0.01, 0.92, 'WHITE SAND' +19,1 'BB DRYSMC F11 MAXSMC REFSMC SATPSI SATDK SATDW WLTSMC QTZ BVIC AXAJ BXAJ XXAJ BDVIC BBVIC GDVIC ' +1, 2.79, 0.010, -0.472, 0.339, 0.192, 0.069, 4.66E-5, 2.65E-5, 0.010, 0.92, 0.05, 0.009, 0.05, 0.05, 0.05, 1.000, 0.050, 'SAND' +2, 4.26, 0.028, -1.044, 0.421, 0.283, 0.036, 1.41E-5, 5.14E-6, 0.028, 0.82, 0.08, 0.010, 0.08, 0.08, 0.08, 1.010, 0.070, 'LOAMY SAND' +3, 4.74, 0.047, -0.569, 0.434, 0.312, 0.141, 5.23E-6, 8.05E-6, 0.047, 0.60, 0.09, 0.009, 0.09, 0.09, 0.09, 1.020, 0.130, 'SANDY LOAM' +4, 5.33, 0.084, 0.162, 0.476, 0.360, 0.759, 2.81E-6, 2.39E-5, 0.084, 0.25, 0.25, 0.010, 0.25, 0.25, 0.25, 1.025, 0.200, 'SILT LOAM' +5, 3.86, 0.061, 0.162, 0.484, 0.347, 0.955, 2.18E-6, 1.66E-5, 0.061, 0.10, 0.15, 0.012, 0.15, 0.15, 0.15, 1.000, 0.170, 'SILT' +6, 5.25, 0.066, -0.327, 0.439, 0.329, 0.355, 3.38E-6, 1.43E-5, 0.066, 0.40, 0.18, 0.013, 0.18, 0.18, 0.18, 1.000, 0.110, 'LOAM' +7, 6.77, 0.069, -1.491, 0.404, 0.315, 0.135, 4.45E-6, 1.01E-5, 0.069, 0.60, 0.20, 0.014, 0.20, 0.20, 0.20, 1.032, 0.260, 'SANDY CLAY LOAM' +8, 8.72, 0.120, -1.118, 0.464, 0.387, 0.617, 2.03E-6, 2.35E-5, 0.120, 0.10, 0.22, 0.015, 0.22, 0.22, 0.22, 1.035, 0.350, 'SILTY CLAY LOAM' +9, 8.17, 0.103, -1.297, 0.465, 0.382, 0.263, 2.45E-6, 1.13E-5, 0.103, 0.35, 0.23, 0.016, 0.23, 0.23, 0.23, 1.040, 0.260, 'CLAY LOAM' +10, 10.73, 0.100, -3.209, 0.406, 0.338, 0.098, 7.22E-6, 1.87E-5, 0.100, 0.52, 0.25, 0.015, 0.25, 0.25, 0.25, 1.042, 0.300, 'SANDY CLAY' +11, 10.39, 0.126, -1.916, 0.468, 0.404, 0.324, 1.34E-6, 9.64E-6, 0.126, 0.10, 0.28, 0.016, 0.28, 0.28, 0.28, 1.045, 0.380, 'SILTY CLAY' +12, 11.55, 0.138, -2.138, 0.468, 0.412, 0.468, 9.74E-7, 1.12E-5, 0.138, 0.25, 0.30, 0.017, 0.30, 0.30, 0.30, 1.000, 0.410, 'CLAY' +13, 5.25, 0.066, -0.327, 0.439, 0.329, 0.355, 3.38E-6, 1.43E-5, 0.066, 0.05, 0.26, 0.012, 0.26, 0.26, 0.26, 1.000, 0.500, 'ORGANIC MATERIAL' +14, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.60, 0.00, 0.001, 0.00, 0.00, 0.00, 1.000, 0.001, 'WATER' +15, 2.79, 0.006, -1.111, 0.20, 0.17, 0.069, 1.41E-4, 1.36E-4, 0.006, 0.07, 1.00, 0.017, 1.00, 1.00, 1.00, 1.000, 0.010, 'BEDROCK' +16, 4.26, 0.028, -1.044, 0.421, 0.283, 0.036, 1.41E-5, 5.14E-6, 0.028, 0.25, 1.00, 0.017, 1.00, 1.00, 1.00, 1.000, 0.001, 'OTHER(land-ice)' +17, 11.55, 0.030, -10.472, 0.468, 0.454, 0.468, 9.74E-7, 1.12E-5, 0.030, 0.60, 1.00, 0.017, 1.00, 1.00, 1.00, 1.000, 0.001, 'PLAYA' +18, 2.79, 0.006, -0.472, 0.200, 0.17, 0.069, 1.41E-4, 1.36E-4, 0.006, 0.52, 0.35, 0.015, 0.35, 0.35, 0.35, 1.000, 0.050, 'LAVA' +19, 2.79, 0.01, -0.472, 0.339, 0.192, 0.069, 4.66E-5, 2.65E-5, 0.01, 0.92, 0.15, 0.009, 0.15, 0.15, 0.15, 1.000, 0.020, 'WHITE SAND' Soil Parameters STAS-RUC -19,1 'BB DRYSMC HC MAXSMC REFSMC SATPSI SATDK SATDW WLTSMC QTZ ' -1, 4.05, 0.002, 1.47, 0.395, 0.174, 0.121, 1.76E-4, 0.608E-6, 0.033, 0.92, 'SAND' -2, 4.38, 0.035, 1.41, 0.410, 0.179, 0.090, 1.56E-4, 0.514E-5, 0.055, 0.82, 'LOAMY SAND' -3, 4.90, 0.041, 1.34, 0.435, 0.249, 0.218, 3.47E-5, 0.805E-5, 0.095, 0.60, 'SANDY LOAM' -4, 5.30, 0.034, 1.27, 0.485, 0.369, 0.786, 7.20E-6, 0.239E-4, 0.143, 0.25, 'SILT LOAM' -5, 5.30, 0.034, 1.27, 0.485, 0.369, 0.786, 7.20E-6, 0.239E-4, 0.143, 0.10, 'SILT' -6, 5.39, 0.050, 1.21, 0.451, 0.314, 0.478, 6.95E-6, 0.143E-4, 0.137, 0.40, 'LOAM' -7, 7.12, 0.068, 1.18, 0.420, 0.299, 0.299, 6.30E-6, 0.990E-5, 0.148, 0.60, 'SANDY CLAY LOAM' -8, 7.75, 0.060, 1.32, 0.477, 0.357, 0.356, 1.70E-6, 0.237E-4, 0.170, 0.10, 'SILTY CLAY LOAM' -9, 5.39, 0.050, 1.21, 0.451, 0.314, 0.478, 6.95E-6, 0.143E-4, 0.137, 0.40, 'CLAY LOAM' -10, 10.40, 0.070, 1.18, 0.426, 0.316, 0.153, 2.17E-6, 0.187E-4, 0.158, 0.52, 'SANDY CLAY' -11, 10.40, 0.070, 1.15, 0.492, 0.409, 0.490, 1.03E-6, 0.964E-5, 0.190, 0.10, 'SILTY CLAY' -12, 11.40, 0.068, 1.09, 0.482, 0.400, 0.405, 1.28E-6, 0.112E-4, 0.198, 0.25, 'CLAY' -13, 5.39, 0.027, 1.21, 0.451, 0.314, 0.478, 6.95E-6, 0.143E-4, 0.117, 0.05, 'ORGANIC MATERIAL' -14, 0.0, 0.0, 4.18, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.00, 'WATER' -15, 4.05, 0.004, 2.03, 0.200, 0.10 , 0.121, 1.41E-4, 0.136E-3, 0.006, 0.60, 'BEDROCK' -16, 4.90, 0.065, 2.10, 0.435, 0.249, 0.218, 3.47E-5, 0.514E-5, 0.114, 0.05, 'OTHER(land-ice)' -17, 11.40, 0.030, 1.41, 0.468, 0.454, 0.468, 9.74E-7, 0.112E-4, 0.030, 0.60, 'PLAYA' -18, 4.05, 0.006, 1.41, 0.200, 0.17, 0.069, 1.41E-4, 0.136E-3, 0.006, 0.52, 'LAVA' -19, 4.05, 0.01, 1.47, 0.339, 0.236, 0.069, 1.76E-4, 0.608E-6, 0.060, 0.92, 'WHITE SAND' +19,1 'BB DRYSMC HC MAXSMC REFSMC SATPSI SATDK SATDW WLTSMC QTZ BVIC AXAJ BXAJ XXAJ BDVIC BBVIC GDVIC ' +1, 4.05, 0.002, 1.47, 0.395, 0.174, 0.121, 1.76E-4, 0.608E-6, 0.033, 0.92, 0.05, 0.009, 0.05, 0.05, 0.05, 1.000, 0.050, 'SAND' +2, 4.38, 0.035, 1.41, 0.410, 0.179, 0.090, 1.56E-4, 0.514E-5, 0.055, 0.82, 0.08, 0.010, 0.08, 0.08, 0.08, 1.010, 0.070, 'LOAMY SAND' +3, 4.90, 0.041, 1.34, 0.435, 0.249, 0.218, 3.47E-5, 0.805E-5, 0.095, 0.60, 0.09, 0.009, 0.09, 0.09, 0.09, 1.020, 0.130, 'SANDY LOAM' +4, 5.30, 0.034, 1.27, 0.485, 0.369, 0.786, 7.20E-6, 0.239E-4, 0.143, 0.25, 0.10, 0.010, 0.25, 0.25, 0.10, 1.025, 0.200, 'SILT LOAM' +5, 5.30, 0.034, 1.27, 0.485, 0.369, 0.786, 7.20E-6, 0.239E-4, 0.143, 0.10, 0.15, 0.012, 0.15, 0.15, 0.15, 1.000, 0.170, 'SILT' +6, 5.39, 0.050, 1.21, 0.451, 0.314, 0.478, 6.95E-6, 0.143E-4, 0.137, 0.40, 0.18, 0.013, 0.18, 0.18, 0.18, 1.000, 0.110, 'LOAM' +7, 7.12, 0.068, 1.18, 0.420, 0.299, 0.299, 6.30E-6, 0.990E-5, 0.148, 0.60, 0.20, 0.014, 0.20, 0.20, 0.20, 1.032, 0.260, 'SANDY CLAY LOAM' +8, 7.75, 0.060, 1.32, 0.477, 0.357, 0.356, 1.70E-6, 0.237E-4, 0.170, 0.10, 0.22, 0.015, 0.22, 0.22, 0.22, 1.035, 0.350, 'SILTY CLAY LOAM' +9, 5.39, 0.050, 1.21, 0.451, 0.314, 0.478, 6.95E-6, 0.143E-4, 0.137, 0.40, 0.23, 0.016, 0.23, 0.23, 0.23, 1.040, 0.260, 'CLAY LOAM' +10, 10.40, 0.070, 1.18, 0.426, 0.316, 0.153, 2.17E-6, 0.187E-4, 0.158, 0.52, 0.25, 0.015, 0.25, 0.25, 0.25, 1.042, 0.300, 'SANDY CLAY' +11, 10.40, 0.070, 1.15, 0.492, 0.409, 0.490, 1.03E-6, 0.964E-5, 0.190, 0.10, 0.28, 0.016, 0.28, 0.28, 0.28, 1.045, 0.380, 'SILTY CLAY' +12, 11.40, 0.068, 1.09, 0.482, 0.400, 0.405, 1.28E-6, 0.112E-4, 0.198, 0.25, 0.30, 0.017, 0.30, 0.30, 0.30, 1.000, 0.410, 'CLAY' +13, 5.39, 0.027, 1.21, 0.451, 0.314, 0.478, 6.95E-6, 0.143E-4, 0.117, 0.05, 0.26, 0.012, 0.26, 0.26, 0.26, 1.000, 0.500, 'ORGANIC MATERIAL' +14, 0.0, 0.0, 4.18, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.00, 0.00, 0.001, 0.00, 0.00, 0.00, 1.000, 0.001, 'WATER' +15, 4.05, 0.004, 2.03, 0.200, 0.10 , 0.121, 1.41E-4, 0.136E-3, 0.006, 0.60, 1.00, 0.017, 1.00, 1.00, 1.00, 1.000, 0.010, 'BEDROCK' +16, 4.90, 0.065, 2.10, 0.435, 0.249, 0.218, 3.47E-5, 0.514E-5, 0.114, 0.05, 1.00, 0.017, 1.00, 1.00, 1.00, 1.000, 0.001, 'OTHER(land-ice)' +17, 11.40, 0.030, 1.41, 0.468, 0.454, 0.468, 9.74E-7, 0.112E-4, 0.030, 0.60, 1.00, 0.017, 1.00, 1.00, 1.00, 1.000, 0.001, 'PLAYA' +18, 4.05, 0.006, 1.41, 0.200, 0.17, 0.069, 1.41E-4, 0.136E-3, 0.006, 0.52, 0.35, 0.015, 0.35, 0.35, 0.35, 1.000, 0.050, 'LAVA' +19, 4.05, 0.01, 1.47, 0.339, 0.236, 0.069, 1.76E-4, 0.608E-6, 0.060, 0.92, 0.15, 0.009, 0.15, 0.15, 0.15, 1.000, 0.020, 'WHITE SAND'