Port soil color climatology prescription for Noah-MP from UFS to SHiELD

See this PR for reference: ufs-community/ccpp-physics#78
spencerkclark · Jun 13, 2024 · b59bb08 · b59bb08
1 parent 3027a97
commit b59bb08
Show file tree

Hide file tree

Showing 7 changed files with 257 additions and 87 deletions.
diff --git a/FV3GFS/FV3GFS_io.F90 b/FV3GFS/FV3GFS_io.F90
@@ -522,7 +522,7 @@ subroutine register_sfc_prop_restart_vars(Model, nx, ny, nvar_s2m, action)
     nvar_s3  = 3
 
     if (Model%lsm == Model%lsm_noahmp) then
-      nvar_s2mp = 39       !mp 2D
+      nvar_s2mp = 40       !mp 2D
       nvar_s3mp = 5        !mp 3D
     else
       nvar_s2mp = 0        !mp 2D
@@ -653,6 +653,7 @@ subroutine register_sfc_prop_restart_vars(Model, nx, ny, nvar_s2m, action)
         sfc_name2(nvar_s2m+55) = 'albivis'
         sfc_name2(nvar_s2m+56) = 'albinir'
         sfc_name2(nvar_s2m+57) = 'emiss'
+        sfc_name2(nvar_s2m+58) = 'scolor'
       endif
 
       !--- names of the 3D variables to save
@@ -1154,6 +1155,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, enforce_
              Sfcprop(nb)%albivis(ix)    = sfc_var2(i,j,nvar_s2m+55)
              Sfcprop(nb)%albinir(ix)    = sfc_var2(i,j,nvar_s2m+56)
              Sfcprop(nb)%emiss(ix)      = sfc_var2(i,j,nvar_s2m+57)
+             Sfcprop(nb)%scolor(ix)     = sfc_var2(i,j,nvar_s2m+58)
            endif
 
 
@@ -2040,6 +2042,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta
             sfc_var2(i,j,nvar_s2m+55) = Sfcprop(nb)%albivis(ix)
             sfc_var2(i,j,nvar_s2m+56) = Sfcprop(nb)%albinir(ix)
             sfc_var2(i,j,nvar_s2m+57) = Sfcprop(nb)%emiss(ix)
+            sfc_var2(i,j,nvar_s2m+58) = Sfcprop(nb)%scolor(ix)
           endif
 
           !--- 3D variables
@@ -6854,6 +6857,17 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Model, Cldprop, Atm_block
       Diag(idx)%data(nb)%var2 => Sfcprop(nb)%sncovr(:)
     enddo
 
+    idx = idx + 1
+    Diag(idx)%axes = 2
+    Diag(idx)%name = 'soil_color'
+    Diag(idx)%desc = 'soil color category'
+    Diag(idx)%unit = 'none'
+    Diag(idx)%mod_name = 'gfs_sfc'
+    allocate (Diag(idx)%data(nblks))
+    do nb = 1,nblks
+      Diag(idx)%data(nb)%var2 => Sfcprop(nb)%scolor(:)
+    enddo
+
     idx = idx + 1
     Diag(idx)%axes = 2
     Diag(idx)%name = 'crain'

diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90
@@ -427,7 +427,7 @@ subroutine GFS_physics_driver                         &
 
       integer, dimension(size(Grid%xlon,1)) ::                          &
            kbot, ktop, kcnv, soiltyp, vegtype, kpbl, slopetyp, kinver,  &
-           lmh, levshc, islmsk,                                         &
+           lmh, levshc, islmsk, soilcol,                                &
            !--- coupling inputs for physics
            islmsk_cice
 
@@ -786,6 +786,7 @@ subroutine GFS_physics_driver                         &
           soiltyp(i)  = int( Sfcprop%stype(i)+0.5 )
           vegtype(i)  = int( Sfcprop%vtype(i)+0.5 )
           slopetyp(i) = int( Sfcprop%slope(i)+0.5 )    !! clu: slope -> slopetyp
+          soilcol(i)  = nint(Sfcprop%scolor(i))
         endif
 !  --- ...  xw: transfer ice thickness & concentration from global to local variables
         zice(i) = Sfcprop%hice(i)
