Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 6 additions & 13 deletions physics/module_sf_ruclsm.F90
Original file line number Diff line number Diff line change
Expand Up @@ -708,8 +708,7 @@ SUBROUTINE LSMRUC( &
ENDIF

!> - Call soilvegin() to initialize soil and surface properties
IF((XLAND(I,J)-1.5).LT.0..and. xice(i,j).lt.xice_threshold)THEN
!-- land
!-- land or ice
CALL SOILVEGIN ( debug_print, &
soilfrac,nscat,shdmin(i,j),shdmax(i,j),mosaic_lu, mosaic_soil,&
NLCAT,ILAND,ISOIL,iswater,MYJ,IFOREST,lufrac,VEGFRA(I,J), &
Expand All @@ -724,16 +723,10 @@ SUBROUTINE LSMRUC( &
print *,'after SOILVEGIN - z0,znt(1,26),lai(1,26)',z0(i,j),znt(i,j),lai(i,j)

if(init)then
! print *,'NLCAT,iland,lufrac,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J)', &
! NLCAT,iland,lufrac,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J),i,j
print *,'NLCAT,iland,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J)', &
NLCAT,iland,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J),i,j

! print *,'NSCAT,soilfrac,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT',&
! NSCAT,soilfrac,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT,i,j
print *,'NSCAT,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT',&
NSCAT,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT,i,j

endif
ENDIF

Expand Down Expand Up @@ -784,7 +777,6 @@ SUBROUTINE LSMRUC( &
print *,'NROOT, meltfactor, iforest, ivgtyp, i,j ', nroot,meltfactor,iforest,ivgtyp(I,J),I,J
ENDIF

ENDIF ! land
!!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
! if(i.eq.397.and.j.eq.562) then
! print *,'RUC LSM - xland(i,j),xice(i,j),snow(i,j)',i,j,xland(i,j),xice(i,j),snow(i,j)
Expand Down Expand Up @@ -7052,7 +7044,7 @@ END SUBROUTINE SOILVEGIN
!> This subroutine computes liquid and forezen soil moisture from the
!! total soil moisture, and also computes soil moisture availability in
!! the top soil layer.
SUBROUTINE RUCLSMINIT( debug_print, slmsk, &
SUBROUTINE RUCLSMINIT( debug_print, landfrac, fice, min_seaice, &
nzs, isltyp, ivgtyp, mavail, &
sh2o, smfr3d, tslb, smois, &
ims,ime, jms,jme, kms,kme, &
Expand All @@ -7065,7 +7057,8 @@ SUBROUTINE RUCLSMINIT( debug_print, slmsk, &
#endif
IMPLICIT NONE
LOGICAL, INTENT(IN ) :: debug_print
REAL, DIMENSION( ims:ime), INTENT(IN ) :: slmsk
REAL, DIMENSION( ims:ime), INTENT(IN ) :: landfrac, fice
REAL, INTENT(IN ) :: min_seaice

INTEGER, INTENT(IN ) :: &
ims,ime, jms,jme, kms,kme, &
Expand Down Expand Up @@ -7125,7 +7118,7 @@ SUBROUTINE RUCLSMINIT( debug_print, slmsk, &
! has isltyp=14 for water
if (isltyp(i,j) == 0) isltyp(i,j)=14

if(slmsk(i) == 1. ) then
if(landfrac(i) > 0. ) then
!-- land
!-- Computate volumetric content of ice in soil
!-- and initialize MAVAIL
Expand Down Expand Up @@ -7158,7 +7151,7 @@ SUBROUTINE RUCLSMINIT( debug_print, slmsk, &
endif
ENDDO

elseif( slmsk(i) == 2.) then
elseif( fice(i) > min_seaice) then
!-- ice
mavail(i,j) = 1.
DO L=1,NZS
Expand Down
85 changes: 61 additions & 24 deletions physics/sfc_drv_ruc.F90
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ module lsm_ruc
subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
flag_restart, flag_init, con_fvirt, con_rd, &
im, lsoil_ruc, lsoil, kice, nlev, & ! in
lsm_ruc, lsm, slmsk, stype, vtype, & ! in
lsm_ruc, lsm, slmsk, stype, vtype, landfrac, & ! in
q1, prsl1, tsfc_lnd, tsfc_ice, tsfc_wat, & ! in
tg3, smc, slc, stc, fice, min_seaice, & ! in
sncovr_lnd, sncovr_ice, snoalb, & ! in
Expand Down Expand Up @@ -64,6 +64,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
real (kind=kind_phys), dimension(:), intent(in) :: slmsk
real (kind=kind_phys), dimension(:), intent(in) :: stype
real (kind=kind_phys), dimension(:), intent(in) :: vtype
real (kind=kind_phys), dimension(:), intent(in) :: landfrac
real (kind=kind_phys), dimension(:), intent(in) :: q1
real (kind=kind_phys), dimension(:), intent(in) :: prsl1
real (kind=kind_phys), dimension(:), intent(in) :: tsfc_lnd
Expand Down Expand Up @@ -168,7 +169,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
vegtype(:) = 0

do i = 1, im ! i - horizontal loop
if (slmsk(i) == 2.) then
!if (slmsk(i) == 2.) then
if (fice(i) > min_seaice) then
!-- ice
if (isot == 1) then
soiltyp(i) = 16
Expand Down Expand Up @@ -225,8 +227,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &

call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in
me, master, lsm_ruc, lsm, slmsk, & ! in
soiltyp, vegtype, & ! in
tsfc_lnd, tsfc_wat, tg3, & ! in
soiltyp, vegtype, landfrac, fice, & ! in
min_seaice, tsfc_lnd, tsfc_wat, tg3, & ! in
zs, dzs, smc, slc, stc, & ! in
sh2o, smfrkeep, tslb, smois, & ! out
wetness, errmsg, errflg)
Expand Down Expand Up @@ -346,7 +348,7 @@ subroutine lsm_ruc_run & ! inputs
& imp_physics, imp_physics_gfdl, imp_physics_thompson, &
& do_mynnsfclay, lsoil_ruc, lsoil, rdlai, zs, &
& t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, &
& dlwflx, dswsfc, tg3, coszen, land, icy, lake, &
& dlwflx, dswsfc, tg3, coszen, land, icy, use_lake, &
& rainnc, rainc, ice, snow, graupel, &
& prsl1, zf, wind, shdmin, shdmax, &
& srflag, sfalb_lnd_bck, snoalb, &
Expand Down Expand Up @@ -414,7 +416,7 @@ subroutine lsm_ruc_run & ! inputs
con_hvap, con_fvirt

logical, dimension(:), intent(in) :: flag_iter, flag_guess
logical, dimension(:), intent(in) :: land, icy, lake
logical, dimension(:), intent(in) :: land, icy, use_lake
logical, dimension(:), intent(in) :: flag_cice
logical, intent(in) :: frac_grid
logical, intent(in) :: do_mynnsfclay
Expand Down Expand Up @@ -465,6 +467,10 @@ subroutine lsm_ruc_run & ! inputs
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

! --- SPP - should be INTENT(IN)
integer :: spp_lsm
real(kind=kind_phys), dimension(im,nlev) :: pattern_spp

! --- locals:
real (kind=kind_phys), dimension(im) :: rho, &
& q0, qs1, albbcksol, &
Expand All @@ -480,6 +486,8 @@ subroutine lsm_ruc_run & ! inputs
& sfcqv_ice_old, sfcqc_ice_old, z0rl_ice_old, &
& sncovr1_ice_old

!-- local spp pattern array
real (kind=kind_phys), dimension(im,lsoil_ruc,1) :: pattern_spp_lsm

real (kind=kind_phys), dimension(lsoil_ruc) :: et

Expand Down Expand Up @@ -571,7 +579,7 @@ subroutine lsm_ruc_run & ! inputs
endif
! - Set flag for ice points for uncoupled model (islmsk(i) == 4 when coupled to CICE)
! - Exclude ice on the lakes if the lake model is turned on.
flag_ice_uncoupled(i) = (flag_ice(i) .and. .not. lake(i))
flag_ice_uncoupled(i) = (flag_ice(i) .and. .not. use_lake(i))
!> - Set flag for land and ice points.
!- 10may19 - ice points are turned off.
flag(i) = land(i) .or. flag_ice_uncoupled(i)
Expand Down Expand Up @@ -622,6 +630,12 @@ subroutine lsm_ruc_run & ! inputs
landusef (:,:,:) = 0.0
soilctop (:,:,:) = 0.0

!-- spp
spp_lsm = 0 ! so far (10May2021)
if(spp_lsm == 0) then
pattern_spp (:,:) = 0.0
endif

!> -- number of soil categories
!if(isot == 1) then
!nscat = 19 ! stasgo
Expand Down Expand Up @@ -852,11 +866,6 @@ subroutine lsm_ruc_run & ! inputs
!acsn(i,j) = acsnow(i)
acsn(i,j) = 0.0

! --- units %
shdfac(i,j) = sigmaf(i)*100.
shdmin1d(i,j) = shdmin(i)*100.
shdmax1d(i,j) = shdmax(i)*100.

tbot(i,j) = tg3(i)

!> - 3. canopy/soil characteristics (s):
Expand Down Expand Up @@ -901,6 +910,10 @@ subroutine lsm_ruc_run & ! inputs
endif

semis_bck(i,j) = semisbase(i)
! --- units %
shdfac(i,j) = sigmaf(i)*100.
shdmin1d(i,j) = shdmin(i)*100.
shdmax1d(i,j) = shdmax(i)*100.

if (land(i)) then ! at least some land in the grid cell

Expand Down Expand Up @@ -947,6 +960,27 @@ subroutine lsm_ruc_run & ! inputs

snoalb1d_lnd(i,j) = snoalb(i)
albbck_lnd(i,j) = albbcksol(i) !sfalb_lnd_bck(i)


!-- spp_lsm
if (spp_lsm == 1) then
!-- spp for LSM is dimentioned as (1:lsoil_ruc)
do k = 1, lsoil_ruc
pattern_spp_lsm (i,k,j) = pattern_spp(i,k)
enddo
!-- stochastic perturbation of snow-free albedo, emissivity and veg.
!-- fraction
albbck_lnd(i,j) = min(albbck_lnd(i,j) * (1. + 0.4*pattern_spp_lsm(i,1,j)), 1.)
sfcems_lnd(i,j) = min(sfcems_lnd(i,j) * (1. + 0.1*pattern_spp_lsm(i,1,j)), 1.)
shdfac(i,j) = min(0.01*shdfac(i,j) * (1. + 0.33*pattern_spp_lsm(i,1,j)),1.)*100.
if (kdt == 2) then
!-- stochastic perturbation of soil moisture at time step 2
do k = 1, lsoil_ruc
smois(i,k) = smois(i,k)*(1+1.5*pattern_spp_lsm(i,k,j))
enddo
endif
endif

alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i)
solnet_lnd(i,j) = dswsfc(i)*(1.-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2

Expand Down Expand Up @@ -1486,8 +1520,8 @@ end subroutine lsm_ruc_run
!! This subroutine contains RUC LSM initialization.
subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
me, master, lsm_ruc, lsm, slmsk, & ! in
soiltyp, vegtype, & ! in
tskin_lnd, tskin_wat, tg3, & ! !in
soiltyp, vegtype, landfrac, fice, & ! in
min_seaice, tskin_lnd, tskin_wat, tg3, & ! in
zs, dzs, smc, slc, stc, & ! in
sh2o, smfrkeep, tslb, smois, & ! out
wetness, errmsg, errflg)
Expand All @@ -1500,7 +1534,10 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
integer, intent(in ) :: im, nlev
integer, intent(in ) :: lsoil_ruc
integer, intent(in ) :: lsoil
real (kind=kind_phys), intent(in ) :: min_seaice
real (kind=kind_phys), dimension(im), intent(in ) :: slmsk
real (kind=kind_phys), dimension(im), intent(in ) :: landfrac
real (kind=kind_phys), dimension(im), intent(in ) :: fice
real (kind=kind_phys), dimension(im), intent(in ) :: tskin_lnd, tskin_wat
real (kind=kind_phys), dimension(im), intent(in ) :: tg3
real (kind=kind_phys), dimension(1:lsoil_ruc), intent(in ) :: zs
Expand Down Expand Up @@ -1658,14 +1695,14 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
tbot(i,j) = tg3(i)
ivgtyp(i,j) = vegtype(i)
isltyp(i,j) = soiltyp(i)
if (slmsk(i) == 0.) then
!-- water
tsk(i,j) = tskin_wat(i)
landmask(i,j)=0.
else
if (landfrac(i) > 0. .or. fice(i) > 0.) then
!-- land or ice
tsk(i,j) = tskin_lnd(i)
landmask(i,j)=1.
else
!-- water
tsk(i,j) = tskin_wat(i)
landmask(i,j)=0.
endif ! land(i)

enddo
Expand All @@ -1680,7 +1717,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
sm_input(i,1,j)=0.

!--- initialize smcwlt2 and smcref2 with Noah values
if(slmsk(i) == 1.) then
if(landfrac(i) > 0.) then
smcref2 (i) = REFSMCnoah(soiltyp(i))
smcwlt2 (i) = WLTSMCnoah(soiltyp(i))
else
Expand All @@ -1691,7 +1728,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
do k=1,lsoil
st_input(i,k+1,j)=stc(i,k)
! convert volumetric soil moisture to SWI (soil wetness index)
if(slmsk(i) == 1. .and. swi_init) then
if(landfrac(i) > 0. .and. swi_init) then
sm_input(i,k+1,j)=min(1.,max(0.,(smc(i,k) - smcwlt2(i))/ &
(smcref2(i) - smcwlt2(i))))
else
Expand Down Expand Up @@ -1726,7 +1763,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in

do j=jts,jte
do i=its,ite
if (slmsk(i) == 1.) then
if (landfrac(i) == 1.) then
!-- land
do k=1,lsoil_ruc
! convert from SWI to RUC volumetric soil moisture
Expand Down Expand Up @@ -1767,7 +1804,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
do j=jts,jte
do i=its,ite

if (slmsk(i) == 1.) then
if (landfrac(i) > 0.) then

! initialize factor
do k=1,lsoil_ruc
Expand Down Expand Up @@ -1844,7 +1881,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
! and soil temperature, and also soil moisture availability in the top
! layer

call ruclsminit( debug_print, slmsk, &
call ruclsminit( debug_print, landfrac, fice, min_seaice, &
lsoil_ruc, isltyp, ivgtyp, mavail, &
soilh2o, smfr, soiltemp, soilm, &
ims,ime, jms,jme, kms,kme, &
Expand Down
11 changes: 10 additions & 1 deletion physics/sfc_drv_ruc.meta
Original file line number Diff line number Diff line change
Expand Up @@ -164,6 +164,15 @@
kind = kind_phys
intent = in
optional = F
[landfrac]
standard_name = land_area_fraction
long_name = fraction of horizontal grid area occupied by land
units = frac
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
intent = in
optional = F
[q1]
standard_name = water_vapor_specific_humidity_at_lowest_model_layer
long_name = water vapor specific humidity at lowest model layer
Expand Down Expand Up @@ -844,7 +853,7 @@
type = logical
intent = in
optional = F
[lake]
[use_lake]
standard_name = flag_for_using_flake
long_name = flag indicating lake points using flake model
units = flag
Expand Down