diff --git a/Makefile b/Makefile index 98a7d5ea75..0c63335207 100644 --- a/Makefile +++ b/Makefile @@ -300,11 +300,11 @@ intel-mpi: # BUILDTARGET Intel compiler suite with Intel MPI library "CC_SERIAL = icc" \ "CXX_SERIAL = icpc" \ "FFLAGS_PROMOTION = -real-size 64" \ - "FFLAGS_OPT = -O3 -convert big_endian -free -align array64byte" \ - "CFLAGS_OPT = -O3" \ - "CXXFLAGS_OPT = -O3" \ + "FFLAGS_OPT = -O3 -xBROADWELL -fma -fp-model precise -traceback -no-wrap-margin -convert big_endian -free -align array64byte" \ + "CFLAGS_OPT = -O3 -xBROADWELL -fma -fp-model precise -traceback" \ + "CXXFLAGS_OPT = -O3 -xBROADWELL -fma -fp-model precise -traceback" \ "LDFLAGS_OPT = -O3" \ - "FFLAGS_DEBUG = -g -convert big_endian -free -CU -CB -check all -fpe0 -traceback" \ + "FFLAGS_DEBUG = -g -convert big_endian -free -CU -CB -check all -fpe0 -traceback -no-wrap-margin" \ "CFLAGS_DEBUG = -g -traceback" \ "CXXFLAGS_DEBUG = -g -traceback" \ "LDFLAGS_DEBUG = -g -fpe0 -traceback" \ @@ -660,7 +660,7 @@ ifneq "$(LAPACK)" "" endif RM = rm -f -CPP = cpp -P -traditional +CPP = ${CXX_SERIAL} -E # Modified for use with the Intel C++ compiler RANLIB = ranlib ifdef CORE @@ -875,7 +875,7 @@ ifeq "$(findstring clean, $(MAKECMDGOALS))" "clean" # CHECK FOR CLEAN TARGET override AUTOCLEAN=false endif # END OF CLEAN TARGET CHECK -VER=$(shell git describe --dirty 2> /dev/null) +VER="v7.3.develop.EPA_PXLSM" # Hard-coded specific version identifier #override CPPFLAGS += -DMPAS_GIT_VERSION=$(VER) ifeq "$(findstring v, $(VER))" "v" diff --git a/src/core_atmosphere/Registry.xml b/src/core_atmosphere/Registry.xml index 9bbf8e5af5..8eca8f60d3 100644 --- a/src/core_atmosphere/Registry.xml +++ b/src/core_atmosphere/Registry.xml @@ -38,6 +38,10 @@ description="The number of months in a year"/> + + + + + + @@ -502,6 +510,7 @@ + @@ -715,6 +724,9 @@ + + + @@ -812,16 +824,20 @@ + + + + @@ -830,6 +846,12 @@ + + + + + + @@ -959,7 +981,9 @@ + + @@ -969,12 +993,15 @@ + + + @@ -1107,6 +1134,20 @@ #endif + + +#ifdef DO_PHYSICS + + + +#endif + + + description="number of soil layers used in land surface scheme" + possible_values="Positive integers; 4 for Noah LSM, 2 for PX LSM."/> + + + + + + + + + + + + + + + possible_values="`suite',`noah',`px',`off'"/> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -2802,7 +2946,7 @@ - + + + + @@ -3051,13 +3201,16 @@ + + - - - - + + @@ -3096,9 +3252,12 @@ - + + @@ -3120,6 +3279,15 @@ + + + + + + diff --git a/src/core_atmosphere/physics/mpas_atmphys_control.F b/src/core_atmosphere/physics/mpas_atmphys_control.F index 9b7a08c5e0..377a66f697 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_control.F +++ b/src/core_atmosphere/physics/mpas_atmphys_control.F @@ -59,6 +59,8 @@ module mpas_atmphys_control ! Laura D. Fowler (laura@ucar.edu) / 2016-03-31. ! * added the options sf_mynn and bl_mynn and for the MYNN parameterization from WRF version 3.6.1. ! Laura D. Fowler (laura@ucar.edu) / 2016-04-11. +! * added Pleim-Xiu LSM scheme option px. +! Robert Gilliam (gilliam.robert@epa.gov) / 2016-09-19. ! * added the option cu_ntiedtke for the "new" Tiedtke parameterization of convection from WRF version 3.8.1. ! Laura D. Fowler (laura@ucar.edu) / 2016-09-19. ! * added the physics suite "convection_scale_aware" (see below for the physics options used in the suite). @@ -278,7 +280,8 @@ subroutine physics_namelist_check(configs) 'set config_sfclayer_scheme different than off') elseif(.not. (config_lsm_scheme .eq. 'off ' .or. & - config_lsm_scheme .eq. 'noah')) then + config_lsm_scheme .eq. 'noah' .or. & + config_lsm_scheme .eq. 'px')) then write(mpas_err_message,'(A,A10)') 'illegal value for land surface scheme: ', & trim(config_lsm_scheme) @@ -358,6 +361,15 @@ subroutine physics_registry_init(mesh,configs,sfc_input) dzs(4,iCell) = 1.00_RKIND enddo + case("px") + !initialize the thickness of the soil layers for the PX scheme: + do iCell = 1, nCells + if(landmask(iCell) == 1) then + dzs(1,iCell) = 0.01_RKIND + dzs(2,iCell) = 0.99_RKIND + endif + enddo + case default end select lsm_select diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F index 6b431b3cc5..af89dcd9df 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F @@ -20,6 +20,7 @@ module mpas_atmphys_driver_lsm use module_sf_noahdrv use module_sf_noah_seaice_drv use module_sf_sfcdiags + use module_sf_pxlsm implicit none private @@ -93,6 +94,8 @@ module mpas_atmphys_driver_lsm ! * added call to seaice_noah to include the parameterization of seaice for the updated Noah land surface ! scheme. ! Laura D. Fowler (laura@ucar.edu) / 2017-02-19. +! * added MODIS LAI and vegetation fraction, plus soil type fraction, improvements to P-X LSM +! Jerold A. Herwehe (herwehe.jerry@epa.gov) / 2018-08-28 ! ! DOCUMENTATION: @@ -121,6 +124,10 @@ subroutine allocate_lsm(config_frac_seaice) if(.not.allocated(smois_p) ) allocate(smois_p(ims:ime,1:num_soils,jms:jme) ) if(.not.allocated(tslb_p) ) allocate(tslb_p(ims:ime,1:num_soils,jms:jme) ) +!arrays for land use and soil type fractions + if(.not.allocated(landusef_p)) allocate(landusef_p(ims:ime,1:num_landu,jms:jme)) + if(.not.allocated(soiltypf_p)) allocate(soiltypf_p(ims:ime,1:num_soilc,jms:jme)) + !other arrays: if(.not.allocated(acsnom_p) ) allocate(acsnom_p(ims:ime,jms:jme) ) if(.not.allocated(acsnow_p) ) allocate(acsnow_p(ims:ime,jms:jme) ) @@ -162,6 +169,7 @@ subroutine allocate_lsm(config_frac_seaice) if(.not.allocated(snowc_p) ) allocate(snowc_p(ims:ime,jms:jme) ) if(.not.allocated(snowh_p) ) allocate(snowh_p(ims:ime,jms:jme) ) if(.not.allocated(sr_p) ) allocate(sr_p(ims:ime,jms:jme) ) + if(.not.allocated(sst_p) ) allocate(sst_p(ims:ime,jms:jme) ) if(.not.allocated(swdown_p) ) allocate(swdown_p(ims:ime,jms:jme) ) if(.not.allocated(tmn_p) ) allocate(tmn_p(ims:ime,jms:jme) ) if(.not.allocated(tsk_p) ) allocate(tsk_p(ims:ime,jms:jme) ) @@ -185,6 +193,35 @@ subroutine allocate_lsm(config_frac_seaice) if(.not.allocated(sfcheadrt_p) ) allocate(sfcheadrt_p(ims:ime,jms:jme) ) if(.not.allocated(soldrain_p) ) allocate(soldrain_p(ims:ime,jms:jme) ) +!additional arrays for px: + if(.not.allocated(mavail_p) ) allocate(mavail_p(ims:ime,jms:jme) ) + if(.not.allocated(hpbl_p) ) allocate(hpbl_p(ims:ime,jms:jme) ) + if(.not.allocated(rmol_p) ) allocate(rmol_p(ims:ime,jms:jme) ) + if(.not.allocated(ust_p) ) allocate(ust_p(ims:ime,jms:jme) ) + if(.not.allocated(ra_p) ) allocate(ra_p(ims:ime,jms:jme) ) + if(.not.allocated(rs_p) ) allocate(rs_p(ims:ime,jms:jme) ) + if(.not.allocated(psih_p) ) allocate(psih_p(ims:ime,jms:jme) ) + if(.not.allocated(imperv_p) ) allocate(imperv_p(ims:ime,jms:jme) ) + if(.not.allocated(canfra_p) ) allocate(canfra_p(ims:ime,jms:jme) ) + if(.not.allocated(vegpx_p) ) allocate(vegpx_p(ims:ime,jms:jme) ) + if(.not.allocated(lai_modis_p) ) allocate(lai_modis_p(ims:ime,jms:jme) ) + if(.not.allocated(lai_px_p) ) allocate(lai_px_p(ims:ime,jms:jme) ) + if(.not.allocated(wwlt_px_p) ) allocate(wwlt_px_p(ims:ime,jms:jme) ) + if(.not.allocated(wfc_px_p) ) allocate(wfc_px_p(ims:ime,jms:jme) ) + if(.not.allocated(wsat_px_p) ) allocate(wsat_px_p(ims:ime,jms:jme) ) + if(.not.allocated(clay_px_p) ) allocate(clay_px_p(ims:ime,jms:jme) ) + if(.not.allocated(csand_px_p) ) allocate(csand_px_p(ims:ime,jms:jme) ) + if(.not.allocated(fmsand_px_p) ) allocate(fmsand_px_p(ims:ime,jms:jme) ) + if(.not.allocated(t2anl_p) ) allocate(t2anl_p(ims:ime,jms:jme) ) + if(.not.allocated(t2anl1_p) ) allocate(t2anl1_p(ims:ime,jms:jme) ) + if(.not.allocated(t2anl2_p) ) allocate(t2anl2_p(ims:ime,jms:jme) ) + if(.not.allocated(rh2anl_p) ) allocate(rh2anl_p(ims:ime,jms:jme) ) + if(.not.allocated(rh2anl1_p) ) allocate(rh2anl1_p(ims:ime,jms:jme) ) + if(.not.allocated(rh2anl2_p) ) allocate(rh2anl2_p(ims:ime,jms:jme) ) + if(.not.allocated(snoanl_p) ) allocate(snoanl_p(ims:ime,jms:jme) ) + if(.not.allocated(snoanl1_p) ) allocate(snoanl1_p(ims:ime,jms:jme) ) + if(.not.allocated(snoanl2_p) ) allocate(snoanl2_p(ims:ime,jms:jme) ) + if(config_frac_seaice) then if(.not.allocated(tsk_sea) ) allocate(tsk_sea(ims:ime,jms:jme) ) if(.not.allocated(tsk_ice) ) allocate(tsk_ice(ims:ime,jms:jme) ) @@ -209,6 +246,10 @@ subroutine deallocate_lsm(config_frac_seaice) if(allocated(smois_p) ) deallocate(smois_p ) if(allocated(tslb_p) ) deallocate(tslb_p ) +!arrays for land use and soil type fractions + if(allocated(landusef_p)) deallocate(landusef_p) + if(allocated(soiltypf_p)) deallocate(soiltypf_p) + !other arrays: if(allocated(acsnom_p) ) deallocate(acsnom_p ) if(allocated(acsnow_p) ) deallocate(acsnow_p ) @@ -250,6 +291,7 @@ subroutine deallocate_lsm(config_frac_seaice) if(allocated(snowc_p) ) deallocate(snowc_p ) if(allocated(snowh_p) ) deallocate(snowh_p ) if(allocated(sr_p) ) deallocate(sr_p ) + if(allocated(sst_p) ) deallocate(sst_p ) if(allocated(swdown_p) ) deallocate(swdown_p ) if(allocated(tmn_p) ) deallocate(tmn_p ) if(allocated(tsk_p) ) deallocate(tsk_p ) @@ -273,6 +315,35 @@ subroutine deallocate_lsm(config_frac_seaice) if(allocated(sfcheadrt_p) ) deallocate(sfcheadrt_p ) if(allocated(soldrain_p) ) deallocate(soldrain_p ) +!additional arrays for px: + if(allocated(mavail_p) ) deallocate(mavail_p ) + if(allocated(hpbl_p) ) deallocate(hpbl_p ) + if(allocated(rmol_p) ) deallocate(rmol_p ) + if(allocated(ust_p) ) deallocate(ust_p ) + if(allocated(ra_p) ) deallocate(ra_p ) + if(allocated(rs_p) ) deallocate(rs_p ) + if(allocated(psih_p) ) deallocate(psih_p ) + if(allocated(imperv_p) ) deallocate(imperv_p ) + if(allocated(canfra_p) ) deallocate(canfra_p ) + if(allocated(vegpx_p) ) deallocate(vegpx_p ) + if(allocated(lai_modis_p) ) deallocate(lai_modis_p ) + if(allocated(lai_px_p) ) deallocate(lai_px_p ) + if(allocated(wwlt_px_p) ) deallocate(wwlt_px_p ) + if(allocated(wfc_px_p) ) deallocate(wfc_px_p ) + if(allocated(wsat_px_p) ) deallocate(wsat_px_p ) + if(allocated(clay_px_p) ) deallocate(clay_px_p ) + if(allocated(csand_px_p) ) deallocate(csand_px_p ) + if(allocated(fmsand_px_p) ) deallocate(fmsand_px_p ) + if(allocated(t2anl_p) ) deallocate(t2anl_p ) + if(allocated(t2anl1_p) ) deallocate(t2anl1_p ) + if(allocated(t2anl2_p) ) deallocate(t2anl2_p ) + if(allocated(rh2anl_p) ) deallocate(rh2anl_p ) + if(allocated(rh2anl1_p) ) deallocate(rh2anl1_p ) + if(allocated(rh2anl2_p) ) deallocate(rh2anl2_p ) + if(allocated(snoanl_p) ) deallocate(snoanl_p ) + if(allocated(snoanl1_p) ) deallocate(snoanl1_p ) + if(allocated(snoanl2_p) ) deallocate(snoanl2_p ) + if(config_frac_seaice) then if(allocated(chs_sea) ) deallocate(chs_sea ) if(allocated(chs2_sea) ) deallocate(chs2_sea ) @@ -317,10 +388,12 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) sfcrunoff,smstav,smstot,snotime,snopcx,sr,udrunoff, & z0,znt real(kind=RKIND),dimension(:),pointer :: shdmin,shdmax,snoalb,sfc_albbck,snow,snowc,snowh,tmn, & - skintemp,vegfra,xice,xland - real(kind=RKIND),dimension(:),pointer :: t2m,th2m,q2 + skintemp,sst,vegfra,xice,xland,hpbl,rmol,ust,psih + real(kind=RKIND),dimension(:),pointer :: t2m,th2m,q2,t2anl1,t2anl2,rh2anl1,rh2anl2,snoanl1,snoanl2 + real(kind=RKIND),dimension(:),pointer :: t2anl,rh2anl,snoanl,ra,rs,imperv,canfra,vegpx,mavail + real(kind=RKIND),dimension(:),pointer :: lai_modis,lai_px,wwlt_px,wfc_px,wsat_px,clay_px,csand_px,fmsand_px real(kind=RKIND),dimension(:),pointer :: raincv,rainncv - real(kind=RKIND),dimension(:,:),pointer:: sh2o,smcrel,smois,tslb,dzs + real(kind=RKIND),dimension(:,:),pointer:: sh2o,smcrel,smois,tslb,dzs,landusef,soiltypf !local variables and arrays: logical:: do_fill @@ -335,24 +408,38 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(diag_physics,'acsnom' ,acsnom ) call mpas_pool_get_array(diag_physics,'acsnow' ,acsnow ) + call mpas_pool_get_array(diag_physics,'canfra' ,canfra ) call mpas_pool_get_array(diag_physics,'canwat' ,canwat ) call mpas_pool_get_array(diag_physics,'chs' ,chs ) call mpas_pool_get_array(diag_physics,'chs2' ,chs2 ) call mpas_pool_get_array(diag_physics,'chklowq' ,chklowq ) + call mpas_pool_get_array(diag_physics,'clay_px' ,clay_px ) call mpas_pool_get_array(diag_physics,'cpm' ,cpm ) call mpas_pool_get_array(diag_physics,'cqs2' ,cqs2 ) + call mpas_pool_get_array(diag_physics,'csand_px' ,csand_px ) + call mpas_pool_get_array(diag_physics,'fmsand_px' ,fmsand_px ) call mpas_pool_get_array(diag_physics,'glw' ,glw ) call mpas_pool_get_array(diag_physics,'grdflx' ,grdflx ) call mpas_pool_get_array(diag_physics,'gsw' ,gsw ) call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) + call mpas_pool_get_array(diag_physics,'hpbl' ,hpbl ) + call mpas_pool_get_array(diag_physics,'imperv' ,imperv ) call mpas_pool_get_array(diag_physics,'lai' ,lai ) + call mpas_pool_get_array(diag_physics,'lai_px' ,lai_px ) call mpas_pool_get_array(diag_physics,'lh' ,lh ) + call mpas_pool_get_array(diag_physics,'mavail' ,mavail ) call mpas_pool_get_array(diag_physics,'noahres' ,noahres ) call mpas_pool_get_array(diag_physics,'potevp' ,potevp ) + call mpas_pool_get_array(diag_physics,'psih' ,psih ) call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) call mpas_pool_get_array(diag_physics,'qgh' ,qgh ) call mpas_pool_get_array(diag_physics,'qsfc' ,qsfc ) call mpas_pool_get_array(diag_physics,'br' ,br ) + call mpas_pool_get_array(diag_physics,'ra' ,ra ) + call mpas_pool_get_array(diag_physics,'rh2anl1' ,rh2anl1 ) + call mpas_pool_get_array(diag_physics,'rh2anl2' ,rh2anl2 ) + call mpas_pool_get_array(diag_physics,'rmol' ,rmol ) + call mpas_pool_get_array(diag_physics,'rs' ,rs ) call mpas_pool_get_array(diag_physics,'sfc_albedo' ,sfc_albedo ) call mpas_pool_get_array(diag_physics,'sfc_albedo_seaice',sfc_albedo_seaice) call mpas_pool_get_array(diag_physics,'sfc_emibck' ,sfc_emibck ) @@ -360,9 +447,18 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(diag_physics,'sfcrunoff' ,sfcrunoff ) call mpas_pool_get_array(diag_physics,'smstav' ,smstav ) call mpas_pool_get_array(diag_physics,'smstot' ,smstot ) + call mpas_pool_get_array(diag_physics,'snoanl1' ,snoanl1 ) + call mpas_pool_get_array(diag_physics,'snoanl2' ,snoanl2 ) call mpas_pool_get_array(diag_physics,'snotime' ,snotime ) call mpas_pool_get_array(diag_physics,'snopcx' ,snopcx ) + call mpas_pool_get_array(diag_physics,'t2anl1' ,t2anl1 ) + call mpas_pool_get_array(diag_physics,'t2anl2' ,t2anl2 ) call mpas_pool_get_array(diag_physics,'udrunoff' ,udrunoff ) + call mpas_pool_get_array(diag_physics,'ust' ,ust ) + call mpas_pool_get_array(diag_physics,'vegpx' ,vegpx ) + call mpas_pool_get_array(diag_physics,'wfc_px' ,wfc_px ) + call mpas_pool_get_array(diag_physics,'wsat_px' ,wsat_px ) + call mpas_pool_get_array(diag_physics,'wwlt_px' ,wwlt_px ) call mpas_pool_get_array(diag_physics,'z0' ,z0 ) call mpas_pool_get_array(diag_physics,'znt' ,znt ) call mpas_pool_get_array(diag_physics,'t2m' ,t2m ) @@ -371,13 +467,18 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(sfc_input,'isltyp' ,isltyp ) call mpas_pool_get_array(sfc_input,'ivgtyp' ,ivgtyp ) + call mpas_pool_get_array(sfc_input,'lai_modis' ,lai_modis ) + call mpas_pool_get_array(sfc_input,'rh2anl' ,rh2anl ) call mpas_pool_get_array(sfc_input,'shdmin' ,shdmin ) call mpas_pool_get_array(sfc_input,'shdmax' ,shdmax ) call mpas_pool_get_array(sfc_input,'snoalb' ,snoalb ) call mpas_pool_get_array(sfc_input,'sfc_albbck',sfc_albbck) + call mpas_pool_get_array(sfc_input,'snoanl' ,snoanl ) call mpas_pool_get_array(sfc_input,'snow' ,snow ) call mpas_pool_get_array(sfc_input,'snowc' ,snowc ) call mpas_pool_get_array(sfc_input,'snowh' ,snowh ) + call mpas_pool_get_array(sfc_input,'sst' ,sst ) + call mpas_pool_get_array(sfc_input,'t2anl' ,t2anl ) call mpas_pool_get_array(sfc_input,'tmn' ,tmn ) call mpas_pool_get_array(sfc_input,'skintemp' ,skintemp ) call mpas_pool_get_array(sfc_input,'vegfra' ,vegfra ) @@ -388,6 +489,8 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(sfc_input,'smcrel' ,smcrel ) call mpas_pool_get_array(sfc_input,'smois' ,smois ) call mpas_pool_get_array(sfc_input,'tslb' ,tslb ) + call mpas_pool_get_array(sfc_input,'landusef' ,landusef ) + call mpas_pool_get_array(sfc_input,'soiltypf' ,soiltypf ) !In Registry.xml, dzs is a function of nCells. In the Noah lsm scheme, dzs is independent !of cell locations: @@ -406,37 +509,76 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) enddo enddo + do j = jts,jte + do n = 1,num_soilc + do i = its,ite + soiltypf_p(i,n,j) = soiltypf(n,i) + enddo + enddo + enddo + + do j = jts,jte + do n = 1,num_landu + do i = its,ite + landusef_p(i,n,j) = landusef(n,i) + enddo + enddo + enddo + do j = jts,jte do i = its,ite acsnom_p(i,j) = acsnom(i) acsnow_p(i,j) = acsnow(i) + canfra_p(i,j) = canfra(i) canwat_p(i,j) = canwat(i) chs_p(i,j) = chs(i) chs2_p(i,j) = chs2(i) chklowq_p(i,j) = chklowq(i) + clay_px_p(i,j) = clay_px(i) cpm_p(i,j) = cpm(i) cqs2_p(i,j) = cqs2(i) + csand_px_p(i,j) = csand_px(i) + fmsand_px_p(i,j) = fmsand_px(i) glw_p(i,j) = glw(i) grdflx_p(i,j) = grdflx(i) gsw_p(i,j) = gsw(i) hfx_p(i,j) = hfx(i) + hpbl_p(i,j) = hpbl(i) + imperv_p(i,j) = imperv(i) lai_p(i,j) = lai(i) + lai_px_p(i,j) = lai_px(i) lh_p(i,j) = lh(i) + mavail_p(i,j) = mavail(i) noahres_p(i,j) = noahres(i) potevp_p(i,j) = potevp(i) + psih_p(i,j) = psih(i) qfx_p(i,j) = qfx(i) qgh_p(i,j) = qgh(i) qsfc_p(i,j) = qsfc(i) br_p(i,j) = br(i) + ra_p(i,j) = ra(i) + rh2anl1_p(i,j) = rh2anl1(i) + rh2anl2_p(i,j) = rh2anl2(i) + rmol_p(i,j) = rmol(i) + rs_p(i,j) = rs(i) sfc_albedo_p(i,j) = sfc_albedo(i) sfc_emibck_p(i,j) = sfc_emibck(i) sfc_emiss_p(i,j) = sfc_emiss(i) sfcrunoff_p(i,j) = sfcrunoff(i) smstav_p(i,j) = smstav(i) smstot_p(i,j) = smstot(i) + snoanl1_p(i,j) = snoanl1(i) + snoanl2_p(i,j) = snoanl2(i) snotime_p(i,j) = snotime(i) snopcx_p(i,j) = snopcx(i) + t2anl1_p(i,j) = t2anl1(i) + t2anl2_p(i,j) = t2anl2(i) udrunoff_p(i,j) = udrunoff(i) + ust_p(i,j) = ust(i) + vegpx_p(i,j) = vegpx(i) + wfc_px_p(i,j) = wfc_px(i) + wsat_px_p(i,j) = wsat_px(i) + wwlt_px_p(i,j) = wwlt_px(i) z0_p(i,j) = z0(i) znt_p(i,j) = znt(i) t2m_p(i,j) = t2m(i) @@ -445,13 +587,18 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) isltyp_p(i,j) = isltyp(i) ivgtyp_p(i,j) = ivgtyp(i) + lai_modis_p(i,j) = lai_modis(i) + rh2anl_p(i,j) = rh2anl(i) shdmin_p(i,j) = shdmin(i) shdmax_p(i,j) = shdmax(i) snoalb_p(i,j) = snoalb(i) + snoanl_p(i,j) = snoanl(i) sfc_albbck_p(i,j) = sfc_albbck(i) snow_p(i,j) = snow(i) snowc_p(i,j) = snowc(i) snowh_p(i,j) = snowh(i) + sst_p(i,j) = sst(i) + t2anl_p(i,j) = t2anl(i) tmn_p(i,j) = tmn(i) tsk_p(i,j) = skintemp(i) vegfra_p(i,j) = vegfra(i) @@ -574,10 +721,12 @@ subroutine lsm_to_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) br,sfc_albedo,sfc_emibck,sfc_emiss,sfcrunoff, & smstav,smstot,snotime,snopcx,sr,udrunoff,z0,znt real(kind=RKIND),dimension(:),pointer :: shdmin,shdmax,snoalb,sfc_albbck,snow,snowc,snowh,tmn, & - skintemp,vegfra,xice,xland - real(kind=RKIND),dimension(:),pointer :: t2m,th2m,q2 + skintemp,sst,vegfra,xice,xland,hpbl,rmol,ust,psih + real(kind=RKIND),dimension(:),pointer :: t2m,th2m,q2,t2anl1,t2anl2,rh2anl1,rh2anl2,snoanl1,snoanl2 + real(kind=RKIND),dimension(:),pointer :: t2anl,rh2anl,snoanl,ra,rs,imperv,canfra,vegpx,mavail + real(kind=RKIND),dimension(:),pointer :: lai_modis,lai_px,wwlt_px,wfc_px,wsat_px,clay_px,csand_px,fmsand_px real(kind=RKIND),dimension(:),pointer :: raincv,rainncv - real(kind=RKIND),dimension(:,:),pointer:: sh2o,smcrel,smois,tslb + real(kind=RKIND),dimension(:,:),pointer:: sh2o,smcrel,smois,tslb,landusef,soiltypf !local variables and arrays: integer:: ip,iEdg @@ -590,35 +739,58 @@ subroutine lsm_to_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(diag_physics,'acsnom' ,acsnom ) call mpas_pool_get_array(diag_physics,'acsnow' ,acsnow ) + call mpas_pool_get_array(diag_physics,'canfra' ,canfra ) call mpas_pool_get_array(diag_physics,'canwat' ,canwat ) call mpas_pool_get_array(diag_physics,'chs' ,chs ) call mpas_pool_get_array(diag_physics,'chs2' ,chs2 ) call mpas_pool_get_array(diag_physics,'chklowq' ,chklowq ) + call mpas_pool_get_array(diag_physics,'clay_px' ,clay_px ) call mpas_pool_get_array(diag_physics,'cpm' ,cpm ) call mpas_pool_get_array(diag_physics,'cqs2' ,cqs2 ) + call mpas_pool_get_array(diag_physics,'csand_px' ,csand_px ) + call mpas_pool_get_array(diag_physics,'fmsand_px' ,fmsand_px ) call mpas_pool_get_array(diag_physics,'glw' ,glw ) call mpas_pool_get_array(diag_physics,'grdflx' ,grdflx ) call mpas_pool_get_array(diag_physics,'gsw' ,gsw ) call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) + call mpas_pool_get_array(diag_physics,'hpbl' ,hpbl ) + call mpas_pool_get_array(diag_physics,'imperv' ,imperv ) call mpas_pool_get_array(diag_physics,'lai' ,lai ) + call mpas_pool_get_array(diag_physics,'lai_px' ,lai_px ) call mpas_pool_get_array(diag_physics,'lh' ,lh ) + call mpas_pool_get_array(diag_physics,'mavail' ,mavail ) call mpas_pool_get_array(diag_physics,'noahres' ,noahres ) call mpas_pool_get_array(diag_physics,'potevp' ,potevp ) + call mpas_pool_get_array(diag_physics,'psih' ,psih ) call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) call mpas_pool_get_array(diag_physics,'qgh' ,qgh ) call mpas_pool_get_array(diag_physics,'qsfc' ,qsfc ) call mpas_pool_get_array(diag_physics,'br' ,br ) + call mpas_pool_get_array(diag_physics,'ra' ,ra ) call mpas_pool_get_array(diag_physics,'raincv' ,raincv ) call mpas_pool_get_array(diag_physics,'rainncv' ,rainncv ) + call mpas_pool_get_array(diag_physics,'rh2anl1' ,rh2anl1 ) + call mpas_pool_get_array(diag_physics,'rh2anl2' ,rh2anl2 ) + call mpas_pool_get_array(diag_physics,'rmol' ,rmol ) + call mpas_pool_get_array(diag_physics,'rs' ,rs ) call mpas_pool_get_array(diag_physics,'sfc_albedo',sfc_albedo) call mpas_pool_get_array(diag_physics,'sfc_emibck',sfc_emibck) call mpas_pool_get_array(diag_physics,'sfc_emiss' ,sfc_emiss ) call mpas_pool_get_array(diag_physics,'sfcrunoff' ,sfcrunoff ) call mpas_pool_get_array(diag_physics,'smstav' ,smstav ) call mpas_pool_get_array(diag_physics,'smstot' ,smstot ) + call mpas_pool_get_array(diag_physics,'snoanl1' ,snoanl1 ) + call mpas_pool_get_array(diag_physics,'snoanl2' ,snoanl2 ) call mpas_pool_get_array(diag_physics,'snotime' ,snotime ) call mpas_pool_get_array(diag_physics,'snopcx' ,snopcx ) + call mpas_pool_get_array(diag_physics,'t2anl1' ,t2anl1 ) + call mpas_pool_get_array(diag_physics,'t2anl2' ,t2anl2 ) call mpas_pool_get_array(diag_physics,'udrunoff' ,udrunoff ) + call mpas_pool_get_array(diag_physics,'ust' ,ust ) + call mpas_pool_get_array(diag_physics,'vegpx' ,vegpx ) + call mpas_pool_get_array(diag_physics,'wfc_px' ,wfc_px ) + call mpas_pool_get_array(diag_physics,'wsat_px' ,wsat_px ) + call mpas_pool_get_array(diag_physics,'wwlt_px' ,wwlt_px ) call mpas_pool_get_array(diag_physics,'z0' ,z0 ) call mpas_pool_get_array(diag_physics,'znt' ,znt ) call mpas_pool_get_array(diag_physics,'t2m' ,t2m ) @@ -627,13 +799,18 @@ subroutine lsm_to_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(sfc_input,'isltyp' ,isltyp ) call mpas_pool_get_array(sfc_input,'ivgtyp' ,ivgtyp ) + call mpas_pool_get_array(sfc_input,'lai_modis' ,lai_modis ) + call mpas_pool_get_array(sfc_input,'rh2anl' ,rh2anl ) call mpas_pool_get_array(sfc_input,'shdmin' ,shdmin ) call mpas_pool_get_array(sfc_input,'shdmax' ,shdmax ) call mpas_pool_get_array(sfc_input,'snoalb' ,snoalb ) call mpas_pool_get_array(sfc_input,'sfc_albbck' ,sfc_albbck) + call mpas_pool_get_array(sfc_input,'snoanl' ,snoanl ) call mpas_pool_get_array(sfc_input,'snow' ,snow ) call mpas_pool_get_array(sfc_input,'snowc' ,snowc ) call mpas_pool_get_array(sfc_input,'snowh' ,snowh ) + call mpas_pool_get_array(sfc_input,'sst' ,sst ) + call mpas_pool_get_array(sfc_input,'t2anl' ,t2anl ) call mpas_pool_get_array(sfc_input,'tmn' ,tmn ) call mpas_pool_get_array(sfc_input,'skintemp' ,skintemp ) call mpas_pool_get_array(sfc_input,'vegfra' ,vegfra ) @@ -643,6 +820,8 @@ subroutine lsm_to_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(sfc_input,'smcrel' ,smcrel ) call mpas_pool_get_array(sfc_input,'smois' ,smois ) call mpas_pool_get_array(sfc_input,'tslb' ,tslb ) + call mpas_pool_get_array(sfc_input,'landusef' ,landusef ) + call mpas_pool_get_array(sfc_input,'soiltypf' ,soiltypf ) do j = jts,jte do n = 1,num_soils @@ -655,49 +834,97 @@ subroutine lsm_to_MPAS(configs,mesh,diag_physics,sfc_input,its,ite) enddo enddo + do j = jts,jte + do n = 1,num_soilc + do i = its,ite + soiltypf(n,i) = soiltypf_p(i,n,j) + enddo + enddo + enddo + + do j = jts,jte + do n = 1,num_landu + do i = its,ite + landusef(n,i) = landusef_p(i,n,j) + enddo + enddo + enddo + do j = jts,jte do i = its,ite acsnom(i) = acsnom_p(i,j) acsnow(i) = acsnow_p(i,j) + canfra(i) = canfra_p(i,j) canwat(i) = canwat_p(i,j) chs(i) = chs_p(i,j) chs2(i) = chs2_p(i,j) chklowq(i) = chklowq_p(i,j) + clay_px(i) = clay_px_p(i,j) cpm(i) = cpm_p(i,j) cqs2(i) = cqs2_p(i,j) + csand_px(i) = csand_px_p(i,j) + fmsand_px(i) = fmsand_px_p(i,j) glw(i) = glw_p(i,j) grdflx(i) = grdflx_p(i,j) gsw(i) = gsw_p(i,j) hfx(i) = hfx_p(i,j) + hpbl(i) = hpbl_p(i,j) + imperv(i) = imperv_p(i,j) lai(i) = lai_p(i,j) + lai_px(i) = lai_px_p(i,j) lh(i) = lh_p(i,j) + mavail(i) = mavail_p(i,j) noahres(i) = noahres_p(i,j) potevp(i) = potevp_p(i,j) + psih(i) = psih_p(i,j) qfx(i) = qfx_p(i,j) qgh(i) = qgh_p(i,j) qsfc(i) = qsfc_p(i,j) br(i) = br_p(i,j) + ra(i) = ra_p(i,j) + rh2anl1(i) = rh2anl1_p(i,j) + rh2anl2(i) = rh2anl2_p(i,j) + rmol(i) = rmol_p(i,j) + rs(i) = rs_p(i,j) sfc_albedo(i) = sfc_albedo_p(i,j) sfc_emibck(i) = sfc_emibck_p(i,j) sfc_emiss(i) = sfc_emiss_p(i,j) sfcrunoff(i) = sfcrunoff_p(i,j) smstav(i) = smstav_p(i,j) smstot(i) = smstot_p(i,j) + snoanl1(i) = snoanl1_p(i,j) + snoanl2(i) = snoanl2_p(i,j) snotime(i) = snotime_p(i,j) snopcx(i) = snopcx_p(i,j) + t2anl1(i) = t2anl1_p(i,j) + t2anl2(i) = t2anl2_p(i,j) udrunoff(i) = udrunoff_p(i,j) + ust(i) = ust_p(i,j) + vegpx(i) = vegpx_p(i,j) + wfc_px(i) = wfc_px_p(i,j) + wsat_px(i) = wsat_px_p(i,j) + wwlt_px(i) = wwlt_px_p(i,j) z0(i) = z0_p(i,j) znt(i) = znt_p(i,j) t2m(i) = t2m_p(i,j) th2m(i) = th2m_p(i,j) q2(i) = q2_p(i,j) + isltyp(i) = isltyp_p(i,j) + ivgtyp(i) = ivgtyp_p(i,j) + lai_modis(i) = lai_modis_p(i,j) + rh2anl(i) = rh2anl_p(i,j) + shdmin(i) = shdmin_p(i,j) + shdmax(i) = shdmax_p(i,j) snoalb(i) = snoalb_p(i,j) sfc_albbck(i) = sfc_albbck_p(i,j) + snoanl(i) = snoanl_p(i,j) snow(i) = snow_p(i,j) snowc(i) = snowc_p(i,j) snowh(i) = snowh_p(i,j) skintemp(i) = tsk_p(i,j) + sst(i) = sst_p(i,j) + t2anl(i) = t2anl_p(i,j) tmn(i) = tmn_p(i,j) vegfra(i) = vegfra_p(i,j) xice(i) = xice_p(i,j) @@ -762,6 +989,9 @@ subroutine init_lsm(dminfo,mesh,configs,diag_physics,sfc_input) case ("noah") call noah_init_forMPAS(dminfo,mesh,configs,diag_physics,sfc_input) + + case ("px") + call noah_init_forMPAS(dminfo,mesh,configs,diag_physics,sfc_input) !may be customized for PX in the future case default @@ -785,18 +1015,32 @@ subroutine driver_lsm(itimestep,configs,mesh,diag_physics,sfc_input,its,ite) type(mpas_pool_type),intent(inout):: sfc_input !local pointers: - logical,pointer:: config_sfc_albedo,config_frac_seaice + logical,pointer :: config_sfc_albedo,config_frac_seaice + logical,pointer :: config_do_restart character(len=StrKIND),pointer:: lsm_scheme character(len=StrKIND),pointer:: mminlu - integer,pointer:: isice + character(len=StrKIND),pointer:: config_landuse_data + character(len=StrKIND),pointer:: config_soilndg_interval + integer,pointer :: config_px_soilndg + integer,pointer :: config_px_smoisinit + integer,pointer :: config_px_modis_veg + integer,pointer :: isice + + integer :: nlcat !----------------------------------------------------------------------------------------------------------------- !call mpas_log_write('') !call mpas_log_write('--- enter subroutine driver_lsm:') - call mpas_pool_get_config(configs,'config_sfc_albedo' ,config_sfc_albedo ) - call mpas_pool_get_config(configs,'config_frac_seaice',config_frac_seaice) - call mpas_pool_get_config(configs,'config_lsm_scheme',lsm_scheme) + call mpas_pool_get_config(configs, 'config_sfc_albedo' ,config_sfc_albedo ) + call mpas_pool_get_config(configs, 'config_frac_seaice',config_frac_seaice) + call mpas_pool_get_config(configs, 'config_lsm_scheme',lsm_scheme) + call mpas_pool_get_config(configs, 'config_landuse_data',config_landuse_data ) + call mpas_pool_get_config(configs, 'config_soilndg_interval',config_soilndg_interval ) + call mpas_pool_get_config(configs, 'config_px_soilndg',config_px_soilndg ) + call mpas_pool_get_config(configs, 'config_px_smoisinit',config_px_smoisinit ) + call mpas_pool_get_config(configs, 'config_px_modis_veg',config_px_modis_veg ) + call mpas_pool_get_config(configs, 'config_do_restart',config_do_restart) call mpas_pool_get_array(sfc_input,'mminlu',mminlu) call mpas_pool_get_array(sfc_input,'isice' ,isice ) @@ -894,7 +1138,46 @@ subroutine driver_lsm(itimestep,configs,mesh,diag_physics,sfc_input,its,ite) its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte & ) call mpas_timer_stop('Noah') - + + case("px") + call mpas_timer_start('PX') + call pxlsm( & + dz8w = dz_p , qv3d = qv_p , t3d = t_p , & + th3d = th_p , rho = rho_p , psfc = psfc_p , & + gsw = gsw_p , glw = glw_p , rainbl = rainbl_p , & + emiss =sfc_emiss_p, itimestep = itimestep , restart =config_do_restart,& + nsoil = num_soils , anal_intervalc=config_soilndg_interval , & + xland = xland_p , xice = xice_p , albedo = sfc_albedo_p , & + snoalb = snoalb_p , smois = smois_p , tslb = tslb_p , & + mavail = mavail_p , ta2 = t2m_p , qa2 = q2_p , & + qsfc = qsfc_p , dzs = dzs_p , psih = psih_p , & + landusef = landusef_p, soilcbot = soiltypf_p , & + vegfra = vegfra_p , vegf_px = vegpx_p , ivgtyp = ivgtyp_p , & + isltyp = isltyp_p , ra = ra_p , rs = rs_p , & + lai = lai_modis_p,imperv = imperv_p , canfra = canfra_p , & + nlcat = num_landu , nscat = num_soilc , & + hfx = hfx_p , qfx = qfx_p , & + lh = lh_p , tsk = tsk_p , sst = sst_p , & + znt = znt_p , canwat = canwat_p , grdflx = grdflx_p , & + shdmin = shdmin_p , shdmax = shdmax_p , snowc = snowc_p , & + pblh = hpbl_p , rmol = rmol_p , ust = ust_p , & + dtbl = dt_pbl , t2_ndg_old= t2anl1_p , t2_ndg_new= t2anl2_p , & + q2_ndg_old= rh2anl1_p , q2_ndg_new= rh2anl2_p , sn_ndg_old= snoanl1_p , & + sn_ndg_new= snoanl2_p , snow = snow_p , snowh = snowh_p , & + snowncv = acsnow_p , t2obs = t2anl_p , q2obs = rh2anl_p , & + pxlsm_smois_init = config_px_smoisinit, pxlsm_soil_nudge = config_px_soilndg, & + pxlsm_modis_veg = config_px_modis_veg , & + lai_px = lai_px_p , & + wwlt_px = wwlt_px_p , wfc_px = wfc_px_p , wsat_px = wsat_px_p , & + clay_px = clay_px_p , csand_px = csand_px_p , fmsand_px = fmsand_px_p , & + ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , & + ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , & + its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte & + ) +! if(config_frac_seaice) then +! call seaice_px( ) ! Future site of PX-compatible handling of fractional sea-ice +! endif + call mpas_timer_stop('PX') case default diff --git a/src/core_atmosphere/physics/mpas_atmphys_initialize_real.F b/src/core_atmosphere/physics/mpas_atmphys_initialize_real.F index eae7dd844d..746ee8a756 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_initialize_real.F +++ b/src/core_atmosphere/physics/mpas_atmphys_initialize_real.F @@ -52,6 +52,13 @@ module mpas_atmphys_initialize_real ! * In subroutine physics_init_seaice, removed the initialization of isice_lu since it is now defined in ! Registry.xml and initialized in subroutine init_atm_static. ! Laura D. Fowler (laura@ucar.edu) / 2017-01-12. +! * generalized soilcat (isltyp) to work with either soiltype_top or soiltype_bot data. +! Jerold A. Herwehe (herwehe.jerry@epa.gov) / 2018-09-10. +! * added fractional soil type (soiltypf) and land use (landusef) dependent on config_frac_landuse option; +! otherwise dominant land use and soil type will be used by default. +! Jerold A. Herwehe (herwehe.jerry@epa.gov) / 2020-02-10. +! * added initialization of lai_modis from MODIS climatological monthly mean LAI for use by PX LSM. +! Jerold A. Herwehe (herwehe.jerry@epa.gov) / 2020-02-20. contains @@ -81,9 +88,9 @@ subroutine physics_initialize_real(mesh, fg, dminfo, dims, configs) real(kind=RKIND),dimension(:,:),pointer:: albedo12m real(kind=RKIND),dimension(:),pointer:: seaice,xice,xland - real(kind=RKIND),dimension(:),pointer:: vegfra,shdmin,shdmax + real(kind=RKIND),dimension(:),pointer:: vegfra,shdmin,shdmax,lai_modis real(kind=RKIND),dimension(:),pointer:: snow,snowc,snowh - real(kind=RKIND),dimension(:,:),pointer:: greenfrac + real(kind=RKIND),dimension(:,:),pointer:: greenfrac,lai12m real(kind=RKIND),dimension(:),pointer:: skintemp,sst @@ -109,9 +116,11 @@ subroutine physics_initialize_real(mesh, fg, dminfo, dims, configs) call mpas_pool_get_array(mesh, 'greenfrac', greenfrac) call mpas_pool_get_array(mesh, 'shdmin', shdmin) call mpas_pool_get_array(mesh, 'shdmax', shdmax) + call mpas_pool_get_array(mesh, 'lai12m', lai12m) call mpas_pool_get_array(fg, 'sfc_albbck', sfc_albbck) call mpas_pool_get_array(fg, 'vegfra', vegfra) + call mpas_pool_get_array(fg, 'lai_modis', lai_modis) call mpas_pool_get_array(fg, 'snow', snow) call mpas_pool_get_array(fg, 'snowc', snowc) call mpas_pool_get_array(fg, 'snowh', snowh) @@ -150,10 +159,12 @@ subroutine physics_initialize_real(mesh, fg, dminfo, dims, configs) if(landmask(iCell) .eq. 0) sfc_albbck(iCell) = 0.08_RKIND enddo -!initialization of the green-ness (vegetation) fraction: interpolation of the monthly values to -!the initial date. get the min/max for each cell for the monthly green-ness fraction: +!initialization of the green-ness (vegetation) fraction and leaf area index: +!interpolation of the monthly values to the initial date, and +!get the min/max for each cell for the monthly green-ness fraction: initial_date = trim(config_start_time) call monthly_interp_to_date(nCellsSolve,initial_date,greenfrac,vegfra) + call monthly_interp_to_date(nCellsSolve,initial_date,lai12m,lai_modis) !calculates the maximum and minimum green-ness (vegetation) fraction: call monthly_min_max(nCellsSolve,greenfrac,shdmin,shdmax) @@ -297,9 +308,6 @@ subroutine init_soil_layers_depth(mesh, fg, dims, configs) call mpas_pool_get_config(configs, 'config_nsoillevels', config_nsoillevels) - if(config_nsoillevels .ne. 4) & - call physics_error_fatal('NOAH lsm uses 4 soil layers. Correct config_nsoillevels.') - do iCell = 1, nCellsSolve iSoil = 1 zs_fg(iSoil,iCell) = 0.5_RKIND * dzs_fg(iSoil,iCell) @@ -310,21 +318,45 @@ subroutine init_soil_layers_depth(mesh, fg, dims, configs) enddo enddo - do iCell = 1, nCellsSolve - dzs(1,iCell) = 0.10_RKIND - dzs(2,iCell) = 0.30_RKIND - dzs(3,iCell) = 0.60_RKIND - dzs(4,iCell) = 1.00_RKIND + if(config_nsoillevels .eq. 4) then ! for Noah lsm + + do iCell = 1, nCellsSolve + dzs(1,iCell) = 0.10_RKIND + dzs(2,iCell) = 0.30_RKIND + dzs(3,iCell) = 0.60_RKIND + dzs(4,iCell) = 1.00_RKIND + + iSoil = 1 + zs(iSoil,iCell) = 0.5_RKIND * dzs(iSoil,iCell) + do iSoil = 2, nSoilLevels + zs(iSoil,iCell) = zs(iSoil-1,iCell) & + + 0.5_RKIND * dzs(iSoil-1,iCell) & + + 0.5_RKIND * dzs(iSoil,iCell) + enddo - iSoil = 1 - zs(iSoil,iCell) = 0.5_RKIND * dzs(iSoil,iCell) - do iSoil = 2, nSoilLevels - zs(iSoil,iCell) = zs(iSoil-1,iCell) & - + 0.5_RKIND * dzs(iSoil-1,iCell) & - + 0.5_RKIND * dzs(iSoil,iCell) enddo - enddo + elseif(config_nsoillevels .eq. 2) then ! for PX lsm + + do iCell = 1, nCellsSolve + dzs(1,iCell) = 0.01_RKIND + dzs(2,iCell) = 0.99_RKIND + + iSoil = 1 + zs(iSoil,iCell) = 0.5_RKIND * dzs(iSoil,iCell) + do iSoil = 2, nSoilLevels + zs(iSoil,iCell) = zs(iSoil-1,iCell) & + + 0.5_RKIND * dzs(iSoil-1,iCell) & + + 0.5_RKIND * dzs(iSoil,iCell) + enddo + + enddo + + else + + call physics_error_fatal('NOAH lsm uses 4 and PX lsm uses 2 soil layers. Correct config_nsoillevels.') + + endif end subroutine init_soil_layers_depth @@ -402,8 +434,8 @@ subroutine init_soil_layers_properties(mesh, fg, dminfo, dims, configs) call mpas_log_write('Error in interpolation of sm_fg to MPAS grid: num_sm = $i', messageType=MPAS_LOG_CRIT, intArgs=(/num_sm/)) endif - if(config_nsoillevels .ne. 4) & - call physics_error_fatal('NOAH lsm uses 4 soil layers. Correct config_nsoillevels.') + if(config_nsoillevels .ne. 4 .and. config_nsoillevels .ne. 2) & + call physics_error_fatal('NOAH lsm uses 4 and PX lsm uses 2 soil layers. Correct config_nsoillevels.') if(.not.allocated(zhave) ) allocate(zhave(nFGSoilLevels+2,nCellsSolve) ) if(.not.allocated(st_input)) allocate(st_input(nFGSoilLevels+2,nCellsSolve)) @@ -434,14 +466,14 @@ subroutine init_soil_layers_properties(mesh, fg, dminfo, dims, configs) enddo -!... interpolate the soil temperature, soil moisture, and soil liquid temperature to the four -! layers used in the NOAH land surface scheme: +!... interpolate the soil temperature, soil moisture, and soil liquid temperature to either +! the four layers used in the NOAH land surface scheme or the two layers used in the PX LSM: do iCell = 1, nCellsSolve if(landmask(iCell) .eq. 1) then - noah: do iSoil = 1 , nSoilLevels + do iSoil = 1 , nSoilLevels input: do ifgSoil = 1 , nFGSoilLevels+2-1 if(iCell .eq. 1) call mpas_log_write('$i $i $r $r $r', & intArgs=(/iSoil,ifgSoil/), & @@ -470,7 +502,7 @@ subroutine init_soil_layers_properties(mesh, fg, dminfo, dims, configs) endif enddo input if(iCell.eq. 1) call mpas_log_write('') - enddo noah + enddo elseif(landmask(iCell) .eq. 0) then @@ -596,14 +628,16 @@ subroutine physics_init_seaice(mesh, input, dims, configs) real(kind=RKIND):: xice_threshold real(kind=RKIND):: mid_point_depth - real(kind=RKIND),dimension(:),pointer :: vegfra + real(kind=RKIND),dimension(:),pointer :: vegfra,lai_modis real(kind=RKIND),dimension(:),pointer :: seaice,xice real(kind=RKIND),dimension(:),pointer :: skintemp,tmn,xland real(kind=RKIND),dimension(:,:),pointer:: tslb,smois,sh2o,smcrel + real(kind=RKIND),dimension(:,:),pointer:: landusef,soiltypf - logical, pointer :: config_frac_seaice + logical, pointer :: config_frac_seaice,config_frac_landuse character(len=StrKIND),pointer:: config_landuse_data - integer,pointer:: isice_lu + integer,pointer:: isice_lu,ismax_lu + integer:: i !note that this threshold is also defined in module_physics_vars.F.It is defined here to avoid !adding "use module_physics_vars" since this subroutine is only used for the initialization of @@ -617,18 +651,23 @@ subroutine physics_init_seaice(mesh, input, dims, configs) call mpas_pool_get_config(configs, 'config_frac_seaice', config_frac_seaice) call mpas_pool_get_config(configs, 'config_landuse_data', config_landuse_data) + call mpas_pool_get_config(configs, 'config_frac_landuse', config_frac_landuse) call mpas_pool_get_dimension(dims, 'nCellsSolve', nCellsSolve) call mpas_pool_get_dimension(dims, 'nSoilLevels', nSoilLevels) call mpas_pool_get_array(mesh, 'isice_lu', isice_lu) + call mpas_pool_get_array(mesh, 'ismax_lu', ismax_lu) call mpas_pool_get_array(mesh, 'landmask', landmask) call mpas_pool_get_array(mesh, 'lu_index', ivgtyp) - call mpas_pool_get_array(mesh, 'soilcat_top', isltyp) + call mpas_pool_get_array(mesh, 'landusef', landusef) + call mpas_pool_get_array(mesh, 'soilcat', isltyp) + call mpas_pool_get_array(mesh, 'soiltypf', soiltypf) call mpas_pool_get_array(input, 'seaice', seaice) call mpas_pool_get_array(input, 'xice', xice) call mpas_pool_get_array(input, 'vegfra', vegfra) + call mpas_pool_get_array(input, 'lai_modis', lai_modis) call mpas_pool_get_array(input, 'skintemp', skintemp) call mpas_pool_get_array(input, 'tmn', tmn) @@ -640,6 +679,7 @@ subroutine physics_init_seaice(mesh, input, dims, configs) call mpas_pool_get_array(input, 'smcrel', smcrel) call mpas_log_write('--- isice_lu = $i', intArgs=(/isice_lu/)) + call mpas_log_write('--- ismax_lu = $i', intArgs=(/ismax_lu/)) !assign the threshold value for xice as a function of config_frac_seaice: if(.not. config_frac_seaice) then @@ -668,9 +708,25 @@ subroutine physics_init_seaice(mesh, input, dims, configs) !... sea-ice points are converted to land points: if(landmask(iCell) .eq. 0) tmn(iCell) = 271.4_RKIND ivgtyp(iCell) = isice_lu +! if(.not. config_frac_landuse) then + landusef(isice_lu,iCell) = 1.0 ! defines dominant land use only + do i = 1,isice_lu-1 + landusef(i,iCell) = 0.0 + end do + do i = isice_lu+1,ismax_lu + landusef(i,iCell) = 0.0 + end do +! else + ! Placeholder for land conversion with fractional land use +! endif isltyp(iCell) = 16 - vegfra(iCell) = 0._RKIND - xland(iCell) = 1._RKIND + soiltypf(16,iCell) = 1.0 ! Currently defines dominant soil type fraction only + do i = 1,15 + soiltypf(i,iCell) = 0.0 + end do + vegfra(iCell) = 0._RKIND + lai_modis(iCell) = 0._RKIND + xland(iCell) = 1._RKIND !... recalculate the soil temperature and soil moisture: do iSoil = 1, nSoilLevels diff --git a/src/core_atmosphere/physics/mpas_atmphys_manager.F b/src/core_atmosphere/physics/mpas_atmphys_manager.F index fe8ee5c27c..fd25c7bbec 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_manager.F +++ b/src/core_atmosphere/physics/mpas_atmphys_manager.F @@ -37,7 +37,10 @@ module mpas_atmphys_manager !defines alarm to update the surface boundary conditions: character(len=*), parameter:: sfcbdyAlarmID = 'sfcbdy' -!defines alarm to update the background surface albedo and the greeness fraction: +!defines alarm to update the soil nudging analyses: + character(len=*), parameter:: soilndgAlarmID = 'soilndg' + +!defines alarm to update the background surface albedo and the greenness fraction: character(len=*), parameter:: greenAlarmID = 'green' !defines alarm to update the ozone path length,the trace gas path length,the total emissivity, @@ -148,6 +151,7 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) config_sfc_albedo, & config_sst_update, & config_sstdiurn_update, & + config_soilndg_update, & config_deepsoiltemp_update character(len=StrKIND),pointer:: config_convection_scheme, & @@ -193,6 +197,7 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) call mpas_pool_get_config(domain%blocklist%configs,'config_sfc_albedo' ,config_sfc_albedo ) call mpas_pool_get_config(domain%blocklist%configs,'config_sst_update' ,config_sst_update ) call mpas_pool_get_config(domain%blocklist%configs,'config_sstdiurn_update' ,config_sstdiurn_update ) + call mpas_pool_get_config(domain%blocklist%configs,'config_soilndg_update' ,config_soilndg_update ) call mpas_pool_get_config(domain%blocklist%configs,'config_deepsoiltemp_update',config_deepsoiltemp_update) !update the current julian day and current year: @@ -237,9 +242,16 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) if(mpas_is_alarm_ringing(clock,sfcbdyAlarmID,ierr=ierr)) then call mpas_reset_clock_alarm(clock,sfcbdyAlarmID,ierr=ierr) if(config_sst_update) & - call physics_update_sst(domain%dminfo,config_frac_seaice,mesh,sfc_input,diag_physics) + call physics_update_sst(domain%dminfo,config_frac_seaice,mesh,block%configs,sfc_input,diag_physics) endif + ! Update P-X soil nudging analyses from soilndg file: T2, RH2 and SNOW + if(mpas_is_alarm_ringing(clock,soilndgAlarmID,ierr=ierr)) then + call mpas_reset_clock_alarm(clock,soilndgAlarmID,ierr=ierr) + if(config_soilndg_update) & + call physics_update_soilndg(domain%dminfo,mesh,block%configs,sfc_input,diag_physics,itimestep) + endif + !apply a diurnal cycle to the sea-surface temperature: if(config_sstdiurn_update) & call physics_update_sstskin(dt_dyn,mesh,diag_physics,sfc_input) @@ -394,7 +406,8 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) config_radtsw_interval, & config_bucket_update, & config_camrad_abs_update, & - config_greeness_update + config_greeness_update, & + config_soilndg_interval logical,pointer:: config_sst_update logical,pointer:: config_frac_seaice @@ -404,7 +417,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) integer,pointer:: cam_dim1 integer,pointer:: nMonths integer,pointer:: nAerosols,nAerLevels,nOznLevels - integer,pointer:: nCellsSolve,nSoilLevels,nVertLevels + integer,pointer:: nCellsSolve,nSoilLevels,nVertLevels,nLandCat,nSoilCat real(kind=RKIND),pointer:: config_dt @@ -428,6 +441,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) call mpas_pool_get_config(configs,'config_pbl_interval' ,config_pbl_interval ) call mpas_pool_get_config(configs,'config_radtlw_interval' ,config_radtlw_interval ) call mpas_pool_get_config(configs,'config_radtsw_interval' ,config_radtsw_interval ) + call mpas_pool_get_config(configs,'config_soilndg_interval' ,config_soilndg_interval ) call mpas_pool_get_config(configs,'config_bucket_update' ,config_bucket_update ) call mpas_pool_get_config(configs,'config_camrad_abs_update',config_camrad_abs_update) call mpas_pool_get_config(configs,'config_greeness_update' ,config_greeness_update ) @@ -445,6 +459,8 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) call mpas_pool_get_dimension(mesh,'nSoilLevels',nSoilLevels) + call mpas_pool_get_dimension(mesh,'nLandCat' ,nLandCat ) + call mpas_pool_get_dimension(mesh,'nSoilCat' ,nSoilCat ) call mpas_pool_get_dimension(mesh,'nVertLevels',nVertLevels) call mpas_pool_get_dimension(state,'num_aerosols',nAerosols) @@ -561,6 +577,17 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) call physics_error_fatal('subroutine physics_init: error creating alarm sfcbdy') endif +!set alarm for updating the soil nudging: + call MPAS_stream_mgr_get_property(stream_manager, 'soilndg', MPAS_STREAM_PROPERTY_RECORD_INTV, stream_interval, & + direction=MPAS_STREAM_INPUT, ierr=ierr) + if(trim(config_soilndg_interval) /= 'none') then + call mpas_set_timeInterval(alarmTimeStep,timeString=config_soilndg_interval,ierr=ierr) + alarmStartTime = startTime + call mpas_add_clock_alarm(clock,soilndgAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr) + if(ierr /= 0) & + call physics_error_fatal('subroutine physics_init: error creating alarm for soil nudging') + endif + !set alarm to update the ozone path length, the trace gas path length, the total emissivity, !and the total absorptivity in the "CAM" long-wave radiation codes. if(trim(config_radt_lw_scheme) .eq. "cam_lw" .or. & @@ -671,6 +698,8 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) !initialization local physics variables: num_months = nMonths num_soils = nSoilLevels + num_landu = nLandCat + num_soilc = nSoilCat if(trim(config_lsm_scheme) .eq. "noah") sf_surface_physics = 2 diff --git a/src/core_atmosphere/physics/mpas_atmphys_update_surface.F b/src/core_atmosphere/physics/mpas_atmphys_update_surface.F index 6e2057d5cb..5b366ac13e 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_update_surface.F +++ b/src/core_atmosphere/physics/mpas_atmphys_update_surface.F @@ -20,7 +20,8 @@ module mpas_atmphys_update_surface public:: physics_update_sst, & physics_update_sstskin, & physics_update_surface, & - physics_update_deepsoiltemp + physics_update_deepsoiltemp,& + physics_update_soilndg !Update surface boundary conditions. @@ -33,6 +34,7 @@ module mpas_atmphys_update_surface ! physics_update_sst : update the sea-surface temperatures. ! physics_update_sstskin : add a diurnal cycle to the sea-surface temperatures. ! physics_update_deepsoiltemp: update the deep soil temperatures. +! physics_update_soilndg : use data assimilation to nudge soil physics for retrospective simulations. ! ! add-ons and modifications to sourcecode: ! ---------------------------------------- @@ -40,11 +42,17 @@ module mpas_atmphys_update_surface ! Laura D. Fowler (laura@ucar.edu) / 2013-08-24. ! * modified sourcecode to use pools. ! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. +! * added subroutine physics_update_soilndg. +! Jon Pleim (pleim.jon@epa.gov) and Rob Gilliam (gilliam.robert@epa.gov) / 2016-09-16 ! * now use isice and iswater initialized in the init file instead of initialized in mpas_atmphys_landuse.F. ! Laura D. Fowler (laura@ucar.edu) / 2017-01-13. ! * corrected the initialization of the soil temperature tslb over ocean points for exact restartability, and ! for consistency with module_sf_noahdrv.F when itimestep = 1. ! Laura D. Fowler (laura@ucar.edu) / 2017-08-29. +! * for use with PX LSM, changed tslb back to sst over ocean points. +! Jerold A. Herwehe (herwehe.jerry@epa.gov) / 2020-01-23. +! * added lai_modis interpolated from MODIS climatological monthly mean LAI for use by PX LSM. +! Jerold A. Herwehe (herwehe.jerry@epa.gov) / 2020-02-27. contains @@ -72,6 +80,8 @@ subroutine physics_update_surface(current_date,config_sfc_albedo,mesh,sfc_input) real(kind=RKIND),dimension(:,:),pointer:: albedo12m real(kind=RKIND),dimension(:) ,pointer:: vegfra,shdmin,shdmax real(kind=RKIND),dimension(:,:),pointer:: greenfrac + real(kind=RKIND),dimension(:) ,pointer:: lai_modis + real(kind=RKIND),dimension(:,:),pointer:: lai12m !local variables: integer:: iCell @@ -89,6 +99,9 @@ subroutine physics_update_surface(current_date,config_sfc_albedo,mesh,sfc_input) call mpas_pool_get_array(sfc_input,'shdmin' , shdmin ) call mpas_pool_get_array(sfc_input,'shdmax' , shdmax ) + call mpas_pool_get_array(sfc_input,'lai12m' , lai12m ) + call mpas_pool_get_array(sfc_input,'lai_modis' , lai_modis ) + !updates the surface background albedo for the current date as a function of the monthly-mean !surface background albedo valid on the 15th day of the month, if config_sfc_albedo is true: if(config_sfc_albedo) then @@ -108,15 +121,20 @@ subroutine physics_update_surface(current_date,config_sfc_albedo,mesh,sfc_input) call monthly_interp_to_date(nCellsSolve,current_date,greenfrac,vegfra) call monthly_min_max(nCellsSolve,greenfrac,shdmin,shdmax) +!updates the leaf area index for the current date as a function of the monthly-mean MODIS LAI +!valid on the 15th day of the month. + call monthly_interp_to_date(nCellsSolve,current_date,lai12m,lai_modis) + end subroutine physics_update_surface !================================================================================================================= - subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,sfc_input,diag_physics) + subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,configs,sfc_input,diag_physics) !================================================================================================================= !input arguments: type(dm_info),intent(in):: dminfo type(mpas_pool_type),intent(in):: mesh + type(mpas_pool_type),intent(in):: configs logical,intent(in):: config_frac_seaice !inout arguments: @@ -127,13 +145,16 @@ subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,sfc_input,diag_phys integer,pointer:: nCellsSolve,nSoilLevels integer,pointer:: isice,iswater - real(kind=RKIND),dimension(:),pointer :: sfc_albbck,sst,snow,tmn,tsk,vegfra,xice,seaice + real(kind=RKIND),dimension(:),pointer :: sfc_albbck,sst,snow,tmn,tsk,vegfra,xice,seaice,lai_modis real(kind=RKIND),dimension(:),pointer :: snowc,snowh real(kind=RKIND),dimension(:,:),pointer:: tslb,sh2o,smois real(kind=RKIND),dimension(:),pointer:: sfc_albedo,sfc_emiss,sfc_emibck real(kind=RKIND),dimension(:),pointer:: xicem,xland +!local pointers: + character(len=StrKIND),pointer:: config_lsm_scheme + !local variables: integer:: icheck integer:: iCell,iSoil @@ -146,6 +167,8 @@ subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,sfc_input,diag_phys !----------------------------------------------------------------------------------------------------------------- + call mpas_pool_get_config(configs,'config_lsm_scheme',config_lsm_scheme) + call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) call mpas_pool_get_dimension(mesh,'nSoilLevels',nSoilLevels) @@ -155,6 +178,7 @@ subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,sfc_input,diag_phys call mpas_pool_get_array(sfc_input,'ivgtyp' ,ivgtyp ) call mpas_pool_get_array(sfc_input,'landmask' ,landmask ) call mpas_pool_get_array(sfc_input,'vegfra' ,vegfra ) + call mpas_pool_get_array(sfc_input,'lai_modis' ,lai_modis ) call mpas_pool_get_array(sfc_input,'sfc_albbck',sfc_albbck) call mpas_pool_get_array(sfc_input,'sst' ,sst ) call mpas_pool_get_array(sfc_input,'tmn' ,tmn ) @@ -216,11 +240,12 @@ subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,sfc_input,diag_phys nb_to_land = nb_to_land + 1 !... sea-ice points are converted to land points: - ivgtyp(iCell) = isice - isltyp(iCell) = 16 - vegfra(iCell) = 0._RKIND - xland(iCell) = 1._RKIND - tmn(iCell) = 271.4_RKIND + ivgtyp(iCell) = isice + isltyp(iCell) = 16 + vegfra(iCell) = 0._RKIND + lai_modis(iCell) = 0._RKIND + xland(iCell) = 1._RKIND + tmn(iCell) = 271.4_RKIND do iSoil = 1, nSoilLevels tslb(iSoil,iCell) = tsk(iCell) @@ -241,11 +266,12 @@ subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,sfc_input,diag_phys nb_to_ocean = nb_to_ocean + 1 !land points turn to water points: - ivgtyp(iCell) = iswater - isltyp(iCell) = 14 - vegfra(iCell) = 0._RKIND - xland(iCell) = 2._RKIND - tmn(iCell) = sst(iCell) + ivgtyp(iCell) = iswater + isltyp(iCell) = 14 + vegfra(iCell) = 0._RKIND + lai_modis(iCell) = 0._RKIND + xland(iCell) = 2._RKIND + tmn(iCell) = sst(iCell) snowc(iCell) = 0 snow(iCell) = 0.0_RKIND @@ -270,9 +296,15 @@ subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,sfc_input,diag_phys if(xland(iCell) >= 1.5_RKIND) then tsk(iCell) = sst(iCell) - do iSoil = 1, nSoilLevels - tslb(iSoil,iCell) = 273.16 - enddo + if(trim(config_lsm_scheme) .eq. "px") then + do iSoil = 1, nSoilLevels + tslb(iSoil,iCell) = sst(iCell) + enddo + else + do iSoil = 1, nSoilLevels + tslb(iSoil,iCell) = 273.16 + enddo + endif endif enddo !call mpas_log_write('') @@ -567,6 +599,74 @@ subroutine physics_update_deepsoiltemp(LeapYear,dt,julian_in,mesh,sfc_input,diag end subroutine physics_update_deepsoiltemp +!================================================================================================== + subroutine physics_update_soilndg(dminfo,mesh,configs,sfc_input,diag_physics,itimestep) +!================================================================================================== + +!input arguments: + type(dm_info),intent(in) :: dminfo + type(mpas_pool_type),intent(in):: mesh + integer,intent(in) :: itimestep + type(mpas_pool_type),intent(in):: configs + +!inout arguments: + type(mpas_pool_type),intent(inout):: sfc_input + type(mpas_pool_type),intent(inout):: diag_physics + +!local pointers: + logical,pointer:: config_do_restart + + integer,pointer:: nCellsSolve + + real(kind=RKIND),dimension(:),pointer :: t2anl,rh2anl,snoanl + real(kind=RKIND),dimension(:),pointer :: t2anl1,rh2anl1,snoanl1 + real(kind=RKIND),dimension(:),pointer :: t2anl2,rh2anl2,snoanl2 + +!local variables: + integer:: iCell + +!-------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_do_restart' ,config_do_restart ) + + call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) + + call mpas_pool_get_array(sfc_input,'t2anl' ,t2anl ) + call mpas_pool_get_array(sfc_input,'rh2anl' ,rh2anl ) + call mpas_pool_get_array(sfc_input,'snoanl' ,snoanl ) + + call mpas_pool_get_array(diag_physics,'t2anl1',t2anl1) + call mpas_pool_get_array(diag_physics,'t2anl2',t2anl2) + call mpas_pool_get_array(diag_physics,'rh2anl1',rh2anl1) + call mpas_pool_get_array(diag_physics,'rh2anl2',rh2anl2) + call mpas_pool_get_array(diag_physics,'snoanl1',snoanl1) + call mpas_pool_get_array(diag_physics,'snoanl2',snoanl2) + +! call mpas_log_write('') +! call mpas_log_write('--- enter subroutine physics_update_soilndg:') + + if(itimestep .eq. 1 .and. .not. config_do_restart) then + do iCell = 1, nCellsSolve + t2anl1(iCell) = t2anl(iCell) + t2anl2(iCell) = t2anl(iCell) + rh2anl1(iCell) = rh2anl(iCell) + rh2anl2(iCell) = rh2anl(iCell) + snoanl1(iCell) = snoanl(iCell) + snoanl2(iCell) = snoanl(iCell) + enddo + else + do iCell = 1, nCellsSolve + t2anl1(iCell) = t2anl2(iCell) + t2anl2(iCell) = t2anl(iCell) + rh2anl1(iCell) = rh2anl2(iCell) + rh2anl2(iCell) = rh2anl(iCell) + snoanl1(iCell) = snoanl2(iCell) + snoanl2(iCell) = snoanl(iCell) + enddo + endif + + end subroutine physics_update_soilndg + !================================================================================================================= end module mpas_atmphys_update_surface !================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_vars.F b/src/core_atmosphere/physics/mpas_atmphys_vars.F index 28c72579f5..2193e11f3a 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_vars.F +++ b/src/core_atmosphere/physics/mpas_atmphys_vars.F @@ -54,6 +54,8 @@ module mpas_atmphys_vars ! * added the variables qvrad_p,qcrad_p,qirad_p, and qsrad_p which are the water vapor,cloud water,cloud ice, ! and snow mixing ratios local to the calculation of the cloud fraction, and used in the radiation codes. ! Laura D. Fowler (laura@ucar.edu) / 2016-07-08. +! * added P-X LSM and soil nudging arrays and control variables. +! Robert C. Gilliam (gilliam.robert@epa.gov) / 2016-09-09. ! * added the variables rqvften and rthften which are the forcing tendencies needed to run the "new" Tiedtke ! parameterization of convection. ! Laura D. Fowler (laura@ucar.edu) / 2016-09-20. @@ -107,6 +109,8 @@ module mpas_atmphys_vars ! * added local variables for the mass-weighted mean velocities for rain, cloud ice, snow, and graupel from the ! Thompson cloud microphysics scheme. ! Laura D. Fowler (laura@ucar.edu) / 2017-04-19. +! * added MODIS LAI and vegetation fraction, plus soil type fraction, arrays for P-X LSM. +! Jerold A. Herwehe (herwehe.jerry@epa.gov) / 2018-08-28. ! * added the local variables cosa_p and sina_p needed in call to subroutine gwdo after updating module_bl_gwdo.F ! to that of WRF version 4.0.2 ! Laura D. Fowler (laura@ucar.edu) / 2019-01-30. @@ -204,7 +208,7 @@ module mpas_atmphys_vars znu_hyd_p !(pres_hyd_p / P0) needed in the Tiedtke convection scheme [Pa] !================================================================================================================= -!... variables related to ozone climatlogy: +!... variables related to ozone climatology: !================================================================================================================= real(kind=RKIND),dimension(:,:,:),allocatable:: & @@ -658,7 +662,9 @@ module mpas_atmphys_vars !albedos as functions of the land surface scheme. integer,public:: & - num_soils !number of soil layers [-] + num_soils, &!number of soil layers [-] + num_soilc, &!number of soil type categories [-] + num_landu !number of land use classes [-] integer,dimension(:,:),allocatable:: & isltyp_p, &!dominant soil type category [-] @@ -670,7 +676,9 @@ module mpas_atmphys_vars smcrel_p, &!soil moisture threshold below which transpiration starts to stress [-] sh2o_p, &!unfrozen soil moisture content [volumetric fraction] smois_p, &!soil moisture [volumetric fraction] - tslb_p !soil temperature [K] + tslb_p, &!soil temperature [K] + soiltypf_p, &!fractional soil type category [-] + landusef_p !fractional land use class [-] real(kind=RKIND),dimension(:,:),allocatable:: & acsnom_p, &!accumulated melted snow [kg m-2] @@ -678,14 +686,14 @@ module mpas_atmphys_vars canwat_p, &!canopy water [kg m-2] chklowq_p, &!surface saturation flag [-] grdflx_p, &!ground heat flux [W m-2] - lai_p, &!leaf area index [-] + lai_p, &!leaf area index [m2 m-2] noahres_p, &!residual of the noah land-surface scheme energy budget [W m-2] potevp_p, &!potential evaporation [W m-2] qz0_p, &!specific humidity at znt [kg kg-1] rainbl_p, &! sfcrunoff_p, &!surface runoff [m s-1] - shdmin_p, &!minimum areal fractional coverage of annual green vegetation [-] - shdmax_p, &!maximum areal fractional coverage of annual green vegetation [-] + shdmin_p, &!minimum areal fractional coverage of annual green vegetation [%] + shdmax_p, &!maximum areal fractional coverage of annual green vegetation [%] smstav_p, &!moisture availability [-] smstot_p, &!total moisture [m3 m-3] snopcx_p, &!snow phase change heat flux [W m-2] @@ -695,7 +703,29 @@ module mpas_atmphys_vars swdown_p, &!downward shortwave flux at the surface [W m-2] udrunoff_p, &!sub-surface runoff [m s-1] tmn_p, &!soil temperature at lower boundary [K] - vegfra_p, &!vegetation fraction [-] + vegfra_p, &!vegetation fraction [%] + rs_p, &!Stomatal resistance for P-X LSM [-] + ra_p, &!Aerodynamic resistance for P-X LSM [-] + imperv_p, &!Impervious surface fraction for P-X LSM [%] + canfra_p, &!Canopy fraction for P-X LSM [%] + vegpx_p, &!Pleim-Xiu fractional landuse weighted veg fraction [%] + lai_modis_p, &!leaf area index from MODIS [m2 m-2] + lai_px_p, &!Computed leaf area index for P-X LSM [m2 m-2] + wwlt_px_p, &!Computed soil wilting point for P-X LSM [m3 m-3] + wfc_px_p, &!Computed soil field capacity for P-X LSM [m3 m-3] + wsat_px_p, &!Computed soil saturation for P-X LSM [m3 m-3] + clay_px_p, &!Aggregated soil clay fraction for P-X LSM [-] + csand_px_p, &!Aggregated soil coarse sand fraction for P-X LSM [-] + fmsand_px_p, &!Aggregated soil fine-medium sand fraction for P-X LSM [-] + t2anl_p, &!2-m temperature analysis at current timestep [K] + t2anl1_p, &!2-m temperature analysis prior read interval from soilndg file [K] + t2anl2_p, &!2-m temperature analysis next read interval from soilndg file [K] + rh2anl_p, &!2-m RH analysis at current timestep [%] + rh2anl1_p, &!2-m RH analysis prior read interval from soilndg file [%] + rh2anl2_p, &!2-m RH analysis next read interval from soilndg file [%] + snoanl_p, &!Snow analysis at current timestep [kg m-2] + snoanl1_p, &!Snow analysis prior read interval from soilndg file [kg m-2] + snoanl2_p, &!Snow analysis next read interval from soilndg file [kg m-2] z0_p !background roughness length [m] real(kind=RKIND),dimension(:,:),allocatable:: & diff --git a/src/core_atmosphere/physics/physics_wrf/Makefile b/src/core_atmosphere/physics/physics_wrf/Makefile index b470771cc2..7a48659995 100644 --- a/src/core_atmosphere/physics/physics_wrf/Makefile +++ b/src/core_atmosphere/physics/physics_wrf/Makefile @@ -37,6 +37,8 @@ OBJS = \ module_sf_noahlsm_glacial_only.o \ module_sf_noah_seaice.o \ module_sf_noah_seaice_drv.o \ + module_sf_pxlsm.o \ + module_sf_pxlsm_data.o \ module_sf_oml.o \ module_sf_sfclay.o \ module_sf_urban.o @@ -96,6 +98,10 @@ module_sf_noah_seaice_drv.o: \ module_sf_noah_seaice.o: \ module_sf_noahlsm.o +module_sf_pxlsm.o: \ + module_sf_pxlsm_data.o \ + ../mpas_atmphys_constants.o + clean: $(RM) *.f90 *.o *.mod @# Certain systems with intel compilers generate *.i files diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_pxlsm.F b/src/core_atmosphere/physics/physics_wrf/module_sf_pxlsm.F new file mode 100644 index 0000000000..d53b0f0733 --- /dev/null +++ b/src/core_atmosphere/physics/physics_wrf/module_sf_pxlsm.F @@ -0,0 +1,2179 @@ +!=============================================================================== +!module_sf_pxlsm.F was originally adapted from ./phys/module_sf_pxlsm.F from +!WRF version 3.8.1 for use in MPAS. +!Jon Pleim (pleim.jon@epa.gov) / 2016-04. +! +!additional modifications to source code for MPAS: +! * Brought up to date with module_sf_pxlsm.F from WRF v4.1.3 as basis, and +! generalized for use in both the MPAS and WRF models. +! Jerold A. Herwehe (herwehe.jerry@epa.gov) / 2019-11-25 +! +!=============================================================================== +! +MODULE module_sf_pxlsm + + USE module_sf_pxlsm_data +#if defined(mpas) + USE mpas_atmphys_constants + USE mpas_atmphys_utilities, only: physics_message,physics_error_fatal +#define FATAL_ERROR(M) call physics_error_fatal( M ) +#define WRITE_MESSAGE(M) call physics_message( M ) +#else + USE module_model_constants + USE module_wrf_error +#define FATAL_ERROR(M) call wrf_error_fatal( M ) +#define WRITE_MESSAGE(M) call wrf_message( M ) + INTEGER, PARAMETER :: NSOLD=20 + REAL, PARAMETER :: RD = 287.04, CPD = 1004.67, & + CPH2O = 4.218E+3, CPICE = 2.106E+3, & + LSUBF = 3.335E+5, SIGMA = 5.67E-8, & + ROVCP = RD / CPD + + REAL, PARAMETER :: RIC = 0.25 ! critical Richardson number + REAL, PARAMETER :: DENW = 1000.0 ! water density in KG/M3 + REAL, PARAMETER :: PI = 3.1415926 +#endif + + REAL, PARAMETER :: CRANKP = 0.5 ! CRANK-NIC PARAMETER + REAL, PARAMETER :: TAUINV = 1.0 / 86400.0 ! 1/1DAY(SEC) + REAL, PARAMETER :: T2TFAC = 1.0 / 10.0 ! Bottom soil temp response factor + REAL, PARAMETER :: PR0 = 0.95 + REAL, PARAMETER :: CZO = 0.032 + REAL, PARAMETER :: OZO = 1.E-4 + +CONTAINS +! + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + SUBROUTINE pxlsm(DZ8W, QV3D, T3D, TH3D, RHO, & + PSFC, GSW, GLW, RAINBL, EMISS, & +#if defined(mpas) + ITIMESTEP,RESTART,NSOIL,ANAL_INTERVALC, & +#else + ITIMESTEP,CURR_SECS,NSOIL,DT,ANAL_INTERVAL, & +#endif + XLAND, XICE, ALBEDO, & + SNOALB, SMOIS, TSLB, MAVAIL, TA2, & + QA2, QSFC, DZS, PSIH, & +#if defined(mpas) + LANDUSEF,SOILCBOT,VEGFRA,VEGF_PX,IVGTYP, & +#else + LANDUSEF,SOILCBOT,VEGFRA,VEGF_PX, & +#endif + ISLTYP,RA,RS,LAI,IMPERV,CANFRA,NLCAT,NSCAT, & + HFX,QFX,LH,TSK,SST,ZNT,CANWAT, & + GRDFLX,SHDMIN,SHDMAX, & +#if defined(mpas) + SNOWC,PBLH,RMOL,UST,DTBL, & +#else + SNOWC,PBLH,RMOL,UST,CAPG,DTBL, & +#endif + T2_NDG_OLD, T2_NDG_NEW, & + Q2_NDG_OLD, Q2_NDG_NEW, & + SN_NDG_OLD, SN_NDG_NEW, SNOW, SNOWH,SNOWNCV,& + T2OBS, Q2OBS, PXLSM_SMOIS_INIT, & + PXLSM_SOIL_NUDGE, & + pxlsm_modis_veg, & + LAI_PX, & + WWLT_PX, WFC_PX, WSAT_PX, & + CLAY_PX, CSAND_PX, FMSAND_PX, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + +!------------------------------------------------------------------------- +! THIS MODULE CONTAINS THE PLEIM-XIU LAND-SURFACE MODEL (PX-LSM). +! IT IS DESIGNED TO SIMULATE CHARACTERISTICS OF THE LAND SURFACE AND +! VEGETATION AND EXCHANGE WITH THE PLANETARY BOUNDARY LAYER (PBL). THE +! SOIL MOISTURE MODEL IS BASED ON THE ISBA SCHEME DEVELOPED BY NOILHAN +! AND PLANTON (1989) AND JACQUEMIN AND NOILHAN (1990) AND INCLUDES +! PROGNOSTIC EQUATIONS FOR SOIL MOISTURE AND SOIL TEMPERATURE IN TWO +! LAYERS (1 CM AND 1 M) AS WELL AS CANOPY WATER CONTENT. SURFACE +! MOISTURE FLUXES ARE MODELED BY 3 PATHWAYS: SOIL EVAPORATION, CANOPY +! EVAPORATION, AND VEGETATIVE EVAPOTRANSPIRRATION. +! EVAPOTRANSPIRATION DIRECTLY FROM THE ROOT ZONE SOIL LAYER IS MODELED +! VIA A CANOPY RESISTANCE ANALOG ALGORITHM WHERE STOMATAL CONDUCTANCE +! IS CONTROLLED BY SOLAR RADIATION, AIR TEMPERATURE, AIR HUMIDITY, AND +! ROOT ZONE SOIL MOISTURE. REQUIRED VEGETATION CHARACTERISTICS DERIVED +! FROM THE USGS LANDUSE DATA INCLUDE: LEAF AREA INDEX, FRACTIONAL VEGETATION +! COVERAGE, ROUGHNESS LENGTH, AND MINIMUM STOMATAL RESISTANCE. AN INDIRECT +! NUDGING SCHEME ADJUSTS SOIL MOISTURE ACCORDING TO DIFFERENCES BETWEEN +! MODELED TEMPERATURE AND HUMIDITY AND ANALYSED SURFACE FIELDS. +! +! References: +! Pleim and Xiu, 1995: Development and testing of a surface flux and planetary +! boundary layer model for application in mesoscale models. +! J. Appl. Meteoro., Vol. 34, 16-32. +! Xiu and Pleim, 2001: Development of a land surface model. Part I: Application +! in a mesoscale meteorological model. J. Appl. Meteoro., +! Vol. 40, 192-209. +! Pleim and Xiu, 2003: Development of a land surface model. Part II: Data +! assimilation. J. Appl. Meteoro., Vol. 42, 1811-1822. +! +! Pleim and Gilliam, 2009: An Indirect Data Assimilation Scheme for Deep Soil Temperature in the +! Pleim-Xiu Land Surface Model. J. Appl. Meteor. Climatol., 48, 1362-1376. +! +! Gilliam and Pleim, 2010: Performance assessment of new land-surface and planetary boundary layer +! physics in the WRF-ARW. Journal of Applied Meteorology and Climatology, 49, 760-774. +! REVISION HISTORY: +! AX 4/2005 - developed the initial WRF version based on the MM5 PX LSM +! RG 2/2008 - Completed testing of the intial working version of PX LSM, released in WRFV3.0 early 2008 +! DW 8/2011 - Landuse specific versions of PX (USGS/NLCD/MODIS) were unified into a single code with +! landuse characteristics defined in module_sf_pxsfclay.F. +! RG 12/2011 - Basic code clean, removed commented out debug statements, lined up columns, etc. +! RG 01/2012 - Removed FIRSTIME Logic that computes PX Landuse characteristics at first time step only. This resulted +! in different solutions when OpenMP was used and would not work with moving domains. +! RG 08/2012 - Added CURR_SECS variable in argument list as replacement for PX internal CURRTIME internally comp var. +! This is neccessary for PX to correctly interpolate analyses for soil nudging. In this same calculation +! logic was added for cases where user does not specify the analysis interval, or no analysis interval is +! relevant as in the no PX soil nudging via namelist (pxlsm_soil_nudge = 0). Prior to this fix the default +! analysis interval was zero, so if not speficied a divide by zero was the result. Also, changes were made to +! ensure PX LSM will work with not only MODIS and USGS, but also both the 40 and 50 class NLCD-MODIS data. +! Also, coupled module_sf_pxlsm_data.F was updated so landuse characteristics across datasets are more +! consistent. Albedo for NLCD two grassland categories were lowered from 23 and 25 to 18 and 19. +! For the NLCD40 and NLCD50 roughness and leaf area were made consistent between the US NLCD and +! outside US MODIS datasets. Prior, US boundaries created boundaries of roughness and LAI. +! RG 10/2014 - Wetlands soil moisture treatment. Grid cell soil moisture cannot fall less than fraction of a grid +! cells wetland area * soil saturation (e.g., SMOIS of cell with 50% wetlands cannot fall below 50% of WSAT) +! - Both soil levels are initialized using MAVAIL (Soil moisture availability) instead of just layer 2. +! - Veg Cv (heat capacity) changed from 8x10-6 to 1.2x10-5 (K-M2/J) +! - Alternate empirical stomatal function of PAR (F1) to better replicate photosynthesis-conductance models. +! The main effect is to reduce stomatal conductance for low PAR. +! - Snow albedo is now computed using fractional land-use weighting. Values for each land-use class +! are defined like other PX landuse parameters in module_sf_pxlsm_data.F. These are based on values +! used by NOAH LSM MODIS in VEGPARM.TBL (MAXALB), but tuned to better match satellite values in maxsnowalb +! dataset. Tuning reduced the MAXALB for all forest classes from values in the 50-60% range to 30-40% range. +! These static values are more representative of albedo after snow has melted of fallen from trees. These +! values were also cross verified with http://www.globalbedo.org/global.php +! - USGS 28 category added as an option +! - Impervious surface and canopy fraction data can be used if processed (otherwise 0% so no impact) +! to alter surface heat capacity (See SURFPX subroutine for details) in urban areas and refine +! LAI and VEGF_PX estimations (see VEGELAND subroutine). +! JP 12/2015 - Surface water vapor mixing ratio calculation added for land surface, which is passed to PX-SFCLAY +! for use over all non-water and non-frozen surfaces. +! - PAR function and impact on transpiration modified according to Echer et al.(2015). See P-X LSM documentation +! for full reference. These act to reduce moisture bias near surface during PBL transition. +! JP 11/2017 - Updated vegetation table for different land cover types. Added in WRFv4.0. +! LR 11/2017 - Update for MODIS vegetation: many changes in soil properties. Added in WRFv4.1. +! (Ran et al., 2016 JGR-atmosphere, Ran et al. 2017 in preparation) +! JP 12/2018 - revised soil type categories (ISTI) to conform to WRF soil type input data +! soil types Sand through Clay are now 1-12 rather than 1-11 +! JP 12/2021 - Added new pathway for evaporation from the ground in the vegetated fraction of the grid cell. +! +!-------------------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------------------- +! ARGUMENT LIST: +! +!... Inputs: +!-- DZ8W dz between full levels (m) +!-- QV3D 3D mixing ratio +!-- T3D Temperature (K) +!-- TH3D Theta (K) +!-- RHO 3D dry air density (kg/m^3) + +!-- PSFC surface pressure (Pa) +!-- GSW downward short wave flux at ground surface (W/m^2) +!-- GLW downward long wave flux at ground surface (W/m^2) +!-- RAINBL Timestep rainfall +!-- EMISS surface emissivity (between 0 and 1) + +!-- ITIMESTEP time step number +!-- NSOIL number of soil layers +!-- DT time step (second) (WRF only) +!-- CURR_SECS time on model domain in seconds, universal WRF variable +!-- ANAL_INTERVAL Interval of analyses used for soil moisture and temperature nudging +!-- ANAL_INTERVALC Interval of analyses used for soil nudging MPAS time character + +!-- XLAND land mask (1 for land, 2 for water) +!-- XICE Sea ice +!-- ALBEDO surface albedo with snow cover effects +!-- SNOALB Albedo of snow + +!-- SMOIS total soil moisture content (volumetric fraction) +!-- TSLB soil temp (K) +!-- MAVAIL Moisture availibility of soil +!-- TA2 2-m temperature +!-- QA2 2-m mixing ratio + +!-- SVPT0 constant for saturation vapor pressure (K) +!-- SVP1 constant for saturation vapor pressure (kPa) +!-- SVP2 constant for saturation vapor pressure (dimensionless) +!-- SVP3 constant for saturation vapor pressure (K) + +!-- DZS thicknesses of soil layers +!-- PSIH similarity stability function for heat + +!-- LANDUSEF Landuse fraction +!-- SOILCBOT Bottom soil fraction +!-- VEGFRA Vegetation fraction (%) +!-- VEGF_PX Veg fraction recomputed and used by PX LSM +!-- ISLTYP Soil type + +!-- RA Aerodynamic resistence +!-- RS Stomatal resistence +!-- LAI read in leaf area index (weighted according to fractional landuse) +!-- ZNT rougness length +!-- QSFC Sat. water vapor mixing ratio at the surface interface + +!-- IMPERV Fraction (percent) of grid cell that is impervious surface (concrete/road/non-veg) +!-- CANFRA Fraction (percent) of grid cell that is covered with tree canopy + +!-- NLCAT Number of landuse categories +!-- NSCAT Number of soil categories + +!-- HFX net upward heat flux at the surface (W/m^2) +!-- QFX net upward moisture flux at the surface (kg/m^2/s) +!-- LH net upward latent heat flux at surface (W/m^2) +!-- TSK surface skin temperature (K) +!-- SST sea surface temperature +!-- CANWAT Canopy water (mm) + +!-- GRDFLX Ground heat flux +!-- SFCEVP Evaportation from surface +!-- SHDMIN Minimum annual vegetation fraction for each grid cell (%) +!-- SHDMAX Maximum annual vegetation fraction for each grid cell (%) + +!-- SNOWC flag indicating snow coverage (1 for snow cover) +!-- PBLH PBL height (m) +!-- RMOL 1/L Reciprocal of Monin-Obukhov length +!-- UST u* in similarity theory (m/s) +!-- CAPG heat capacity for soil (J/K/m^3) +!-- DTBL time step of boundary layer calls + +!-- T2_NDG_OLD Analysis temperature prior to current time +!-- T2_NDG_NEW Analysis temperature ahead of current time +!-- Q2_NDG_OLD Analysis mixing ratio prior to current time +!-- Q2_NDG_NEW Analysis mixing ratio ahead of current time + +!-- SN_NDG_OLD Analysis snow water prior to current time +!-- SN_NDG_NEW Analysis snow water ahead of current time +!-- SNOW Snow water equivalent +!-- SNOWH Physical snow depth +!-- SNOWNCV Time step accumulated snow + +!-- T2OBS Analysis temperature interpolated from prior and next in time analyses +!-- Q2OBS Analysis moisture interpolated from prior and next in time analyses +!-- PXLSM_SMOIS_INIT Flag to intialize deep soil moisture to a value derived from moisture availability +!-- PXLSM_SOIL_NUDGE Flag to use soil moisture and temperature nudging in the PX LSM; +! This is typically done for the first simulation. +!-- pxlsm_modis_veg Use MODIS vegetation option: 1 yes, 0 no +!-- LAI_PX LAI used for PX (m^2/m^2) +!-- WWLT_PX Computed soil wilting point for PX (m^3/m^3) +!-- WFC_PX Computed soil field capacity for PX (m^3/m^3) +!-- WSAT_PX Computed soil saturation for PX (m^3/m^3) +!-- CLAY_PX Aggregated soil clay fraction for PX +!-- CSAND_PX Aggregated soil coarse sand fraction for PX +!-- FMSAND_PX Aggregated soil fine-medium sand fraction for PX +!-- RESTART Flag for restart run and to make sure soil moisture is not reinitialized + +!-- ids start index for i in domain +!-- ide end index for i in domain +!-- jds start index for j in domain +!-- jde end index for j in domain +!-- kds start index for k in domain +!-- kde end index for k in domain +!-- ims start index for i in memory +!-- ime end index for i in memory +!-- jms start index for j in memory +!-- jme end index for j in memory +!-- kms start index for k in memory +!-- kme end index for k in memory +!-- jts start index for j in tile +!-- jte end index for j in tile +!-- kts start index for k in tile +!-- kte end index for k in tile +!... Outputs: + + IMPLICIT NONE + +!.......Arguments +#if defined(mpas) +! DECLARATIONS - CHARACTER + CHARACTER (LEN = 8), INTENT(IN) :: ANAL_INTERVALC + +#endif +! DECLARATIONS - INTEGER + INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte + + INTEGER, INTENT(IN) :: NSOIL, ITIMESTEP, NLCAT, NSCAT, & +#if defined(mpas) + PXLSM_SMOIS_INIT, PXLSM_SOIL_NUDGE +#else + ANAL_INTERVAL, PXLSM_SMOIS_INIT, PXLSM_SOIL_NUDGE +#endif + + INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ISLTYP +#if defined(mpas) + INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: IVGTYP +#endif + +! DECLARATIONS - REAL +#if defined(mpas) + REAL, INTENT(IN ) :: DTBL +#else + REAL, INTENT(IN ),OPTIONAL :: curr_secs + + REAL, INTENT(IN ) :: DT,DTBL +#endif + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: RHO, & + T3D, TH3D, DZ8W, QV3D + + REAL, DIMENSION(1:NSOIL), INTENT(IN):: DZS + REAL, DIMENSION( ims:ime , 1:NSOIL, jms:jme ), INTENT(INOUT) :: SMOIS, TSLB + + REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: RA, RS, LAI, ZNT, QSFC + REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: GRDFLX, TSK, TA2, QA2 + + REAL, DIMENSION( ims:ime , 1:NLCAT, jms:jme ), INTENT(IN):: LANDUSEF + REAL, DIMENSION( ims:ime , 1:NSCAT, jms:jme ), INTENT(IN):: SOILCBOT + + REAL, DIMENSION( ims:ime, jms:jme ), & + INTENT(IN) :: PSFC, GSW, GLW, RAINBL, & + SHDMIN, SHDMAX, & + PBLH, RMOL, SNOWNCV, & + UST, MAVAIL, SST, EMISS + + REAL, DIMENSION( ims:ime, jms:jme ), & + INTENT(IN) :: T2_NDG_OLD, T2_NDG_NEW, & + Q2_NDG_OLD, Q2_NDG_NEW, & + SN_NDG_OLD, SN_NDG_NEW + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: T2OBS, Q2OBS + +#if defined(mpas) + LOGICAL, INTENT(IN ) :: RESTART + + REAL, DIMENSION( ims:ime, jms:jme ), & + INTENT(INOUT) :: CANWAT, QFX, HFX, LH, & +#else + REAL, DIMENSION( ims:ime, jms:jme ), & + INTENT(INOUT) :: CAPG,CANWAT, QFX, HFX, LH, & +#endif + PSIH,VEGFRA, VEGF_PX, SNOW, SNOALB, & + SNOWH, SNOWC, ALBEDO, XLAND, XICE, & + IMPERV, CANFRA + + INTEGER, OPTIONAL, INTENT(IN) :: pxlsm_modis_veg + + REAL, DIMENSION( ims:ime, jms:jme ), & + OPTIONAL, INTENT(OUT) :: LAI_PX, WWLT_PX, WFC_PX, WSAT_PX, & + CLAY_PX, CSAND_PX, FMSAND_PX + +!------------------------------------------------------------------------- +! ---------- Local Variables -------------------------------- + + + !---- PARAMETERS + INTEGER, PARAMETER :: NSTPS = 11 ! max. soil types + REAL, PARAMETER :: DTPBLX = 40.0 ! Max PX timestep = 40 sec + + + !---- INTEGERS + INTEGER :: KWAT + INTEGER, DIMENSION( 1: NSTPS ) :: JP +#if defined(mpas) + INTEGER:: J, I, K, NS, NUDGE, ISTI, DOMLU + INTEGER:: NTSPS, IT, HH, MM, SS, CURR_SECS, ANAL_INTERVAL + + !------------------------------------------------------------------- + ! MPAS Incomplete.... Moved local until added to namelist or output + REAL, DIMENSION( ims:ime, jms:jme ) :: CAPG + REAL, DIMENSION( ims:ime, 1:NLCAT, jms:jme ) :: LANDUSEFL + REAL, DIMENSION( 1:NSCAT ) :: SOILCBOTL + !------------------------------------------------------------------- +#else + INTEGER:: J, I, NS, NUDGE, ISTI + INTEGER:: NTSPS, IT +#endif + + !---- REALS + REAL, DIMENSION( ims:ime, jms:jme ) :: XLAI, XLAIMN, RSTMIN, & + XVEG, XVEGMN, XSNUP, & + XALB, XSNOALB, WETFRA + + REAL, DIMENSION( ims:ime, jms:jme ) :: RADNET, EG, ER, ETR, QST + + REAL:: SFCPRS,TA1,DENS1,QV1,ZLVL,SOLDN,LWDN, & + EMISSI,PRECIP,THETA1,VAPPRS,QSBT, & + WG,W2,WR,TG,T2,USTAR,MOLX,Z0, & + RAIR,CPAIR,IFLAND,ISNOW, & + ES,QSS,BETAP, & + RH2_OLD, RH2_NEW, T2_OLD, T2_NEW, & + CORE, CORB, TIME_BETWEEN_ANALYSIS, & + RH2OBS, HU, SNOBS, & + FWSAT,FWFC,FWWLT,FB,FCGSAT,FJP,FAS, & +#if defined(mpas) + PI, G, CPD, LUCHECK, & +#endif + FWRES, FC3, FCLAY, FCSAND, FFMSAND, & + FSEAS, T2I, HC_SNOW, SNOW_FRA,SNOWALB, & + QST12,ZFUNC,ZF1,ZA2,QV2, DT_FDDA, & + FC2R,FC1SAT, DTPBL, RAW + + CHARACTER (LEN = 6) :: LAND_USE_TYPE + CHARACTER (LEN = 512) :: message + +!------------------------------------------------------------------------- +!-------------------------------Executable starts here-------------------- +! +#if defined(mpas) + ! Variables added to make code more like WRF version + PI = pii + G = gravity + CPD = cp + + ! New MPAS Code. Convert MPAS Char string of soilndg interval to + READ(ANAL_INTERVALC(1:2),'(i)') HH + READ(ANAL_INTERVALC(4:5),'(i)') MM + READ(ANAL_INTERVALC(7:8),'(i)') SS + ANAL_INTERVAL = (HH * 3600) + (MM * 60) + (SS) + + ! Determine Landuse Dataset by the number of categories + IF (NLCAT == 40) THEN + LAND_USE_TYPE = 'NLCD40' + ELSE IF (NLCAT == 20) THEN + LAND_USE_TYPE = 'MODIS' + ELSE IF (NLCAT == 24) THEN + LAND_USE_TYPE = 'USGS' + ELSE + WRITE_MESSAGE ('P-X LSM error. Number of landuse categories not consistent with known') + WRITE(message,*) 'landuse datasets. Only MODIS20, USGS24, and NLCD40 allowed. Number input:',NLCAT + WRITE_MESSAGE(message) + FATAL_ERROR('Error: Unknown Land Use Category') + END IF +#else + ! Determine Landuse Dataset by the number of categories + IF (NLCAT == 50) THEN + LAND_USE_TYPE = 'NLCD50' + ELSE IF (NLCAT == 40) THEN + LAND_USE_TYPE = 'NLCD40' + ELSE IF (NLCAT == 20) THEN + LAND_USE_TYPE = 'MODIS' + ELSE IF (NLCAT == 21) THEN + LAND_USE_TYPE = 'MODIS' + ELSE IF (NLCAT == 24) THEN + LAND_USE_TYPE = 'USGS' + ELSE IF (NLCAT == 28) THEN + LAND_USE_TYPE = 'USGS28' + ELSE + FATAL_ERROR("Error: Unknown Land Use Category") + END IF +#endif + + IF (ITIMESTEP .EQ. 1) THEN +#if defined(mpas) + WRITE(message,*) 'Landuse dataset used in PX: ',LAND_USE_TYPE,' with',NLCAT,' categories' + WRITE_MESSAGE(message) + WRITE(message,*) 'P-X soil nudging interval, MPAS format = ',ANAL_INTERVALC + WRITE_MESSAGE(message) + WRITE(message,*) 'P-X soil nudging interval in seconds = ',ANAL_INTERVAL + WRITE_MESSAGE(message) + WRITE(message,*) 'P-X soil nudging switch (0/1):',PXLSM_SOIL_NUDGE + WRITE_MESSAGE(message) + WRITE(message,*) 'P-X soil moisture initialization switch (0/1):',PXLSM_SMOIS_INIT + WRITE_MESSAGE(message) + WRITE(message,*) 'Soil layer thickness dzs(1) and dzs(2):',DZS(1),DZS(2) + WRITE_MESSAGE(message) + WRITE(message,*) 'Restart run:',RESTART + WRITE_MESSAGE(message) +#else + WRITE(message,*) 'PX LSM will use the ' // TRIM(LAND_USE_TYPE) // ' landuse tables' + WRITE_MESSAGE(message) + PRINT *, 'The analysis interval for surface soil and temp nudging = ',ANAL_INTERVAL,'sec.' +#endif + ENDIF + + !----------------------------------------------------------------------------------- + ! Kill WRF if user specifies soil nudging but provides no analysis interval, then provide helpful message. + IF (ANAL_INTERVAL .LE. 0.0 .AND. PXLSM_SOIL_NUDGE .EQ. 1) THEN + WRITE_MESSAGE('PX LSM Error: The User specified analysis interval is zero or negative.') + WRITE_MESSAGE('If the PX LSM is used with soil nudging (pxlsm_soil_nudge=1) a wrfsfdda_d0* file is required.') + WRITE_MESSAGE('Make sure these files are present and') + WRITE_MESSAGE('Check the namelist to ensure sgfdda_interval_m is set to proper sfc analysis interval') + STOP + ENDIF + !----------------------------------------------------------------------------------- + !--- Compute time relatve to old and new analysis time for timestep interpolation + IF(PXLSM_SOIL_NUDGE .EQ. 1) THEN +#if defined(mpas) + CURR_SECS = (ITIMESTEP-1) * DTBL ! FOR MPAS + TIME_BETWEEN_ANALYSIS = MOD(CURR_SECS,ANAL_INTERVAL) +#else + DT_FDDA = ANAL_INTERVAL * 1.0 ! Convert DT of Analysis to real + TIME_BETWEEN_ANALYSIS = MOD(CURR_SECS,DT_FDDA) +#endif + IF (TIME_BETWEEN_ANALYSIS .EQ. 0.0) THEN + CORB = 1.0 + CORE = 0.0 + ELSE +#if defined(mpas) + CORE = TIME_BETWEEN_ANALYSIS / ANAL_INTERVAL +#else + CORE = TIME_BETWEEN_ANALYSIS / DT_FDDA +#endif + CORB = 1.0 - CORE + ENDIF + ENDIF +#if defined(mpas) + + !-- Test LANDUSEF input array for population. If a cell has zero landuse fraction, + ! LANDUSEF is empty, so default to dominant landuse via IVGTYP. If LANDUSEF + ! is not empty, use fractional landuse input. LANDUSEFL is local fractional + ! landuse. + DO J = jts,jte + DO I = its,ite + LUCHECK = SUM(LANDUSEF(I,:,J)) + DO K = 1,NLCAT + IF(LUCHECK .EQ. 0.0) THEN + LANDUSEFL(I,K,J) = 0.0 + ELSE + LANDUSEFL(I,K,J) = LANDUSEF(I,K,J) + ENDIF + ENDDO + IF(LUCHECK .EQ. 0.0) THEN + DOMLU = IVGTYP(I,J) + LANDUSEFL(I,DOMLU,J) = 1.0 + ENDIF + ENDDO + ENDDO + +#endif + !----------------------------------------------------------------------------------- + ! Compute vegetation and land-use characteristics by land-use fraction weighting + ! These parameters include LAI, VEGF, ZNT, ALBEDO, SNOALB, RS, etc. +#if defined(mpas) + CALL VEGELAND(LANDUSEFL, VEGFRA, SHDMIN, SHDMAX, NLCAT, & +#else + CALL VEGELAND(LANDUSEF, VEGFRA, SHDMIN, SHDMAX, NLCAT, & +#endif + ZNT,XLAI,XLAIMN,RSTMIN,XVEG,XVEGMN,XSNUP, & + XLAND, XALB,XSNOALB,WETFRA,IMPERV,CANFRA, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte, LAND_USE_TYPE, & + KWAT ) + !----------------------------------------------------------------------------------- + + !----------------------------------------------------------------------------------- + ! Main loop over individual grid cells + DO J = jts,jte + DO I = its,ite + + IFLAND = XLAND(I,J) + + ! Compute soil properties via weighting of fractional components + IF (IFLAND .LT. 1.5 ) THEN + + !--------------------------------------------------------- +#if defined(mpas) + DO K = 1,NSCAT + SOILCBOTL(K) = SOILCBOT(I,K,J) + ENDDO + CALL SOILPROP (RESTART, SOILCBOTL, & +#else + CALL SOILPROP (SOILCBOT(I,:,J), & +#endif + ITIMESTEP, MAVAIL(I,J), & + PXLSM_SMOIS_INIT, & + FWSAT,FWFC,FWWLT,FCLAY,FCSAND,FFMSAND, & + FB,FCGSAT, & + FJP,FAS,FC2R,FC1SAT,FWRES, FC3, ISTI, & + SMOIS(I,1,J), SMOIS(I,2,J) ) + !---------------------------------------------------------- + !---------------------------------------------------------- + ISLTYP(I,J) = ISTI + ELSE + ISLTYP(I,J) = 14 ! STATSGO type for water + + !-- added for MODIS model + FWWLT = 0.1 + FWFC = 1.0 + FWSAT = 1.0 + + FCLAY = 0.0 + FCSAND = 0.0 + FFMSAND = 0.0 + !-- end + + ENDIF + + !-- added for MODIS model + WWLT_PX(I,J) = FWWLT + WFC_PX(I,J) = FWFC + WSAT_PX(I,J) = FWSAT + + CLAY_PX(I,J) = FCLAY * 0.01 ! percent to fraction + CSAND_PX(I,J) = FCSAND * 0.01 + FMSAND_PX(I,J) = FFMSAND * 0.01 + !-- end + + !-- Variables Sub. SURFPX needs + SFCPRS = PSFC(i,j) / 1000.0 ! surface pressure in cb + TA1 = T3D(i,1,j) ! air temperature at first layer + DENS1 = RHO(I,1,J) ! air density at first layer + QV1 = QV3D(i,1,j) ! water vapor mixing ratio at first layer + QV2 = QV3D(i,2,j) + ZLVL = 0.5 * DZ8W(i,1,j) ! thickness of lowest half level + ZF1 = DZ8W(i,1,j) + ZA2 = ZF1 + 0.5 * DZ8W(i,2,j) + + LWDN = GLW(I,J) ! longwave radiation + EMISSI = EMISS(I,J) ! emissivity + PRECIP = MAX ( 1.0E-3*RAINBL(i,j)/DTBL,0.0) ! accumulated precip. rate during DT (=dtpbl) + ! convert RAINBL from mm to m for PXLSM + WR = 1.0E-3*CANWAT(I,J) ! convert CANWAT from mm to m for PXLSM + THETA1 = TH3D(i,1,j) ! potential temp at first layer + SNOBS = SNOW(I,J) ! Set snow cover to existing model value + ! this is overwritten below if snow analysis is available + ! otherwise snow cover remains constant through simulation + + IF(PXLSM_SOIL_NUDGE .EQ. 1) THEN + !-- 2 m Temp and RH for Nudging + T2_OLD = T2_NDG_OLD(I,J) + T2_NEW = T2_NDG_NEW(I,J) +#if defined(mpas) + RH2_OLD = Q2_NDG_OLD(I,J) * 0.01 ! convert incoming RH from % to fraction + RH2_NEW = Q2_NDG_NEW(I,J) * 0.01 ! convert incoming RH from % to fraction +#else + VAPPRS = SVP1 * EXP(SVP2 * (T2_OLD - SVPT0) / ( T2_OLD - SVP3)) + QSBT = EP_2 * VAPPRS / (SFCPRS - VAPPRS) + RH2_OLD = Q2_NDG_OLD(I,J) / QSBT + VAPPRS = SVP1 * EXP(SVP2 * (T2_NEW - SVPT0) / (T2_NEW - SVP3)) + QSBT = EP_2 * VAPPRS / (SFCPRS - VAPPRS) + RH2_NEW = Q2_NDG_NEW(I,J) / QSBT +#endif + RH2OBS = CORB * RH2_OLD + CORE * RH2_NEW + T2OBS(I,J) = CORB * T2_OLD + CORE * T2_NEW + Q2OBS(I,J) = CORB * Q2_NDG_OLD(I,J) + CORE * Q2_NDG_NEW(I,J) + SNOBS = CORB * SN_NDG_OLD(I,J) + CORE * SN_NDG_NEW(I,J) + ENDIF + + USTAR = MAX(UST(I,J),0.005) + + IF (IFLAND .GE. 1.5) THEN ! if over water + ZNT(I,J) = CZO * UST(I,J) * UST(I,J) / G + OZO + ENDIF + + Z0 = ZNT(I,J) + CPAIR = CPD * (1.0 + 0.84 * QV1) ! J/(K KG) + + ! Set WRF Snow albedo to PX snow albedo based on fractional landuse + ! Snow albedo for each landuse class is defined in module_sf_pxlsm_data.F + SNOALB(I,J) = XSNOALB(I,J) + !------------------------------------------------------------- + ! Compute fractional snow area and snow albedo + CALL PXSNOW (ITIMESTEP, SNOBS, SNOWNCV(I,J), SNOW(I,J), & + SNOWH(I,J), XSNUP(I,J), XALB(i,j), & + SNOALB(I,J), & + HC_SNOW, SNOW_FRA, SNOWC(I,J), ALBEDO(I,J) ) + !------------------------------------------------------------- + + !------------------------------------------------------------- + ! Sea Ice from analysis and water cells that are very cold, but more than 50% water + ! are converted to ice/snow for more reasonable treatment. + IF( (XICE(I,J).GE.0.5) .OR. & + (SST(I,J).LE.270.0.AND.XLAND(I,J).GE.1.50) ) THEN + XLAND(I,J) = 1.0 + IFLAND = 1.0 + ZNT(I,J) = 0.001 ! Ice + SMOIS(I,1,J) = 1.0 ! FWSAT + SMOIS(I,2,J) = 1.0 ! FWSAT + XICE(I,J) = 1.0 + ALBEDO(I,J) = 0.7 + SNOWC(I,J) = 1.0 + SNOW_FRA = 1.0 + VEGF_PX(I,J) = 0.0 + LAI_PX(I,J) = 0.0 + LAI(I,J) = 0.0 + ENDIF + !------------------------------------------------------------- + + !------------------------------------------------------------- + !-- Note that when IFGROW = 0 is selected in Vegeland then max and min + !-- LAI and Veg are the same + T2I = TSLB(I,2,J) + FSEAS = AMAX1(1.0 - 0.015625 * (290.0 - T2I) ** 2,0.0) + IF (T2I .GE. 290.0) FSEAS = 1.0 + + !get PX table vegetation + LAI_PX(I,J) = XLAIMN(I,J) + FSEAS*(XLAI(I,J) - XLAIMN(I,J)) + VEGF_PX(I,J) = XVEGMN(I,J) + FSEAS*(XVEG(I,J) - XVEGMN(I,J)) + +!... use MODIS LAI and VEGFRA from wrflowinp + IF ( pxlsm_modis_veg .EQ. 1 ) THEN + + ! get LAI for vegetated area + IF ( VEGFRA(I,J) .GT. 0.0 ) THEN + LAI_PX(I,J) = LAI(I,J) / ( VEGFRA(I,J) / 100.0) + ELSE + LAI_PX(I,J) = 0.0 + ENDIF + + VEGF_PX(I,J) = VEGFRA(I,J) / 100.0 + + !vegF is just for the land + IF ( LANDUSEF(I,KWAT,J) .LT. 1.0 ) THEN + VEGF_PX(I,J) = VEGF_PX(I,J) / (1.0 - LANDUSEF(I,KWAT,J)) + ELSE + VEGF_PX(I,J) = 0.0 + ENDIF + + ENDIF + + LAI_PX(I,J) = MIN(LAI_PX(I,J), 8.0) + LAI_PX(I,J) = MAX(LAI_PX(I,J), 0.0001) + + VEGF_PX(I,J) = MIN(VEGF_PX(I,J), 1.0) + VEGF_PX(I,J) = MAX(VEGF_PX(I,J), 0.0001) + +!... END OF MODIS LAI and FPAR + + + ! Ensure veg algorithms not used for water + IF (IFLAND .GE. 1.5) THEN + VEGF_PX(I,J) = 0.0 + LAI_PX(I,J) = 0.0 + ENDIF + !------------------------------------------------------------- + + + SOLDN = GSW(I,J) / (1.0 - ALBEDO(I,J)) ! downward shortwave radiaton + ISNOW = SNOWC(I,J) + + + NUDGE=PXLSM_SOIL_NUDGE +#if defined(mpas) + ! Changed for MPAS since array dimensions are 1 x NCELLS + !IF ( J .LE. 2 .OR. J .GE. (jde-1) ) NUDGE=0 + !IF ( I .LE. 2 .OR. I .GE. (ide-1) ) NUDGE=0 +#else + IF ( J .LE. 2 .OR. J .GE. (jde-1) ) NUDGE=0 + IF ( I .LE. 2 .OR. I .GE. (ide-1) ) NUDGE=0 +#endif + + IF ( RMOL(I,J) .GT. 0.0 ) THEN + MOLX = AMIN1(1/RMOL(I,J),1000.0) + ELSE IF ( RMOL(I,J) .LT. 0.0 ) THEN + MOLX = AMAX1(1/RMOL(I,J),-1000.0) + ELSE + MOLX = 1000 + ENDIF + + ZFUNC = ZF1 * (1.0 - ZF1 / MAX(100.,PBLH(I,J))) ** 2 + QST12 = KARMAN * ZFUNC*(QV2-QV1) / (ZA2-ZLVL) + + + !------------------------------------------------------------- + !-- LSM sub-time loop too prevent dt > 40 sec +#if defined(mpas) + NTSPS = INT(DTBL / (DTPBLX + 0.000001) + 1.0) ! Changed from DT to DTBL in case not called every tmestep + DTPBL = DTBL / NTSPS ! JP 5/16 +#else + NTSPS = INT(DT / (DTPBLX + 0.000001) + 1.0) + DTPBL = DT / NTSPS +#endif + + DO IT=1,NTSPS + + !... SATURATION VAPOR PRESSURE (MB) + IF ( TSLB(I,1,J) .LE. SVPT0 ) THEN ! For ground that is below freezing + ES = SVP1 * EXP(22.514 - 6.15E3 / TSLB(I,1,J)) ! cb + ELSE + ES = SVP1 * EXP(SVP2 * (TSLB(I,1,J) - SVPT0) / (TSLB(I,1,J) - SVP3)) + ENDIF + QSS = ES * 0.622 / (SFCPRS - ES) + + !... beta method, Lee & Pielke (JAM,May1992) + BETAP = 1.0 + IF (IFLAND .LT. 1.5 .AND. ISNOW .LT. 0.5 .AND. SMOIS(I,1,J) .LE. FWFC) THEN + BETAP = 0.25 * (1.0 - COS(SMOIS(I,1,J) / FWFC * PI)) ** 2 + ENDIF + + !------------------------------------------------------------------------- + CALL SURFPX (DTPBL, IFLAND, SNOWC(I,J), NUDGE, XICE(I,J), & !in + SOLDN, GSW(I,J), LWDN, EMISSI, ZLVL, & !in + MOLX, Z0, USTAR, & !in + SFCPRS, DENS1, QV1, QSS, TA1, & !in + THETA1, PRECIP, & !in + CPAIR, PSIH(I,J), & !in + RH2OBS,T2OBS(I,J), & !in + VEGF_PX(I,J), ISTI, LAI_PX(I,J), IMPERV(I,J), CANFRA(I,J),& !in + BETAP, RSTMIN(I,J), HC_SNOW, SNOW_FRA, WETFRA(I,J), & !in + FWWLT, FWFC, FWRES, FCGSAT, FWSAT, FB, & !in ! Soil model updates - JEP 12/14 + FC1SAT,FC2R,FAS,FJP,FC3,DZS(1),DZS(2),QST12, & !in + RADNET(I,J), GRDFLX(I,J), HFX(I,J), QFX(I,J), LH(I,J), & !out + EG(I,J), ER(I,J), ETR(I,J), & !out + QST(I,J), CAPG(I,J), RS(I,J), RA(I,J), & !out + TSLB(I,1,J), TSLB(I,2,J), & !out + SMOIS(I,1,J), SMOIS(I,2,J), WR, & + TA2(I,J), QA2(I,J), LAND_USE_TYPE,I,J ) + !------------------------------------------------------------------------- + + END DO ! Time internal PX time loop + + IF (IFLAND .GE. 1.5) THEN + TSK(I,J) = SST(I,J) ! Skin temp set to sea surface temperature for open water + ELSE + TSK(I,J) = TSLB(I,1,J) ! Skin temp set to 1 cm soil temperature in PX for now + ENDIF + CANWAT(I,J) = WR * 1000. ! convert WR back to mm for CANWAT + RAW = RA(I,J) + 4.503 / USTAR + QSFC(I,J) = QFX(I,J) * RAW / DENS1 + QV1 + + ENDDO + ENDDO + +!------------------------------------------------------ + END SUBROUTINE pxlsm +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + SUBROUTINE VEGELAND( landusef, vegfra, & + shdmin, shdmax, & + nlcat, znt, xlai, & + xlaimn, rstmin, xveg, xvegmn, xsnup, xland, & + xalb, xsnoalb, wetfra, imperv, canfra, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte, & + LAND_USE_TYPE, KWAT_OUT ) +!------------------------------------------------------------------------- +! +! CALLED FROM Sub. bl_init in module_physics.init.F +! +! THIS PROGRAM PROCESSES THE USGS LANDUSE DATA +! WHICH HAS BEEN GRIDDED BY THE WPS SYSTEM +! AND PRODUCES 2-D FIELDS OF LU RELATED PARAMETERS +! FOR USE IN THE PX SURFACE MODEL +! +! +! REVISION HISTORY: +! AX Oct 2004 - developed WRF version based on VEGELAND in the MM5 PX LSM +! RG Dec 2006 - revised for WRFV2.1.2 +! JP Dec 2007 - revised for WRFV3 - removed IFGROW options +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + + IMPLICIT NONE +!... + INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte + + INTEGER , INTENT(IN) :: NLCAT + + REAL, DIMENSION( ims:ime , 1:NLCAT, jms:jme ), INTENT(IN) :: LANDUSEF + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: VEGFRA, SHDMIN, SHDMAX + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ZNT, IMPERV, CANFRA + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: XLAI, XLAIMN, RSTMIN, XALB, & + XVEG, XVEGMN, XSNUP, XLAND, & + WETFRA, XSNOALB + + INTEGER, INTENT(OUT) :: KWAT_OUT + + CHARACTER (LEN = 6), INTENT(IN) :: LAND_USE_TYPE + + +!... local variables + + INTEGER :: ITF, JTF, K, J, I + REAL :: SUMLAI, SUMLMN, SUMRSI, SUMLZ0, SUMVEG, SUMVMN, & + ALAI, VEGF, SUMSNUP, SUMALB, SUMSNOALB + + REAL :: VFMX, VFMN, VSEAS, FAREA, FWAT, ZNOTC, FCAN, FIMP, FORFRA, EXTFOR + REAL, DIMENSION( NLCAT ) :: LAIMX, LAIMN, Z0, VEG, VEGMN, SNUP, ALB, SNOALB + + REAL, PARAMETER :: ZNOTCMN = 5.0 ! CM, MIN Zo FOR CROPS + REAL, PARAMETER :: ZNOTCMX = 15.0 ! CM, MAX Zo FOR CROPS + + REAL, SAVE, DIMENSION(:), POINTER :: RSMIN, Z00, VEG0, VEGMN0, LAI0, & + LAIMN0, SNUP0, ALBF, SNOALBF + + CHARACTER (LEN = 512) :: message + + !---- INITIALIZE PARAMETERS + INTEGER, SAVE :: KWAT, LIMIT1, LIMIT2 + + ! Initialize LU characteristics by LU Dataset + IF (LAND_USE_TYPE == 'USGS') THEN + KWAT = 16 + RSMIN => RSMIN_USGS + Z00 => Z00_USGS + VEG0 => VEG0_USGS + VEGMN0 => VEGMN0_USGS + LAI0 => LAI0_USGS + LAIMN0 => LAIMN0_USGS + SNUP0 => SNUP0_USGS + ALBF => ALBF_USGS + SNOALBF=> SNOALB_USGS + LIMIT1 = 2 + LIMIT1 = 6 + ELSE IF (LAND_USE_TYPE == 'USGS28') THEN + KWAT = 16 + RSMIN => RSMIN_USGS28 + Z00 => Z00_USGS28 + VEG0 => VEG0_USGS28 + VEGMN0 => VEGMN0_USGS28 + LAI0 => LAI0_USGS28 + LAIMN0 => LAIMN0_USGS28 + SNUP0 => SNUP0_USGS28 + ALBF => ALBF_USGS28 + SNOALBF=> SNOALB_USGS28 + LIMIT1 = 2 + LIMIT1 = 6 + ELSE IF (LAND_USE_TYPE == 'NLCD50') THEN + KWAT = 1 + RSMIN => RSMIN_NLCD50 + Z00 => Z00_NLCD50 + VEG0 => VEG0_NLCD50 + VEGMN0 => VEGMN0_NLCD50 + LAI0 => LAI0_NLCD50 + LAIMN0 => LAIMN0_NLCD50 + SNUP0 => SNUP0_NLCD50 + ALBF => ALBF_NLCD50 + SNOALBF=> SNOALB_NLCD50 + LIMIT1 = 20 + LIMIT1 = 43 + ELSE IF (LAND_USE_TYPE == 'NLCD40') THEN + KWAT = 17 + RSMIN => RSMIN_NLCD40 + Z00 => Z00_NLCD40 + VEG0 => VEG0_NLCD40 + VEGMN0 => VEGMN0_NLCD40 + LAI0 => LAI0_NLCD40 + LAIMN0 => LAIMN0_NLCD40 + SNUP0 => SNUP0_NLCD40 + ALBF => ALBF_NLCD40 + SNOALBF=> SNOALB_NLCD40 + LIMIT1 = 20 + LIMIT1 = 43 + ELSE IF (LAND_USE_TYPE == 'MODIS') THEN + KWAT = 17 + RSMIN => RSMIN_MODIS + Z00 => Z00_MODIS + VEG0 => VEG0_MODIS + VEGMN0 => VEGMN0_MODIS + LAI0 => LAI0_MODIS + LAIMN0 => LAIMN0_MODIS + SNUP0 => SNUP0_MODIS + ALBF => ALBF_MODIS + SNOALBF=> SNOALB_MODIS + LIMIT1 = 12 + LIMIT1 = 14 + END IF + + KWAT_OUT = KWAT + !-------------------------------------------------------------------- + DO J = jts,jte + DO I = its,ite + XLAI(I,J) = 0.0 + XLAIMN(I,J) = 0.0 + RSTMIN(I,J) = 9999.0 + XVEG(I,J) = 0.0 + XVEGMN(I,J) = 0.0 + XSNUP(I,J) = 0.0 + XALB(I,J) = 0.0 + XSNOALB(I,J)= 0.0 + + ! Code that may be needed in case these arrays are not intialized + ! with zero by real.exe when not defined by GEOGRID or present + ! in met_em* files + !IMPERV(I,J) = AMAX1(0.0001,IMPERV(I,J)) + !CANFRA(I,J) = AMAX1(0.0001,CANFRA(I,J)) + + ENDDO + ENDDO + !-------------------------------------------------------------------- + + DO J = jts,jte + DO I = its,ite + !-- Initialize 2 and 3-D veg parameters to be caculated + DO K=1,NLCAT + LAIMX(K) = LAI0(K) + LAIMN(K) = LAIMN0(K) + Z0(K) = Z00(K) + VEG(K) = VEG0(K) + VEGMN(K) = VEGMN0(K) + SNUP(K) = SNUP0(K) + ALB(K) = ALBF(K) + SNOALB(K)= SNOALBF(K) + ENDDO + + !-- INITIALIZE SUMS + SUMLAI = 0.0 + SUMLMN = 0.0 + SUMRSI = 0.0 + SUMLZ0 = 0.0 + SUMVEG = 0.0 + SUMVMN = 0.0 + ALAI = 0.0 + SUMSNUP = 0.0 + SUMALB = 0.0 + SUMSNOALB = 0.0 + + !-- ESTIMATE CROP EMERGANCE DATE FROM VEGFRAC + VFMX = SHDMAX(I,J) + VFMN = SHDMIN(I,J) + VEGF = VEGFRA(I,J) + + !-- Computations for VEGETATION CELLS ONLY + IF(VFMX.GT.0.0.AND.LANDUSEF(I,KWAT,J).LT.1.00) THEN + VSEAS = VEGF/VFMX + IF(VSEAS.GT.1.0.OR.VSEAS.LT.0.0) THEN + VSEAS = MIN(VSEAS,1.0) + VSEAS = MAX(VSEAS,0.0) + ENDIF + + ZNOTC = ZNOTCMN * (1-VSEAS) + ZNOTCMX * VSEAS ! Zo FOR CROPS + DO K = 1, NLCAT + IF (LAND_USE_TYPE == 'MODIS') THEN + !-- USE THE VEGFRAC DATA ONLY FOR CROPS + IF (K.EQ.12 .OR. K.EQ.14) THEN + LAIMX(K) = LAIMN0(K) * (1-VSEAS) + LAI0(K) * VSEAS + LAIMN(K) = LAIMX(K) + VEG(K) = VEGMN0(K) * (1-VSEAS) + VEG0(K) * VSEAS + VEGMN(K) = VEG(K) + !-- SEASONALLY VARY Zo FOR MODIS DryCrop (k=12) + IF (K .EQ. 12) THEN + Z0(K) = ZNOTC + !-- CrGrM (k=14) USE AVG WITH GRASS AND FOREST + ELSE IF (K .EQ.14) THEN + Z0(K) = 0.5 * (ZNOTC + Z00(K)) + ENDIF + ENDIF + ELSE IF (LAND_USE_TYPE == 'NLCD50') THEN + !-- USE THE VEGFRAC DATA ONLY FOR CROPS + IF (K.EQ.20 .OR. K.EQ.43 .OR. K.EQ.45) THEN + LAIMX(K) = LAIMN0(K) * (1-VSEAS) + LAI0(K) * VSEAS + LAIMN(K) = LAIMX(K) + VEG(K) = VEGMN0(K) * (1-VSEAS) + VEG0(K) * VSEAS + VEGMN(K) = VEG(K) + !-- SEASONALLY VARY Zo FOR DryCrop (k=20) OR Irigated Crop (k=43) OR Mix Crop (k=4) + IF (K.EQ.20 .OR. K.EQ.43) THEN + Z0(K) = ZNOTC + !-- CrNatM (k=45) USE AVG WITH GRASS AND FOREST + ELSE IF (K.EQ.45) THEN + Z0(K) = 0.5 * (ZNOTC + Z00(K)) + ENDIF + ENDIF + ELSE IF (LAND_USE_TYPE == 'NLCD40') THEN + !-- USE THE VEGFRAC DATA ONLY FOR CROPS + IF (K.EQ.12 .OR. K.EQ.14 .OR. K.EQ.38) THEN + LAIMX(K) = LAIMN0(K) * (1-VSEAS) + LAI0(K) * VSEAS + LAIMN(K) = LAIMX(K) + VEG(K) = VEGMN0(K) * (1-VSEAS) + VEG0(K) * VSEAS + VEGMN(K) = VEG(K) + !-- SEASONALLY VARY Zo FOR Crop (k=12 for MODIS or 38 for NLCD) + IF (K.EQ.12 .OR. K.EQ.38) THEN + Z0(K) = ZNOTC + !-- CrNatM (k=14) USE AVG WITH GRASS AND FOREST + ELSE IF (K.EQ.14) THEN + Z0(K) = 0.5 * (ZNOTC + Z00(K)) + ENDIF + ENDIF + ELSE IF (LAND_USE_TYPE == 'USGS') THEN + !-- USE THE VEGFRAC DATA ONLY FOR CROPS + IF (K .GE. 2 .AND. K .LE. 6) THEN + LAIMX(K) = LAIMN0(K) * (1-VSEAS) + LAI0(K) * VSEAS + LAIMN(K) = LAIMX(K) + VEG(K) = VEGMN0(K) * (1-VSEAS) + VEG0(K) * VSEAS + VEGMN(K) = VEG(K) + !-- SEASONALLY VARY Zo FOR DryCrop (k=2) OR Irigated Crop (k=3) OR Mix Crop (k=4) + IF (K .GE. 2 .AND. K .LE. 4) THEN + Z0(K) = ZNOTC + !-- CrGrM (k=5) or CrWdM (k=6) USE AVG WITH GRASS AND FOREST + ELSE IF (K .GE.5 .AND. K .LE. 6) THEN + Z0(K) = 0.5 * (ZNOTC + Z00(K)) + ENDIF + ENDIF + ELSE IF (LAND_USE_TYPE == 'USGS28') THEN + !-- USE THE VEGFRAC DATA ONLY FOR CROPS + IF (K .GE. 2 .AND. K .LE. 6) THEN + LAIMX(K) = LAIMN0(K) * (1-VSEAS) + LAI0(K) * VSEAS + LAIMN(K) = LAIMX(K) + VEG(K) = VEGMN0(K) * (1-VSEAS) + VEG0(K) * VSEAS + VEGMN(K) = VEG(K) + !-- SEASONALLY VARY Zo FOR DryCrop (k=2) OR Irigated Crop (k=3) OR Mix Crop (k=4) + IF (K .GE. 2 .AND. K .LE. 4) THEN + Z0(K) = ZNOTC + !-- CrGrM (k=5) or CrWdM (k=6) USE AVG WITH GRASS AND FOREST + ELSE IF (K .GE.5 .AND. K .LE. 6) THEN + Z0(K) = 0.5 * (ZNOTC + Z00(K)) + ENDIF + ENDIF + + END IF + + ENDDO + + ENDIF !-- IF cell is vegetation + + !------------------------------------- + !-- LOOP THROUGH LANDUSE Fraction and compute totals + DO K = 1, NLCAT + FAREA = LANDUSEF(I,K,J) + SUMLAI = SUMLAI + LAIMX(K) * FAREA + SUMLMN = SUMLMN + LAIMN(K) * FAREA + ALAI = ALAI + FAREA + SUMRSI = SUMRSI + FAREA * LAIMX(K) / RSMIN(K) + SUMLZ0 = SUMLZ0 + FAREA * ALOG(Z0(K)) + SUMVEG = SUMVEG + FAREA * VEG(K) + SUMVMN = SUMVMN + FAREA * VEGMN(K) + SUMSNUP = SUMSNUP+ FAREA * SNUP(K) + SUMALB = SUMALB + FAREA * ALB(K) + SUMSNOALB= SUMSNOALB + FAREA * SNOALB(K) + ENDDO + + FWAT = LANDUSEF(I,KWAT,J) + !-- CHECK FOR WATER + IF (FWAT .GE. 0.50) THEN ! Changed WRFV3.7 + XLAI(I,J) = LAIMX(KWAT) + XLAIMN(I,J) = LAIMN(KWAT) + RSTMIN(I,J) = RSMIN(KWAT) + ZNT(I,J) = Z0(KWAT) + XVEG(I,J) = VEG(KWAT) + XVEGMN(I,J) = VEGMN(KWAT) + XSNUP(I,J) = SNUP(KWAT) + XALB(I,J) = ALB(KWAT) + XSNOALB(I,J)= SNOALB(KWAT) + ELSE + IF (FWAT .GT. 0.10) THEN + ALAI = ALAI - FWAT + SUMLZ0 = SUMLZ0 - FWAT * ALOG(Z0(KWAT)) + ENDIF + XLAI(I,J) = SUMLAI / ALAI + XLAIMN(I,J) = SUMLMN / ALAI + RSTMIN(I,J) = SUMLAI / SUMRSI + ZNT(I,J) = EXP(SUMLZ0/ALAI) + XVEG(I,J) = SUMVEG / ALAI + XVEGMN(I,J) = SUMVMN / ALAI + XSNUP(I,J) = SUMSNUP + XALB(I,J) = SUMALB + XSNOALB(I,J)= SUMSNOALB + ENDIF + + IF (FWAT .GT. 0.50) THEN + ZNT(I,J) = Z0(KWAT) + XALB(I,J) = ALB(KWAT) + XSNOALB(I,J)= SNOALB(KWAT) + ENDIF + + !-- Compute wetlands fraction for proper MMLUIN data set + !-- Note: if LU categories change, these hard coded indicies must be updated + IF (LAND_USE_TYPE == 'USGS') THEN + WETFRA(I,J) = LANDUSEF(I,17,J)+LANDUSEF(I,18,J) + ELSE IF (LAND_USE_TYPE == 'USGS28') THEN + WETFRA(I,J) = LANDUSEF(I,17,J)+LANDUSEF(I,18,J) + ELSE IF (LAND_USE_TYPE == 'NLCD50') THEN + WETFRA(I,J) = LANDUSEF(I,22,J)+LANDUSEF(I,23,J)+LANDUSEF(I,27,J)+LANDUSEF(I,28,J)+LANDUSEF(I,42,J) + ELSE IF (LAND_USE_TYPE == 'NLCD40') THEN + WETFRA(I,J) = LANDUSEF(I,39,J)+LANDUSEF(I,40,J)+LANDUSEF(I,11,J) + ELSE IF (LAND_USE_TYPE == 'MODIS') THEN + WETFRA(I,J) = LANDUSEF(I,11,J) + END IF + + ZNT(I,J) = ZNT(I,J) * 0.01 !CONVERT TO M + XVEG(I,J) = XVEG(I,J) * 0.01 !CONVERT TO FRAC + XVEGMN(I,J) = XVEGMN(I,J) * 0.01 + XLAND(I,J) = 1.0 + FWAT + XALB(I,J) = XALB(I,J) * 0.01 + XSNOALB(I,J)= XSNOALB(I,J) * 0.01 + + !-------Adjustment according to CANFRA and IMPERV fo NLCD40 only ----------- + FIMP = IMPERV(I,J) * 0.01 + FCAN = CANFRA(I,J) * 0.01 + IF (LAND_USE_TYPE == 'NLCD40') THEN + XVEG(I,J) = MIN(XVEG(I,J),1.0-FIMP) + XVEGMN(I,J) = MIN(XVEGMN(I,J),1.0-FIMP) + XVEG(I,J) = MAX(XVEG(I,J),FCAN) + XVEGMN(I,J) = MAX(XVEGMN(I,J),FCAN) + + FORFRA = LANDUSEF(I,39,J)+LANDUSEF(I,30,J)+LANDUSEF(I,29,J)+LANDUSEF(I,28,J) + EXTFOR = FCAN - FORFRA + IF (EXTFOR.GE.0.01) THEN + XLAI(I,J) = LAIMX(30) * EXTFOR + XLAI(I,J) * (1-EXTFOR) + XLAIMN(I,J) = LAIMN(30) * EXTFOR + XLAIMN(I,J) * (1-EXTFOR) + ENDIF + ENDIF + !-------------------------------------------------------------------------- + + ENDDO + ENDDO + !-------------------------------------------------------------------- + + END SUBROUTINE vegeland + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + SUBROUTINE SURFPX(DTPBL, IFLAND, ISNOW, NUDGEX, XICE1, SOLDN, GSW, & !in + LWDN, EMISSI, Z1, MOL, ZNT, UST, PSURF, DENS1, & !in + QV1, QSS, TA1, THETA1, PRECIP, CPAIR, PSIH, & !in + RH2OBS, T2OBS, VEGFRC, ISTI,LAI,IMPERV,CANFRA,BETAP, & !in + RSTMIN, HC_SNOW, SNOW_FRA, WETFRA, WWLT, WFC, & !in + WRES, CGSAT, WSAT, B, C1SAT, C2R, AS, JP, C3, DS1, & !in + DS2, QST12, & !in + RADNET, GRDFLX, HFX, QFX, LH, EG, ER, ETR, & !out + QST, CAPG, RS, RA, TG, T2, WG, W2, WR, & !out + TA2, QA2, LAND_USE_TYPE, I, J ) !out + +!------------------------------------------------------------------------------ +! +! FUNCTION: +! THIS SUBROUTINE COMPUTES SOIL MOISTURE AND TEMPERATURE TENDENCIES +! BY SOLVING THE PROGNOSTIC EQUATIONS IN PX95. +! +! SUBROUTINES CALLED: +! SUB. QFLUX compute the soil and canopy evaporation, and transpiration +! SUB. SMASS compute nudging coefficients for soil moisture and temp nudging +! +! ARGUMENTS: +! DTPBL: TIME STEP OF THE MINOR LOOP FOR THE LAND-SURFACE/PBL MODEL +! IFLAND: INDEX WHICH INDICATES THE TYPE OF SURFACE,=1,LAND;=2,SEA +! ISNOW: SNOW (=1) OR NOT (=0) +! NUDGE: SWITCH FOR SOIL MOISTURE NUDGING +! SOLDN: SHORT-WAVE RADIATION +! LWDN: LONG-WAVE RADIATION +! EMISSI: EMISSIVITY +! Z1: HEIGHT OF THE LOWEST HALF LAYER +! MOL: MONIN-OBUKOV LENGH (M) +! ZNT: ROUGHNESS LENGTH (M) +! UST: FRICTION VELOCITY (M/S) +! TST: Turbulent moisture scale +! RA: AERODYNAMIC RESISTENCE +! PSURF: P AT SURFACE (CB) +! DENS1: AIR DENSITY AT THE FIRST HALF LAYER +! QV1: Air humidity at first half layer +! QSS: Saturation mixing ratio at ground +! TA1: Air temperature at first half layer +! THETA1: Potential temperature at first half layer +! PRECIP: Precipitation rate in m/s +! STBOLT: STEFAN BOLTZMANN'S CONSTANT +! KARMAN: VON KARMAN CONSTANT +! CPAIR: Specific heat of moist air (M^2 S^-2 K^-1) +! PSIH Similarity stability function for heat +! TAUINV: 1/1DAY(SEC) +! VEGFRC: Vegetation coverage +! ISTI: soil type +! LAI: Leaf area index +! IMPERV: Percentage of IMPERVIOUS Fraction +! CANFRA: Percentage of Canopy/Tree Fraction +! BETAP: Coefficient for bare soil evaporation +! WETFRA: Fraction of Wetlands area +! T2OBS: Observed temperature at SCREEN HT (K) +! RH2OBS: Observed relative humidity at SCREEN HT (fraction) +! RSTMIN Minimum Stomatol resistence +!... Outputs from SURFPX +! RADNET: Net radiation +! HFX: SENSIBLE HEAT FLUX (W / M^2) +! QFX: TOTAL EVAP FLUX (KG / M^2 S) +! GRDFLX: Ground heat flux (W / M^2) +! QST: Turbulent moisture scale +! CAPG: THERMAL CAPACITY OF GROUND SLAB (J/M^2/K) +! RS: Surface resistence +! RA: Surface aerodynamic resistence +! EG: evaporation from ground (bare soil) +! ER: evaporation from canopy +! ETR: transpiration from vegetation +! TA2: diagnostic 2-m temperature from surface layer and lsm +! +!... Updated variables in this subroutine +! TG: Soil temperature at first soil layer +! T2: Soil temperature in root zone +! WG: Soil moisture at first soil layer +! W2: Soil moisture at root zone +! WR: Canopy water content in m +! +! REVISION HISTORY: +! AX 2/2005 - developed WRF version based on the MM5 PX LSM +! +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + IMPLICIT NONE + +!.......Arguments + +!.. Integer + INTEGER , INTENT(IN) :: ISTI, NUDGEX, I, J + +!... Real + REAL , INTENT(IN) :: DTPBL, DS1, DS2 + REAL , INTENT(IN) :: IFLAND, ISNOW, XICE1 + REAL , INTENT(IN) :: SOLDN, GSW, LWDN, EMISSI, Z1 + REAL , INTENT(IN) :: ZNT + REAL , INTENT(IN) :: PSURF, DENS1, QV1, QSS, TA1, THETA1, PRECIP + REAL , INTENT(IN) :: CPAIR + REAL , INTENT(IN) :: VEGFRC, LAI, IMPERV, CANFRA + REAL , INTENT(IN) :: RSTMIN, HC_SNOW, SNOW_FRA, WETFRA + REAL , INTENT(IN) :: WWLT, WFC, WRES, CGSAT, WSAT, B, C1SAT, C2R, AS, JP, C3 + REAL , INTENT(IN) :: RH2OBS,T2OBS + REAL , INTENT(IN) :: QST12 + + REAL , INTENT(OUT) :: RADNET, EG, ER, ETR + REAL , INTENT(OUT) :: QST, CAPG, RS, TA2, QA2 + + REAL , INTENT(INOUT) :: TG, T2, WG, W2, WR, UST, RA, BETAP + REAL , INTENT(INOUT) :: GRDFLX, QFX, HFX, LH, PSIH, MOL + + CHARACTER (LEN = 6), INTENT(IN) :: LAND_USE_TYPE + +!... Local Variables + +!... Real +#if defined(mpas) + REAL :: PI, ROVCP, DENW +#endif + REAL :: HF, LV, CQ4, WETSAT, SM2 + REAL :: RAH, RAW, ET, W2CG, CG, CT, SOILFLX, CPOT, THETAG + REAL :: ZOL, ZOBOL, ZNTOL, Y, Y0, PSIH15, YNT + REAL :: WGNUDG, W2NUDG, ALPH1, ALPH2, BET1, BET2, T1P5 + REAL :: CQ1, CQ2, CQ3, COEFFNP1, COEFFN, TSNEW, TSHLF, T2NEW + REAL :: ROFF, WRMAX, PC, DWR, PNET, TENDWR, WRNEW + REAL :: COF1, CFNP1WR, CFNWR, PG, FASS + REAL :: TENDW2, W2NEW, W2HLF, W2REL, C1, C2, WEQ, CFNP1, CFN, WGNEW + REAL :: ALN10, TMP1, TMP2, TMP3, AA, AB, TST, RBH, CTVEG + REAL :: QST1,PHIH,PSIOB + REAL :: T2NUD, T2NUDF + REAL :: VAPPRS, QSBT, RH2MOD, IMF, VEGF, SOILF + REAL :: RSOIL, LDRY, DP + REAL :: C1MAX,ZZA,ZZB,ZDEL,ZLY,ZA,ZB,ZY2 + REAL :: RINC, HCAN + + CHARACTER (LEN = 512) :: message + +!... Parameters + REAL :: ZOBS, GAMAH, BETAH, SIGF, BH, CT_SNOW, CT_IMPERV + + REAL, PARAMETER :: CV = 1.2E-5 ! K-M2/J Note: Update from 8E-6 10/14 Jon Pleim + + PARAMETER (ZOBS = 1.5) ! height for observed screen temp., (m) + PARAMETER (BH = 15.7) + PARAMETER (GAMAH = 16. ) !11.6) + PARAMETER (BETAH = 5.0 ) !8.21) + PARAMETER (SIGF = 0.5) ! rain interception see LSM (can be 0-1) + REAL, PARAMETER :: DWAT = 0.2178 ! [cm^2 / s] at 273.15K + !-------------------------------------------------------------------- + ! OLD PX legacy value from MM5 ... unknown origin PARAMETER (CT_SNOW = 5.54E-5) + ! New value of CT_SNOW calibrated using multilayer soil model where csnow=6.9E5 J/(m3 K) + ! from NCAR (WRFV3.2 -WRFV3.6.1) CSM PARAMETER (CT_SNOW = 2.0E-5) + PARAMETER (CT_SNOW = 2.0E-5) + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! CS for concrete/asphalt/road material (http://www.engineeringtoolbox.com/specific-heat-capacity-d_391.html) + ! cs_imperv = 920 J kg-1 K-1 + ! CS for asphalt and concrete from 0.1785 to 0.20 cal g-1 K-1 (http://pages.towson.edu/morgan/files/Impervious.pdf) + ! the values above translate to ~750 to 850 J kg-1 K-1 + ! + ! CAPG used for WRF urban physics ranges from 1.0E6 for roof and building walls to 1.4E6 J m-3 K-1 for roads/urban ground + ! Using these values to back out CS along with 0.15 m thickness 1.4E6 J m-3 K-1 * 0.15 m = 2.1E5 J m-2 K-1 + ! inverse of the value above gives CT_IMPERV value of 1/0.000021 = 4.762E-6 K m2 J-1 + + ! The middle value will be used for now. 850 J kg-1 K-1. This needs to be converted from J/K per kg to area using + ! the approxiate concrete/asphalt density and layer thickness or represenative thickness. For starters (12/2011) + ! well not use the PX first layer thickness, but representative thickness of most roads/parkinglots/buildings. + ! for now welll use 6 inches or about 15 cm or 0.15 m. Density of concrete (normal) from + ! Dorf, Richard. Engineering Handbook. New York: CRC Press, 1996. is ~2400 kg m-3. + ! Using these values 850 J kg-1 K-1 * 2400 kg m-3 * 0.15 m = 3.06E5 J m-2 K-1 or in CT form (inverse) 3.268E-6 K m2 J-1 + ! If you look at the range of possible values considering density differences of concrete/asphalt/etc + ! Values can range from 2.5 to 6.0 E-6 + PARAMETER (CT_IMPERV = 3.268E-6) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +#if defined(mpas) + PI = pii + ROVCP = rcp + DENW = rho_w +#endif + ALN10 = ALOG(10.0) + RADNET = SOLDN - (EMISSI *(STBOLT *TG **4 - LWDN)) ! NET RADIATION + !-------------------------------------------------------------------- + CPOT = (100.0 / PSURF) ** ROVCP ! rcp is global constant(module_model_constants) + THETAG = TG * CPOT + + ZOL = Z1/MOL + ZOBOL = ZOBS/MOL + ZNTOL = ZNT/MOL + + !----------------------------------------------------------------------------------------- + IF (MOL .LT. 0.0) THEN + Y = ( 1.0 - GAMAH * ZOL ) ** 0.5 + Y0 = ( 1.0 - GAMAH * ZOBOL ) ** 0.5 + YNT = ( 1.0 - GAMAH * ZNTOL ) ** 0.5 + PSIH15 = 2.0 * ALOG((Y + 1.0) / (Y0 + 1.0)) + PSIH = 2.0 * ALOG((Y + 1.0) / (YNT + 1.0)) + PSIOB = 2.0 * ALOG((Y0 + 1.0) / (YNT + 1.0)) + PHIH = 1.0 / Y + ELSE + IF ((ZOL - ZNTOL) .LE. 1.0) THEN + PSIH = -BETAH*(ZOL-ZNTOL) + ELSE + PSIH = 1.-BETAH-(ZOL-ZNTOL) + ENDIF + IF ((ZOBOL - ZNTOL) .LE. 1.0) THEN + PSIOB = -BETAH * (ZOBOL - ZNTOL) + ELSE + PSIOB = 1.0 - BETAH - (ZOBOL - ZNTOL) + ENDIF + PSIH15 = PSIH - PSIOB + IF (ZOL .LE. 1.0) THEN + PHIH = 1.0 + BETAH * ZOL + ELSE + PHIH = BETAH + ZOL + ENDIF + ENDIF + !----------------------------------------------------------------------------------------- + !-- ADD RA AND RB FOR HEAT AND MOISTURE + !... RB FOR HEAT = 5 /UST + !... RB FOR WATER VAPOR = 5*(0.599/0.709)^2/3 /UST = 4.503/UST + RA = PR0* ( ALOG(Z1/ZNT) - PSIH )/(KARMAN*UST) + RAH = RA + 5.0 / UST + RAW = RA + 4.503 / UST + IF (IFLAND .LT. 1.5 .AND. XICE1 .LT. 0.5) THEN + LDRY = 1.75*DS1*(EXP((1.-WG/WSAT)**5)-1.)/1.718 ! 1.75 cm is the layer thickness used by S&Z09 + DP = DWAT*1.E-4 * WSAT**2 * (1.-WRES/WSAT)**(2.+3./B) + RSOIL = LDRY/DP + ELSE + RSOIL = 0.0 + ENDIF + !-------------------------------------------------------------------- + ! Compute soil moisture layer 2 that considers fraction of saturated + ! wetlands. If 100% of cell is wetland, soil moisture can be no lower + ! than full soil saturation. If half wetland, no less than half saturated + IF (IFLAND .LT. 1.5) THEN + WETSAT = 1.00 * WSAT ! Wetlands soil moisture + SM2 = (WETFRA * WETSAT) ! + W2 = AMAX1(SM2, W2) ! In case that W2 > Field capacity (heavy precip), use wetter W2 + ENDIF + + !-------------------------------------------------------------------- + ! In-canopy resistance - Erisman et al (1994) + HCAN = ZNT * 10.0 + RINC = 14.0 * LAI* HCAN / UST + + !-------------------------------------------------------------------- + !-- COMPUTE MOISTURE FLUX + CALL QFLUX( DENS1, QV1, TA1, SOLDN, RAW, QSS, & + VEGFRC, ISNOW, ISTI, IFLAND, LAI, BETAP, & + WG, W2, WR, & + RSTMIN, WWLT, WFC, RSOIL, RINC, & + EG, ER, ETR, CQ4, RS, FASS) + !-------------------------------------------------------------------- + + !-------------------------------------------------------------------- + ! Compute Total evaporation (ET) from various modes of moisture flux + ET = EG + ER + ETR + QST = -ET / (DENS1 * UST) + + LV = 2.83E6 !-- LATENT HEAT OF SUBLIMATION AT 0C FROM STULL(1988) + IF (ISNOW .LT. 0.5 .AND. TG .GT. 273.15) & + LV = (2.501 - 0.00237 * (TG - 273.15)) * 1.E6 !-- FROM STULL(1988) in J/KG + + QFX = ET + LH = LV * QFX + !----------------------------------------------------------------------------------------- + + !----------------------------------------------------------------------------------------- + ! Surface sensible heat flux + TST = (THETA1 - THETAG ) / (UST*RAH) + HF = UST * TST + HFX = AMAX1(-DENS1 * CPAIR * HF, -250.0) ! using -250. from MM5 + !----------------------------------------------------------------------------------------- + + !----------------------------------------------------------------------------------------- + ! Compute the diagnosed 2m Q and T consistent with PX LSM + QST1 = 0.5*(QST+QST12/PHIH) + TA2 = (THETAG + TST * (PR0 / KARMAN * (ALOG(ZOBS / ZNT) - PSIOB)+5.))/CPOT + QA2 = QV1 - QST1 * PR0/ KARMAN * (ALOG(Z1 / ZOBS) - PSIH15) + + IF (QA2 .LE. 0.0) QA2 = QV1 + + !-- Relative humidity + VAPPRS = SVP1 * EXP(SVP2 * (TA2 - SVPT0) / (TA2 - SVP3)) + QSBT = EP_2 * VAPPRS / (PSURF - VAPPRS) + RH2MOD = QA2 / QSBT + !----------------------------------------------------------------------------------------- + IF (IFLAND .LT. 1.5) THEN + W2CG = AMAX1(W2,WWLT) + CG = CGSAT * 1.0E-6 * (WSAT/ W2CG) ** & + (0.5 * B / ALN10) + ! IMPERVIOUS weighting scheme -- Subtract highly accurate impervious fraction from cell + ! remainder is split between ground and vegetation. CT is a weighted fractional average. + ! Snow CT is then applied for final heat capacity + IMF = AMAX1(0.0,IMPERV/100.0) + VEGF = (1.0 - IMF) * VEGFRC + SOILF= (1.0 - IMF) * (1.0 - VEGFRC) + CT = 1./( IMF/CT_IMPERV + VEGF/CV + SOILF/CG) + CT = 1./(SNOW_FRA/CT_SNOW + (1-SNOW_FRA)/CT) + CAPG = 1.0/CT + + SOILFLX = 2.0 * PI * TAUINV * (TG - T2) + GRDFLX = SOILFLX / CT + ENDIF + !----------------------------------------------------------------------------------------- + + !-------------------------------------------------------------------- + !-- ASSIMILATION --- COMPUTE SOIL MOISTURE NUDGING FROM TA2 and RH2 + !-------COMPUTE ASSIMILATION COEFFICIENTS FOR ALL I + IF (IFLAND .LT. 1.5) THEN + IF (NUDGEX .EQ. 0) THEN !-- NO NUDGING CASE + WGNUDG = 0.0 + W2NUDG = 0.0 + T2NUD = 0.0 + ELSE !-- NUDGING CASE + + CALL SMASS (ISTI, FASS, SOLDN, VEGFRC, RA, WWLT, WFC, & + ALPH1, ALPH2, BET1, BET2, T2NUDF) + + !--COMPUTE SOIL MOISTURE NUDGING + WGNUDG = ALPH1 * (T2OBS - TA2) + ALPH2 * (RH2OBS - RH2MOD) * 100 !NUDGING W2 FOR NON-VEG + W2NUDG = BET1 * (T2OBS - TA2) + BET2 * (RH2OBS - RH2MOD) * 100 + IF (W2 .GE. WFC) W2NUDG = AMIN1(W2NUDG,0.0) + IF (W2 .LE. WWLT) W2NUDG = AMAX1(W2NUDG,0.0) + IF (W2 .GE. WFC) WGNUDG = AMIN1(WGNUDG,0.0) + IF (W2 .LE. WWLT) WGNUDG = AMAX1(WGNUDG,0.0) + T2NUD = T2NUDF * (T2OBS - TA2) + ENDIF + ENDIF + !----------------------------------------------------------------------------------------- + + !----------------------------------------------------------------------------------------- + !-- Compute new values for TS,T2,WG,W2 and WR. No change over ice or water (XLAND > 1) + IF (IFLAND .LT. 1.5) THEN + !-- SOLVE BY CRANK-NIC -- TENDTS=CT*(RADNET-HFX-QFX)-SOILFLX + !-- Calculate the coefficients for implicit calculation of TG + CQ1 = (1.0 - 0.622 * LV * CRANKP / (r_d * TG)) * QSS + CQ2 = 0.622 * LV * QSS * CRANKP / (r_d * TG * TG) + CQ3 = DENS1 * (1.0 - VEGFRC) / (RAW + RSOIL) + COEFFNP1 = 1.0 + DTPBL * CRANKP * (4.0 * EMISSI * STBOLT * TG ** 3 & + * CT + DENS1 * CPAIR / RAH * CPOT * CT + 2.0 * PI & + * TAUINV ) + DTPBL * (CT * LV * CQ2 * (CQ3 + CQ4)) + COEFFN = CT * (GSW + EMISSI * (STBOLT * (4.0 * CRANKP - 1.0) & + * TG*TG*TG*TG + LWDN) & !NET RAD + + DENS1 * CPAIR / RAH * (THETA1 - (1.0 - CRANKP) * THETAG) & + - LV * (CQ3 * (CQ1 - QV1) + CQ4 * (CQ1 - QV1))) & !SFC HEAT FLUX + - 2.0 * PI * TAUINV * ((1.0 - CRANKP) * TG - T2) !SOIL FLUX + TSNEW = (TG + DTPBL * COEFFN) / COEFFNP1 + !-- FOR SNOW COVERED SURFACE TEMPERATURE IS NOT MORE THAN ZERO + IF (XICE1 .GT. 0.5) TSNEW = AMIN1(TSNEW,273.15) ! Re-added Jan 2010 to keep ice surface at or below freezing (J. Pleim) + TSHLF = 0.5 * ( TSNEW + TG) + T2NEW = (T2 + DTPBL * TAUINV * T2TFAC * (TSHLF - (1 - CRANKP) * T2) & + + DTPBL*T2NUD) & ! Added deep temperature nudging + / (1.0 + DTPBL * TAUINV * T2TFAC * CRANKP) + !-- REPLACE OLD with NEW Value + TG = TSNEW + T2 = T2NEW + ENDIF + !----------------------------------------------------------------------------------------- + + !----------------------------------------------------------------------------------------- + ! Compute new subsurface soil and canopy moisture values DENS1. No change required over ocean. + IF (IFLAND .LT. 1.5 .AND. XICE1 .LT. 0.5) THEN + !-- Compute WR + ROFF = 0.0 + WRMAX = 0.2E-3 * VEGFRC * LAI ! max. WRMAX IN m + + IF (WRMAX .GT. 0.0) THEN + !-- PC is precip. intercepted by veg.(M/S) + PC = VEGFRC * SIGF * PRECIP + DWR = (WRMAX - WR) / DTPBL ! the tendency to reach max. + PNET = PC - ER/ DENW ! residual of precip. and evap. + IF (PNET .GT. DWR) THEN + ROFF = PNET - DWR + PC = PC - ROFF + ENDIF + IF (QSS .LT. QV1) THEN + TENDWR = PC - ER / DENW + WRNEW = WR + DTPBL * TENDWR + ELSE + COF1 = DENS1 / DENW * VEGFRC * (QSS - QV1) / RAW + !-- using delta=wr/wrmax + CFNP1WR = 1.0 + DTPBL * COF1 * CRANKP / WRMAX + CFNWR = PC - COF1 * (1.0 - CRANKP) * WR / WRMAX + WRNEW = (WR + DTPBL * CFNWR) / CFNP1WR + ENDIF + ELSE + PC = 0.0 + WRNEW = 0.0 + ENDIF + !--------------------------------------------- + !-- Compute W2 + PG = DENW * (PRECIP - PC) ! PG is precip. reaching soil (PC already including ROFF) + TENDW2 = 1.0 / (DENW * DS2) * (PG - EG - ETR) & + - C3/DS2 * TAUINV * AMAX1(0.0,(W2 - WFC)) & + + (W2NUDG + WGNUDG) / DS2 ! NUDGING + W2NEW = W2 + DTPBL * TENDW2 + W2NEW = AMIN1(W2NEW,WSAT) + W2NEW = AMAX1(W2NEW,WRES) !0.05) !Limei 08/02/2017 + W2HLF = 0.5 * (W2 + W2NEW) + !.. new values + W2 = W2NEW + WR = AMIN1(WRMAX,WRNEW) + ENDIF + !----------------------------------------------------------------------------------------- + + !----------------------------------------------------------------------------------------- + ! Compute new surface soil moisture values (WR). + IF (IFLAND .LT. 1.5 .AND. XICE1 .LT. 0.5) THEN ! over ocean no change to wg w2,wr + !-- FOR SNOW COVERED SURFACE, ASSUME SURFACE IS SATURATED AND + ! WG AND W2 ARE NOT CHANGED + IF (ISNOW .GT. 0.5) THEN + WG = WSAT + ELSE + W2REL = W2HLF / WSAT + IF (WG .GT. WWLT) THEN + C1 = DS1*C1SAT * (WSAT / WG) ** (0.5 * B + 1.0) + ELSE ! revise C1 for wg < wilting point Noilhan & Mahfouf (1996) + ZY2 = C1SAT * (WSAT / WWLT) ** (0.5 * B + 1.0) + C1MAX = (1.19*WWLT - 5.09)*TG - 146.*WWLT + 1786. + C1MAX = MAX(MAX(C1MAX,ZY2),10.) +!* Giard-Bazile formulation (resolution of a second order equation) +! + ZLY = LOG( C1MAX/10.) + ZZA = - LOG( ZY2 /10.) + ZZB = 2. * WWLT * ZLY + ZDEL= 4. * (ZLY+ZZA) * ZLY * WWLT**2 + ZA = (-ZZB+SQRT(ZDEL)) / (2.*ZZA) + ZB = ZA**2 / ZLY + C1 = DS1*C1MAX * EXP(-(WG-ZA)**2/ZB) + ENDIF + + C2 = C2R * W2HLF / (WSAT - W2HLF + 1.E-11) + IF (W2HLF .GE. WSAT) THEN + WEQ = WSAT + ELSE + WEQ = W2HLF - AS * WSAT * W2REL ** JP * & + (1.0 - W2REL ** (8.0 * JP)) + ENDIF + + !.... The diffusion method in Sakaguchi and Zeng [2009] (JGR-Atmos.) + CFNP1 = 1.0 + DTPBL * C2 * TAUINV * CRANKP + CFN = C1 / (DENW * DS1) * (PG - EG) - C2 * TAUINV * & + ((1.0 - CRANKP) * WG - WEQ) + WGNUDG/ DS1 + + WGNEW = AMAX1((WG + DTPBL * CFN) / CFNP1, WRES ) !0.001) ! Limei 08/02/2017 + !-- NEW VALUES + WG = AMIN1(WGNEW,WSAT) + + ENDIF !endif for ISNOW + ENDIF !endif for XLAND + + END SUBROUTINE surfpx +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + SUBROUTINE QFLUX (DENS1, QV1, TA1, RG, RAW, QSS, & ! in + VEGFRC, ISNOW, ISTI, IFLAND, LAI, BETAP, & ! in + WG, W2, WR, & ! in + RSTMIN, WWLT, WFC, RSOIL, RINC, & ! in + EG, ER, ETR, CQ4, RS, FASS) ! out + +!------------------------------------------------------------------------- +! +! FUNCTION: +! THIS SUBROUTINE COMPUTES EVAPORATION FROM BARE SOIL (EG) AND FROM +! THE WET PART OF CANOPY (ER) AND TRANSPIRATION FROM THE DRY PART OF +! CANOPY (ETR). +! +! REVISION HISTORY: +! A. Xiu Oct 2004 - adapted from the PX LSM in MM5 for the WRF system +! R. Gilliam Dec 2006 - Completed WRF V2.1.2 implementation +! +!------------------------------------------------------------------------- +! QFLUX ARGUMENT LIST: +!------------------------------------------------------------------------- +! INPUTS: +!-- DENS1 air density at first layer +!-- QV1 air humidity at first layer +!-- TA1 air temperature at first layer +!-- RG shortwave radition reaching the ground +!-- RAW RA+RB for moisture +!-- QSS saturation mixing ratio at ground +!-- VEGFRC vegetation coverage +!-- ISNOW if snow on the ground +!-- ISTI soil type +!-- IFLAND if land (=1) or water (=2) +!-- LAI leaf area index +!-- BETAP +!-- WG soil moisture at first soil layer +!-- W2 soil moisture at root zone +!-- WR Canopy water +! +! OUTPUTS FROM QFLUX: +!-- EG evaporation from ground (bare soil) +!-- ER evaporation from canopy +!-- ETR transpiration from vegetation +!-- CQ4 +!-- RS surface resistence +!-- FASS parameter for soil moisture nudging +!------------------------------------------------------------------------- +!------------------------------------------------------------------------- + + IMPLICIT NONE + +! DECLARATIONS - INTEGER + INTEGER , INTENT(IN) :: ISTI + +! DECLARATIONS - REAL + REAL , INTENT(IN) :: ISNOW, IFLAND + REAL , INTENT(IN) :: DENS1, QV1, TA1, RG, RAW, QSS, & + VEGFRC, LAI, & + WG, W2, WR, RSTMIN + REAL , INTENT(INOUT):: BETAP, RSOIL + REAL, INTENT(IN) :: WWLT, WFC, RINC + + REAL , INTENT(OUT) :: EG, ER, ETR, CQ4, RS, FASS + +!... Local Variables + +!... Real + REAL :: WRMAX, DELTA, SIGG, RADL, RADF, W2AVAIL, W2MXAV + REAL :: FTOT, F1, F2, F3, F4 + REAL :: FSHELT, GS, GA, FX + REAL :: PAR, F1MAX + + +!... Parameters + REAL, PARAMETER :: RSMAX = 5000.0 ! s/m + REAL, PARAMETER :: FTMIN = 0.0000001 ! m/s + REAL, PARAMETER :: F3MIN = 0.25 + +! +!... for water surface, no canopy evaporation and transpiration + ER = 0.0 + ETR = 0.0 + CQ4 = 0.0 + +!... GROUND EVAPORATION (DEPOSITION) + IF (QSS .LT. QV1) RSOIL = 0.0 + EG = DENS1 * (QSS - QV1) * ((1.0 - VEGFRC) / (RAW + RSOIL) + VEGFRC/(RAW + RINC + RSOIL)) + +!... CANOPY + IF (IFLAND .LT. 1.5 .AND. VEGFRC .GT. 0.0) THEN + WRMAX = 0.2E-3 * VEGFRC * LAI ! in unit m + IF (WR .LE. 0.0) THEN + DELTA = 0.0 + ELSE + DELTA = WR / WRMAX ! referred to SiB model + ENDIF + + IF (QSS .GE. QV1) THEN + SIGG = DELTA + ELSE + SIGG = 1.0 + ENDIF + + ER = DENS1 * VEGFRC * SIGG * (QSS - QV1) / RAW + ENDIF + !!--------------------------------------------------------------------- + + !-- TRANSPIRATION + !!--------------------------------------------------------------------- + IF (IFLAND .LT. 1.5 .AND. VEGFRC .GT. 0.0) THEN + + !!!-RADIATION + IF (RSTMIN .GT. 130.0) THEN + F1MAX = 1.-0.02*LAI !Echer2015 Trees + ELSE + F1MAX = 1.-0.07*LAI !Echer2015 crops/grass + ENDIF + PAR = 0.45 * RG * 4.566 ! converted from W/m2 to umoles/m2/s (1/.219) Echer2015 + F1 = F1MAX*(1.0-exp(-0.0017*PAR)) !Echer2015 + F1 = AMAX1(F1,RSTMIN / RSMAX) + + !!!-SOIL MOISTURE + W2AVAIL = W2 - WWLT + W2MXAV = WFC - WWLT + F2 = 1.0 / (1.0 + EXP(-5.0 * ( W2AVAIL / W2MXAV - & + (W2MXAV / 3.0 + WWLT)))) ! according JP, 9/94 + + !-AIR TEMP + !... according to Avissar (1985) and AX 7/95 + IF (TA1 .LE. 302.15) THEN + F4 = 1.0 / (1.0 + EXP(-0.41 * (TA1 - 282.05))) + ELSE + F4 = 1.0 / (1.0 + EXP(0.5 * (TA1 - 314.0))) + ENDIF + + FTOT = LAI * F1 * F2 * F4 + ENDIF + + !!--------------------------------------------------------------------- + IF (IFLAND .LT. 1.5 .AND. VEGFRC .GT. 0.0) THEN + FSHELT = 1.0 ! go back to NP89 + GS = FTOT / (RSTMIN * FSHELT) + GA = 1.0 / RAW + !-- Compute humidity effect according to RH at leaf surf + F3 = 0.5 * (GS - GA + SQRT(GA * GA + GA * GS * & + (4.0 * QV1 / QSS - 2.0) + GS * GS)) / GS + F3 = AMIN1(AMAX1(F3,F3MIN),1.0) + RS = 1.0 / (GS * F3) + + !--- Compute Assimilation factor for soil moisture nudging - jp 12/94 + !-- Note that the 30 coef is to result in order 1 factor for max + IF (RG .LT. 0.00001) THEN ! do not nudge during night + FX = 0.0 + ELSE + FX = 30.0 * F1 * F4 * LAI / (RSTMIN * FSHELT) + ENDIF + + FASS = FX + ETR = DENS1 * VEGFRC * (1.0 - SIGG) * (QSS - QV1) / (RAW + RS) + !..... CQ4 is used for the implicit calculation of TG in SURFACE + CQ4 = DENS1 * VEGFRC * ((1.0 - SIGG) / (RAW + RS) + SIGG / RAW) + ENDIF + + END SUBROUTINE qflux +!------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ + SUBROUTINE SMASS (ISTI, FASS, RG, VEGFRC, RA, & !in + WWLT, WFC, & !in + ALPH1, ALPH2, BET1, BET2, T2NUDF ) !out +!------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ + IMPLICIT NONE +!------------------------------------------------------------------------------------------ +! SMASS COMPUTES SOIL MOISTURE NUDGING COEFFICIENTS +!------------------------------------------------------------------------------------------ +! +!.........Arguments + INTEGER, PARAMETER :: NSCAT = 16 ! max. soil types + + INTEGER, INTENT(IN) :: ISTI + REAL, INTENT(IN) :: FASS, RG, VEGFRC, RA + REAL, INTENT(IN) :: WWLT, WFC + REAL, INTENT(OUT) :: ALPH1, ALPH2, BET1, BET2, T2NUDF + + +!........Local variables + +!... Real + REAL :: FBET, FALPH, FRA, FTEXT + +!... Parameters + REAL, PARAMETER :: A1MAX = -10.E-5, A2MAX = 1.E-5 ! m/K, m for 6hr period + REAL, PARAMETER :: B1MAX = -10.E-3, B2MAX = 1.E-3 ! m/K, m (Bouttier et al 1993) + REAL, PARAMETER :: TASSI = 4.6296E-5 ! 1/6hr in 1/sec + REAL, PARAMETER :: RAMIN = 10.0 ! 0.1 s/cm + REAL, PARAMETER :: WFCX = 0.243 ! middle of WFC range + REAL, PARAMETER :: WWLTX = 0.169 ! middle of WWLT range + + + FBET = FASS + FALPH = RG / 1370.0 +!--TEXTURE FACTOR NORMALIZED BY LOAM (IST=5) + FRA = RAMIN / RA ! scale by aerodynamic resistance + FTEXT = TASSI * (WWLT + WFC) / (WWLTX + WFCX) * FRA + + ALPH1 = A1MAX * FALPH * (1.0 - VEGFRC) * FTEXT + ALPH2 = A2MAX * FALPH * (1.0 - VEGFRC) * FTEXT + BET1 = B1MAX * FBET * VEGFRC * FTEXT + BET2 = B2MAX * FBET * VEGFRC * FTEXT + T2NUDF= 1.0E-5 * ( VEGFRC*MAX((1.0 - 5.0 * FALPH),0.0) + (1-VEGFRC) ) ! T2 Nudging at night and day for non-veg frac - jp 10/30/14 + + END SUBROUTINE smass +!------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ +#if defined(mpas) + SUBROUTINE SOILPROP (RESTART,SOILCBOT,ITIMESTEP, MAVAIL, & ! IN +#else + SUBROUTINE SOILPROP (SOILCBOT,ITIMESTEP, MAVAIL, & ! IN +#endif + PXLSM_SMOIS_INIT, & ! IN + FWSAT,FWFC,FWWLT,FCLAY,FCSAND, & ! OUT + FFMSAND,FB,FCGSAT, & ! OUT + FJP,FAS,FC2R,FC1SAT,FWRES,FC3,ISTI, & ! OUT + WG, W2 ) ! OUT + !------------------------------------------------------------------------ + ! SOILPROP COMPUTES SOIL PARAMETERS FOR BOTH BOTTOM AND TOP LAYERS + ! USING FRACTIONAL SOIL TYPE. AN OPTION IS AVAILABLE TO + ! COMPUTE THE SOIL PARAMETERS USING FRACTIONAL INFORMATION, + ! OR TO JUST USE SOIL PARAMETERS OF THE DOMINANT SOIL TYPE + !------------------------------------------------------------------------ + !-- SOIL PARAMETERS ARE SPECIFIED BY SOIL TYPE: + ! # SOIL TYPE WSAT WFC WWLT B CGSAT JP AS C2R C1SAT WRES + ! _ _________ ____ ___ ____ ____ _____ ___ ___ ___ _____ ____ + ! 1 SAND .395 .135 .068 4.05 3.222 4 .387 3.9 .082 0.020 + ! 2 LOAMY SAND .410 .150 .075 4.38 3.057 4 .404 3.7 .098 0.035 + ! 3 SANDY LOAM .435 .195 .114 4.90 3.560 4 .219 1.8 .132 0.041 + ! 4 SILT LOAM .485 .255 .179 5.30 4.418 6 .105 0.8 .153 0.015 + ! 5 SILT .485 .255 .179 5.30 4.418 6 .105 0.8 .153 0.015 + ! 6 LOAM .451 .240 .155 5.39 4.111 6 .148 0.8 .191 0.027 + ! 7 SND CLY LM .420 .255 .175 7.12 3.670 6 .135 0.8 .213 0.068 + ! 8 SLT CLY LM .477 .322 .218 7.75 3.593 8 .127 0.4 .385 0.040 + ! 9 CLAY LOAM .476 .325 .250 8.52 3.995 10 .084 0.6 .227 0.075 + ! 10 SANDY CLAY .426 .310 .219 10.40 3.058 8 .139 0.3 .421 0.109 + ! 11 SILTY CLAY .482 .370 .283 10.40 3.729 10 .075 0.3 .375 0.056 + ! 12 CLAY .482 .367 .286 11.40 3.600 12 .083 0.3 .342 0.090 + !------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ + IMPLICIT NONE + + !.........Arguments + INTEGER, PARAMETER :: NSCAT = 16 ! max. soil types + INTEGER, PARAMETER :: NSCATMIN = 16 ! min. soil types + +#if defined(mpas) + LOGICAL, INTENT(IN) :: RESTART +#endif + INTEGER, INTENT(IN) :: ITIMESTEP, PXLSM_SMOIS_INIT + REAL, INTENT(IN) :: MAVAIL + REAL, DIMENSION(1:NSCAT), INTENT(IN) :: SOILCBOT + REAL, INTENT(OUT) :: FWSAT,FWFC,FWWLT,FCLAY, & + FCSAND,FFMSAND,FB,FCGSAT, & + FJP,FAS,FC2R,FC1SAT,FWRES,FC3 + REAL, INTENT(INOUT):: W2, WG + INTEGER, INTENT(OUT) :: ISTI + +!........Local variables + CHARACTER*4, AVCLASS + CHARACTER*4, DIMENSION( 1: NSCAT ) :: TEXID +!... Integer + INTEGER:: S +!... Real + REAL:: TFRACBOT, CFRAC, SUMCSND, SUMFMSND, SUMCLY, & + AVS, AVCS, AVFMS, AVC, AVSLT, & + SSMPOT, DSMPOT ! saturated and air-dry soil matric potential + + REAL, DIMENSION( 1: NSCATMIN ) :: CSAND, FMSAND, CLAY +!.......... DATA statement for SOIL PARAMETERS for the 11 soil types +!...........Follow Menut et al., 2013 JGR + DATA CSAND /46.0,40.0,29.0, 0.0, 0.0, & + 0.0,29.0, 0.0, 0.0, 0.0, & + 0.0, 0.0, 0.0, 0.0,46.0, & + 0.0/ + DATA FMSAND /46.0,40.0,29.0,17.0,10.0, & + 43.0,29.0,10.0,32.0,52.0, & + 6.0,22.0,43.0,43.0,46.0, & + 32.0/ + + DATA CLAY / 3.0, 4.0,10.0,13.0, 5.0, & + 18.0,27.0,34.0,34.0,42.0, & + 47.0,58.0,18.0,18.0, 3.0, & + 34.0/ + + DATA TEXID/'Sand','Lsan','Sloa','Sill','Silt', & + 'Loam','Sclo','Sicl','Cllo','Sacl', & + 'Sicy','Clay','Ormt','Wate','Bedr', & + 'Othe'/ +!-- Removed soil parameter lookup table data since these parameters are now computed analytically (Noilhan and Mahfouf 1996) + + DSMPOT = -1.0E7 ! mm air-dry water matric potential +! +!-------------------------------Executable starts here-------------------- + +! Compute soil characteristics by sand (coarse and fine-medium) and clay fraction + + CFRAC = 0.0 + SUMCSND = 0.0 + SUMFMSND = 0.0 + SUMCLY = 0.0 + TFRACBOT = 0.0 + + DO S = 1,NSCAT + + TFRACBOT = TFRACBOT + SOILCBOT(S) + SUMCSND = SUMCSND + CSAND(S) * SOILCBOT(S) + SUMFMSND = SUMFMSND + FMSAND(S) * SOILCBOT(S) + SUMCLY = SUMCLY + CLAY(S) * SOILCBOT(S) + + IF (SOILCBOT(S) .GE. CFRAC) THEN ! Find Dominant Category and fraction + ISTI = S + CFRAC = SOILCBOT(S) + ENDIF + + ENDDO + + + IF (TFRACBOT .GT. 0.001) THEN + AVCS = SUMCSND / TFRACBOT + AVFMS = SUMFMSND / TFRACBOT + AVS = AVCS + AVFMS + + AVC = SUMCLY / TFRACBOT + AVSLT = 100.0 - AVS - AVC + + IF (AVS .GT. (85.+ 0.5*AVC)) THEN + AVCLASS = 'Sand' + ISTI = 1 + ELSE IF (AVS .GT. (70.+ AVC)) THEN + AVCLASS = 'Lsan' + ISTI = 2 + ELSE IF ((AVC .LT. 20. .AND. AVS .GT. 52.) & + .OR. (AVC .LE. 7.5 .AND. AVSLT .LT. 50.)) THEN + AVCLASS = 'Sloa' + ISTI = 3 + ELSE IF (AVC .LT. 35. .AND. AVS .GT. 45. .AND. AVSLT .LT. 28.) THEN + AVCLASS = 'Sclo' + ISTI = 7 + ELSE IF (AVC .GE. 35. .AND. AVS .GT. 45.) THEN + AVCLASS = 'Sacl' + ISTI = 10 + ELSE IF (AVC .LT. 27.0 .AND. AVSLT .LT. 50.) THEN + AVCLASS = 'Loam' + ISTI = 6 + ELSE IF (AVC .LT. 12. .AND. AVSLT .GT. 80.) THEN + AVCLASS = 'Silt' + ISTI = 5 + ELSE IF (AVC .LT. 27.) THEN + AVCLASS = 'Sill' + ISTI = 4 + ELSE IF (AVC .LT. 40. .AND. AVS .GT. 20.) THEN + AVCLASS = 'Cllo' + ISTI = 9 + ELSE IF (AVC .LT. 40.) THEN + AVCLASS = 'Sicl' + ISTI = 8 + ELSE IF (AVSLT .GE. 40.) THEN + AVCLASS = 'Sicy' + ISTI = 11 + ELSE + AVCLASS = 'Clay' + ISTI = 12 + ENDIF + ELSE + ! set no soil to 9 - clay loam + ISTI = 9 + AVCLASS = TEXID(ISTI) + + AVCS = CSAND(ISTI) + AVFMS = FMSAND(ISTI) + AVS = AVCS + AVFMS + + AVC = CLAY(ISTI) + AVSLT = 100.0 - AVS - AVC + + ENDIF + + FCSAND = AVCS + FFMSAND = AVFMS + FCLAY = AVC + + ! Continuous formulation of secondary soil parameters (Noilhan and Mahfouf 1996) + FWSAT = (-1.08 * AVS + 494.305) * 1.0E-3 + FWWLT = 37.1342E-3 * SQRT(AVC) + FWFC = 89.0467E-3 * AVC**0.3496 + FB = 0.137 * AVC + 3.501 + FCGSAT= -1.557E-2 * AVS - 1.441E-2 * AVC + 4.7021 + FC1SAT= (5.58 * AVC + 84.88) * 1.0E-2 + FC2R = 13.815 * AVC**(-0.954) + FC3 = 5.327 * AVC **(-1.043) + FAS = 732.42E-3 * AVC **(-0.539) + FJP = 0.134 * AVC + 3.4 + FWRES = 0.00123 * AVC - 0.00066 * AVSLT + 0.0405 !J. Pleim fitted function + FWRES = AMAX1(FWRES, 0.01) !L. Ran set minimum + + ! Compute W2 using soil moisture availability if pxlsm_smois_init (in namelist) is not zero +#if defined(mpas) + IF ( (ITIMESTEP .EQ. 1) .AND. (PXLSM_SMOIS_INIT .EQ. 1) .AND. (.NOT. RESTART) ) THEN +#else + IF (ITIMESTEP .EQ. 1 .AND. PXLSM_SMOIS_INIT .GT. 0) THEN +#endif + WG = FWWLT + (0.5*(FWSAT+FWFC) - FWWLT) * MAVAIL + W2 = FWWLT + (0.5*(FWSAT+FWFC) - FWWLT) * MAVAIL + ENDIF + + END SUBROUTINE soilprop +!------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ + SUBROUTINE PXSNOW (ITIMESTEP, ASNOW, CSNOW, SNOW, & + SNOWH, SNUP, & + ALB, SNOALB, & + HC_SNOW, SNOW_FRA, SNOWC, SNOWALB) +!------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ +! Pleim-Xiu LSM Simple Snow model +!--------------------------------------------------------------------------------------------------- +! ITIMESTEP -- Model time step index +! ASNOW -- Analyzed snow water equivalent (mm) +! CSNOW -- Current snow water equivalent (mm) +! SNOW -- Snow water equivalent in model (mm) +! SNOWH -- Physical snow depth (m) +! SNUP -- Physical snow depth (landuse dependent) where when below, snow cover is fractional +! +! HC_SNOW -- Heat capacity of snow as a function of depth +! SNOW_FRA -- Factional snow area +! IFSNOW -- Snow flag +! SNOWALB -- Snow albedo +!--------------------------------------------------------------------------------------------------- + + IMPLICIT NONE + +!--- Arguments + REAL, PARAMETER :: W2SN_CONV = 10.0 + REAL, PARAMETER :: CS_SNOWPACK = 2092.0 + REAL, PARAMETER :: SALP = 2.6 +!----------------------------------------------- + INTEGER, INTENT(IN) :: ITIMESTEP + REAL, INTENT(IN) :: ASNOW, CSNOW, SNUP, ALB, SNOALB + REAL, INTENT(INOUT) :: SNOW, SNOWH, SNOWC + REAL, INTENT(OUT) :: HC_SNOW, SNOW_FRA, SNOWALB +!------------------------------------------------------------------------------------ + + +!----------------------------------------------- +! Local variables + !... Real + REAL:: CONV_WAT2SNOW, CSNOWW, RHO_SNOWPACK, & + LIQSN_RATIO, SNEQV, RSNOW +#if defined(mpas) + REAL:: DENW +#endif +!----------------------------------------------- +#if defined(mpas) + DENW = rho_w +#endif + + SNEQV = ASNOW*0.001 ! Snow water in meters + RHO_SNOWPACK = 450 ! Snowpack density (kg/m3), this should be computed in the future + LIQSN_RATIO = DENW/RHO_SNOWPACK ! Ratio of water density and snowpack density + + CONV_WAT2SNOW = LIQSN_RATIO/1000 ! Conversion factor for snow liquid equiv. (mm) to snowpack (m) + + SNOW = ASNOW ! Set snow water to analysis value for now, implement a nudging scheme later + SNOWH = SNOW * CONV_WAT2SNOW ! Conversion of snow water (mm) to snow depth (m) + + + ! Is snow cover now present. The limit is 0.45 mm of water eqivalent or about 2 inches snow depth + SNOWC = 0.0 + IF (SNOWH .GT. 0.005) SNOWC = 1.0 + + HC_SNOW = RHO_SNOWPACK * CS_SNOWPACK * SNOWH + + IF (SNEQV .LT. SNUP) THEN + RSNOW = SNEQV / SNUP + SNOW_FRA = 1. - ( EXP ( - SALP * RSNOW) - RSNOW * EXP ( - SALP)) + ELSE + SNOW_FRA = 1.0 + END IF + + SNOWC = SNOW_FRA + + SNOWALB = ALB + SNOWC*(SNOALB-ALB) + + END SUBROUTINE pxsnow +!------------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------------ + +END MODULE module_sf_pxlsm + diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_pxlsm_data.F b/src/core_atmosphere/physics/physics_wrf/module_sf_pxlsm_data.F new file mode 100644 index 0000000000..e9def75186 --- /dev/null +++ b/src/core_atmosphere/physics/physics_wrf/module_sf_pxlsm_data.F @@ -0,0 +1,639 @@ +!WRF:MODEL_LAYER:PHYSICS +! +! RG 10/2014 - Added LU-based SNOALB that is used for LU fraction weighted value if specificed. +! +! + +MODULE module_sf_pxlsm_data + +!***************************************************************************** +! MODIS-ONLY (1XX)/MODIS (2XX) LU characterization ... +!------------------------------------------------------------------------------- +!Index Rstmin Zo Mxfr MnFr MxLA MnLA SNUP ALB SNOALB +! 1 175. 100. 93. 93. 5.5 3.5 0.08 12. 30. Evergreen Needleleaf Forest +! 2 120. 90. 92. 92. 6.0 3.5 0.08 12. 30. Evergreen Broadleaf Forest +! 3 175. 100. 60. 60. 3.0 1.5 0.08 14. 30. Deciduous Needleleaf Forest +! 4 200. 100. 91. 91. 6.0 1.5 0.08 16. 40. Deciduous Broadleaf Forest' +! 5 200. 100. 92. 92. 5.5 2.2 0.08 13. 35. Mixed Forest +! 6 200. 15. 40. 20. 1.5 1.0 0.03 22. 50. Closed Shrublands +! 7 200. 15. 40. 17. 1.5 1.3 0.035 20. 60. Open Shrublands +! 8 150. 25. 70. 60. 2.3 2.0 0.03 22. 50. Woody Savanna +! 9 120. 15. 70. 40. 1.5 0.5 0.04 20. 50. Savanna +!------------------------------------------------------------------------------- +! 10 100. 7. 50. 20. 1.5 0.5 0.04 19. 70. Grasslands +! 11 200 20. 65. 35. 2.5 1.0 0.08 15. 50. Perminent Wetlands +! 12 70. 10. 90. 20. 3.5 0.7 0.04 18. 66. Croplands +! 13 150. 80. 5. 5. 2.0 0.5 0.04 11. 46. Urban andBuilt-up' +! 14 100. 30. 80. 40. 3.5 1.0 0.04 18. 68. Cropland/Natural Vegetation Mosaic +! 15 9999. 1.2 0.1 0.1 0.1 0.1 0.02 60. 82. Snow and Ice +! 16 100. 5. 0.5 0.5 0.2 0.1 0.02 25. 75. Barren or Sparsely Vegetated +! 17 9999. 0.1 00. 00. 0.0 0.0 0.01 8.0 08. IGBP water +! 18 175. 30. 70. 50. 3.4 2.0 0.80 15. 45. wooded tundra +! 19 120. 15. 40. 20. 2.4 1.0 0.40 15. 50. mixed tundra +! 20 100. 10. 20. 5. 1.4 0.1 .015 25. 75. barren tundra +!------------------------------------------------------------------------------------ +!**************************************************************************************** +!**************************************************************************************** + REAL, DIMENSION(21), TARGET :: RSMIN_MODIS, Z00_MODIS, & + VEG0_MODIS, VEGMN0_MODIS, & + LAI0_MODIS, LAIMN0_MODIS, & + SNUP0_MODIS, ALBF_MODIS, & + SNOALB_MODIS + + DATA RSMIN_MODIS & + / 175.0, 120.0, 175.0, 200.0, 200.0, & + 200.0, 200.0, 150.0, 120.0, 100.0, & + 200.0, 70.0, 150.0, 100.0, 9999.0, & + 100.0, 9999.0, 175.0, 120.0, 100.0, 9999.0 / + + DATA Z00_MODIS & + / 100.0, 90.0, 100.0, 100.0, 100.0, & + 15.0, 15.0, 25.0, 15.0, 7.0, & + 20.0, 10.0, 80.0, 30.0, 1.2, & + 5.0, 0.1, 30.0, 15.0, 10.0, 0.1 / + + DATA VEG0_MODIS & + / 93.0, 92.0, 60.0, 91.0, 92.0, & + 40.0, 20.0, 70.0, 70.0, 50.0, & + 65.0, 90.0, 5.0, 80.0, 0.1, & + 0.5, 0.0, 70.0, 40.0, 20.0, 0.0 / + + DATA VEGMN0_MODIS & + / 93.0, 92.0, 60.0, 91.0, 92.0, & + 20.0, 10.0, 60.0, 40.0, 20.0, & + 35.0, 20.0, 5.0, 40.0, 0.1, & + 0.5, 0.0, 50.0, 20.0, 5.0, 0.0 / + + DATA LAI0_MODIS & + / 5.5, 6.0, 3.0, 6.0, 5.5, & + 1.5, 1.5, 2.3, 1.5, 1.5, & + 2.5, 3.5, 2.0, 3.5, 0.1, & + 0.2, 0.0, 3.4, 2.4, 1.4, 0.0 / + + DATA LAIMN0_MODIS & + / 3.5, 3.5, 1.5, 2.0, 2.5, & + 1.0, 1.3, 2.0, 1.5, 1.5, & + 2.0, 1.5, 1.5, 1.5, 0.1, & + 0.1, 0.0, 2.0, 1.0, 0.1, 0.0 / + + DATA SNUP0_MODIS & + / 0.08, 0.08, 0.08, 0.08, 0.08, & + 0.03, 0.035, 0.03, 0.04, 0.04, & + 0.08, 0.04, 0.04, 0.04, 0.02, & + 0.02, 0.01, 0.80, 0.40, 0.015, 0.01 / + + DATA ALBF_MODIS & + / 12.0, 12.0, 14.0, 16.0, 13.0, & + 22.0, 20.0, 22.0, 20.0, 19.0, & + 17.0, 18.0, 11.0, 18.0, 60.0, & + 25.0, 8.0, 15.0, 15.0, 25.0, 8.0 / + + DATA SNOALB_MODIS & + / 30.0, 30.0, 30.0, 40.0, 35.0, & + 50.0, 60.0, 50.0, 50.0, 70.0, & + 50.0, 66.0, 46.0, 68.0, 82.0, & + 75.0, 8.0, 45.0, 55.0, 75.0, 8.0 / + +!**************************************************************************************** +!**************************************************************************************** +! 50 CLASS NLCD (US only, cats 1-30)/MODIS (Outside US, cats 31-50) LU characterization +!--------------------------------------------------------------------------------------- +!Index Rstmin Zo Mxfr MnFr MxLA MnLA ALB SNOALB Cat Desc. +! 1 9999. 0.1 00. 00. 0.0 0.0 8 70. Open water +! 2 9999. 1.2 5. 02. 0.1 0.1 60 82. Perennial Ice/snow +! 3 120. 30. 90. 80. 3.0 1.0 12 60. Developed, Open space +! 4 120. 40. 70 60. 3.0 1.0 11 46. Developed, Low Intensity +! 5 140. 60. 40. 30. 3.0 1.0 10 43. Developed, Medium Intensity +! 6 160. 100. 15. 5. 3.0 1.0 10 40. Developed, High Intensity +! 7 100. 5. 20. 5. 1.0 0.5 20 75. Barren land +! 8 100. 5. 15. 5. 0.5 0.2 35 75. Unconsolidated Shore +! 9 200. 100. 95. 50. 5.0 1.0 15 40. Deciduous Forest +! 10 175. 100. 90. 80. 4.0 3.0 10 30. Evergreen Forest +!------------------------------------------------------------------------------- +! 11 200. 100. 95. 60. 5.0 2.0 13 35. Mixed Forest +! 12 200. 10. 50. 20. 2.0 1.0 20 65. Dwarf Scrub +! 13 200. 15. 75. 50. 2.5 1.0 20 60. Shrub/Scrub +! 14 100. 7. 85. 60. 2.5 1.0 19 70. Grassland/Herbaceous +! 15 100. 7. 80. 20. 2.0 1.0 23 60. Sedge/Herbaceous +! 16 100. 5. 80. 20. 1.0 1.0 20 60. Lichens +! 17 100. 5. 80. 20. 1.0 1.0 20 60. Moss +! 18 100. 5. 50. 20. 1.0 1.0 15 75. Tundra +! 19 80. 7. 95. 80. 3.0 1.0 18 68. Pasture/Hay' +! 20 70. 10. 95. 10. 3.0 0.5 18 66. Cultivated Crops +!------------------------------------------------------------------------------- +! 21 200. 55. 90. 80. 5.0 2.0 15 40. Woody Wetland +! 22 200. 80. 90. 80. 5.0 2.0 15 40. Palustrine Forested Wetland +! 23 164. 30. 90. 80. 3.0 1.0 15 50. Palustrine Scrub/Shrub Wetland +! 24 200. 60. 90. 80. 5.0 2.0 15 50. Estuarine Forested Wetland +! 25 164. 30. 90. 80. 3.0 1.0 15 50. Estuarine Scrub/Shrub Wetland +! 26 120. 11. 85. 40. 2.0 1.0 18 59. Emergent Herbaceous Wetland +! 27 120. 11. 85. 40. 2.0 1.0 18 59. Palustrine Emergent Wetland +! 28 120. 11. 85. 40. 2.0 1.0 18 59. Estuarine Emergent Wetland +! 29 100. 5. 60. 20. 1.0 0.5 10 50. Palustrine Aquatic Bed +! 30 100. 5. 60. 20. 1.0 0.5 10 50. Estuarine Aquatic Bed +!------------------------------------------------------------------------------- +! 31 9999. 0.1 00. 00. 0.0 0.0 8 8. Open water (mapped to 1) +! 32 175. 100. 90. 80. 4.0 3.0 12 30. Evergreen Needleleaf Forest +! 33 120. 90. 95. 85. 5.0 4.0 12 30. Evergreen Broadleaf Forest +! 34 175. 100. 95. 50. 5.0 1.0 14 40. Deciduous Needleleaf Forest +! 35 200. 100. 95. 50. 5.0 1.0 16 40. Deciduous Broadleaf Forest' +! 36 200. 100. 95. 60. 5.0 2.0 13 35. Mixed Forest +! 37 200. 15. 90. 50. 3.0 1.0 22 50. Closed Shrublands +! 38 200. 15. 75. 50. 2.5 1.0 20 60. Open Shrublands +! 39 150. 25. 80. 60. 2.5 1.0 22 50. Woody Savanna +! 40 120. 15. 70. 50 2.0 1.0 20 50. Savanna +!------------------------------------------------------------------------------- +! 41 100. 7. 85. 60. 2.5 1.0 19 70. Grasslands +! 42 160. 20. 75. 45. 3.0 1.0 14 59. Perminent Wetlands +! 43 70. 10. 95. 10. 3.0 0.5 18 66. Croplands +! 44 150. 80. 40. 20. 3.0 1.0 11 46. Urban andBuilt-up' +! 45 100. 30. 95. 40. 3.0 1.0 18 68. Cropland/Natural Vegetation Mosaic +! 46 9999. 1.2 5. 02. 0.1 0.1 60 82. Snow and Ice +! 47 100. 5. 20. 5. 1.0 0.5 25 75. Barren or Sparsely Vegetated +! 48 9999. 0.1 00. 00. 0.0 0.0 8 08. IGBP water +! 49 9999. 0.1 00. 00. 0.0 0.0 8 60. unclassified +! 50 9999. 0.1 00. 00. 0.0 0.0 8 75. fill value (normally ocean water) +!------------------------------------------------------------------------------------ + + REAL, DIMENSION(50), TARGET :: RSMIN_NLCD50, Z00_NLCD50, & + VEG0_NLCD50, VEGMN0_NLCD50, & + LAI0_NLCD50, LAIMN0_NLCD50, & + SNUP0_NLCD50, ALBF_NLCD50, & + SNOALB_NLCD50 + + DATA RSMIN_NLCD50 & + / 9999.0, 9999.0, 120.0, 120.0, 140.0, & + 160.0, 100.0, 100.0, 200.0, 175.0, & + 200.0, 200.0, 200.0, 100.0, 100.0, & + 100.0, 100.0, 100.0, 80.0, 70.0, & + 200.0, 200.0, 164.0, 200.0, 164.0, & + 120.0, 120.0, 120.0, 100.0, 100.0, & + 9999.0, 175.0, 120.0, 175.0, 200.0, & + 200.0, 200.0, 200.0, 150.0, 120.0, & + 100.0, 160.0, 70.0, 150.0, 100.0, & + 9999.0, 100.0, 9999.0, 9999.0, 9999.0 / + + DATA Z00_NLCD50 & + / 0.10, 1.20, 30.0, 40.0, 60.0, & + 100.0, 5.0, 5.0, 100.0, 100.0, & + 100.0, 10.0, 15.0, 7.0, 7.0, & + 5.0, 5.0, 5.0, 7.0, 10.0, & + 55.0, 80.0, 30.0, 60.0, 30.0, & + 11.0, 11.0, 11.0, 5.0, 5.0, & + 0.1, 100.0, 90.0, 100.0, 100.0, & + 100.0, 15.0, 15.0, 25.0, 15.0, & + 7.0, 20.0, 10.0, 80.0, 30.0, & + 1.2, 5.0, 0.1, 0.1, 0.1 / + + DATA VEG0_NLCD50 & + / 00.0, 5.0, 90.0, 70.0, 40.0, & + 15.0, 20.0, 15.0, 95.0, 90.0, & + 95.0, 50.0, 75.0, 85.0, 80.0, & + 80.0, 80.0, 50.0, 95.0, 95.0, & + 90.0, 90.0, 90.0, 90.0, 90.0, & + 85.0, 85.0, 85.0, 60.0, 60.0, & + 0.0, 90.0, 95.0, 95.0, 95.0, & + 95.0, 90.0, 75.0, 80.0, 70.0, & + 85.0, 75.0, 95.0, 40.0, 95.0, & + 5.0, 20.0, 0.0, 0.0, 0.0 / + + DATA VEGMN0_NLCD50 & + / 00.0, 2.0, 80.0, 60.0, 30.0, & + 05.0, 05.0, 5.0, 50.0, 80.0, & + 60.0, 20.0, 50.0, 60.0, 20.0, & + 20.0, 20.0, 20.0, 80.0, 10.0, & + 80.0, 80.0, 80.0, 80.0, 80.0, & + 40.0, 40.0, 40.0, 20.0, 20.0, & + 0.0, 80.0, 85.0, 50.0, 50.0, & + 60.0, 50.0, 50.0, 60.0, 50.0, & + 60.0, 45.0, 10.0, 20.0, 40.0, & + 2.0, 5.0, 0.0, 0.0, 0.0 / + + DATA LAI0_NLCD50 & + / 0.0, 0.1, 3.0, 3.0, 3.0, & + 3.0, 1.0, 0.5, 5.0, 4.0, & + 5.0, 2.0, 2.5, 2.5, 2.0, & + 1.0, 1.0, 1.0, 3.0, 3.0, & + 5.0, 5.0, 3.0, 5.0, 3.0, & + 2.0, 2.0, 2.0, 1.0, 1.0, & + 0.0, 4.0, 5.0, 5.0, 5.0, & + 5.0, 3.0, 2.5, 2.5, 2.0, & + 2.5, 3.0, 3.0, 3.0, 3.0, & + 0.1, 1.0, 0.0, 0.0, 0.0 / + + DATA LAIMN0_NLCD50 & + / 0.0, 0.1, 1.0, 1.0, 1.0, & + 1.0, 0.5, 0.2, 1.0, 3.0, & + 2.0, 1.0, 1.0, 1.0, 1.0, & + 1.0, 1.0, 1.0, 1.0, 0.5, & + 2.0, 2.0, 1.0, 2.0, 1.0, & + 1.0, 1.0, 1.0, 0.5, 0.5, & + 0.0, 3.0, 4.0, 1.0, 1.0, & + 2.0, 1.0, 1.0, 1.0, 1.0, & + 1.0, 1.0, 0.5, 1.0, 1.0, & + 0.1, 0.5, 0.0, 0.0, 0.0 / + + DATA SNUP0_NLCD50 & + / 0.01, 0.02, 0.04, 0.04, 0.04, & + 0.04, 0.02, 0.02, 0.08, 0.08, & + 0.08, 0.04, 0.04, 0.04, 0.01, & + 0.01, 0.01, 0.02, 0.04, 0.04, & + 0.08, 0.08, 0.04, 0.08, 0.04, & + 0.04, 0.06, 0.06, 0.02, 0.02, & + 0.08, 0.08, 0.08, 0.08, 0.08, & + 0.08, 0.03, 0.035, 0.03, 0.04, & + 0.04, 0.015, 0.04, 0.04, 0.04, & + 0.02, 0.02, 0.01, 0.01, 0.01 / + + DATA ALBF_NLCD50 & + / 8.0, 60.0, 12.0, 11.0, 10.0, & + 10.0, 20.0, 35.0, 15.0, 10.0, & + 13.0, 20.0, 20.0, 19.0, 23.0, & + 20.0, 20.0, 15.0, 18.0, 18.0, & + 15.0, 15.0, 15.0, 15.0, 15.0, & + 18.0, 18.0, 18.0, 10.0, 10.0, & + 8.0, 12.0, 12.0, 14.0, 16.0, & + 13.0, 22.0, 20.0, 22.0, 20.0, & + 19.0, 14.0, 18.0, 11.0, 18.0, & + 60.0, 25.0, 8.0, 8.0, 8.0 / + + DATA SNOALB_NLCD50 & + / 70.0, 82.0, 60.0, 46.0, 43.0, & + 40.0, 75.0, 75.0, 40.0, 30.0, & + 35.0, 65.0, 60.0, 70.0, 60.0, & + 60.0, 60.0, 75.0, 68.0, 66.0, & + 40.0, 40.0, 50.0, 50.0, 50.0, & + 59.0, 59.0, 59.0, 50.0, 50.0, & + 8.0, 30.0, 30.0, 40.0, 40.0, & + 35.0, 50.0, 60.0, 50.0, 50.0, & + 70.0, 59.0, 66.0, 46.0, 68.0, & + 82.0, 75.0, 8.0, 60.0, 75.0 / + +!**************************************************************************************** +!**************************************************************************************** + + +!**************************************************************************************** +!**************************************************************************************** +! 40 CLASS MODIS (Outside US, cats 1-20)/NLCD (US only, cats 21-40) LU characterization +!------------------------------------------------------------------------------- +!Index Rstmin Zo Mxfr MnFr MxLA MnLA SNUP ALB SNOALB +! 1 175. 100. 93. 93. 5.5 3.5 0.08 12. 30. Evergreen Needleleaf Forest +! 2 120. 90. 92. 92. 6.0 3.5 0.08 12. 30. Evergreen Broadleaf Forest +! 3 175. 100. 60. 60. 3.0 1.5 0.08 14. 30. Deciduous Needleleaf Forest +! 4 200. 100. 91. 91. 6.0 2.0 0.08 16. 40. Deciduous Broadleaf Forest' +! 5 200. 100. 92. 92. 5.5 2.5 0.08 13. 35. Mixed Forest +! 6 200. 15. 40. 20. 1.5 1.0 0.03 22. 50. Closed Shrublands +! 7 200. 15. 20. 10. 1.5 1.3 0.035 20. 60. Open Shrublands +! 8 150. 25. 70. 60. 2.3 2.0 0.03 22. 50. Woody Savanna +! 9 120. 15. 70. 40. 1.5 1.5 0.04 20. 50. Savanna +!------------------------------------------------------------------------------- +! 10 100. 7. 50. 20. 1.5 1.5 0.04 19. 70. Grasslands +! 11 200 20. 65. 35. 2.5 2.0 0.08 15. 50. Perminent Wetlands +! 12 70. 10. 90. 20. 3.5 1.5 0.04 18. 66. Croplands +! 13 150. 80. 5. 5. 2.0 1.5 0.04 11. 46. Urban andBuilt-up' +! 14 100. 30. 80. 40. 3.5 1.5 0.04 18. 68. Cropland/Natural Vegetation Mosaic +! 15 9999. 1.2 0.1 0.1 0.1 0.1 0.02 60. 82. Snow and Ice +! 16 100. 5. 0.5 0.5 0.2 0.1 0.02 25. 75. Barren or Sparsely Vegetated +! 17 9999. 0.1 00. 00. 0.0 0.0 0.01 8.0 08. IGBP water +! 18 175. 30. 70. 50. 3.4 2.0 0.80 15. 45. wooded tundra +! 19 120. 15. 40. 20. 2.4 1.0 0.40 15. 50. mixed tundra +! 20 100. 10. 20. 5. 1.4 0.1 .015 25. 75. barren tundra +! 21 9999. 0.1 00. 00. 0.0 0.0 0.01 8.0 08. Open water +! 22 9999. 1.2 0.1 0.1 0.1 0.1 0.02 60. 82. Perennial Ice/snow +! 23 120. 30. 25. 25. 5.5 1.7 0.04 16. 60. Developed, Open space +! 24 120. 80. 15. 15. 3.0 1.7 0.04 13. 46. Developed, Low Intensity +! 25 140. 120. 5. 5. 2.5 1.7 0.04 11. 43. Developed, Medium Intensity +! 26 160. 200. 1. 1. 2.5 2.0 0.04 10. 40. Developed, High Intensity +! 27 100. 5. 0.5 0.5 0.2 0.1 0.02 20. 75. Barren land +! 28 200. 100. 91. 91. 6.0 2.0 0.08 15. 40. Deciduous Forest +! 29 175. 100. 93. 93. 5.5 3.5 0.08 12. 30. Evergreen Forest +!------------------------------------------------------------------------------- +! 30 200. 100. 92. 92. 5.5 2.5 0.08 13. 35. Mixed Forest +! 31 200. 10. 15. 10. 1.0 1.0 0.04 20. 65. Dwarf Scrub +! 32 200. 15. 20. 10. 1.5 1.3 0.04 20. 60. Shrub/Scrub +! 33 100. 7. 50. 20. 2.0 1.5 0.04 19. 70. Grassland/Herbaceous +! 34 100. 7. 30. 20. 2.0 1.5 0.01 23. 60. Sedge/Herbaceous +! 35 100. 5. 20. 20. 1.0 1.0 0.01 20. 60. Lichens +! 36 100. 5. 20. 20. 1.0 1.0 0.01 20. 60. Moss +! 37 80. 7. 80. 10. 3.5 1.5 0.04 18. 68. Pasture/Hay' +! 38 70. 10. 90. 10. 4.0 1.5 0.04 18. 66. Cultivated Crops +!------------------------------------------------------------------------------- +! 39 200. 55. 92. 50. 5.5 2.2 0.08 15. 40. Woody Wetland +! 40 120. 11. 50. 30. 3.0 2.0 0.04 18. 50. Emergent Herbaceous Wetland +!------------------------------------------------------------------------------------ + + REAL, DIMENSION(40), TARGET :: RSMIN_NLCD40, Z00_NLCD40, & + VEG0_NLCD40, VEGMN0_NLCD40, & + LAI0_NLCD40, LAIMN0_NLCD40, & + SNUP0_NLCD40, ALBF_NLCD40, & + SNOALB_NLCD40 + + DATA RSMIN_NLCD40 & + / 175.0, 120.0, 175.0, 200.0, 200.0, & + 200.0, 200.0, 150.0, 120.0, 100.0, & + 200.0, 70.0, 150.0, 100.0, 9999.0, & + 100.0, 9999.0, 175.0, 120.0, 100.0, & + 9999.0, 9999.0, 120.0, 120.0, 140.0, & + 160.0, 100.0, 200.0, 175.0, 200.0, & + 200.0, 200.0, 100.0, 100.0, 100.0, & + 100.0, 80.0, 70.0, 200.0, 120.0 / + + DATA Z00_NLCD40 & + / 100.0, 90.0, 100.0, 100.0, 100.0, & + 15.0, 15.0, 25.0, 15.0, 7.0, & + 20.0, 10.0, 80.0, 30.0, 1.2, & + 5.0, 0.1, 30.0, 15.0, 10.0, & + 0.10, 1.20, 30.0, 80.0, 120.0, & + 200.0, 5.0, 100.0, 100.0, 100.0, & + 10.0, 15.0, 7.0, 7.0, 5.0, & + 5.0, 7.0, 10.0, 55.0, 11.0 / + + DATA VEG0_NLCD40 & + / 93.0, 92.0, 60.0, 91.0, 92.0, & + 40.0, 20.0, 70.0, 70.0, 50.0, & + 65.0, 90.0, 5.0, 80.0, 0.1, & + 0.5, 0.0, 70.0, 40.0, 20.0, & + 0.0, 0.1, 25.0, 15.0, 5.0, & + 1.0, 0.5, 91.0, 93.0, 92.0, & + 15.0, 20.0, 50.0, 30.0, 20.0, & + 20.0, 80.0, 90.0, 92.0, 50.0 / + + DATA VEGMN0_NLCD40 & + / 93.0, 92.0, 60.0, 91.0, 92.0, & + 20.0, 10.0, 60.0, 40.0, 20.0, & + 35.0, 20.0, 5.0, 40.0, 0.1, & + 0.5, 0.0, 50.0, 20.0, 5.0, & + 0.0, 0.1, 25.0, 15.0, 5.0, & + 1.0, 0.5, 91.0, 93.0, 92.0, & + 10.0, 10.0, 20.0, 20.0, 20.0, & + 20.0, 10.0, 10.0, 50.0, 30.0 / + + DATA LAI0_NLCD40 & + / 5.5, 6.0, 3.0, 6.0, 5.5, & + 1.5, 1.5, 2.3, 1.5, 1.5, & + 2.5, 3.5, 2.0, 3.5, 0.1, & + 0.2, 0.0, 3.4, 2.4, 1.4, & + 0.0, 0.1, 5.5, 3.0, 2.5, & + 2.5, 0.2, 6.0, 5.5, 5.5, & + 1.0, 1.5, 2.0, 2.0, 1.0, & + 1.0, 3.5, 4.0, 5.5, 3.0 / + + DATA LAIMN0_NLCD40 & + / 3.5, 3.5, 1.5, 2.0, 2.5, & + 1.0, 1.3, 2.0, 1.5, 1.5, & + 2.0, 1.5, 1.5, 1.5, 0.1, & + 0.1, 0.0, 2.0, 1.0, 0.1, & + 0.0, 0.1, 1.7, 1.7, 1.7, & + 2.0, 0.1, 2.0, 3.5, 2.5, & + 1.0, 1.3, 1.5, 1.5, 1.0, & + 1.0, 1.5, 1.5, 2.2, 2.0 / + + DATA SNUP0_NLCD40 & + / 0.08, 0.08, 0.08, 0.08, 0.08, & + 0.03, 0.035, 0.03, 0.04, 0.04, & + 0.08, 0.04, 0.04, 0.04, 0.02, & + 0.02, 0.01, 0.80, 0.40, 0.015, & + 0.01, 0.02, 0.04, 0.04, 0.04, & + 0.04, 0.02, 0.08, 0.08, 0.08, & + 0.04, 0.04, 0.04, 0.01, 0.01, & + 0.01, 0.04, 0.04, 0.08, 0.04 / + + DATA ALBF_NLCD40 & + / 12.0, 12.0, 14.0, 16.0, 13.0, & + 22.0, 20.0, 22.0, 20.0, 19.0, & + 17.0, 18.0, 11.0, 18.0, 60.0, & + 25.0, 8.0, 15.0, 15.0, 25.0, & + 8.0, 60.0, 12.0, 11.0, 10.0, & + 10.0, 20.0, 15.0, 12.0, 13.0, & + 20.0, 20.0, 19.0, 23.0, 20.0, & + 20.0, 18.0, 18.0, 15.0, 18.0 / + + DATA SNOALB_NLCD40 & + / 30.0, 30.0, 30.0, 40.0, 35.0, & + 50.0, 60.0, 50.0, 50.0, 70.0, & + 50.0, 66.0, 46.0, 68.0, 82.0, & + 75.0, 8.0, 45.0, 50.0, 75.0, & + 8.0, 82.0, 60.0, 46.0, 43.0, & + 40.0, 75.0, 40.0, 30.0, 35.0, & + 65.0, 60.0, 70.0, 60.0, 60.0, & + 60.0, 68.0, 66.0, 40.0, 50.0 / + +!**************************************************************************************** +!**************************************************************************************** +! USGS LU characterization +!--------------------------- +! Name Rstmin Zo Mxfr MnFr MxLA MnLA ALB SNOALB +! 1 Urban 150. 50. 40. 20. 2.0 0.5 15 46. Urban or Built-up Land +! 2 DrCrp 70. 10. 95. 15. 3.0 0.5 17 66. Dryland Cropland and Pasture +! 3 IrCrp 60. 10. 95. 10. 3.0 0.5 18 66. Irrigated Cropland and Pasture +! 4 MixCp 70. 10. 95. 15. 3.0 0.5 18 66. Mixed Dry/Irr Crop and Past +! 5 CrGrM 80. 10. 95. 35. 2.5 1.0 18 70. Grassland/Cropland Mosaic +! 6 CrWdM 180. 40. 95. 40. 4.0 1.5 16 50. Woodland/Cropland Mosaic +! 7 GrsLd 100. 7. 95. 70. 2.5 1.0 19 70. Grassland +! 8 ShrLd 200. 20. 70. 50. 3.0 1.0 22 50. Shrubland +! 9 ShrGr 150. 20. 85. 60. 3.0 1.0 20 60. Mixed Shrubland/Grassland +! 10 Savan 120. 20. 80. 60. 2.0 1.0 20 50. Savanna +! 11 DBFst 200. 50. 95. 50. 5.0 1.0 16 40. Broadleaf Deciduous Forest +! 12 DNFst 175. 50. 95. 50. 5.0 1.0 14 30. Deciduous Coniferous Forest +! 13 EBFst 120. 40. 95. 85. 5.0 4.0 12 30. Evergreen Broadleaf Forest (Palm?) +! 14 ENFst 175. 50. 90. 80. 4.0 3.0 12 30. Evergreen Coniferous Forest +! 15 MxFst 200. 50. 95. 60. 5.0 2.0 13 35. Mixed forest +! 16 Water 9999. 0.1 00. 00. 0.0 0.0 08 08. Water +! 17 HWtld 164. 15. 60. 40. 2.0 1.0 14 50. Herbaceous Wetland (none in east) +! 18 WWtld 200. 45. 90. 80. 5.0 3.0 14 40. Forested Wetlands (e.g. Everglades) +! 19 BarSp 100. 5. 10. 05. 0.5 0.2 25 75. Barren or Sparsely Vegetated +! 20 HrTun 150. 10. 20. 10. 1.0 0.5 15 55. Herbaceous Tundra +! 21 WdTun 200. 10. 30. 10. 1.0 0.5 15 60. Shrub and Brush Tundra +! 22 MxTun 150. 5. 20. 05. 1.0 0.5 15 60. Mixed Tundra +! 23 BGTun 100. 5. 5. 02. 0.1 0.1 25 75. Bare Ground Tundra +! 24 SnwIc 300. 5. 5. 02. 0.1 0.1 55 82. Perennial Snowfields or Glaciers +!----------------------------------------------------------------------------- + + REAL, DIMENSION(24), TARGET :: RSMIN_USGS, Z00_USGS, & + VEG0_USGS, VEGMN0_USGS, & + LAI0_USGS, LAIMN0_USGS, & + SNUP0_USGS, ALBF_USGS, & + SNOALB_USGS + + DATA RSMIN_USGS & + / 150.0, 70.0, 60.0, 70.0, 80.0, & + 180.0, 100.0, 200.0, 150.0, 120.0, & + 200.0, 175.0, 120.0, 175.0, 200.0, & + 9999.0, 164.0, 200.0, 100.0, 150.0, & + 200.0, 150.0, 100.0, 300.0 / + + DATA Z00_USGS & + / 50.0, 10.0, 10.0, 10.0, 10.0, & + 40.0, 7.0, 20.0, 20.0, 20.0, & + 50.0, 50.0, 40.0, 50.0, 50.0, & + 0.1, 15.0, 45.0, 5.0, 10.0, & + 10.0, 5.0, 5.0, 5.0 / + + DATA VEG0_USGS & + / 40.0, 95.0, 95.0, 95.0, 95.0, & + 95.0, 95.0, 70.0, 85.0, 80.0, & + 95.0, 95.0, 95.0, 90.0, 95.0, & + 0.00, 60.0, 90.0, 10.0, 20.0, & + 30.0, 20.0, 5.0, 5.0 / + + DATA VEGMN0_USGS & + / 20.0, 15.0, 10.0, 15.0, 35.0, & + 40.0, 70.0, 50.0, 60.0, 60.0, & + 50.0, 50.0, 85.0, 80.0, 60.0, & + 0.0, 40.0, 80.0, 5.0, 10.0, & + 10.0, 5.0, 2.0, 2.0 / + + DATA LAI0_USGS & + / 2.0, 3.0, 3.0, 3.0, 2.5, & + 4.0, 2.5, 3.0, 3.0, 2.0, & + 5.0, 5.0, 5.0, 4.0, 5.0, & + 0.0, 2.0, 5.0, 0.50, 1.0, & + 1.0, 1.0, 0.1, 0.1 / + + DATA LAIMN0_USGS & + / 0.50, 0.50, 0.50, 0.50, 1.0, & + 1.5, 1.0, 1.0, 1.0, 1.0, & + 1.0, 1.0, 4.0, 3.0, 2.0, & + 0.0, 1.0, 3.0, 0.20, 0.50, & + 0.50, 0.50, 0.10, 0.10 / + + DATA SNUP0_USGS & + / 0.04, 0.04, 0.04, 0.04, 0.04, & + 0.04, 0.04, 0.03, 0.035, 0.04, & + 0.08, 0.08, 0.08, 0.08, 0.08, & + 0.01, 0.01, 0.01, 0.02, 0.02, & + 0.025, 0.025, 0.025, 0.02 / + + DATA ALBF_USGS & + / 15.0, 17.0, 18.0, 18.0, 18.0, & + 16.0, 19.0, 22.0, 20.0, 20.0, & + 16.0, 14.0, 12.0, 12.0, 13.0, & + 8.0, 14.0, 14.0, 25.0, 15.0, & + 15.0, 15.0, 25.0, 55.0 / + + DATA SNOALB_USGS & + / 46.0, 66.0, 66.0, 66.0, 70.0, & + 50.0, 70.0, 50.0, 60.0, 50.0, & + 40.0, 40.0, 40.0, 30.0, 35.0, & + 8.0, 50.0, 40.0, 75.0, 55.0, & + 60.0, 60.0, 75.0, 82.0 / + +!**************************************************************************************** +!**************************************************************************************** +!**************************************************************************************** +! USGS LU characterization +!--------------------------- +! Name Rstmin Zo Mxfr MnFr MxLA MnLA ALB SNOALB +! 1 Urban 150. 50. 40. 20. 2.0 0.5 15 46. Urban or Built-up Land +! 2 DrCrp 70. 10. 95. 15. 3.0 0.5 17 66. Dryland Cropland and Pasture +! 3 IrCrp 60. 10. 95. 10. 3.0 0.5 18 66. Irrigated Cropland and Pasture +! 4 MixCp 70. 10. 95. 15. 3.0 0.5 18 66. Mixed Dry/Irr Crop and Past +! 5 CrGrM 80. 10. 95. 35. 2.5 1.0 18 70. Grassland/Cropland Mosaic +! 6 CrWdM 180. 40. 95. 40. 4.0 1.5 16 50. Woodland/Cropland Mosaic +! 7 GrsLd 100. 7. 95. 70. 2.5 1.0 19 70. Grassland +! 8 ShrLd 200. 20. 70. 50. 3.0 1.0 22 50. Shrubland +! 9 ShrGr 150. 20. 85. 60. 3.0 1.0 20 60. Mixed Shrubland/Grassland +! 10 Savan 120. 20. 80. 60. 2.0 1.0 20 50. Savanna +! 11 DBFst 200. 50. 95. 50. 5.0 1.0 16 40. Broadleaf Deciduous Forest +! 12 DNFst 175. 50. 95. 50. 5.0 1.0 14 30. Deciduous Coniferous Forest +! 13 EBFst 120. 40. 95. 85. 5.0 4.0 12 30. Evergreen Broadleaf Forest (Palm?) +! 14 ENFst 175. 50. 90. 80. 4.0 3.0 12 30. Evergreen Coniferous Forest +! 15 MxFst 200. 50. 95. 60. 5.0 2.0 13 35. Mixed forest +! 16 Water 9999. 0.1 00. 00. 0.0 0.0 08 08. Water +! 17 HWtld 164. 15. 60. 40. 2.0 1.0 14 50. Herbaceous Wetland (none in east) +! 18 WWtld 200. 45. 90. 80. 5.0 3.0 14 40. Forested Wetlands (e.g. Everglades) +! 19 BarSp 100. 5. 10. 05. 0.5 0.2 25 75. Barren or Sparsely Vegetated +! 20 HrTun 150. 10. 20. 10. 1.0 0.5 15 55. Herbaceous Tundra +! 21 WdTun 200. 10. 30. 10. 1.0 0.5 15 60. Shrub and Brush Tundra +! 22 MxTun 150. 5. 20. 05. 1.0 0.5 15 60. Mixed Tundra +! 23 BGTun 100. 5. 5. 02. 0.1 0.1 25 75. Bare Ground Tundra +! 24 SnwIc 300. 5. 5. 02. 0.1 0.1 55 82. Perennial Snowfields or Glaciers +! 25 playa 100. 5. 10. 05. 0.5 0.2 25 75. Playa +! 26 lava 100. 5. 10. 05. 0.5 0.2 25 75. Lava +! 27 sand 100. 5. 10. 05. 0.5 0.2 25 75. White Sand +! 28 nana 100. 5. 10. 05. 0.5 0.2 25 75. Unassigned +!----------------------------------------------------------------------------- + + REAL, DIMENSION(28), TARGET :: RSMIN_USGS28, Z00_USGS28, & + VEG0_USGS28, VEGMN0_USGS28, & + LAI0_USGS28, LAIMN0_USGS28, & + SNUP0_USGS28, ALBF_USGS28, & + SNOALB_USGS28 + + DATA RSMIN_USGS28 & + / 150.0, 70.0, 60.0, 70.0, 80.0, & + 180.0, 100.0, 200.0, 150.0, 120.0, & + 200.0, 175.0, 120.0, 175.0, 200.0, & + 9999.0, 164.0, 200.0, 100.0, 150.0, & + 200.0, 150.0, 100.0, 300.0, 100.0, & + 100.0, 100.0, 100.0 / + + DATA Z00_USGS28 & + / 50.0, 10.0, 10.0, 10.0, 10.0, & + 40.0, 7.0, 20.0, 20.0, 20.0, & + 50.0, 50.0, 40.0, 50.0, 50.0, & + 0.1, 15.0, 45.0, 5.0, 10.0, & + 10.0, 5.0, 5.0, 5.0, 5.0, & + 5.0, 5.0, 5.0 / + + DATA VEG0_USGS28 & + / 40.0, 95.0, 95.0, 95.0, 95.0, & + 95.0, 95.0, 70.0, 85.0, 80.0, & + 95.0, 95.0, 95.0, 90.0, 95.0, & + 0.00, 60.0, 90.0, 10.0, 20.0, & + 30.0, 20.0, 5.0, 5.0, 5.0, & + 5.0, 5.0, 5.0 / + + DATA VEGMN0_USGS28 & + / 20.0, 15.0, 10.0, 15.0, 35.0, & + 40.0, 70.0, 50.0, 60.0, 60.0, & + 50.0, 50.0, 85.0, 80.0, 60.0, & + 0.0, 40.0, 80.0, 5.0, 10.0, & + 10.0, 5.0, 2.0, 2.0, 2.0, & + 2.0, 2.0, 2.0 / + + DATA LAI0_USGS28 & + / 2.0, 3.0, 3.0, 3.0, 2.5, & + 4.0, 2.5, 3.0, 3.0, 2.0, & + 5.0, 5.0, 5.0, 4.0, 5.0, & + 0.0, 2.0, 5.0, 0.50, 1.0, & + 1.0, 1.0, 0.1, 0.1, 0.1, & + 0.1, 0.1, 0.1 / + + DATA LAIMN0_USGS28 & + / 0.50, 0.50, 0.50, 0.50, 1.0, & + 1.5, 1.0, 1.0, 1.0, 1.0, & + 1.0, 1.0, 4.0, 3.0, 2.0, & + 0.0, 1.0, 3.0, 0.20, 0.50, & + 0.50, 0.50, 0.10, 0.10, 0.10, & + 0.10, 0.10, 0.10 / + + DATA SNUP0_USGS28 & + / 0.04, 0.04, 0.04, 0.04, 0.04, & + 0.04, 0.04, 0.03, 0.035, 0.04, & + 0.08, 0.08, 0.08, 0.08, 0.08, & + 0.01, 0.01, 0.01, 0.02, 0.02, & + 0.025, 0.025, 0.025, 0.02, 0.02, & + 0.02, 0.02, 0.02 / + + DATA ALBF_USGS28 & + / 15.0, 17.0, 18.0, 18.0, 18.0, & + 16.0, 19.0, 22.0, 20.0, 20.0, & + 16.0, 14.0, 12.0, 12.0, 13.0, & + 8.0, 14.0, 14.0, 25.0, 15.0, & + 15.0, 15.0, 25.0, 55.0, 25.0, & + 10.0, 50.0, 50.0 / + + DATA SNOALB_USGS28 & + / 46.0, 66.0, 66.0, 66.0, 70.0, & + 50.0, 70.0, 50.0, 60.0, 50.0, & + 40.0, 40.0, 40.0, 30.0, 35.0, & + 8.0, 50.0, 40.0, 75.0, 55.0, & + 60.0, 60.0, 75.0, 82.0, 75.0, & + 75.0, 75.0, 75.0 / + +!**************************************************************************************** +!**************************************************************************************** + +END MODULE module_sf_pxlsm_data diff --git a/src/core_init_atmosphere/Registry.xml b/src/core_init_atmosphere/Registry.xml index 7bc8d53146..8c270e40fd 100644 --- a/src/core_init_atmosphere/Registry.xml +++ b/src/core_init_atmosphere/Registry.xml @@ -36,6 +36,10 @@ description="The number of first-guess atmospheric layers"/> + + + 8 = surface field (SST, sea-ice) update file for use with real-data simulations, \newline + 9 = lateral boundary conditions update file for use with real-data simulations, \newline + 10 = P-X soil nudging update file for use with real-data simulations, \newline + 13 = CAM-MPAS 3-d grid with specified topography and zeta levels" + possible_values="1 -- 10, or 13"/> + + + + + possible_values="`USGS' or `MODIFIED_IGBP_MODIS_NOAH' or `NLCD40'"/> + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -392,13 +503,17 @@ + + + + @@ -488,13 +603,17 @@ + + + + @@ -547,10 +666,15 @@ + + + + + @@ -561,6 +685,8 @@ + + + + + + + + + + + + - + + + @@ -755,16 +901,19 @@ - + - - - + + + + + + @@ -1106,7 +1262,7 @@ description="geopotential height vertically interpolated from first guess" packages="met_stage_out"/> - @@ -1114,10 +1270,34 @@ description="background surface albedo" packages="met_stage_out"/> + + + + + + + + + + + + + + domain % blocklist + do while (associated(block_ptr)) + call mpas_pool_get_subpool(block_ptr % structs, 'mesh', mesh) + call mpas_pool_get_subpool(block_ptr % structs, 'fg', fg) + call mpas_pool_get_subpool(block_ptr % structs, 'state', state) + + ! Defined in mpas_init_atm_surface.F + call init_atm_case_soilndg(domain, domain % dminfo, stream_manager, mesh, fg, state, block_ptr % dimensions, block_ptr % configs) + block_ptr => block_ptr % next + end do + else if (config_init_case == 13 ) then call mpas_log_write(' CAM-MPAS grid ') @@ -369,9 +383,9 @@ subroutine init_atm_setup_case(domain, stream_manager) else - call mpas_log_write(' ***********************************************************', messageType=MPAS_LOG_ERR) - call mpas_log_write(' Only test cases 1 through 9 and 13 are currently supported.', messageType=MPAS_LOG_ERR) - call mpas_log_write(' ***********************************************************', messageType=MPAS_LOG_CRIT) + call mpas_log_write(' ************************************************************', messageType=MPAS_LOG_ERR) + call mpas_log_write(' Only test cases 1 through 10 and 13 are currently supported.', messageType=MPAS_LOG_ERR) + call mpas_log_write(' ************************************************************', messageType=MPAS_LOG_CRIT) end if @@ -453,7 +467,7 @@ subroutine init_atm_case_jw(mesh, nCells, nVertLevels, state, diag, configs) real (kind=RKIND) :: r_earth, etavs, ztemp, zd, zt, dz, str - real (kind=RKIND) :: es, xnutr, znut, ptemp + real (kind=RKIND) :: es, xnutr, znut, ptemp real (kind=RKIND), dimension(nVertLevels + 1 ) :: sh, zw, ah real (kind=RKIND), dimension(nVertLevels ) :: zu, dzw, rdzwp, rdzwm @@ -1964,7 +1978,7 @@ subroutine init_atm_case_mtn_wave(mesh, nCells, nVertLevels, state, diag, config real (kind=RKIND) :: um, vm,rcp, rcv real (kind=RKIND) :: temp, pres, a_scale - real (kind=RKIND) :: xi, xa, xc, xla, zinv, xn2, xn2m, xn2l, z_edge, z_edge3 + real (kind=RKIND) :: xi, xa, xc, xla, zinv, xn2, xn2m, xn2l, z_edge, z_edge3 integer, dimension(nCells, 2) :: next_cell logical, parameter :: terrain_smooth = .false. @@ -2600,7 +2614,7 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two real (kind=RKIND) :: target_z - integer :: iCell, iCell1, iCell2 , iEdge, i, k, nz, cell1, cell2 + integer :: iCell, iCell1, iCell2 , iEdge, i, k, nz, itr, itrp, cell1, cell2 integer, pointer :: nCellsSolve, nz1 integer :: nInterpPoints, ndims @@ -2647,7 +2661,7 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state real (kind=RKIND) :: p0 - real (kind=RKIND) :: etavs, ztemp, zd, zt, dz, str + real (kind=RKIND) :: etavs, ztemp, zd, zt, dz, str, grd, kfrac real (kind=RKIND) :: es, rs, xnutr, znut, rcv @@ -2676,6 +2690,24 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state real (kind=RKIND), pointer :: config_ztop logical, pointer :: config_tc_vertical_grid character (len=StrKIND), pointer :: config_specified_zeta_levels + logical, pointer :: config_spline_vertical_grid + real (kind=RKIND), pointer :: config_spline_x1 + real (kind=RKIND), pointer :: config_spline_y1 + real (kind=RKIND), pointer :: config_spline_x2 + real (kind=RKIND), pointer :: config_spline_y2 + real (kind=RKIND), pointer :: config_spline_x3 + real (kind=RKIND), pointer :: config_spline_y3 + real (kind=RKIND), pointer :: config_spline_x4 + real (kind=RKIND), pointer :: config_spline_y4 + real (kind=RKIND), pointer :: config_spline_x5 + real (kind=RKIND), pointer :: config_spline_y5 + real (kind=RKIND), pointer :: config_spline_x6 + real (kind=RKIND), pointer :: config_spline_y6 + real (kind=RKIND), pointer :: config_spline_x7 + real (kind=RKIND), pointer :: config_spline_y7 + real (kind=RKIND), pointer :: config_spline_x8 + real (kind=RKIND), pointer :: config_spline_y8 + logical, pointer :: config_EPA_vertical_grid logical, pointer :: config_use_spechumd integer, pointer :: config_nfglevels integer, pointer :: config_nfgsoillevels @@ -2705,6 +2737,7 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state real (kind=RKIND), dimension(:,:), pointer :: rho real (kind=RKIND), dimension(:,:), pointer :: relhum real (kind=RKIND), dimension(:,:), pointer :: spechum + real (kind=RKIND), dimension(:,:), pointer :: ozone real (kind=RKIND), dimension(:,:), pointer :: ru real (kind=RKIND), dimension(:,:), pointer :: rw real (kind=RKIND), dimension(:), pointer :: precipw @@ -2715,6 +2748,8 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state real (kind=RKIND), dimension(:,:), pointer :: uReconstructMeridional real (kind=RKIND), dimension(:), pointer :: psfc + real (kind=RKIND), dimension(:), pointer :: hgttrop + real (kind=RKIND), dimension(:), pointer :: ptrop real (kind=RKIND), dimension(:), pointer :: skintemp real (kind=RKIND), dimension(:), pointer :: snow real (kind=RKIND), dimension(:), pointer :: snowc @@ -2724,6 +2759,7 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state real (kind=RKIND), dimension(:,:), pointer :: t_fg real (kind=RKIND), dimension(:,:), pointer :: rh_fg real (kind=RKIND), dimension(:,:), pointer :: sh_fg + real (kind=RKIND), dimension(:,:), pointer :: o3_fg real (kind=RKIND), dimension(:,:), pointer :: gfs_z real (kind=RKIND), dimension(:,:), pointer :: p_fg real (kind=RKIND), dimension(:,:), pointer :: st_fg @@ -2734,11 +2770,36 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state logical :: too_many_fg_levs integer :: level_value - ! For outputting surface fields u10, v10, q2, rh2, and t2m from first-guess data + ! For outputting surface fields q2, rh2, and t2m from first-guess data real (kind=RKIND), dimension(:), pointer :: q2 real (kind=RKIND), dimension(:), pointer :: rh2 real (kind=RKIND), dimension(:), pointer :: t2m + ! For cubic spline definition of air quality layer thickness profile + integer, parameter :: nprof = 8 + real (kind=RKIND), dimension(nprof) :: & + xx, &!< x-dimension control point for cubic spline interpolation + yy !< y-dimension control point for cubic spline interpolation + real (kind=RKIND), parameter :: & + cadj = 0.3, &!< layer thickness adjustment coefficient + ctol = 0.001 !< tolerance for layer fit to model top + real (kind=RKIND), dimension(nprof) :: & + ya, &!< Thickness scaled to match model top + y2ndDer, &!< 2nd derivative at nodes of layer profile definition + acoef !< Tridiagonal decomposition factor + real (kind=RKIND) :: & + thick, &!< Interpolated layer thickness + zint, &!< Height for interpolation + ptef, &!< Profile top error factor + adj, &!< Thickness adjustment factor + xRatio, &!< X-dimension scale for interpolation + tvar, &!< temporary variable + aa, &!< temporary variable + bb, &!< temporary variable + cc !< temporary variable + real (kind=RKIND), dimension(nVertLevels+1) :: zwtemp + integer :: nlayerint, klo, khi, ncount + character (len=StrKIND) :: errstring call mpas_pool_get_config(configs, 'config_met_prefix', config_met_prefix) @@ -2751,6 +2812,24 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state call mpas_pool_get_config(configs, 'config_ztop', config_ztop) call mpas_pool_get_config(configs, 'config_tc_vertical_grid', config_tc_vertical_grid) call mpas_pool_get_config(configs, 'config_specified_zeta_levels', config_specified_zeta_levels) + call mpas_pool_get_config(configs, 'config_EPA_vertical_grid', config_EPA_vertical_grid) + call mpas_pool_get_config(configs, 'config_spline_vertical_grid', config_spline_vertical_grid) + call mpas_pool_get_config(configs, 'config_spline_x1', config_spline_x1) + call mpas_pool_get_config(configs, 'config_spline_y1', config_spline_y1) + call mpas_pool_get_config(configs, 'config_spline_x2', config_spline_x2) + call mpas_pool_get_config(configs, 'config_spline_y2', config_spline_y2) + call mpas_pool_get_config(configs, 'config_spline_x3', config_spline_x3) + call mpas_pool_get_config(configs, 'config_spline_y3', config_spline_y3) + call mpas_pool_get_config(configs, 'config_spline_x4', config_spline_x4) + call mpas_pool_get_config(configs, 'config_spline_y4', config_spline_y4) + call mpas_pool_get_config(configs, 'config_spline_x5', config_spline_x5) + call mpas_pool_get_config(configs, 'config_spline_y5', config_spline_y5) + call mpas_pool_get_config(configs, 'config_spline_x6', config_spline_x6) + call mpas_pool_get_config(configs, 'config_spline_y6', config_spline_y6) + call mpas_pool_get_config(configs, 'config_spline_x7', config_spline_x7) + call mpas_pool_get_config(configs, 'config_spline_y7', config_spline_y7) + call mpas_pool_get_config(configs, 'config_spline_x8', config_spline_x8) + call mpas_pool_get_config(configs, 'config_spline_y8', config_spline_y8) call mpas_pool_get_config(configs, 'config_use_spechumd', config_use_spechumd) call mpas_pool_get_config(configs, 'config_nfglevels', config_nfglevels) call mpas_pool_get_config(configs, 'config_nfgsoillevels', config_nfgsoillevels) @@ -2815,6 +2894,7 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state call mpas_pool_get_array(diag, 'surface_pressure', surface_pressure) call mpas_pool_get_array(diag, 'relhum', relhum) call mpas_pool_get_array(diag, 'spechum', spechum) + call mpas_pool_get_array(diag, 'ozone', ozone) call mpas_pool_get_array(diag, 'ru', ru) call mpas_pool_get_array(diag, 'rw', rw) @@ -2851,6 +2931,8 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state call mpas_pool_get_array(fg, 'st_fg', st_fg) call mpas_pool_get_array(fg, 'sm_fg', sm_fg) call mpas_pool_get_array(fg, 'psfc', psfc) + call mpas_pool_get_array(fg, 'ptrop', ptrop) + call mpas_pool_get_array(fg, 'hgttrop', hgttrop) call mpas_pool_get_array(fg, 'skintemp', skintemp) call mpas_pool_get_array(fg, 'snow', snow) call mpas_pool_get_array(fg, 'snowc', snowc) @@ -2860,6 +2942,7 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state call mpas_pool_get_array(fg, 't', t_fg) call mpas_pool_get_array(fg, 'rh', rh_fg) call mpas_pool_get_array(fg, 'sh', sh_fg) + call mpas_pool_get_array(fg, 'o3', o3_fg) call mpas_pool_get_array(fg, 'gfs_z', gfs_z) call mpas_pool_get_array(fg, 'p', p_fg) @@ -3043,6 +3126,127 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state if (k > 1) dzw(k-1) = zw(k)-zw(k-1) end do + else if (config_spline_vertical_grid) then + + call mpas_log_write('Setting up vertical levels using a cubic spline fit') + + zt = config_ztop + xx(1) = config_spline_x1 + yy(1) = config_spline_y1 + xx(2) = config_spline_x2 + yy(2) = config_spline_y2 + xx(3) = config_spline_x3 + yy(3) = config_spline_y3 + xx(4) = config_spline_x4 + yy(4) = config_spline_y4 + xx(5) = config_spline_x5 + yy(5) = config_spline_y5 + xx(6) = config_spline_x6 + yy(6) = config_spline_y6 + xx(7) = config_spline_x7 + yy(7) = config_spline_y7 + xx(8) = config_spline_x8 + yy(8) = config_spline_y8 + +! Set up cubic spline definition of layer thickness vertical profile + y2ndDer(1)=0.0 + y2ndDer(nprof)=0.0 + acoef(1)=0.0 + ya(1:nprof) = yy(1:nprof) + + do i=2,nprof-1 + xRatio=(xx(i)-xx(i-1))/(xx(i+1)-xx(i-1)) + tvar=1.0/(2.0+xRatio*y2ndDer(i-1)) + y2ndDer(i)=tvar*(xRatio-1.0) + acoef(i) = tvar*(6.0*((ya(i+1)-ya(i))/(xx(i+1)-xx(i)) & + -(ya(i)-ya(i-1))/(xx(i)-xx(i-1)))/(xx(i+1)-xx(i-1)) & + -xRatio*acoef(i-1)) + enddo + + do i=nprof-1,1,-1 + y2ndDer(i)=y2ndDer(i)*y2ndDer(i+1)+acoef(i) + enddo + +! Loop to set layer interface heights from air quality profile + ptef = 0. + zwtemp(1)= 0. + ncount = 0 + do while(abs(1.0-ptef) > ctol) + zwtemp(2) = ya(1) + zint = ya(1) + nlayerint = 2 + do while (nlayerint.lt.nz) + klo=1 + khi=nprof + do while (khi-klo.gt.1) + k=(khi+klo)/2 + if(xx(k).gt.zint)then + khi=k + else + klo=k + endif + enddo + cc=xx(khi)-xx(klo) + aa=(xx(khi)-zint)/cc + bb=(zint-xx(klo))/cc + thick=aa*ya(klo)+bb*ya(khi)+((aa**3-aa)*y2ndDer(klo)+ & + (bb**3-bb)*y2ndDer(khi))*(cc**2)/6. + zint = zint+thick + nlayerint = nlayerint+1 + zwtemp(nlayerint) = zint + enddo + if(ptef.eq.0.) then + ptef = zt/zint + if(ptef > 1.5) then + call mpas_log_write('*** Significant layer inflation required ***') + call mpas_log_write('*** You may want to use more layers ***') + call mpas_log_write('*** and/or a lower model top ***') + else if(ptef < 0.6) then + call mpas_log_write('*** Significant layer deflation required ***') + call mpas_log_write('*** You may want to use fewer layers ***') + call mpas_log_write('*** and/or a higher model top ***') + endif + else + ptef = zt/zint + endif + call mpas_log_write('Using first layer, ptef = $r $r',realArgs=(/ya(1),ptef/)) + ncount = ncount+1 + if(ncount > 20) then + call mpas_log_write('*** ERROR: layer adjustment failure ***') + call mpas_log_write(' *** Iteration did not converge ***') + call mpas_dmpar_global_abort('****************************************************************************', deferredAbort=.true.) + call mpas_dmpar_global_abort('ERROR: Aborted while setting up vertical levels for Air Quality applications', deferredAbort=.true.) + call mpas_dmpar_global_abort('****************************************************************************') + endif + adj = 1.0+(cadj*(ptef-1.0)) + ya(1:nprof) = ya(1:nprof)*adj + y2ndDer(1:nprof) = y2ndDer(1:nprof)*adj + enddo + +! Now make minor adjustment to layers to fit within specified top + do k=1,nz + zw(k) = zwtemp(k)*ptef + enddo + call mpas_log_write('Layers for Air Quality applications generated') + call mpas_log_write('Number of layers and Model top = $i $r',intArgs=(/nz1/),realArgs=(/zt/)) + call mpas_log_write('Adjusted bottom layer thickness (m) = $r',realArgs=(/zw(2)/)) + call mpas_log_write('') + + else if (config_EPA_vertical_grid) then + + call mpas_log_write('Setting up vertical levels as in MPAS 4.0 and earlier, but') + call mpas_log_write('*** Using custom layer definition ***') + + str = 3. + grd = 0.03 + zt = config_ztop + + do k=1,nz + kfrac = real(k-1)/real(nz1) + zw(k) = zt*((1-grd)*kfrac**str+grd*kfrac) + if (k > 1) dzw(k-1) = zw(k)-zw(k-1) + end do + ! ! Otherwise, use the vertical level configuration from MPAS v2.0 ! @@ -3402,9 +3606,12 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state trim(field % field) == 'TT' .or. & trim(field % field) == 'RH' .or. & trim(field % field) == 'SPECHUMD' .or. & + trim(field % field) == 'O3' .or. & trim(field % field) == 'GHT' .or. & trim(field % field) == 'PMSL' .or. & trim(field % field) == 'PSFC' .or. & + trim(field % field) == 'PTROP' .or. & + trim(field % field) == 'HGTTROP' .or. & trim(field % field) == 'SOILHGT' .or. & trim(field % field) == 'SM000010' .or. & trim(field % field) == 'SM010040' .or. & @@ -3452,6 +3659,8 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state trim(field % field) == 'ST028100' .or. & trim(field % field) == 'ST100255' .or. & trim(field % field) == 'ST100289' .or. & + trim(field % field) == 'PTROP' .or. & + trim(field % field) == 'HGTTROP' .or. & trim(field % field) == 'SNOW' .or. & trim(field % field) == 'SEAICE' .or. & trim(field % field) == 'SKINTEMP') then @@ -3580,6 +3789,13 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state lonPoints => lonCell call mpas_pool_get_array(fg, 'sh', destField2d) ndims = 2 + else if (trim(field % field) == 'O3') then + call mpas_log_write('Interpolating O3 at $i $r', intArgs=(/k/), realArgs=(/vert_level(k)/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'o3', destField2d) + ndims = 2 else if (trim(field % field) == 'GHT') then call mpas_log_write('Interpolating GHT at $i $r', intArgs=(/k/), realArgs=(/vert_level(k)/)) nInterpPoints = nCells @@ -3615,6 +3831,20 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state lonPoints => lonCell call mpas_pool_get_array(fg, 'psfc', destField1d) ndims = 1 + else if (trim(field % field) == 'PTROP') then + call mpas_log_write('Interpolating PTROP') + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'ptrop', destField1d) + ndims = 1 + else if (trim(field % field) == 'HGTTROP') then + call mpas_log_write('Interpolating HGTTROP') + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'hgttrop', destField1d) + ndims = 1 else if (trim(field % field) == 'SOILHGT') then call mpas_log_write('Interpolating SOILHGT') nInterpPoints = nCells @@ -4584,6 +4814,22 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state end do + ! O3 + sorted_arr(:,:) = -999.0 + ozone(:,iCell) = 0._RKIND + do k = 1, nfglevels_actual + sorted_arr(1,k) = z_fg(k,iCell) + if (vert_level(k) == 200100.0) sorted_arr(1,k) = 99999.0 + sorted_arr(2,k) = o3_fg(k,iCell) + end do + call mpas_quicksort(nfglevels_actual, sorted_arr) + do k = nVertLevels, 1, -1 + target_z = 0.5 * (zgrid(k,iCell) + zgrid(k+1,iCell)) + ozone(k,iCell) = vertical_interp(target_z, nfglevels_actual-1, & + sorted_arr(:,1:nfglevels_actual-1), order=1, extrap=0) + end do + + ! GHT sorted_arr(:,:) = -999.0 do k = 1, nfglevels_actual @@ -6537,32 +6783,39 @@ subroutine physics_idealized_init(mesh, fg) type (mpas_pool_type), intent(inout) :: fg !local variables: - integer :: iCell, iMonth, iSoil - integer, pointer :: nCells, nSoilLevels, nMonths - integer, dimension(:), pointer :: landmask, lu_index, soilcat_top - real (kind=RKIND), dimension(:), pointer :: ter, xice, shdmin, shdmax, vegfra, sfc_albbck, xland, seaice + integer :: iCell, iMonth, iSoil, iLandCat, iSoilCat + integer, pointer :: nCells, nSoilLevels, nMonths, nLandCat, nSoilCat + integer, dimension(:), pointer :: landmask, lu_index, soilcat + real (kind=RKIND), dimension(:), pointer :: ter, xice, shdmin, shdmax, vegfra, sfc_albbck, xland, seaice, lai_modis real (kind=RKIND), dimension(:), pointer :: snow, snowc, snoalb, snowh, skintemp, sst, tmn - real (kind=RKIND), dimension(:,:), pointer :: tslb, smcrel, sh2o, smois, dzs, albedo12m, greenfrac + real (kind=RKIND), dimension(:,:), pointer :: landusef, soiltypf + real (kind=RKIND), dimension(:,:), pointer :: tslb, smcrel, sh2o, smois, dzs, albedo12m, greenfrac, lai12m !--------------------------------------------------------------------------------------------- call mpas_pool_get_dimension(mesh, 'nCells', nCells) call mpas_pool_get_dimension(mesh, 'nSoilLevels', nSoilLevels) call mpas_pool_get_dimension(mesh, 'nMonths', nMonths) + call mpas_pool_get_dimension(mesh, 'nLandCat', nLandCat) + call mpas_pool_get_dimension(mesh, 'nSoilCat', nSoilCat) call mpas_pool_get_array(mesh, 'ter', ter) call mpas_pool_get_array(mesh, 'landmask', landmask) call mpas_pool_get_array(mesh, 'lu_index', lu_index) - call mpas_pool_get_array(mesh, 'soilcat_top', soilcat_top) + call mpas_pool_get_array(mesh, 'landusef', landusef) + call mpas_pool_get_array(mesh, 'soilcat', soilcat) + call mpas_pool_get_array(mesh, 'soiltypf', soiltypf) call mpas_pool_get_array(mesh, 'shdmin', shdmin) call mpas_pool_get_array(mesh, 'shdmax', shdmax) call mpas_pool_get_array(mesh, 'snoalb', snoalb) call mpas_pool_get_array(mesh, 'albedo12m', albedo12m) call mpas_pool_get_array(mesh, 'greenfrac', greenfrac) + call mpas_pool_get_array(mesh, 'lai12m', lai12m) call mpas_pool_get_array(fg, 'xice', xice) call mpas_pool_get_array(fg, 'vegfra', vegfra) call mpas_pool_get_array(fg, 'sfc_albbck', sfc_albbck) + call mpas_pool_get_array(fg, 'lai_modis', lai_modis) call mpas_pool_get_array(fg, 'xland', xland) call mpas_pool_get_array(fg, 'seaice', seaice) call mpas_pool_get_array(fg, 'snow', snow) @@ -6588,11 +6841,12 @@ subroutine physics_idealized_init(mesh, fg) xice(iCell) = 0.0 landmask(iCell) = 0 lu_index(iCell) = 0 - soilcat_top(iCell) = 0 + soilcat(iCell) = 0 shdmin(iCell) = 0.0 shdmax(iCell) = 0.0 vegfra(iCell) = 0.0 sfc_albbck(iCell) = 0.0 + lai_modis(iCell) = 0.0 xland(iCell) = 0.0 seaice(iCell) = 0.0 @@ -6615,11 +6869,22 @@ subroutine physics_idealized_init(mesh, fg) smois(iSoil,iCell) = 0.0 dzs(iSoil,iCell) = 0.0 end do + + !fractional soil type: + do iSoilCat = 1, nSoilCat + soiltypf(iSoilCat,iCell) = 0.0 + end do + + !fractional land use: + do iLandCat = 1, nLandCat + landusef(iLandCat,iCell) = 0.0 + end do - !monthly climatological surface albedo and greeness fraction: + !monthly climatological surface albedo, greeness fraction, and leaf area index: do iMonth = 1, nMonths albedo12m(iMonth,iCell) = 0.08 greenfrac(iMonth,iCell) = 0.0 + lai12m(iMonth,iCell) = 0.0 end do end do diff --git a/src/core_init_atmosphere/mpas_init_atm_core_interface.F b/src/core_init_atmosphere/mpas_init_atm_core_interface.F index c4e35dc382..bc9821a7e6 100644 --- a/src/core_init_atmosphere/mpas_init_atm_core_interface.F +++ b/src/core_init_atmosphere/mpas_init_atm_core_interface.F @@ -113,6 +113,7 @@ function init_atm_setup_packages(configs, packages, iocontext) result(ierr) integer :: ierr logical, pointer :: initial_conds, sfc_update, lbcs + logical, pointer :: soilndg_update logical, pointer :: gwd_stage_in, gwd_stage_out, vertical_stage_in, vertical_stage_out, met_stage_in, met_stage_out logical, pointer :: config_native_gwd_static, config_static_interp, config_vertical_grid, config_met_interp logical, pointer :: first_guess_field @@ -133,6 +134,9 @@ function init_atm_setup_packages(configs, packages, iocontext) result(ierr) nullify(sfc_update) call mpas_pool_get_package(packages, 'sfc_updateActive', sfc_update) + nullify(soilndg_update) + call mpas_pool_get_package(packages, 'soilndg_updateActive', soilndg_update) + nullify(lbcs) call mpas_pool_get_package(packages, 'lbcsActive', lbcs) @@ -156,6 +160,7 @@ function init_atm_setup_packages(configs, packages, iocontext) result(ierr) if (.not. associated(initial_conds) .or. & .not. associated(sfc_update) .or. & + .not. associated(soilndg_update) .or. & .not. associated(gwd_stage_in) .or. & .not. associated(gwd_stage_out) .or. & .not. associated(vertical_stage_in) .or. & @@ -183,6 +188,14 @@ function init_atm_setup_packages(configs, packages, iocontext) result(ierr) lbcs = .false. end if + if (config_init_case == 10) then + initial_conds = .false. + soilndg_update = .true. + else + initial_conds = .true. + soilndg_update = .false. + end if + if (config_init_case == 7) then ! diff --git a/src/core_init_atmosphere/mpas_init_atm_static.F b/src/core_init_atmosphere/mpas_init_atm_static.F index f38529052b..9758331e28 100644 --- a/src/core_init_atmosphere/mpas_init_atm_static.F +++ b/src/core_init_atmosphere/mpas_init_atm_static.F @@ -88,9 +88,11 @@ end subroutine interp_accumulation_function ! 12.1.2.2 of the Fortran standard) and currently, only PGI does not support this, so ! use module level variables for now... ! + real (kind=RKIND), dimension(:,:), pointer :: landusef + real (kind=RKIND), dimension(:,:), pointer :: soiltypf integer (kind=I8KIND), dimension(:), pointer :: ter_integer integer, dimension(:), pointer :: lu_index - integer, dimension(:), pointer :: soilcat_top + integer, dimension(:), pointer :: soilcat integer, dimension(:), pointer :: nhs integer, dimension(:,:), allocatable:: ncat ! Landmask is used by the accumulation function for maxsnoalb so it needs to be a global variable @@ -148,6 +150,7 @@ subroutine init_atm_static(mesh, dims, configs) integer, pointer :: isice_lu, iswater_lu integer :: iswater_soil + integer, pointer :: ismax_lu integer, pointer :: nCells, nCellsSolve, nEdges, nVertices, maxEdges logical, pointer :: on_a_sphere real (kind=RKIND), pointer :: sphere_radius @@ -171,12 +174,16 @@ subroutine init_atm_static(mesh, dims, configs) integer (kind=I8KIND), dimension(:), pointer :: snoalb_integer real (kind=RKIND), dimension(:), pointer :: shdmin, shdmax real (kind=RKIND), dimension(:,:), pointer :: greenfrac + real (kind=RKIND), dimension(:,:), pointer :: lai12m + integer (kind=I8KIND), dimension(:,:), pointer :: lai12m_int real (kind=RKIND), dimension(:,:), pointer :: albedo12m integer (kind=I8KIND), dimension(:,:), pointer :: albedo12m_int + real (kind=RKIND), dimension(:,:), pointer :: landusef + real (kind=RKIND), dimension(:,:), pointer :: soiltypf real (kind=RKIND) :: fillval real (kind=RKIND), pointer :: missing_value integer, dimension(:), pointer :: lu_index - integer, dimension(:), pointer :: soilcat_top + integer, dimension(:), pointer :: soilcat integer, dimension(:), pointer :: landmask integer, dimension(:), pointer :: bdyMaskCell character(len=StrKIND), pointer :: mminlu @@ -254,13 +261,17 @@ subroutine init_atm_static(mesh, dims, configs) call mpas_pool_get_array(mesh, 'verticesOnCell', verticesOnCell) call mpas_pool_get_array(mesh, 'lu_index', lu_index) + call mpas_pool_get_array(mesh, 'landusef', landusef) call mpas_pool_get_array(mesh, 'mminlu', mminlu) call mpas_pool_get_array(mesh, 'isice_lu', isice_lu) call mpas_pool_get_array(mesh, 'iswater_lu', iswater_lu) - call mpas_pool_get_array(mesh, 'soilcat_top', soilcat_top) + call mpas_pool_get_array(mesh, 'ismax_lu', ismax_lu) + call mpas_pool_get_array(mesh, 'soilcat', soilcat) + call mpas_pool_get_array(mesh, 'soiltypf', soiltypf) call mpas_pool_get_array(mesh, 'landmask', landmask) call mpas_pool_get_array(mesh, 'snoalb', snoalb) call mpas_pool_get_array(mesh, 'greenfrac', greenfrac) + call mpas_pool_get_array(mesh, 'lai12m', lai12m) call mpas_pool_get_array(mesh, 'albedo12m', albedo12m) call mpas_pool_get_array(mesh, 'shdmin', shdmin) call mpas_pool_get_array(mesh, 'shdmax', shdmax) @@ -340,11 +351,14 @@ subroutine init_atm_static(mesh, dims, configs) write(mminlu,'(a)') 'USGS' case('MODIFIED_IGBP_MODIS_NOAH') write(mminlu,'(a)') 'MODIFIED_IGBP_MODIS_NOAH' + case('NLCD40') + write(mminlu,'(a)') 'NLCD40' case default call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR) call mpas_log_write('Invalid land use dataset '''//trim(config_landuse_data) & //''' selected for config_landuse_data', messageType=MPAS_LOG_ERR) - call mpas_log_write(' Possible options are: ''USGS'', ''MODIFIED_IGBP_MODIS_NOAH''', messageType=MPAS_LOG_ERR) + call mpas_log_write(' Possible options are: ''USGS'', ''MODIFIED_IGBP_MODIS_NOAH'', ', messageType=MPAS_LOG_ERR) + call mpas_log_write(' or ''NLCD40''' , messageType=MPAS_LOG_ERR) call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR) call mpas_log_write('Please correct the namelist.', messageType=MPAS_LOG_CRIT) end select surface_input_select0 @@ -383,46 +397,80 @@ subroutine init_atm_static(mesh, dims, configs) case('MODIFIED_IGBP_MODIS_NOAH') call mpas_log_write('Using 20-class MODIS 30-arc-second land cover dataset') geog_sub_path = 'modis_landuse_20class_30s/' + case('NLCD40') + call mpas_log_write('Using 20-class MODIS 30-arc-second land cover dataset for most of globe') + geog_sub_path = 'modis_landuse_20class_30s/' case default call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR) call mpas_log_write('Invalid land use dataset '''//trim(config_landuse_data) & //''' selected for config_landuse_data', messageType=MPAS_LOG_ERR) - call mpas_log_write(' Possible options are: ''USGS'', ''MODIFIED_IGBP_MODIS_NOAH''', messageType=MPAS_LOG_ERR) + call mpas_log_write(' Possible options are: ''USGS'', ''MODIFIED_IGBP_MODIS_NOAH'', ', messageType=MPAS_LOG_ERR) + call mpas_log_write(' or ''NLCD40''' , messageType=MPAS_LOG_ERR) call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR) call mpas_log_write('Please correct the namelist.', messageType=MPAS_LOG_CRIT) end select surface_input_select1 call mpas_log_write('--- start interpolate LU_INDEX') - call interp_landuse(mesh, tree, trim(config_geog_data_path)//trim(geog_sub_path), isice_lu, iswater_lu) + call interp_landuse(mesh, tree, trim(config_geog_data_path)//trim(geog_sub_path), isice_lu, iswater_lu, ismax_lu, configs) call mpas_log_write('--- end interpolate LU_INDEX') + if (config_landuse_data == 'NLCD40') then + ! Incorporate NLCD fractional percentage land use for CONUS, with MODIS for rest of world + call mpas_log_write('Overlaying 40-class NLCD 9-arc-second land cover dataset for CONUS') + geog_sub_path = 'nlcd2011_ll_9s/' + call mpas_log_write('--- start interpolate NLCD LU_INDEX for CONUS') + call interp_landuse2(mesh, dims, configs, trim(config_geog_data_path)//trim(geog_sub_path), isice_lu, iswater_lu, ismax_lu) + call mpas_log_write('--- end interpolate NLCD LU_INDEX for CONUS') + end if + ! -! Interpolate SOILCAT_TOP +! Interpolate SOILCAT ! - geog_sub_path = 'soiltype_top_30s/' + surface_input_select2: select case(trim(config_landuse_data)) + case('USGS') + geog_sub_path = 'soiltype_top_30s/' + case('MODIFIED_IGBP_MODIS_NOAH') + geog_sub_path = 'soiltype_top_30s/' + case('NLCD40') + geog_sub_path = 'soiltype_bot_30s/' + case default + end select surface_input_select2 - call mpas_log_write('--- start interpolate SOILCAT_TOP') - call interp_soilcat(mesh, tree, trim(config_geog_data_path)//trim(geog_sub_path), iswater_soil) - call mpas_log_write('--- end interpolate SOILCAT_TOP') + call mpas_log_write('--- start interpolate SOILCAT') + call interp_soilcat(mesh, tree, trim(config_geog_data_path)//trim(geog_sub_path), iswater_soil, configs) + call mpas_log_write('--- end interpolate SOILCAT') !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! KLUDGE TO FIX SOIL TYPE OVER ANTARCTICA !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - where (lu_index == isice_lu) soilcat_top = 16 +! where (lu_index == isice_lu) soilcat = 16 + do iCell = 1,nCells + if (lu_index(iCell) == isice_lu) then + do i = 1,16 + soiltypf(i,iCell) = 0.0 + end do + soilcat(iCell) = 16 + soiltypf(soilcat(iCell),iCell) = 1.0 + end if + end do !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! CORRECT INCONSISTENT SOIL AND LAND USE DATA !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do iCell = 1,nCells if (lu_index(iCell) == iswater_lu .or. & - soilcat_top(iCell) == iswater_soil) then + soilcat(iCell) == iswater_soil) then if (lu_index(iCell) /= iswater_lu) then call mpas_log_write('Turning lu_index into water at $i', intArgs=(/iCell/)) + landusef(lu_index(iCell),iCell) = 0.0 lu_index(iCell) = iswater_lu + landusef(lu_index(iCell),iCell) = 1.0 ! Currently defines dominant land use fraction only + soiltypf(soilcat(iCell),iCell) = 1.0 ! Currently defines dominant soil type fraction only end if - if (soilcat_top(iCell) /= iswater_soil) then - call mpas_log_write('Turning soilcat_top into water at $i', intArgs=(/iCell/)) - soilcat_top(iCell) = iswater_soil + if (soilcat(iCell) /= iswater_soil) then + call mpas_log_write('Turning soilcat into water at $i', intArgs=(/iCell/)) + soilcat(iCell) = iswater_soil + soiltypf(soilcat(iCell),iCell) = 1.0 ! Currently defines dominant soil type fraction only end if end if end do @@ -919,6 +967,150 @@ subroutine init_atm_static(mesh, dims, configs) call mpas_log_write('--- end interpolate GREENFRAC') +! +! Interpolate LAI +! + + call mpas_log_write('Using MODIS LAI 30-arc-second data for climatological monthly leaf area index') + + geog_sub_path = 'lai_modis_30s/' + + ierr = mgr % init(trim(config_geog_data_path)//trim(geog_sub_path)) + if (ierr /= 0) then + call mpas_log_write('Error occurred when initalizing the interpolation of monthly leaf area index (lai12m)', & + messageType=MPAS_LOG_CRIT) + endif + + call mpas_pool_get_config(mgr % pool, 'tile_bdr', tile_bdr) + call mpas_pool_get_config(mgr % pool, 'tile_x', tile_nx) + call mpas_pool_get_config(mgr % pool, 'tile_y', tile_ny) + call mpas_pool_get_config(mgr % pool, 'tile_z', tile_nz) + call mpas_pool_get_config(mgr % pool, 'missing_value', missing_value) + call mpas_pool_get_config(mgr % pool, 'scale_factor', scalefactor_ptr) + scalefactor = scalefactor_ptr + + allocate(nhs(nCells)) + allocate(lai12m_int(tile_nz, nCells)) + nhs(:) = 0 + lai12m(:,:) = 0.0 + lai12m_int(:,:) = 0_I8KIND + fillval = 0.0 + + do iCell = 1, nCells + if (nhs(iCell) == 0) then + tile => null() + ierr = mgr % get_tile(latCell(iCell), lonCell(iCell), tile) + if (ierr /= 0 .or. .not. associated(tile)) then + call mpas_log_write('Could not get tile that contained cell $i', intArgs=(/iCell/), messageType=MPAS_LOG_CRIT) + end if + + ierr = mgr % push_tile(tile) + if (ierr /= 0) then + call mpas_log_write("Error pushing this tile onto the stack: "//trim(tile % fname), messageType=MPAS_LOG_CRIT) + end if + end if + + do while (.not. mgr % is_stack_empty()) + tile => mgr % pop_tile() + + if (tile % is_processed) then + cycle + end if + + call mpas_log_write('Processing tile: '//trim(tile % fname)) + + all_pixels_mapped_to_halo_cells = .true. + + do j = tile_bdr + 1, tile_ny + tile_bdr, 1 + do i = tile_bdr + 1, tile_nx + tile_bdr, 1 + + call mgr % tile_to_latlon(tile, j, i, lat_pt, lon_pt) + call mpas_latlon_to_xyz(xPixel, yPixel, zPixel, sphere_radius, lat_pt, lon_pt) + call mpas_kd_search(tree, (/xPixel, yPixel, zPixel/), res, max_distance=max_kdtree_distance2) + + if (.not. associated(res)) cycle + + ! + ! This field only matters for land cells, and for all but the outermost boundary cells, + ! we can safely assume that the nearest model grid cell contains the pixel (else, a different + ! cell would be nearest) + ! + if (landMask(res % id) == 1 .and. bdyMaskCell(res % id) < nBdyLayers) then + do k = 1, tile_nz + if (tile % tile(i, j, k) == missing_value) then + i8val = int(fillval, kind=I8KIND) + else + i8val = int(tile % tile(i,j,k), kind=I8KIND) + end if + lai12m_int(k, res % id) = lai12m_int(k, res % id) + i8val + end do + nhs(res % id) = nhs(res % id) + 1 + + if (res % id <= nCellsSolve) then + all_pixels_mapped_to_halo_cells = .false. + end if + + ! For outermost land cells, additional work is needed to verify that the pixel + ! actually lies within the nearest cell + else if (landMask(res % id) == 1) then + if (mpas_in_cell(xPixel, yPixel, zPixel, xCell(res % id), yCell(res % id), zCell(res % id), & + nEdgesOnCell(res % id), verticesOnCell(:,res % id), xVertex, yVertex, zVertex)) then + do k = 1, tile_nz + if (tile % tile(i, j, k) == missing_value) then + i8val = int(fillval, kind=I8KIND) + else + i8val = int(tile % tile(i,j,k), kind=I8KIND) + end if + lai12m_int(k, res % id) = lai12m_int(k, res % id) + i8val + end do + nhs(res % id) = nhs(res % id) + 1 + + if (res % id <= nCellsSolve) then + all_pixels_mapped_to_halo_cells = .false. + end if + end if + end if + end do + end do + + tile % is_processed = .true. + + if (.not. all_pixels_mapped_to_halo_cells) then + ierr = mgr % push_neighbors(tile) + if (ierr /= 0) then + call mpas_log_write("Error pushing the tile neighbors of: "//trim(tile%fname), messageType=MPAS_LOG_CRIT) + end if + end if + + end do + end do + + do iCell = 1, nCells + ! For land points that have no overlap with valid data, and for water points, + ! just use the fill value... + if (nhs(iCell) == 0) then + lai12m(:,iCell) = fillval + else + lai12m(:,iCell) = real(real(lai12m_int(:,iCell), kind=R8KIND) / real(nhs(iCell), kind=R8KIND), kind=RKIND) + lai12m(:,iCell) = lai12m(:,iCell) * scalefactor + end if + if (lu_index(iCell) == isice_lu) then + lai12m(:,iCell) = fillval + end if + end do + + deallocate(nhs) + deallocate(lai12m_int) + + ierr = mgr % finalize() + if (ierr /= 0) then + call mpas_log_write('Error occurred when finalizing the interpolation of monthly leaf area index (lai12m)', & + messageType=MPAS_LOG_CRIT) + endif + + call mpas_log_write('--- end interpolate LAI') + + ! ! Interpolate ALBEDO12M ! @@ -1562,16 +1754,18 @@ end subroutine categorical_interp_accumulation !> that isice and iswater are in the dataset's index file. ! !----------------------------------------------------------------------- - subroutine interp_landuse(mesh, kdtree, geog_data_path, isice_lu, iswater_lu) + subroutine interp_landuse(mesh, kdtree, geog_data_path, isice_lu, iswater_lu, ismax_lu, configs) implicit none ! Input variables type (mpas_pool_type), intent(inout) :: mesh type (mpas_kd_type), pointer, intent(in) :: kdtree + type (mpas_pool_type), intent(in) :: configs character (len=*), intent(in) :: geog_data_path integer, intent(out) :: isice_lu integer, intent(out) :: iswater_lu + integer, intent(out) :: ismax_lu ! Local variables type (mpas_geotile_mgr_type) :: mgr @@ -1579,9 +1773,12 @@ subroutine interp_landuse(mesh, kdtree, geog_data_path, isice_lu, iswater_lu) integer, pointer :: isice_lu_ptr integer, pointer :: iswater_lu_ptr + logical, pointer :: config_frac_landuse + real (kind=RKIND), pointer :: scalefactor - integer :: iCell + integer :: ncattot + integer :: i, iCell integer :: ierr ierr = mgr % init(trim(geog_data_path)) @@ -1590,28 +1787,52 @@ subroutine interp_landuse(mesh, kdtree, geog_data_path, isice_lu, iswater_lu) return ! Program execution should not reach this statement since the preceding message is a critical error end if + call mpas_pool_get_config(configs, 'config_frac_landuse', config_frac_landuse) + call mpas_pool_get_dimension(mesh, 'nCells', nCells) call mpas_pool_get_array(mesh, 'lu_index', lu_index) + call mpas_pool_get_array(mesh, 'landusef', landusef) call mpas_pool_get_config(mgr % pool, 'scale_factor', scalefactor) call mpas_pool_get_config(mgr % pool, 'category_min', category_min) call mpas_pool_get_config(mgr % pool, 'category_max', category_max) call mpas_pool_get_config(mgr % pool, 'isice', isice_lu_ptr) call mpas_pool_get_config(mgr % pool, 'iswater', iswater_lu_ptr) + isice_lu = isice_lu_ptr iswater_lu = iswater_lu_ptr + ismax_lu = category_max allocate(ncat(category_min:category_max, nCells)) ncat(:,:) = 0 + landusef(:,:) = 0.0 call init_atm_map_static_data(mesh, mgr, kdtree, categorical_interp_criteria, categorical_interp_accumulation) - do iCell = 1, nCells - ! Because maxloc returns the location of the maximum value of an array as if the - ! starting index of the array is 1, and dataset categories do not necessarily start - ! at 1, we need to use category_min to ensure the correct category location is chosen. - lu_index(iCell) = maxloc(ncat(:,iCell), dim=1) - 1 + category_min - end do + if (.not. config_frac_landuse) then ! compute dominant land use + do iCell = 1, nCells + ! Because maxloc returns the location of the maximum value of an array as if the + ! starting index of the array is 1, and dataset categories do not necessarily start + ! at 1, we need to use category_min to ensure the correct category location is chosen. + lu_index(iCell) = maxloc(ncat(:,iCell), dim=1) - 1 + category_min + landusef(lu_index(iCell),iCell) = 1.0 ! defines dominant land use only + end do + else ! compute fractional land use + do iCell = 1, nCells + ! Note that lu_index currently defines dominant land use only for ivgtyp, where + ! ivgtyp is used by Noah LSM (and PX LSM when landusef=0 everywhere). + lu_index(iCell) = maxloc(ncat(:,iCell), dim=1) - 1 + category_min + ncattot = 0 + do i = 1,ismax_lu + ncattot = ncattot + ncat(i,iCell) + end do + do i = 1,ismax_lu + if (ncat(i,iCell) > 0) then + landusef(i,iCell) = real(ncat(i,iCell))/ncattot ! defines fractional land use for PX LSM + end if + end do + end do + end if deallocate(ncat) ierr = mgr % finalize() @@ -1625,6 +1846,172 @@ subroutine interp_landuse(mesh, kdtree, geog_data_path, isice_lu, iswater_lu) end subroutine interp_landuse + !*********************************************************************** + ! + ! routine interp_landuse2 + ! + !> \brief Interpolate NLCD land use for CONUS + !> \details + !> Interpolate NLCD land use by using the nlcd2011_ll_9s/ dataset. Then + !> overlay the interpolated NLCD data onto CONUS, leaving the previously- + !> interpolated MODIS land use in place over the rest of the globe. + ! + !----------------------------------------------------------------------- + subroutine interp_landuse2(mesh, dims, configs, geog_data_path, isice_lu, iswater_lu, ismax_lu) + + implicit none + + ! Input variables + type (mpas_pool_type), intent(inout) :: mesh + type (mpas_pool_type), intent(in) :: dims + type (mpas_pool_type), intent(in) :: configs + character (len=*), intent(in) :: geog_data_path + integer, intent(inout) :: isice_lu + integer, intent(inout) :: iswater_lu + integer, intent(inout) :: ismax_lu + + ! Local variables + type (mpas_geotile_mgr_type) :: mgr + character (len=StrKIND) :: fname + character (kind=c_char), dimension(StrKIND+1) :: c_fname + real (kind=c_float), dimension(:,:,:), pointer, contiguous :: rarray + real (kind=RKIND) :: scalefactor + real (kind=RKIND) :: dx, dy + real (kind=RKIND) :: lat_pt, lon_pt + real (kind=RKIND) :: start_lat, start_lon + real (kind=RKIND), dimension(:), pointer :: latCell, lonCell + integer, pointer :: nCells, maxEdges + integer, dimension(:), pointer :: nEdgesOnCell + integer, dimension(:,:), pointer :: cellsOnCell + integer (c_int) :: endian, isigned, istatus, wordsize + integer (c_int) :: nx, ny, nz + integer:: i,j,k + integer:: iCell,iPoint,iTileStart,iTileEnd,jTileStart,jTileEnd,iEnd,jEnd + type (c_ptr) :: rarray_ptr + + logical, pointer :: config_frac_landuse + + integer :: ncattot + integer :: ierr + + ierr = mgr % init(trim(geog_data_path)) + if (ierr /= 0) then + call mpas_log_write("Error occured initalizing interpolation for "//trim(geog_data_path), messageType=MPAS_LOG_CRIT) + return ! Program execution should not reach this statement since the preceding message is a critical error + end if + + call mpas_pool_get_config(configs, 'config_frac_landuse', config_frac_landuse) + + call mpas_pool_get_dimension(dims, 'nCells', nCells) + call mpas_pool_get_dimension(dims, 'maxEdges', maxEdges) + call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(mesh, 'cellsOnCell', cellsOnCell) + call mpas_pool_get_array(mesh, 'latCell', latCell) + call mpas_pool_get_array(mesh, 'lonCell', lonCell) + call mpas_pool_get_array(mesh, 'lu_index', lu_index) + call mpas_pool_get_array(mesh, 'landusef', landusef) + call mpas_pool_get_config(mgr % pool, 'category_min', category_min) + + ismax_lu = 40 + iswater_lu = 17 + isice_lu = 15 + nx = 6000 + ny = 3800 + nz = 40 + isigned = 0 + endian = 0 + wordsize = 2 + scalefactor = 0.1 + dx = 0.0025 + dy = 0.0025 + start_lat = 9.00125000 + start_lon = -139.99875000 + jEnd = 19001 + iEnd = 30001 + allocate(rarray(nx,ny,nz)) + allocate(ncat(ismax_lu,nCells)) + ncat(:,:) = 0 + + rarray_ptr = c_loc(rarray) + + do jTileStart = 1,jEnd,ny + jTileEnd = jTileStart + ny - 1 + + do iTileStart = 1,iEnd,nx + iTileEnd = iTileStart + nx - 1 + write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path), & + iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd + call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) + + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & + wordsize,istatus) + call init_atm_check_read_error(istatus, fname) + rarray(:,:,:) = rarray(:,:,:) * real(scalefactor, kind=c_float) ! rarray contains fractional % (0-100) land use by category + + iPoint = 1 + do k=1,nz + do j=1,ny + do i=1,nx + ! Check if the NLCD dataset has zeros + if (nint(rarray(i,j,k)) == 0) cycle + + lat_pt = start_lat + (jTileStart + j - 2) * dy + lon_pt = start_lon + (iTileStart + i - 2) * dx + lat_pt = lat_pt * PI / 180.0 + lon_pt = lon_pt * PI / 180.0 + + iPoint = nearest_cell(lat_pt,lon_pt,iPoint,nCells,maxEdges, & + nEdgesOnCell,cellsOnCell, & + latCell,lonCell) + ncat(k,iPoint) = ncat(k,iPoint) + 1 + end do + end do + end do + + end do + end do + + if (.not. config_frac_landuse) then ! compute dominant NLCD land use for CONUS + do iCell = 1, nCells + if (maxloc(ncat(:,iCell), dim=1) < 21) cycle ! do not change MODIS land use outside CONUS + ! Because maxloc returns the location of the maximum value of an array as if the + ! starting index of the array is 1, and dataset categories do not necessarily start + ! at 1, we need to use category_min to ensure the correct category location is chosen. + lu_index(iCell) = maxloc(ncat(:,iCell), dim=1) - 1 + category_min + landusef(lu_index(iCell),iCell) = 1.0 ! defines dominant NLCD land use only + end do + else ! compute fractional NLCD land use for CONUS + do iCell = 1, nCells + if (maxloc(ncat(:,iCell), dim=1) < 21) cycle ! do not change MODIS land use outide CONUS + ! Note that lu_index currently defines dominant land use only for ivgtyp, where + ! ivgtyp is used by Noah LSM (and PX LSM when landusef=0 everywhere). + lu_index(iCell) = maxloc(ncat(:,iCell), dim=1) - 1 + category_min + ncattot = 0 + do i = 1,ismax_lu + ncattot = ncattot + ncat(i,iCell) + end do + do i = 1,ismax_lu + if (ncat(i,iCell) > 0) then + do j = 1,ismax_lu + landusef(j,iCell) = 0.0 ! clear MODIS landusef if NLCD (CONUS) cell + end do + end if + end do + do i = 1,ismax_lu + if (ncat(i,iCell) > 0) then + landusef(i,iCell) = real(ncat(i,iCell))/ncattot ! defines fractional land use for PX LSM + end if + end do + end do + end if + deallocate(rarray) + deallocate(ncat) + + nullify(category_min) + + end subroutine interp_landuse2 + !*********************************************************************** ! ! routine interp_soilcat @@ -1643,13 +2030,14 @@ end subroutine interp_landuse !> iswater is present in the dataset's index file. !> !----------------------------------------------------------------------- - subroutine interp_soilcat(mesh, kdtree, geog_data_path, iswater_soil) + subroutine interp_soilcat(mesh, kdtree, geog_data_path, iswater_soil, configs) implicit none ! Input variables type (mpas_pool_type), intent(inout) :: mesh type (mpas_kd_type), pointer, intent(in) :: kdtree + type (mpas_pool_type), intent(in) :: configs character (len=*), intent(in) :: geog_data_path integer, intent(out) :: iswater_soil @@ -1660,7 +2048,10 @@ subroutine interp_soilcat(mesh, kdtree, geog_data_path, iswater_soil) real (kind=RKIND), pointer :: scalefactor - integer :: iCell + logical, pointer :: config_frac_landuse + + integer :: ncattot + integer :: i, iCell integer :: ierr ierr = mgr % init(trim(geog_data_path)) @@ -1669,8 +2060,11 @@ subroutine interp_soilcat(mesh, kdtree, geog_data_path, iswater_soil) return end if + call mpas_pool_get_config(configs, 'config_frac_landuse', config_frac_landuse) + call mpas_pool_get_dimension(mesh, 'nCells', nCells) - call mpas_pool_get_array(mesh, 'soilcat_top', soilcat_top) + call mpas_pool_get_array(mesh, 'soilcat', soilcat) + call mpas_pool_get_array(mesh, 'soiltypf', soiltypf) call mpas_pool_get_config(mgr % pool, 'scale_factor', scalefactor) call mpas_pool_get_config(mgr % pool, 'category_min', category_min) call mpas_pool_get_config(mgr % pool, 'category_max', category_max) @@ -1680,15 +2074,39 @@ subroutine interp_soilcat(mesh, kdtree, geog_data_path, iswater_soil) allocate(ncat(category_min:category_max, nCells)) ncat(:,:) = 0 + soiltypf(:,:) = 0.0 call init_atm_map_static_data(mesh, mgr, kdtree, categorical_interp_criteria, categorical_interp_accumulation) - do iCell = 1, nCells - ! Because maxloc returns the location of the maximum value of an array as if the - ! starting index of the array is 1, and dataset categories do not necessarily start - ! at 1, we need to use category_min to ensure the correct category location is chosen. - soilcat_top(iCell) = maxloc(ncat(:,iCell), dim=1) - 1 + category_min - end do + if(.not. config_frac_landuse) then ! compute dominant soil type for dominant land use + do iCell = 1, nCells + ! Because maxloc returns the location of the maximum value of an array as if the + ! starting index of the array is 1, and dataset categories do not necessarily start + ! at 1, we need to use category_min to ensure the correct category location is chosen. + soilcat(iCell) = maxloc(ncat(:,iCell), dim=1) - 1 + category_min + soiltypf(soilcat(iCell),iCell) = 1.0 ! defines dominant soil type only + end do + else ! compute fractional soil type for fractional land use + do iCell = 1,nCells + soilcat(iCell) = 1 + do i = 2,16 + if(ncat(i,iCell) > ncat(soilcat(iCell),iCell)) then + soilcat(iCell) = i ! currently defines dominant soil type only for isltyp + end if + end do + end do + do iCell = 1,nCells + ncattot = 0 + do i = 1,16 + ncattot = ncattot + ncat(i,iCell) + end do + do i = 1,16 + if(ncat(i,iCell) > 0) then + soiltypf(i,iCell) = real(ncat(i,iCell))/ncattot ! defines fractional soil type for PX LSM + end if + end do + end do + end if deallocate(ncat) ierr = mgr % finalize() diff --git a/src/core_init_atmosphere/mpas_init_atm_surface.F b/src/core_init_atmosphere/mpas_init_atm_surface.F index 962ccb282c..b9060b1ad1 100644 --- a/src/core_init_atmosphere/mpas_init_atm_surface.F +++ b/src/core_init_atmosphere/mpas_init_atm_surface.F @@ -19,7 +19,7 @@ module mpas_init_atm_surface implicit none private - public :: init_atm_case_sfc, interp_sfc_to_MPAS + public :: init_atm_case_sfc, interp_sfc_to_MPAS, init_atm_case_soilndg, interp_soilndg_to_MPAS contains @@ -276,6 +276,249 @@ subroutine interp_sfc_to_MPAS(timeString, mesh, fg, dims, dminfo, config_sfc_pre end subroutine interp_sfc_to_MPAS +!================================================================================================== + subroutine init_atm_case_soilndg(domain, dminfo, stream_manager, mesh, fg, state, dims, configs) +!================================================================================================== + + use mpas_stream_manager + + implicit none + +!input arguments: + type (domain_type), intent(inout) :: domain + type (dm_info), intent(in) :: dminfo + type (MPAS_streamManager_type), intent(inout) :: stream_manager + type (mpas_pool_type), intent(inout) :: mesh + type (mpas_pool_type), intent(inout) :: fg + type (mpas_pool_type), intent(inout) :: state + type (mpas_pool_type), intent(in) :: dims + type (mpas_pool_type), intent(in) :: configs + +!local variables: + type (MPAS_Time_type) :: curr_time, next_time, stop_time + character(len=StrKIND) :: timeStringC, timeStringN, timeStop + + character(len=StrKIND), pointer :: config_sfc_prefix, config_sfc_prefix_hires + character(len=StrKIND), pointer :: xtime + integer :: ierr, count + + +!================================================================================================== + + + call mpas_pool_get_config(configs, 'config_sfc_prefix', config_sfc_prefix) + call mpas_pool_get_config(configs, 'config_sfc_prefix_hires', config_sfc_prefix_hires) + + call mpas_pool_get_array(state, 'xtime', xtime) + +!loop over all times: + curr_time = mpas_get_clock_time(domain % clock, MPAS_NOW) + stop_time = mpas_get_clock_time(domain % clock, MPAS_STOP_TIME) + count = 1 + do while (curr_time <= stop_time) + + if(count > 1) then + curr_time = next_time + end if + + call mpas_get_time(curr_time, dateTimeString=timeStringC) + call mpas_get_time(stop_time, dateTimeString=timeStop) + xtime = timeStringC + + call mpas_advance_clock(domain % clock) + next_time = mpas_get_clock_time(domain % clock, MPAS_NOW) + call mpas_get_time(next_time, dateTimeString=timeStringN) + + ! Read the T2, RH2 and SNOW analyses from the surface file, and interpolate the data to the MPAS grid. + ! If hires analysis is specified do blending with coarse analysis. If default of NONE, only interp + ! the main analysis. Note that hires analysis needs to be placed on a global lat-lon grid using wgrib2 + ! + if(trim(config_sfc_prefix_hires) == "NONE") then + call interp_soilndg_to_MPAS(timeStringN(1:13), mesh, fg, dims, dminfo, config_sfc_prefix, 1) + else + call mpas_log_write('Blending hires '//trim(config_sfc_prefix_hires)//' with '//trim(config_sfc_prefix)) + call interp_soilndg_to_MPAS(timeStringN(1:13), mesh, fg, dims, dminfo, config_sfc_prefix_hires, 1) + call interp_soilndg_to_MPAS(timeStringN(1:13), mesh, fg, dims, dminfo, config_sfc_prefix, 0) + endif + + + !write the interpolated T2, RH2 and SNOW analyses in MPAS output file: + call mpas_stream_mgr_write(stream_manager, streamID='soilndg', ierr=ierr) + call mpas_stream_mgr_reset_alarms(stream_manager, streamID='soilndg', direction=MPAS_STREAM_OUTPUT, ierr=ierr) + + count = count +1 + + end do + + end subroutine init_atm_case_soilndg + +!================================================================================================== + subroutine interp_soilndg_to_MPAS(timeString, mesh, fg, dims, dminfo, config_sfc_prefix, firstpass) +!================================================================================================== + + use mpas_dmpar + + implicit none + +!input arguments: + character(len=*), intent(in) :: timeString + type (mpas_pool_type), intent(in) :: mesh + type (mpas_pool_type), intent(in) :: dims + type (dm_info), intent(in) :: dminfo + character(len=*), intent(in) :: config_sfc_prefix + integer, intent(in) :: firstpass + +!inout arguments: + type (mpas_pool_type), intent(inout) :: fg + + +!local variables: + type(met_data) :: field !real*4 meteorological data. + + integer :: istatus + integer :: masked + integer, dimension(5) :: interp_list + integer, dimension(:), pointer :: mask_array + logical :: have_landmask + + real(kind=RKIND) :: fillval, maskval, msgval + real(kind=RKIND), dimension(:,:), allocatable :: maskslab + + integer, dimension(:), pointer :: landmask + real(kind=RKIND), dimension(:), pointer :: destField1d + real(kind=RKIND), dimension(:), pointer :: t2anl, rh2anl, snoanl + + integer, pointer :: nCells + +!================================================================================================== + + call mpas_pool_get_array(mesh, 'landmask', mask_array) + call mpas_pool_get_array(mesh, 'landmask', landmask) + call mpas_pool_get_array(fg, 't2anl', t2anl) + call mpas_pool_get_array(fg, 'rh2anl', rh2anl) + call mpas_pool_get_array(fg, 'snoanl', snoanl) + + call mpas_pool_get_dimension(dims, 'nCells', nCells) + +!open intermediate file: + call read_met_init(trim(config_sfc_prefix),.false.,timeString,istatus) + if(istatus /= 0) then + call mpas_log_write('********************************************************************************', messageType=MPAS_LOG_ERR) + call mpas_log_write('Error opening surface file '//trim(config_sfc_prefix)//':'//timeString(1:13), messageType=MPAS_LOG_ERR) + call mpas_log_write('********************************************************************************', messageType=MPAS_LOG_CRIT) + else + call mpas_log_write('Processing file '//trim(config_sfc_prefix)//':'//timeString(1:13)) + end if + +!scan through all fields in the file, looking for the LANDSEA field: + have_landmask = .false. + call read_next_met_field(field,istatus) + do while (istatus == 0) + if(index(field % field, 'LANDSEA') /= 0) then + have_landmask = .true. + if(.not.allocated(maskslab)) allocate(maskslab(-2:field % nx+3, field % ny)) + maskslab(1:field % nx, 1:field % ny) = field % slab(1:field % nx, 1:field % ny) + maskslab(0, 1:field % ny) = field % slab(field % nx, 1:field % ny) + maskslab(-1, 1:field % ny) = field % slab(field % nx-1, 1:field % ny) + maskslab(-2, 1:field % ny) = field % slab(field % nx-2, 1:field % ny) + maskslab(field % nx+1, 1:field % ny) = field % slab(1, 1:field % ny) + maskslab(field % nx+2, 1:field % ny) = field % slab(2, 1:field % ny) + maskslab(field % nx+3, 1:field % ny) = field % slab(3, 1:field % ny) +! write(0,*) 'minval, maxval of LANDSEA = ', minval(maskslab), maxval(maskslab) + end if + deallocate(field % slab) + call read_next_met_field(field,istatus) + end do + call read_met_close() + +!read sea-surface temperatures and seaice data. open intermediate file: + call read_met_init(trim(config_sfc_prefix),.false.,timeString(1:13),istatus) + if(istatus /= 0) then + call mpas_log_write('********************************************************************************', messageType=MPAS_LOG_ERR) + call mpas_log_write('Error opening surface file '//trim(config_sfc_prefix)//':'//timeString(1:13), messageType=MPAS_LOG_ERR) + call mpas_log_write('********************************************************************************', messageType=MPAS_LOG_CRIT) + end if + +!scan through all fields in the file, looking for the T2, RH2 and SNOWH + call read_next_met_field(field,istatus) + do while (istatus == 0) + + if(index(field % field, 'T2') /= 0) then + call mpas_log_write('... Processing T2:') + if(firstpass == 1) then + t2anl(1:nCells) = 0.0_RKIND + end if + destField1d => t2anl + + !interpolation to the MPAS grid: + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = N_NEIGHBOR + msgval = -1.0e30_R4KIND !missing value + masked = 1 + maskval = 1.0_RKIND + fillval = 0.0_RKIND + call interp_to_MPAS2(mesh,nCells,field,destField1d,interp_list,msgval,masked,maskval,fillval, & + mask_array) + deallocate(field%slab) + + ! 2-m Rel. Hum. (RH2 in Ungrib file) + else if(index(field % field, 'RH2') /= 0) then + call mpas_log_write('... Processing RH2:') + if(firstpass == 1) then + rh2anl(1:nCells) = 0.0_RKIND + end if + destField1d => rh2anl + + !interpolation to the MPAS grid: + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = N_NEIGHBOR + msgval = -1.0e30_R4KIND !missing value + masked = 1 + maskval = 1.0_RKIND + fillval = 0.0_RKIND + call interp_to_MPAS2(mesh,nCells,field,destField1d,interp_list,msgval,masked,maskval,fillval, & + mask_array) + deallocate(field%slab) + + ! Snow water (SNOW in Ungrib file) + else if(index(field % field, 'SNOW') /= 0) then + call mpas_log_write('... Processing SNOW:') + if(firstpass == 1) then + snoanl(1:nCells) = 0.0_RKIND + end if + destField1d => snoanl + + !interpolation to the MPAS grid: + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = N_NEIGHBOR + msgval = -1.0e30_R4KIND !missing value + masked = 1 + maskval = 1.0_RKIND + fillval = 0.0_RKIND + call interp_to_MPAS2(mesh,nCells,field,destField1d,interp_list,msgval,masked,maskval,fillval, & + mask_array) + deallocate(field%slab) + + else + deallocate(field%slab) + + end if + + call read_next_met_field(field,istatus) + end do + +!close intermediate file: + call read_met_close() + if(allocated(maskslab)) deallocate(maskslab) + + end subroutine interp_soilndg_to_MPAS + !================================================================================================== subroutine interp_to_MPAS(mesh,nCells,field,destField1d,interp_list,msgval,masked,maskval,fillval, & mask_array,maskslab) @@ -384,6 +627,122 @@ subroutine interp_to_MPAS(mesh,nCells,field,destField1d,interp_list,msgval,maske end subroutine interp_to_MPAS +!================================================================================================== + subroutine interp_to_MPAS2(mesh,nCells,field,destField1d,interp_list,msgval,masked,maskval,fillval, & + mask_array,maskslab) +!================================================================================================== + +!input arguments: + type (mpas_pool_type), intent(in) :: mesh + integer, intent(in) :: nCells + type (met_data), intent(in) :: field !real*4 meteorological data. + + integer, intent(in) :: masked + integer, dimension(5), intent(in) :: interp_list + integer, dimension(:), intent(in), pointer :: mask_array + + real(kind=RKIND), intent(in) :: fillval, maskval, msgval + real(kind=RKIND), intent(in), dimension(*), optional :: maskslab + +!inout arguments: + real(kind=RKIND), intent(inout), dimension(:), pointer :: destField1d + +!local variables: + type(proj_info) :: proj + integer :: i, nInterpPoints + real(kind=RKIND) :: lat,lon,x,y, tmpfield + real(kind=RKIND), dimension(:,:), allocatable :: rslab + + real(kind=RKIND), dimension(:), pointer :: latPoints, lonPoints + real(kind=RKIND), dimension(:), pointer :: latCell, lonCell + +!-------------------------------------------------------------------------------------------------- + + call mpas_pool_get_array(mesh, 'latCell', latCell) + call mpas_pool_get_array(mesh, 'lonCell', lonCell) + + call map_init(proj) + if(field % iproj == PROJ_LATLON) then + call map_set(PROJ_LATLON, proj, & + latinc = real(field % deltalat,RKIND), & + loninc = real(field % deltalon,RKIND), & + knowni = 1.0_RKIND, & + knownj = 1.0_RKIND, & + lat1 = real(field % startlat,RKIND), & + lon1 = real(field % startlon,RKIND)) +! write(0,*) '--- The projection is PROJ_LATLON.' + else if(field % iproj == PROJ_GAUSS) then + call map_set(PROJ_GAUSS, proj, & + nlat = nint(field % deltalat), & + loninc = 360.0_RKIND / real(field % nx,RKIND), & + lat1 = real(field % startlat,RKIND), & + lon1 = real(field % startlon,RKIND)) +! write(0,*) '--- The projection is PROJ_GAUSS.' + else if(field % iproj == PROJ_PS) then + call map_set(PROJ_PS, proj, & + dx = real(field % dx,RKIND), & + truelat1 = real(field % truelat1,RKIND), & + stdlon = real(field % xlonc,RKIND), & + knowni = real(field % nx / 2.0,RKIND), & + knownj = real(field % ny / 2.0,RKIND), & + lat1 = real(field % startlat,RKIND), & + lon1 = real(field % startlon,RKIND)) +! write(0,*) '--- The projection is PROJ_PS.' + end if + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + + allocate(rslab(-2:field % nx+3, field % ny)) + rslab(1:field % nx, 1:field % ny) = field % slab(1:field % nx, 1:field % ny) + rslab( 0, 1:field % ny) = field % slab(field % nx , 1:field % ny) + rslab(-1, 1:field % ny) = field % slab(field % nx-1, 1:field % ny) + rslab(-2, 1:field % ny) = field % slab(field % nx-2, 1:field % ny) + rslab(field % nx+1, 1:field % ny) = field % slab(1, 1:field % ny) + rslab(field % nx+2, 1:field % ny) = field % slab(2, 1:field % ny) + rslab(field % nx+3, 1:field % ny) = field % slab(3, 1:field % ny) + + do i = 1,nInterpPoints + if(mask_array(i) /= masked) then + lat = latPoints(i) * DEG_PER_RAD + lon = lonPoints(i) * DEG_PER_RAD + call latlon_to_ij(proj, lat, lon, x, y) + if(y <= 0.5) then + y = 1.0 + else if(y >= real(field%ny)+0.5) then + y = real(field % ny) + end if + if(x < 0.5) then + lon = lon + 360.0 + call latlon_to_ij(proj, lat, lon, x, y) + else if (x >= real(field%nx)+0.5) then + lon = lon - 360.0 + call latlon_to_ij(proj, lat, lon, x, y) + end if + + if(present(maskslab)) then + if(destField1d(i) == 0.0 .or. destField1d(i) > 999999999999 ) then + destField1d(i) = interp_sequence(x,y,1,rslab,-2,field%nx+3,1,field%ny,1,1, & + msgval,interp_list,4,maskval=maskval,mask_array=maskslab) + else + endif + else + if(destField1d(i) == 0.0 .or. destField1d(i) > 999999999999 ) then + destField1d(i) = interp_sequence(x,y,1,rslab,-2,field%nx+3,1,field%ny,1,1, & + msgval,interp_list,4,maskval=maskval) + else + endif + end if + else + destField1d(i) = fillval + end if + + end do + deallocate(rslab) + + end subroutine interp_to_MPAS2 + !================================================================================================== end module mpas_init_atm_surface !==================================================================================================