@@ -1320,7 +1321,8 @@ subroutine GFS_physics_driver                         &
           call noahmpdrv                                               &
 !  ---  inputs:
            (im, Model%lsoil, kdt, Statein%pgr,  Statein%ugrs, Statein%vgrs,   &
-            Statein%tgrs,  Statein%qgrs, soiltyp, vegtype, sigmaf,     &
+            Statein%tgrs,  Statein%qgrs, soiltyp, soilcol,             &
+            vegtype, sigmaf,                                           &
             Radtend%semis, adjsfcdlw_for_coupling,                     &
             adjsfcdsw_for_coupling, adjsfcnsw_for_coupling, dtf,       &
             Sfcprop%tg3, cd, cdq, Statein%prsl(:,1), work3,            &

diff --git a/GFS_layer/GFS_typedefs.F90 b/GFS_layer/GFS_typedefs.F90
@@ -225,6 +225,7 @@ module GFS_typedefs
     real (kind=kind_phys), pointer :: vfrac  (:)   => null()  !< vegetation fraction
     real (kind=kind_phys), pointer :: vtype  (:)   => null()  !< vegetation type
     real (kind=kind_phys), pointer :: stype  (:)   => null()  !< soil type
+    real (kind=kind_phys), pointer :: scolor (:)   => null()  !< soil color
     real (kind=kind_phys), pointer :: uustar (:)   => null()  !< boundary layer parameter
     real (kind=kind_phys), pointer :: oro    (:)   => null()  !< orography
     real (kind=kind_phys), pointer :: oro_uf (:)   => null()  !< unfiltered orography
@@ -1607,6 +1608,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model)
     allocate (Sfcprop%vfrac   (IM))
     allocate (Sfcprop%vtype   (IM))
     allocate (Sfcprop%stype   (IM))
+    allocate (Sfcprop%scolor  (IM))
     allocate (Sfcprop%uustar  (IM))
     allocate (Sfcprop%oro     (IM))
     allocate (Sfcprop%oro_uf  (IM))
@@ -1619,6 +1621,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model)
     Sfcprop%vfrac   = clear_val
     Sfcprop%vtype   = clear_val
     Sfcprop%stype   = clear_val
+    Sfcprop%scolor  = clear_val
     Sfcprop%uustar  = clear_val
     Sfcprop%oro     = clear_val
     Sfcprop%oro_uf  = clear_val

diff --git a/gsmphys/gcycle.F90 b/gsmphys/gcycle.F90
@@ -40,6 +40,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop)
         VEGFCS (Model%nx*Model%ny),             &
         VETFCS (Model%nx*Model%ny),             &
         SOTFCS (Model%nx*Model%ny),             &
+        SLCFCS (Model%nx*Model%ny),             &
          CVFCS (Model%nx*Model%ny),             &
         CVBFCS (Model%nx*Model%ny),             &
         CVTFCS (Model%nx*Model%ny),             &
@@ -117,6 +118,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop)
           VEGFCS  (len)          = Sfcprop(nb)%vfrac  (ix)
           VETFCS  (len)          = Sfcprop(nb)%vtype  (ix)
           SOTFCS  (len)          = Sfcprop(nb)%stype  (ix)
+          SLCFCS  (len)          = Sfcprop(nb)%scolor (ix)
           CVFCS   (len)          = Cldprop(nb)%cv     (ix)
           CVBFCS  (len)          = Cldprop(nb)%cvb    (ix)
           CVTFCS  (len)          = Cldprop(nb)%cvt    (ix)
@@ -183,8 +185,9 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop)
                      VMNFCS, VMXFCS, SLPFCS, ABSFCS, TSFFCS, TSCLIM,      &
                      SNOFCS, ZORFCS, ALBFC1, MLDCLIM, QFLUXADJ, TG3FCS, CNPFCS,      &
                      SMCFC1, STCFC1, SLIFCS, AISFCS, F10MFCS,     &
-                     VEGFCS, VETFCS, SOTFCS, ALFFC1, CVFCS,       &
-                     CVBFCS, CVTFCS, Model%me, Model%nlunit,      &
+                     VEGFCS, VETFCS, SOTFCS, SLCFCS, ALFFC1,      &
+                     CVFCS, CVBFCS, CVTFCS, Model%me,             &
+                     Model%nlunit,                                &
                      size(Model%input_nml_file),                  &
                      Model%input_nml_file,                        &
                      Model%ialb, Model%isot, Model%ivegsrc,       &
@@ -220,6 +223,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop)
           Sfcprop(nb)%vfrac  (ix) = VEGFCS  (len)
           Sfcprop(nb)%vtype  (ix) = VETFCS  (len)
           Sfcprop(nb)%stype  (ix) = SOTFCS  (len)
+          Sfcprop(nb)%scolor (ix) = SLCFCS  (len)
           Cldprop(nb)%cv     (ix) = CVFCS   (len)
           Cldprop(nb)%cvb    (ix) = CVBFCS  (len)
           Cldprop(nb)%cvt    (ix) = CVTFCS  (len)

diff --git a/gsmphys/noahmp_tables.f90 b/gsmphys/noahmp_tables.f90
@@ -15,7 +15,7 @@ module noahmp_tables
     integer :: i
     integer, private, parameter :: mvt   = 30 ! use 30 instead of 27
     integer, private, parameter :: mband = 2
