Skip to content

Commit

Permalink
Merge pull request #2 from climbfuji/hannah_GF_RadiationUpdate_Revert…
Browse files Browse the repository at this point in the history 
…Aerosols_dom_20210823_2

Hannah gf radiation update revert aerosols dom 20210823 part 2
  • Loading branch information
@hannahcbarnes
hannahcbarnes authored Aug 23, 2021
2 parents 2069121 + a96f7bb commit 5a7d775
Show file tree
Hide file tree
Showing 3 changed files with 77 additions and 38 deletions.
19 changes: 6 additions & 13 deletions physics/module_sf_ruclsm.F90
View file
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
View file
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
View file
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

0 comments on commit 5a7d775

Please sign in to comment.