Feature/pnorris/#422 #443 rrtmg lw sw combo generator

GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSradiation_GridComp/GEOS_RadiationGridComp.F90

@@ -458,6 +458,12 @@ end subroutine SetServices
 
   subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC )
 
+! !USES:
+  use cloud_condensate_inhomogeneity, only: initialize_inhomogeneity
+  use cloud_subcol_gen, only : initialize_cloud_subcol_gen, &
+    def_aam1, def_aam2, def_aam30, def_aam4, &
+    def_ram1, def_ram2, def_ram30, def_ram4
+
 ! !ARGUMENTS:
 
   type(ESMF_GridComp), intent(inout) :: GC     ! Gridded component 
@@ -484,52 +490,75 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC )
 
 ! Local derived type aliases
 
-   type (MAPL_MetaComp),      pointer  :: MAPL
-   type (ESMF_State),         pointer  :: GIM(:)
-
-   type (ESMF_Config)                  :: CF
+  type (MAPL_MetaComp),      pointer  :: MAPL
+! type (ESMF_State),         pointer  :: GIM(:)
+! type (ESMF_Config)                  :: CF
 
-!=============================================================================
+! Correlation length parameters from resource file
 
-! Begin... 
+  real :: aam1, aam2, aam30, aam4
+  real :: ram1, ram2, ram30, ram4
+
+!=============================================================================
 
 ! Get the target components name and set-up traceback handle.
 ! -----------------------------------------------------------
 
     Iam = "Initialize"
-    call ESMF_GridCompGet( GC, NAME=COMP_NAME, CONFIG=CF, RC=STATUS )
-    VERIFY_(STATUS)
+    call ESMF_GridCompGet (GC, NAME=COMP_NAME, __RC__)  ! CONFIG=CF, __RC__)
     Iam = trim(COMP_NAME) // trim(Iam)
 
 ! Generic initialize
 !-------------------
 
-    call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC=STATUS )
-    VERIFY_(STATUS)
+    call MAPL_GenericInitialize (GC, IMPORT, EXPORT, CLOCK, __RC__)
 
 ! Get my MAPL object
 !-------------------
 
-    call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS )
-    VERIFY_(STATUS)
+    call MAPL_GetObjectFromGC (GC, MAPL, __RC__)
 
 ! Start Total timer after generic initialize
 !-------------------------------------------
 
-    call MAPL_TimerOn(MAPL,"TOTAL")
+    call MAPL_TimerOn (MAPL,"TOTAL")
 
 ! Get parameters from MAPL
 !-------------------------
 
-    call MAPL_Get ( MAPL, GIM=GIM, RC=STATUS )
-    VERIFY_(STATUS)
+!   call MAPL_Get (MAPL, GIM=GIM, __RC__)
+
+! Initialize module-level cloud generator details.
+! Currently these are only used by RRTMG SW and LW, so should probably
+! make conditional on either RRTMG SW and LW being used. Dont bother
+! for now. Also, may later use the cloud generator for RRTMGP as well.
+!---------------------------------------------------------------------
+
+! Set up RRTMG condensate inhomogeneity tables
+
+    call initialize_inhomogeneity(1)
+
+! Set RRTMG cloud subcolumn generator correlation length parameters to non-default values
+! from MAPL resource parameters. Comment out to just use defaults in module cloud_subcol_gen.
+
+    call MAPL_GetResource(MAPL,aam1 ,LABEL="ADL_AM1:" ,default=def_aam1 ,__RC__)
+    call MAPL_GetResource(MAPL,aam2 ,LABEL="ADL_AM2:" ,default=def_aam2 ,__RC__)
+    call MAPL_GetResource(MAPL,aam30,LABEL="ADL_AM30:",default=def_aam30,__RC__)
+    call MAPL_GetResource(MAPL,aam4 ,LABEL="ADL_AM4:" ,default=def_aam4 ,__RC__)
+    call MAPL_GetResource(MAPL,ram1 ,LABEL="RDL_AM1:" ,default=def_ram1 ,__RC__)
+    call MAPL_GetResource(MAPL,ram2 ,LABEL="RDL_AM2:" ,default=def_ram2 ,__RC__)
+    call MAPL_GetResource(MAPL,ram30,LABEL="RDL_AM30:",default=def_ram30,__RC__)
+    call MAPL_GetResource(MAPL,ram4 ,LABEL="RDL_AM4:" ,default=def_ram4 ,__RC__)
+    call initialize_cloud_subcol_gen( &
+      adl_am1=aam1, adl_am2=aam2, adl_am30=aam30, adl_am4=aam4, &
+      rdl_am1=ram1, rdl_am2=ram2, rdl_am30=ram30, rdl_am4=ram4)
 
 ! All done
 !---------
 