-    integer, private, parameter :: msc   = 8
+    integer, private, parameter :: msc   = 20
     integer, private, parameter :: max_soiltyp = 30
     integer, private, parameter :: slcats = 30
     real (kind=kind_phys) :: slope_table(9)                     !slope factor for soil drainage
@@ -732,12 +732,12 @@ module noahmp_tables
 
 !    &_______________________________________________________________________&
     real (kind=kind_phys) :: albsat_table(msc,mband)   !saturated soil albedos: 1=vis, 2=nir
-    data(albsat_table(i,1),i=1,8)/0.15,0.11,0.10,0.09,0.08,0.07,0.06,0.05/
-    data(albsat_table(i,2),i=1,8)/0.30,0.22,0.20,0.18,0.16,0.14,0.12,0.10/
+    data(albsat_table(i,1),i=1,20)/0.25,0.23,0.21,0.20,0.19,0.18,0.17,0.16,0.15,0.14,0.13,0.12,0.11,0.10,0.09,0.08,0.07,0.06,0.05,0.04/
+    data(albsat_table(i,2),i=1,20)/0.50,0.46,0.42,0.40,0.38,0.36,0.34,0.32,0.30,0.28,0.26,0.24,0.22,0.20,0.18,0.16,0.14,0.12,0.10,0.08/
 
     real (kind=kind_phys) :: albdry_table(msc,mband)   !dry soil albedos: 1=vis, 2=nir
-    data(albdry_table(i,1),i=1,8)/0.27,0.22,0.20,0.18,0.16,0.14,0.12,0.10/
-    data(albdry_table(i,2),i=1,8)/0.54,0.44,0.40,0.36,0.32,0.28,0.24,0.20/
+    data(albdry_table(i,1),i=1,20)/0.36,0.34,0.32,0.31,0.30,0.29,0.28,0.27,0.26,0.25,0.24,0.23,0.22,0.20,0.18,0.16,0.14,0.12,0.10,0.08/
+    data(albdry_table(i,2),i=1,20)/0.61,0.57,0.53,0.51,0.49,0.48,0.45,0.43,0.41,0.39,0.37,0.35,0.33,0.31,0.29,0.27,0.25,0.23,0.21,0.16/
 
     real (kind=kind_phys) :: albice_table(mband)       !albedo land ice: 1=vis, 2=nir
     data (albice_table(i),i=1,mband) /0.80, 0.55/

diff --git a/gsmphys/sfc_noahmp_drv.f b/gsmphys/sfc_noahmp_drv.f
@@ -3,7 +3,8 @@
       subroutine noahmpdrv                                              &
 !...................................
 !  ---  inputs:
-     &     ( im, km,itime,ps, u1, v1, t1, q1, soiltyp, vegtype, sigmaf, &
+     &     ( im, km,itime,ps, u1, v1, t1, q1, soiltyp, soilcol,vegtype, &
+     &       sigmaf,                                                    &
      &       sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch,          &
      &       prsl1, prslki, zf, dry, wind, slopetyp,                    &
      &       shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess,      &
@@ -84,7 +85,8 @@ subroutine noahmpdrv                                              &
 
       integer, intent(in) :: im, km, itime,imon
 
-      integer, dimension(im), intent(in) :: soiltyp, vegtype, slopetyp
+      integer, dimension(im), intent(in) :: soiltyp, soilcol, vegtype,  &
+     &       slopetyp
 
       real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1,   &
      &       t1, q1, sigmaf, dlwflx, dswsfc, snet, tg3, cm,             &
@@ -205,7 +207,8 @@ subroutine noahmpdrv                                              &
      &                         irb,tr,evc,chleaf,chuc,chv2,chb2,        &
      &                         fpice,pahv,pahg,pahb,pah,co2pp,o2pp,ch2b
 
-      integer :: i, k, ice, stype, vtype ,slope,nroot,couple
+      integer :: i, k, ice, stype, soil_color_category
+      integer :: vtype ,slope,nroot,couple
       logical :: flag(im)
       logical :: snowng,frzgra
 
@@ -431,6 +434,7 @@ subroutine noahmpdrv                                              &
           vtype = vegtype(i)
           stype = soiltyp(i)
           slope = slopetyp(i)
+          soil_color_category = soilcol(i)
           shdfac= sigmaf(i)
 
           shdmin1d = shdmin(i)   
@@ -574,8 +578,8 @@ subroutine noahmpdrv                                              &
           cmm(i) = cm(i)  * wind(i)
 
 
-
-       call transfer_mp_parameters(vtype,stype,slope,isc,parameters)
+       call transfer_mp_parameters(vtype,stype,slope,                   &
+     &                             soil_color_category,parameters)
 
        call noahmp_options(idveg ,iopt_crs,iopt_btr,iopt_run,iopt_sfc,  &
      & iopt_frz,iopt_inf,iopt_rad,iopt_alb,iopt_snf,iopt_tbot,iopt_stc)