Fixed allocation for RRTMGP aerosol/cloudy optical property DDT. Adju…

…sted SW aerosol band ordering in GFS_rrtmgp_pre.F90.
climbfuji · May 2, 2019 · 6c55b93 · 6c55b93
1 parent d14dba3
commit 6c55b93
Show file tree

Hide file tree

Showing 3 changed files with 30 additions and 35 deletions.
diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90
@@ -540,14 +540,18 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein,   & ! input
                    Model%lsswr, Model%lslwr,                      &
                    faersw, faerlw, aerodp)                          !  ---  outputs
 
-! CCPP
-      do j = 1,NBDSW
+
+      ! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the 
+      ! band ordering was [nIR -> UV -> IR(band)]
+      faersw1(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,NBDSW,1)
+      faersw2(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,NBDSW,2)
+      faersw3(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,NBDSW,3)
+      do j = 2,NBDSW
         do k = 1, LMK
           do i = 1, IM
-            ! NF_AESW = 3
-            faersw1(i,k,j) = faersw(i,k,j,1)
-            faersw2(i,k,j) = faersw(i,k,j,2)
-            faersw3(i,k,j) = faersw(i,k,j,3)
+             faersw1(i,k,j) = faersw(i,k,j-1,1)
+             faersw2(i,k,j) = faersw(i,k,j-1,2)
+             faersw3(i,k,j) = faersw(i,k,j-1,3)
           enddo
         enddo
        enddo

diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90
@@ -232,9 +232,6 @@ subroutine rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)
     ! How are we handling cloud-optics?
     rrtmgp_lw_cld_phys = Model%rrtmgp_cld_phys
 
-    ! HACK. If using RRTMG cloud_optics w/ RRTMGP, we need to be able to define
-    if (Model%rrtmgp_cld_phys .eq. 0) rrtmgp_lw_cld_phys=1
-
     ! Filenames are set in the gfs_physics_nml (scm/src/GFS_typedefs.F90)
     kdist_file      = trim(Model%rrtmgp_root)//trim(Model%kdist_lw_file_gas)
     kdist_cldy_file = trim(Model%rrtmgp_root)//trim(Model%kdist_lw_file_clouds)
@@ -724,9 +721,6 @@ subroutine rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)
             pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice))
     endif
 
-    ! HACK!
-    rrtmgp_lw_cld_phys = Model%rrtmgp_cld_phys
-
   end subroutine rrtmgp_lw_init
 
   ! #########################################################################################
@@ -1002,20 +996,18 @@ subroutine rrtmgp_lw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, vmr
     ! #######################################################################################
     ! Call RRTMGP
     ! #######################################################################################
-    ! Allocate space for source functions and gas optical properties
-    call check_error_msg(sources%alloc(                 ncol, nlay, kdist_lw))
-    call check_error_msg(optical_props_clr%alloc_1scl(  ncol, nlay, kdist_lw))
-    call check_error_msg(optical_props_mcica%alloc_1scl(ncol, nlay, kdist_lw))
-    ! DJS_asks_RP
-    ! Need to use kdist_lw_cldy here, otherewise if we use kdist_lw, optical_props_cldy gets
-    ! allocated with nBands != nGpts, which then fails when calling kdist_lw_cldy%cloud_optics
-    call check_error_msg(optical_props_cldy%alloc_1scl( ncol, nlay, kdist_lw_cldy))
-    ! We have also have aerosol information by band, so need to allocate just like for 
-    ! clouds, where nbands = ngpts = 16. This is problematic when not using RRTMGP cloud_optics(),
-    ! as kdist_lw_cldy only gets loaded, so this breaks when using rrtmg cloud_optics with rrtmgp.
-    call check_error_msg(optical_props_aer%alloc_1scl(  ncol, nlay, kdist_lw_cldy))
-
-    ! Initialize RRTMGP files
+    ! Allocate space for source functions and gas optical properties [ncol,nlay,ngpts]
+    call check_error_msg(sources%alloc(                 nCol, nLay, kdist_lw))
+    call check_error_msg(optical_props_clr%alloc_1scl(  nCol, nLay, kdist_lw))
+    call check_error_msg(optical_props_mcica%alloc_1scl(nCol, nLay, kdist_lw))
+    ! Cloud optics [nCol,nLay,nBands]
+    call check_error_msg(optical_props_cldy%init(optical_props_clr%get_band_lims_wavenumber()))
+    call check_error_msg(optical_props_cldy%alloc_1scl(ncol,nlay))
+    ! Aerosol optics [Ccol,nLay,nBands]
+    call check_error_msg(optical_props_aer%init(optical_props_clr%get_band_lims_wavenumber()))
+    call check_error_msg(optical_props_aer%alloc_1scl(ncol,nlay))
+
+    ! Initialize RRTMGP files 
     fluxAllSky%flux_up   => flux_up_allSky
     fluxAllsky%flux_dn   => flux_dn_allSky
     fluxClrSky%flux_up   => flux_up_clrSky

diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90
@@ -226,9 +226,6 @@ subroutine rrtmgp_sw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)
     ! How are we handling cloud-optics?
     rrtmgp_sw_cld_phys = Model%rrtmgp_cld_phys
 
-    ! HACK. If using RRTMG cloud_optics w/ RRTMGP, we need to be able to define
-    if (Model%rrtmgp_cld_phys .eq. 0) rrtmgp_sw_cld_phys=1
-
     ! Filenames are set in the gfs_physics_nml (scm/src/GFS_typedefs.F90)
     kdist_file      = trim(Model%rrtmgp_root)//trim(Model%kdist_sw_file_gas)
     kdist_cldy_file = trim(Model%rrtmgp_root)//trim(Model%kdist_sw_file_clouds)
@@ -720,9 +717,6 @@ subroutine rrtmgp_sw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)
             pade_sizereg_extice_sw, pade_sizereg_ssaice_sw, pade_sizereg_asyice_sw))
     endif
 
-    ! HACK
-    rrtmgp_sw_cld_phys = Model%rrtmgp_cld_phys
-
   end subroutine rrtmgp_sw_init
   ! #########################################################################################
   ! RRTMGP_SW_RUN
@@ -1073,11 +1067,16 @@ subroutine rrtmgp_sw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, vmr
     ! #######################################################################################
     if (nDay .gt. 0) then
 
-       ! Allocate space for source functions and gas optical properties
+       ! Allocate space for gas optical properties
+       ! Clear-sky 
        call check_error_msg(optical_props_clr%alloc_2str(  nday, nlay, kdist_sw))
-       call check_error_msg(optical_props_aer%alloc_2str(  nday, nlay, kdist_sw_cldy))
-       call check_error_msg(optical_props_cldy%alloc_2str( nday, nlay, kdist_sw_cldy))
        call check_error_msg(optical_props_mcica%alloc_2str(nday, nlay, kdist_sw))
+       ! Cloud optics [nCol,nLay,nBands]
+       call check_error_msg(optical_props_cldy%init(optical_props_clr%get_band_lims_wavenumber()))
+       call check_error_msg(optical_props_cldy%alloc_2str(ncol,nlay))
+       ! Aerosol optics [Ccol,nLay,nBands]
+       call check_error_msg(optical_props_aer%init(optical_props_clr%get_band_lims_wavenumber()))
+       call check_error_msg(optical_props_aer%alloc_2str(ncol,nlay))
 
        ! Initialize RRTMGP files
        fluxAllSky%flux_up => flux_up_allSky