-    call MAPL_TimerOff(MAPL,"TOTAL")
+    call MAPL_TimerOff (MAPL,"TOTAL")
+    RETURN_(ESMF_SUCCESS)
 
-   RETURN_(ESMF_SUCCESS)
   end subroutine Initialize
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSradiation_GridComp/GEOS_RadiationShared/CMakeLists.txt

@@ -3,6 +3,8 @@ esma_set_this ()
 set (srcs
   radconstants.F90
   gettau.F90
+  cloud_condensate_inhomogeneity.F90
+  cloud_subcol_gen.F90
   )
 
 esma_add_library (${this}

GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSradiation_GridComp/GEOSsolar_GridComp/RRTMG/rrtmg_sw/gcm_model/src/tab_xcw.F90 → GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSradiation_GridComp/GEOS_RadiationShared/cloud_condensate_inhomogeneity.F90

@@ -1,15 +1,128 @@
-      module tab_xcw
+module cloud_condensate_inhomogeneity
 
-        implicit none
-        save
+   use iso_fortran_env, only : error_unit
 
-        integer, parameter  :: N1 = 1000
-        integer, parameter  :: N2 = 140
-        real, dimension(N1,N2) :: XCW
+   implicit none
 
-      contains
+   ! state is saved outside of scope
+   save
+
+   ! all fields and methods hidden unless declared public below
+   private
+
+   ! lookup table dimensions
+   integer, parameter :: n1 = 1000
+   integer, parameter :: n2 = 140
+
+   ! inhomogeneity type and table
+   integer :: inhm = 0
+   real, allocatable :: xcw(:,:)
+
+   ! initialization status
+   logical :: initialized = .false.
+
+   ! public interface
+   public :: inhomogeneity_initialized  ! check if initialized
+   public :: initialize_inhomogeneity   ! get resources
+   public :: release_inhomogeneity      ! release resources
+   public :: condensate_inhomogeneous   ! test if inhomogeneous or not
+   public :: zcw_lookup                 ! lookup zcw if inhomogeneous
+
+contains
+
+   logical function inhomogeneity_initialized()
+     inhomogeneity_initialized = initialized
+   end function inhomogeneity_initialized
+
+   subroutine initialize_inhomogeneity (ih)
+
+      ! ih == 0: homogeneous
+      ! ih == 1: inhomogeneous, beta  distribution
+      ! ih == 2: inhomogeneous, gamma distribution
+
+      integer, intent(in) :: ih
+
+      if (initialized) then
+         write(error_unit,*) 'file:', __FILE__, ', line:', __LINE__
+         error stop 'must release_inhomogeneity first'
+      end if
+
+      if (ih == 1) then
+         call tabulate_xcw_beta
+      elseif (ih == 2) then
+         call tabulate_xcw_gamma
+      elseif (ih /= 0) then
+         write(error_unit,*) 'file:', __FILE__, ', line:', __LINE__
+         write(error_unit,*) 'ih == ', ih
+         error stop 'unknown inhomogeneity type: ih'
+      endif
+
+      initialized = .true.
+      inhm = ih
+
+   end subroutine initialize_inhomogeneity
+
+   subroutine release_inhomogeneity 
+      if (allocated(xcw)) deallocate(xcw)
+      initialized = .false.
+      inhm = 0
+   end subroutine release_inhomogeneity
+
+   function condensate_inhomogeneous result (inhomo)
+      logical :: inhomo
+      if (.not. initialized) then
+         write(error_unit,*) 'file:', __FILE__, ', line:', __LINE__
+         error stop 'must initialize_inhomogeneity first'
+      end if 
+      inhomo = (inhm > 0)
+   end function condensate_inhomogeneous
+
+   ! -----------------------------------------------------------
+   function zcw_lookup (cdf, sigma_qcw) result (zcw)
+   ! -----------------------------------------------------------
+   ! Horizontally inhomogeneous cloud condensate:
+   ! Determine ZCW = ratio of cloud condensate mixing ratio QC
+   !   to its mean value for all cloudy cells in this layer.
+   ! -----------------------------------------------------------
+
+      real, intent(in) :: cdf        ! condensate cumulative prob in [0,1]
+      real, intent(in) :: sigma_qcw  ! relative std deviation
+      real :: zcw
+
+      integer :: ind1, ind2
+      real :: rind1, rind2
+
+      if (.not. condensate_inhomogeneous()) then
+         write(error_unit,*) 'file:', __FILE__, ', line:', __LINE__
+         error stop 'zcw_lookup only works if condensate_inhomogeneous()'
+      end if 
+
+      ! bilinear interpolation of ZCW tabulated in array XCW as a func of
+      !   * cumulative condensate probability CDF
+      !   * relative standard deviation SIGMA_QCW
+      ! Take care that the definition of RIND2 is consistent with
+      !   subroutines TABULATE_XCW
+
+      rind1 = cdf * (n1 - 1) + 1.
+      ind1  = max(1, min(int(rind1), n1-1))
+      rind1 = rind1 - ind1
+      rind2 = 40. * sigma_qcw - 3.
+      ind2  = max(1, min(int(rind2), n2-1))
+      rind2 = rind2 - ind2
+
+      zcw =  (1.0-rind1) * (1.0-rind2) * xcw(ind1,ind2)     &
+           + (1.0-rind1) * rind2       * xcw(ind1,ind2+1)   &
+           + rind1 * (1.0-rind2)       * xcw(ind1+1,ind2)   &
+           + rind1 * rind2             * xcw(ind1+1,ind2+1)
+
+   end function zcw_lookup
+
+
+   subroutine tabulate_xcw_beta
+
+      if (allocated(xcw)) deallocate(xcw)
+      allocate (xcw(n1,n2))
 
-      subroutine tabulate_xcw_beta
       xcw(:,  1) = (/&
          0.1000E-04, 0.7137E+00, 0.7315E+00, 0.7426E+00,&
          0.7508E+00, 0.7573E+00, 0.7628E+00, 0.7676E+00,&
@@ -35151,9 +35264,13 @@ subroutine tabulate_xcw_beta
          0.1997E+02, 0.2108E+02, 0.2238E+02, 0.2394E+02,&
          0.0000E+00, 0.0000E+00, 0.0000E+00, 0.0000E+00/)
 
-      end subroutine tabulate_xcw_beta
+   end subroutine tabulate_xcw_beta
+
+   subroutine tabulate_xcw_gamma
+
+      if (allocated(xcw)) deallocate(xcw)
+      allocate (xcw(n1,n2))
 
-      subroutine tabulate_xcw_gamma
       xcw(:,  1) = (/&
          0.1000E-04, 0.7192E+00, 0.7364E+00, 0.7470E+00,&
          0.7549E+00, 0.7612E+00, 0.7665E+00, 0.7711E+00,&
@@ -70295,6 +70412,6 @@ subroutine tabulate_xcw_gamma
          0.2105E+02, 0.2245E+02, 0.2414E+02, 0.2624E+02,&
          0.0000E+00, 0.0000E+00, 0.0000E+00, 0.0000E+00/)
 
-      end subroutine tabulate_xcw_gamma
+   end subroutine tabulate_xcw_gamma
 
-      end module tab_xcw
+end module cloud_condensate_inhomogeneity