@@ -33,7 +33,7 @@ module lsm_ruc
33
33
subroutine lsm_ruc_init (me , master , isot , ivegsrc , nlunit , &
34
34
flag_restart , flag_init , con_fvirt , con_rd , &
35
35
im , lsoil_ruc , lsoil , kice , nlev , & ! in
36
- lsm_ruc , lsm , slmsk , stype , vtype , & ! in
36
+ lsm_ruc , lsm , slmsk , stype , vtype , landfrac , & ! in
37
37
q1 , prsl1 , tsfc_lnd , tsfc_ice , tsfc_wat , & ! in
38
38
tg3 , smc , slc , stc , fice , min_seaice , & ! in
39
39
sncovr_lnd , sncovr_ice , snoalb , & ! in
@@ -64,6 +64,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
64
64
real (kind= kind_phys), dimension (:), intent (in ) :: slmsk
65
65
real (kind= kind_phys), dimension (:), intent (in ) :: stype
66
66
real (kind= kind_phys), dimension (:), intent (in ) :: vtype
67
+ real (kind= kind_phys), dimension (:), intent (in ) :: landfrac
67
68
real (kind= kind_phys), dimension (:), intent (in ) :: q1
68
69
real (kind= kind_phys), dimension (:), intent (in ) :: prsl1
69
70
real (kind= kind_phys), dimension (:), intent (in ) :: tsfc_lnd
@@ -168,7 +169,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
168
169
vegtype(:) = 0
169
170
170
171
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
172
174
!- - ice
173
175
if (isot == 1 ) then
174
176
soiltyp(i) = 16
@@ -225,8 +227,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
225
227
226
228
call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in
227
229
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
230
232
zs, dzs, smc, slc, stc, & ! in
231
233
sh2o, smfrkeep, tslb, smois, & ! out
232
234
wetness, errmsg, errflg)
@@ -346,7 +348,7 @@ subroutine lsm_ruc_run & ! inputs
346
348
& imp_physics, imp_physics_gfdl, imp_physics_thompson, &
347
349
& do_mynnsfclay, lsoil_ruc, lsoil, rdlai, zs, &
348
350
& t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, &
349
- & dlwflx, dswsfc, tg3, coszen, land, icy, lake, &
351
+ & dlwflx, dswsfc, tg3, coszen, land, icy, use_lake, &
350
352
& rainnc, rainc, ice, snow, graupel, &
351
353
& prsl1, zf, wind, shdmin, shdmax, &
352
354
& srflag, sfalb_lnd_bck, snoalb, &
@@ -414,7 +416,7 @@ subroutine lsm_ruc_run & ! inputs
414
416
con_hvap, con_fvirt
415
417
416
418
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
418
420
logical , dimension (:), intent (in ) :: flag_cice
419
421
logical , intent (in ) :: frac_grid
420
422
logical , intent (in ) :: do_mynnsfclay
@@ -465,6 +467,10 @@ subroutine lsm_ruc_run & ! inputs
465
467
character (len=* ), intent (out ) :: errmsg
466
468
integer , intent (out ) :: errflg
467
469
470
+ ! --- SPP - should be INTENT(IN)
471
+ integer :: spp_lsm
472
+ real (kind= kind_phys), dimension (im,nlev) :: pattern_spp
473
+
468
474
! --- locals:
469
475
real (kind= kind_phys), dimension (im) :: rho, &
470
476
& q0, qs1, albbcksol, &
@@ -480,6 +486,8 @@ subroutine lsm_ruc_run & ! inputs
480
486
& sfcqv_ice_old, sfcqc_ice_old, z0rl_ice_old, &
481
487
& sncovr1_ice_old
482
488
489
+ !- - local spp pattern array
490
+ real (kind= kind_phys), dimension (im,lsoil_ruc,1 ) :: pattern_spp_lsm
483
491
484
492
real (kind= kind_phys), dimension (lsoil_ruc) :: et
485
493
@@ -571,7 +579,7 @@ subroutine lsm_ruc_run & ! inputs
571
579
endif
572
580
! - Set flag for ice points for uncoupled model (islmsk(i) == 4 when coupled to CICE)
573
581
! - 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))
575
583
! > - Set flag for land and ice points.
576
584
!- 10may19 - ice points are turned off.
577
585
flag(i) = land(i) .or. flag_ice_uncoupled(i)
@@ -622,6 +630,12 @@ subroutine lsm_ruc_run & ! inputs
622
630
landusef (:,:,:) = 0.0
623
631
soilctop (:,:,:) = 0.0
624
632
633
+ !- - spp
634
+ spp_lsm = 0 ! so far (10May2021)
635
+ if (spp_lsm == 0 ) then
636
+ pattern_spp (:,:) = 0.0
637
+ endif
638
+
625
639
! > -- number of soil categories
626
640
! if(isot == 1) then
627
641
! nscat = 19 ! stasgo
@@ -852,11 +866,6 @@ subroutine lsm_ruc_run & ! inputs
852
866
! acsn(i,j) = acsnow(i)
853
867
acsn(i,j) = 0.0
854
868
855
- ! --- units %
856
- shdfac(i,j) = sigmaf(i)* 100 .
857
- shdmin1d(i,j) = shdmin(i)* 100 .
858
- shdmax1d(i,j) = shdmax(i)* 100 .
859
-
860
869
tbot(i,j) = tg3(i)
861
870
862
871
! > - 3. canopy/soil characteristics (s):
@@ -901,6 +910,10 @@ subroutine lsm_ruc_run & ! inputs
901
910
endif
902
911
903
912
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 .
904
917
905
918
if (land(i)) then ! at least some land in the grid cell
906
919
@@ -947,6 +960,27 @@ subroutine lsm_ruc_run & ! inputs
947
960
948
961
snoalb1d_lnd(i,j) = snoalb(i)
949
962
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
+
950
984
alb_lnd(i,j) = albbck_lnd(i,j) * (1 .- sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i)
951
985
solnet_lnd(i,j) = dswsfc(i)* (1 .- alb_lnd(i,j)) ! ..net sw rad flx (dn-up) at sfc in w/m2
952
986
@@ -1486,8 +1520,8 @@ end subroutine lsm_ruc_run
1486
1520
! ! This subroutine contains RUC LSM initialization.
1487
1521
subroutine rucinit (restart , im , lsoil_ruc , lsoil , nlev , & ! in
1488
1522
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
1491
1525
zs , dzs , smc , slc , stc , & ! in
1492
1526
sh2o , smfrkeep , tslb , smois , & ! out
1493
1527
wetness , errmsg , errflg )
@@ -1500,7 +1534,10 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
1500
1534
integer , intent (in ) :: im, nlev
1501
1535
integer , intent (in ) :: lsoil_ruc
1502
1536
integer , intent (in ) :: lsoil
1537
+ real (kind= kind_phys), intent (in ) :: min_seaice
1503
1538
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
1504
1541
real (kind= kind_phys), dimension (im), intent (in ) :: tskin_lnd, tskin_wat
1505
1542
real (kind= kind_phys), dimension (im), intent (in ) :: tg3
1506
1543
real (kind= kind_phys), dimension (1 :lsoil_ruc), intent (in ) :: zs
@@ -1658,14 +1695,14 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
1658
1695
tbot(i,j) = tg3(i)
1659
1696
ivgtyp(i,j) = vegtype(i)
1660
1697
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
1666
1699
!- - land or ice
1667
1700
tsk(i,j) = tskin_lnd(i)
1668
1701
landmask(i,j)= 1 .
1702
+ else
1703
+ !- - water
1704
+ tsk(i,j) = tskin_wat(i)
1705
+ landmask(i,j)= 0 .
1669
1706
endif ! land(i)
1670
1707
1671
1708
enddo
@@ -1680,7 +1717,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
1680
1717
sm_input(i,1 ,j)= 0 .
1681
1718
1682
1719
!- -- initialize smcwlt2 and smcref2 with Noah values
1683
- if (slmsk (i) == 1 .) then
1720
+ if (landfrac (i) > 0 .) then
1684
1721
smcref2 (i) = REFSMCnoah(soiltyp(i))
1685
1722
smcwlt2 (i) = WLTSMCnoah(soiltyp(i))
1686
1723
else
@@ -1691,7 +1728,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
1691
1728
do k= 1 ,lsoil
1692
1729
st_input(i,k+1 ,j)= stc(i,k)
1693
1730
! 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
1695
1732
sm_input(i,k+1 ,j)= min (1 .,max (0 .,(smc(i,k) - smcwlt2(i))/ &
1696
1733
(smcref2(i) - smcwlt2(i))))
1697
1734
else
@@ -1726,7 +1763,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
1726
1763
1727
1764
do j= jts,jte
1728
1765
do i= its,ite
1729
- if (slmsk (i) == 1 .) then
1766
+ if (landfrac (i) == 1 .) then
1730
1767
!- - land
1731
1768
do k= 1 ,lsoil_ruc
1732
1769
! convert from SWI to RUC volumetric soil moisture
@@ -1767,7 +1804,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
1767
1804
do j= jts,jte
1768
1805
do i= its,ite
1769
1806
1770
- if (slmsk (i) == 1 .) then
1807
+ if (landfrac (i) > 0 .) then
1771
1808
1772
1809
! initialize factor
1773
1810
do k= 1 ,lsoil_ruc
@@ -1844,7 +1881,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in
1844
1881
! and soil temperature, and also soil moisture availability in the top
1845
1882
! layer
1846
1883
1847
- call ruclsminit( debug_print, slmsk, &
1884
+ call ruclsminit( debug_print, landfrac, fice, min_seaice, &
1848
1885
lsoil_ruc, isltyp, ivgtyp, mavail, &
1849
1886
soilh2o, smfr, soiltemp, soilm, &
1850
1887
ims,ime, jms,jme, kms,kme, &
0 commit comments