Update land perturbation scheme

physics/GFS_MP_generic.meta

@@ -732,8 +732,8 @@
   intent = inout
   optional = F
 [do_sppt]
-  standard_name = flag_for_stochastic_surface_physics_perturbations
-  long_name = flag for stochastic surface physics perturbations
+  standard_name = flag_for_stochastic_physics_perturbations
+  long_name = flag for stochastic physics perturbations
   units = flag
   dimensions = ()
   type = logical

physics/GFS_debug.F90

@@ -484,7 +484,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
                         call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts )
                         call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts )
                      end if
-                     if (Model%do_sfcperts) then
+                     if (Model%lndp_type .NE. 0) then
                         call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts'  , Coupling%sfc_wts   )
                      end if
                      if (Model%do_ca) then

physics/GFS_rrtmg_pre.F90

@@ -931,12 +931,15 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein,   & ! input
 !  perturbation size
 !  ---  turn vegetation fraction pattern into percentile pattern
       alb1d(:) = 0.
-      if (Model%do_sfcperts) then
-        if (Model%pertalb(1) > 0.) then
-          do i=1,im
-            call cdfnor(Coupling%sfc_wts(i,5),alb1d(i))
+      if (Model%lndp_type==1) then
+          do k =1,Model%n_var_lndp
+            if (Model%lndp_var_list(k) == 'alb') then
+              do i=1,im
+                call cdfnor(Coupling%sfc_wts(i,k),alb1d(i)) 
+                !lndp_alb = Model%lndp_prt_list(k)
+              enddo
+            endif
           enddo
-        endif
       endif
 ! mg, sfc-perts
 

physics/GFS_rrtmgp_sw_pre.F90

@@ -27,8 +27,9 @@ end subroutine GFS_rrtmgp_sw_pre_init
 !> \section arg_table_GFS_rrtmgp_sw_pre_run
 !! \htmlinclude GFS_rrtmgp_sw_pre.html
 !!
-  subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, solhr,     &
-       pertalb, lon, coslat, sinlat,  snowd, sncovr, snoalb, zorl, tsfc, hprime, alvsf,     &
+  subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list,     &  
+       lndp_prt_list, lsswr, solhr,                                                         &
+       lon, coslat, sinlat,  snowd, sncovr, snoalb, zorl, tsfc, hprime, alvsf,              &
        alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, sfc_wts, p_lay, tv_lay,      &
        relhum, p_lev, sw_gas_props,                                                         &
        nday, idxday, alb1d, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif,               &
@@ -39,14 +40,16 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, s
          me,                & ! Current MPI rank
          nCol,              & ! Number of horizontal grid points
          nLev,              & ! Number of vertical layers
-         nsfcpert             ! Number of surface perturbations
+         n_var_lndp,        &  ! Number of surface variables perturbed
+         lndp_type             ! Type of land perturbations scheme used
+    character(len=3), dimension(n_var_lndp), intent(in) ::  & 
+         lndp_var_list
+    real(kind_phys), dimension(n_var_lndp), intent(in) ::   &
+         lndp_prt_list
     logical,intent(in) :: &
-         lsswr,             & ! Call RRTMGP SW radiation?
-         do_sfcperts
+         lsswr             ! Call RRTMGP SW radiation?
     real(kind_phys), intent(in) :: &
-         solhr                ! Time in hours after 00z at the current timestep
-    real(kind_phys), dimension(5), intent(in) :: &
-         pertalb              ! Magnitude of surface albedo perturbation (frac)
+         solhr                 ! Time in hours after 00z at the current timestep
     real(kind_phys), dimension(nCol), intent(in) :: &
          lsmask,            & ! Landmask: sea/land/ice=0/1/2
          lon,               & ! Longitude
@@ -66,7 +69,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, s
          facwf,             & ! Fractional coverage with weak cosz dependency (frac)
          fice,              & ! Ice fraction over open water (frac)
          tisfc                ! Sea ice surface skin temperature (K)
-    real(kind_phys), dimension(nCol,nsfcpert), intent(in) :: &
+    real(kind_phys), dimension(nCol,n_var_lndp), intent(in) :: &
          sfc_wts              ! Weights for stochastic surface physics perturbation ()    
     real(kind_phys), dimension(nCol,nLev),intent(in) :: &
          p_lay,             & ! Layer pressure
@@ -100,6 +103,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, s
     ! Local variables
     integer :: i, j, iCol, iBand, iLay
     real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb
+    real(kind_phys) :: lndp_alb
 
     ! Initialize CCPP error handling variables
     errmsg = ''
@@ -130,13 +134,17 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, s
     !  ---  turn vegetation fraction pattern into percentile pattern
     ! #######################################################################################
     alb1d(:) = 0.
-    if (do_sfcperts) then
-       if (pertalb(1) > 0.) then
+    lndp_alb = -999.
+    if (lndp_type ==1) then
+      do k =1,n_var_lndp
+       if (lndp_var_list(k) == 'alb') then
           do i=1,ncol
-             call cdfnor(sfc_wts(i,5),alb1d(i))
+            call cdfnor(sfc_wts(i,k),alb1d(i))
+            lndp_alb = lndp_prt_list(k)
           enddo
-       endif
-    endif  
+        endif
+      enddo
+    endif
 
     ! #######################################################################################
     ! Call module_radiation_surface::setalb() to setup surface albedo.

physics/GFS_rrtmgp_sw_pre.meta

@@ -25,25 +25,43 @@
   type = integer
   intent = in
   optional = F 
-[nsfcpert]
-  standard_name = number_of_surface_perturbations
-  long_name = number of surface perturbations
+[n_var_lndp]
+  standard_name = number_of_land_surface_variables_perturbed
+  long_name = number of land surface variables perturbed
   units = count
   dimensions = ()
   type = integer
   intent = in
   optional = F   
-[lsswr]
-  standard_name = flag_to_calc_sw
-  long_name = logical flags for sw radiation calls
-  units = flag
+[lndp_type]
+  standard_name = index_for_stochastic_land_surface_perturbation_type
+  long_name = index for stochastic land surface perturbations type
+  units = index
   dimensions = ()
-  type = logical
+  type = integer
+  intent = in
+  optional = F
+[lndp_prt_list]
+  standard_name =magnitude_of_perturbations_for_landperts
+  long_name = magnitude of perturbations for landperts
+  units = variable
+  dimensions = (number_of_land_surface_variables_perturbed)
+  type = real
+  kind = kind_phys
+  intent = in 
+  optional = F
+[lndp_var_list]
+  standard_name = variables_to_be_perturbed_for_landperts
+  long_name = variables to be perturbed for landperts
+  units = none
+  dimensions =  (number_of_land_surface_variables_perturbed)
+  type = character
+  kind = len=3
   intent = in
   optional = F
-[do_sfcperts]
-  standard_name = flag_for_stochastic_surface_perturbations
-  long_name = flag for stochastic surface perturbations option
+[lsswr]
+  standard_name = flag_to_calc_sw
+  long_name = logical flags for sw radiation calls
   units = flag
   dimensions = ()
   type = logical
@@ -58,15 +76,6 @@
   kind = kind_phys
   intent = in
   optional = F
-[pertalb]
-  standard_name = magnitude_of_surface_albedo_perturbation
-  long_name = magnitude of surface albedo perturbation
-  units = frac
-  dimensions = (5)
-  type = real
-  kind = kind_phys
-  intent = in
-  optional = F
 [lon]
   standard_name = longitude
   long_name = longitude

physics/GFS_stochastics.meta

@@ -26,8 +26,8 @@
   intent = in
   optional = F
 [do_sppt]
-  standard_name = flag_for_stochastic_surface_physics_perturbations
-  long_name = flag for stochastic surface physics perturbations
+  standard_name = flag_for_stochastic_physics_perturbations
+  long_name = flag for stochastic physics perturbations
   units = flag
   dimensions = ()
   type = logical

physics/GFS_surface_generic.F90

@@ -27,8 +27,9 @@ end subroutine GFS_surface_generic_pre_finalize
       subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, stype, vtype, slope, &
                           prsik_1, prslk_1, tsfc, phil, con_g,                                             &
                           sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, ca_global,dtdtr,&
-                          drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, do_sfcperts, nsfcpert, sfc_wts,        &
-                          pertz0, pertzt, pertshc, pertlai, pertvegf, z01d, zt1d, bexp1d, xlai1d, vegf1d,  &
+                          drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts,        &
+                          lndp_var_list, lndp_prt_list,                                                    &
+                          z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf,                                    &
                           cplflx, flag_cice, islmsk_cice, slimskin_cpl, tisfc, tsfco, fice, hice,          &
                           wind, u1, v1, cnvwind, smcwlt2, smcref2, errmsg, errflg)
 
