Skip to content

Commit 5a7d775

Browse files
Merge pull request #2 from climbfuji/hannah_GF_RadiationUpdate_RevertAerosols_dom_20210823_2
Hannah gf radiation update revert aerosols dom 20210823 part 2
2 parents 2069121 + a96f7bb commit 5a7d775

File tree

3 files changed

+77
-38
lines changed

3 files changed

+77
-38
lines changed

physics/module_sf_ruclsm.F90

+6-13
Original file line numberDiff line numberDiff line change
@@ -708,8 +708,7 @@ SUBROUTINE LSMRUC( &
708708
ENDIF
709709

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

726725
if(init)then
727-
! print *,'NLCAT,iland,lufrac,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J)', &
728-
! NLCAT,iland,lufrac,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J),i,j
729726
print *,'NLCAT,iland,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J)', &
730727
NLCAT,iland,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J),i,j
731-
732-
! print *,'NSCAT,soilfrac,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT',&
733-
! NSCAT,soilfrac,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT,i,j
734728
print *,'NSCAT,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT',&
735729
NSCAT,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT,i,j
736-
737730
endif
738731
ENDIF
739732

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

787-
ENDIF ! land
788780
!!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
789781
! if(i.eq.397.and.j.eq.562) then
790782
! print *,'RUC LSM - xland(i,j),xice(i,j),snow(i,j)',i,j,xland(i,j),xice(i,j),snow(i,j)
@@ -7052,7 +7044,7 @@ END SUBROUTINE SOILVEGIN
70527044
!> This subroutine computes liquid and forezen soil moisture from the
70537045
!! total soil moisture, and also computes soil moisture availability in
70547046
!! the top soil layer.
7055-
SUBROUTINE RUCLSMINIT( debug_print, slmsk, &
7047+
SUBROUTINE RUCLSMINIT( debug_print, landfrac, fice, min_seaice, &
70567048
nzs, isltyp, ivgtyp, mavail, &
70577049
sh2o, smfr3d, tslb, smois, &
70587050
ims,ime, jms,jme, kms,kme, &
@@ -7065,7 +7057,8 @@ SUBROUTINE RUCLSMINIT( debug_print, slmsk, &
70657057
#endif
70667058
IMPLICIT NONE
70677059
LOGICAL, INTENT(IN ) :: debug_print
7068-
REAL, DIMENSION( ims:ime), INTENT(IN ) :: slmsk
7060+
REAL, DIMENSION( ims:ime), INTENT(IN ) :: landfrac, fice
7061+
REAL, INTENT(IN ) :: min_seaice
70697062

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

7128-
if(slmsk(i) == 1. ) then
7121+
if(landfrac(i) > 0. ) then
71297122
!-- land
71307123
!-- Computate volumetric content of ice in soil
71317124
!-- and initialize MAVAIL
@@ -7158,7 +7151,7 @@ SUBROUTINE RUCLSMINIT( debug_print, slmsk, &
71587151
endif
71597152
ENDDO
71607153

7161-
elseif( slmsk(i) == 2.) then
7154+
elseif( fice(i) > min_seaice) then
71627155
!-- ice
71637156
mavail(i,j) = 1.
71647157
DO L=1,NZS

physics/sfc_drv_ruc.F90

+61-24
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ module lsm_ruc
3333
subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
3434
flag_restart, flag_init, con_fvirt, con_rd, &
3535
im, lsoil_ruc, lsoil, kice, nlev, & ! in
36-
lsm_ruc, lsm, slmsk, stype, vtype, & ! in
36+
lsm_ruc, lsm, slmsk, stype, vtype, landfrac, & ! in
3737
q1, prsl1, tsfc_lnd, tsfc_ice, tsfc_wat, & ! in
3838
tg3, smc, slc, stc, fice, min_seaice, & ! in
3939
sncovr_lnd, sncovr_ice, snoalb, & ! in
@@ -64,6 +64,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
6464
real (kind=kind_phys), dimension(:), intent(in) :: slmsk
6565
real (kind=kind_phys), dimension(:), intent(in) :: stype
6666
real (kind=kind_phys), dimension(:), intent(in) :: vtype
67+
real (kind=kind_phys), dimension(:), intent(in) :: landfrac
6768
real (kind=kind_phys), dimension(:), intent(in) :: q1
6869
real (kind=kind_phys), dimension(:), intent(in) :: prsl1
6970
real (kind=kind_phys), dimension(:), intent(in) :: tsfc_lnd
@@ -168,7 +169,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
168169
vegtype(:) = 0
169170

170171
do i = 1, im ! i - horizontal loop
171-
if (slmsk(i) == 2.) then
172+
!if (slmsk(i) == 2.) then
173+
if (fice(i) > min_seaice) then
172174
!-- ice
173175
if (isot == 1) then
174176
soiltyp(i) = 16
@@ -225,8 +227,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
225227

226228
call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in
227229
me, master, lsm_ruc, lsm, slmsk, & ! in
228-
soiltyp, vegtype, & ! in
229-
tsfc_lnd, tsfc_wat, tg3, & ! in
230+
soiltyp, vegtype, landfrac, fice, & ! in
231+
min_seaice, tsfc_lnd, tsfc_wat, tg3, & ! in
230232
zs, dzs, smc, slc, stc, & ! in
231233
sh2o, smfrkeep, tslb, smois, & ! out
232234
wetness, errmsg, errflg)
@@ -346,7 +348,7 @@ subroutine lsm_ruc_run & ! inputs
346348
& imp_physics, imp_physics_gfdl, imp_physics_thompson, &
347349
& do_mynnsfclay, lsoil_ruc, lsoil, rdlai, zs, &
348350
& t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, &
349-
& dlwflx, dswsfc, tg3, coszen, land, icy, lake, &
351+
& dlwflx, dswsfc, tg3, coszen, land, icy, use_lake, &
350352
& rainnc, rainc, ice, snow, graupel, &
351353
& prsl1, zf, wind, shdmin, shdmax, &
352354
& srflag, sfalb_lnd_bck, snoalb, &
@@ -414,7 +416,7 @@ subroutine lsm_ruc_run & ! inputs
414416
con_hvap, con_fvirt
415417

416418
logical, dimension(:), intent(in) :: flag_iter, flag_guess
417-
logical, dimension(:), intent(in) :: land, icy, lake
419+
logical, dimension(:), intent(in) :: land, icy, use_lake
418420
logical, dimension(:), intent(in) :: flag_cice
419421
logical, intent(in) :: frac_grid
420422
logical, intent(in) :: do_mynnsfclay
@@ -465,6 +467,10 @@ subroutine lsm_ruc_run & ! inputs
465467
character(len=*), intent(out) :: errmsg
466468
integer, intent(out) :: errflg
467469

470+
! --- SPP - should be INTENT(IN)
471+
integer :: spp_lsm
472+
real(kind=kind_phys), dimension(im,nlev) :: pattern_spp
473+
468474
! --- locals:
469475
real (kind=kind_phys), dimension(im) :: rho, &
470476
& q0, qs1, albbcksol, &
@@ -480,6 +486,8 @@ subroutine lsm_ruc_run & ! inputs
480486
& sfcqv_ice_old, sfcqc_ice_old, z0rl_ice_old, &
481487
& sncovr1_ice_old
482488

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

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

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

633+
!-- spp
634+
spp_lsm = 0 ! so far (10May2021)
635+
if(spp_lsm == 0) then
636+
pattern_spp (:,:) = 0.0
637+
endif
638+
625639
!> -- number of soil categories
626640
!if(isot == 1) then
627641
!nscat = 19 ! stasgo
@@ -852,11 +866,6 @@ subroutine lsm_ruc_run & ! inputs
852866
!acsn(i,j) = acsnow(i)
853867
acsn(i,j) = 0.0
854868

855-
! --- units %
856-
shdfac(i,j) = sigmaf(i)*100.
857-
shdmin1d(i,j) = shdmin(i)*100.
858-
shdmax1d(i,j) = shdmax(i)*100.
859-
860869
tbot(i,j) = tg3(i)
861870

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

903912
semis_bck(i,j) = semisbase(i)
913+
! --- units %
914+
shdfac(i,j) = sigmaf(i)*100.
915+
shdmin1d(i,j) = shdmin(i)*100.
916+
shdmax1d(i,j) = shdmax(i)*100.
904917

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

@@ -947,6 +960,27 @@ subroutine lsm_ruc_run & ! inputs
947960

948961
snoalb1d_lnd(i,j) = snoalb(i)
949962
albbck_lnd(i,j) = albbcksol(i) !sfalb_lnd_bck(i)
963+
964+
965+
!-- spp_lsm
966+
if (spp_lsm == 1) then
967+
!-- spp for LSM is dimentioned as (1:lsoil_ruc)
968+
do k = 1, lsoil_ruc
969+
pattern_spp_lsm (i,k,j) = pattern_spp(i,k)
970+
enddo
971+
!-- stochastic perturbation of snow-free albedo, emissivity and veg.
972+
!-- fraction
973+
albbck_lnd(i,j) = min(albbck_lnd(i,j) * (1. + 0.4*pattern_spp_lsm(i,1,j)), 1.)
974+
sfcems_lnd(i,j) = min(sfcems_lnd(i,j) * (1. + 0.1*pattern_spp_lsm(i,1,j)), 1.)
975+
shdfac(i,j) = min(0.01*shdfac(i,j) * (1. + 0.33*pattern_spp_lsm(i,1,j)),1.)*100.
976+
if (kdt == 2) then
977+
!-- stochastic perturbation of soil moisture at time step 2
978+
do k = 1, lsoil_ruc
979+
smois(i,k) = smois(i,k)*(1+1.5*pattern_spp_lsm(i,k,j))
980+
enddo
981+
endif
982+
endif
983+
950984
alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i)
951985
solnet_lnd(i,j) = dswsfc(i)*(1.-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2
952986

@@ -1486,8 +1520,8 @@ end subroutine lsm_ruc_run
14861520
!! This subroutine contains RUC LSM initialization.
14871521
subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
14881522
me, master, lsm_ruc, lsm, slmsk, & ! in
1489-
soiltyp, vegtype, & ! in
1490-
tskin_lnd, tskin_wat, tg3, & ! !in
1523+
soiltyp, vegtype, landfrac, fice, & ! in
1524+
min_seaice, tskin_lnd, tskin_wat, tg3, & ! in
14911525
zs, dzs, smc, slc, stc, & ! in
14921526
sh2o, smfrkeep, tslb, smois, & ! out
14931527
wetness, errmsg, errflg)
@@ -1500,7 +1534,10 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
15001534
integer, intent(in ) :: im, nlev
15011535
integer, intent(in ) :: lsoil_ruc
15021536
integer, intent(in ) :: lsoil
1537+
real (kind=kind_phys), intent(in ) :: min_seaice
15031538
real (kind=kind_phys), dimension(im), intent(in ) :: slmsk
1539+
real (kind=kind_phys), dimension(im), intent(in ) :: landfrac
1540+
real (kind=kind_phys), dimension(im), intent(in ) :: fice
15041541
real (kind=kind_phys), dimension(im), intent(in ) :: tskin_lnd, tskin_wat
15051542
real (kind=kind_phys), dimension(im), intent(in ) :: tg3
15061543
real (kind=kind_phys), dimension(1:lsoil_ruc), intent(in ) :: zs
@@ -1658,14 +1695,14 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
16581695
tbot(i,j) = tg3(i)
16591696
ivgtyp(i,j) = vegtype(i)
16601697
isltyp(i,j) = soiltyp(i)
1661-
if (slmsk(i) == 0.) then
1662-
!-- water
1663-
tsk(i,j) = tskin_wat(i)
1664-
landmask(i,j)=0.
1665-
else
1698+
if (landfrac(i) > 0. .or. fice(i) > 0.) then
16661699
!-- land or ice
16671700
tsk(i,j) = tskin_lnd(i)
16681701
landmask(i,j)=1.
1702+
else
1703+
!-- water
1704+
tsk(i,j) = tskin_wat(i)
1705+
landmask(i,j)=0.
16691706
endif ! land(i)
16701707

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

16821719
!--- initialize smcwlt2 and smcref2 with Noah values
1683-
if(slmsk(i) == 1.) then
1720+
if(landfrac(i) > 0.) then
16841721
smcref2 (i) = REFSMCnoah(soiltyp(i))
16851722
smcwlt2 (i) = WLTSMCnoah(soiltyp(i))
16861723
else
@@ -1691,7 +1728,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
16911728
do k=1,lsoil
16921729
st_input(i,k+1,j)=stc(i,k)
16931730
! convert volumetric soil moisture to SWI (soil wetness index)
1694-
if(slmsk(i) == 1. .and. swi_init) then
1731+
if(landfrac(i) > 0. .and. swi_init) then
16951732
sm_input(i,k+1,j)=min(1.,max(0.,(smc(i,k) - smcwlt2(i))/ &
16961733
(smcref2(i) - smcwlt2(i))))
16971734
else
@@ -1726,7 +1763,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
17261763

17271764
do j=jts,jte
17281765
do i=its,ite
1729-
if (slmsk(i) == 1.) then
1766+
if (landfrac(i) == 1.) then
17301767
!-- land
17311768
do k=1,lsoil_ruc
17321769
! convert from SWI to RUC volumetric soil moisture
@@ -1767,7 +1804,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
17671804
do j=jts,jte
17681805
do i=its,ite
17691806

1770-
if (slmsk(i) == 1.) then
1807+
if (landfrac(i) > 0.) then
17711808

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

1847-
call ruclsminit( debug_print, slmsk, &
1884+
call ruclsminit( debug_print, landfrac, fice, min_seaice, &
18481885
lsoil_ruc, isltyp, ivgtyp, mavail, &
18491886
soilh2o, smfr, soiltemp, soilm, &
18501887
ims,ime, jms,jme, kms,kme, &

physics/sfc_drv_ruc.meta

+10-1
Original file line numberDiff line numberDiff line change
@@ -164,6 +164,15 @@
164164
kind = kind_phys
165165
intent = in
166166
optional = F
167+
[landfrac]
168+
standard_name = land_area_fraction
169+
long_name = fraction of horizontal grid area occupied by land
170+
units = frac
171+
dimensions = (horizontal_dimension)
172+
type = real
173+
kind = kind_phys
174+
intent = in
175+
optional = F
167176
[q1]
168177
standard_name = water_vapor_specific_humidity_at_lowest_model_layer
169178
long_name = water vapor specific humidity at lowest model layer
@@ -844,7 +853,7 @@
844853
type = logical
845854
intent = in
846855
optional = F
847-
[lake]
856+
[use_lake]
848857
standard_name = flag_for_using_flake
849858
long_name = flag indicating lake points using flake model
850859
units = flag

0 commit comments

Comments
 (0)