@@ -56,19 +57,17 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc,
         real(kind=kind_phys), dimension(im),          intent(out) :: dsnow_cpl
         real(kind=kind_phys), dimension(im),          intent(in)  :: rain_cpl
         real(kind=kind_phys), dimension(im),          intent(in)  :: snow_cpl
-        logical, intent(in) :: do_sfcperts
-        integer, intent(in) :: nsfcpert
-        real(kind=kind_phys), dimension(im,nsfcpert), intent(in)  :: sfc_wts
-        real(kind=kind_phys), dimension(:),           intent(in)  :: pertz0
-        real(kind=kind_phys), dimension(:),           intent(in)  :: pertzt
-        real(kind=kind_phys), dimension(:),           intent(in)  :: pertshc
-        real(kind=kind_phys), dimension(:),           intent(in)  :: pertlai
-        real(kind=kind_phys), dimension(:),           intent(in)  :: pertvegf
+        integer, intent(in) :: lndp_type
+        integer, intent(in) :: n_var_lndp
+        character(len=3), dimension(n_var_lndp),      intent(in)  :: lndp_var_list
+        real(kind=kind_phys), dimension(n_var_lndp),  intent(in)  :: lndp_prt_list
+        real(kind=kind_phys), dimension(im,n_var_lndp), intent(in)  :: sfc_wts
         real(kind=kind_phys), dimension(im),          intent(out) :: z01d
         real(kind=kind_phys), dimension(im),          intent(out) :: zt1d
         real(kind=kind_phys), dimension(im),          intent(out) :: bexp1d
         real(kind=kind_phys), dimension(im),          intent(out) :: xlai1d
         real(kind=kind_phys), dimension(im),          intent(out) :: vegf1d
+        real(kind=kind_phys),                         intent(out) :: lndp_vgf
 
         logical, intent(in) :: cplflx
         real(kind=kind_phys), dimension(im), intent(in) :: slimskin_cpl
@@ -89,7 +88,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc,
         integer,          intent(out) :: errflg
 
         ! Local variables
-        integer              :: i
+        integer              :: i, k
         real(kind=kind_phys) :: onebg
         real(kind=kind_phys) :: cdfz
 
@@ -107,34 +106,28 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc,
 
         ! Scale random patterns for surface perturbations with perturbation size
         ! Turn vegetation fraction pattern into percentile pattern
-        if (do_sfcperts) then
-          if (pertz0(1) > zero) then
-            z01d(:) = pertz0(1) * sfc_wts(:,1)
-!            if (me == 0) print*,'sfc_wts(:,1) min and max',minval(sfc_wts(:,1)),maxval(sfc_wts(:,1))
-!            if (me == 0) print*,'z01d min and max ',minval(z01d),maxval(z01d)
-          endif
-          if (pertzt(1) > zero) then
-            zt1d(:) = pertzt(1) * sfc_wts(:,2)
-          endif
-          if (pertshc(1) > zero) then
-            bexp1d(:) = pertshc(1) * sfc_wts(:,3)
-          endif
-          if (pertlai(1) > zero) then
-            xlai1d(:) = pertlai(1) * sfc_wts(:,4)
-          endif
-!   --- do the albedo percentile calculation in GFS_radiation_driver instead --- !
-!          if (pertalb(1) > 0.) then
-!            do i=1,im
-!              call cdfnor(sfc_wts(i,5),cdfz)
-!              alb1d(i) = cdfz
-!            enddo
-!          endif
-          if (pertvegf(1) > zero) then
-            do i=1,im
-              call cdfnor(sfc_wts(i,6),cdfz)
-              vegf1d(i) = cdfz
-            enddo
-          endif
+        lndp_vgf=-999.
+
+        if (lndp_type==1) then
+        do k =1,n_var_lndp
+           select case(lndp_var_list(k))
+           case ('rz0')
+                z01d(:) = lndp_prt_list(k)* sfc_wts(:,k)
+           case ('rzt')
+                zt1d(:) = lndp_prt_list(k)* sfc_wts(:,k)
+           case ('shc')
+                bexp1d(:) = lndp_prt_list(k) * sfc_wts(:,k)
+           case ('lai')
+                xlai1d(:) = lndp_prt_list(k)* sfc_wts(:,k)
+           case ('vgf')
+        ! note that the pertrubed vegfrac is being used in sfc_drv, but not sfc_diff
+              do i=1,im
+                call cdfnor(sfc_wts(i,k),cdfz)
+                vegf1d(i) = cdfz
+              enddo
+              lndp_vgf = lndp_prt_list(k)
+           end select
+        enddo
         endif
 
         ! End of stochastic physics / surface perturbation