Revert "Some modifications for rrtmgp physics blocking to work."

This reverts commit d35be37.

physics/rrtmgp_lw_main.F90

@@ -195,17 +195,19 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
          lw_optical_props_precipByBand
     type(ty_source_func_lw)     :: sources 
     type(ty_fluxes_byband)      :: flux_allsky, flux_clrsky
-    integer :: iCol, iLay, iGas, iBand, iCol2, ix, iblck, blksz
-
+    integer :: iCol, iLay, iGas, iBand, iCol2, ix, iblck
+    integer, dimension(rrtmgp_phys_blksz) :: ipseed_lw
     type(random_stat) :: rng_stat
+    real(kind_phys), dimension(rrtmgp_phys_blksz) :: zcf0, zcf1
+    logical, dimension(rrtmgp_phys_blksz,nLay,lw_gas_props%get_ngpt()) :: maskMCICA
+    real(kind_phys), dimension(rrtmgp_phys_blksz) :: tau_rain, tau_snow
     real(kind_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D
-    real(kind_phys) :: tau_rain, tau_snow
-    integer,         dimension(:),     allocatable :: ipseed_lw
-    real(kind_phys), dimension(:),     allocatable :: zcf0, zcf1, rng2D
-    real(kind_phys), dimension(:,:),   allocatable :: lw_Ds, sfc_emiss_byband
-    real(kind_phys), dimension(:,:,:), allocatable :: rng3D,rng3D2
-    logical,         dimension(:,:,:), allocatable :: maskMCICA
-    real(kind_phys), dimension(:,:,:), allocatable, target :: fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky
+    real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2
+    real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLay) :: rng2D
+    real(kind_phys), dimension(rrtmgp_phys_blksz,nLay+1,lw_gas_props%get_nband()),target :: &
+         fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky
+    real(kind_phys), dimension(rrtmgp_phys_blksz,lw_gas_props%get_ngpt()) :: lw_Ds
+    real(kind_phys), dimension(lw_gas_props%get_nband(),rrtmgp_phys_blksz) :: sfc_emiss_byband
 
     ! Initialize CCPP error handling variables
     errmsg = ''
@@ -218,57 +220,44 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
     ! Allocate/initialize RRTMGP DDT's
     !
     ! ######################################################################################
-    blksz = minval((/nCol,rrtmgp_phys_blksz/))
-
-    allocate(ipseed_lw(blksz), zcf0(blksz), zcf1(blksz), &
-         maskMCICA(blksz,nLay,lw_gas_props%get_ngpt()), &
-         rng3D(lw_gas_props%get_ngpt(),nLay,blksz), &
-         rng3D2(lw_gas_props%get_ngpt(),nLay,blksz), &
-         rng2D(lw_gas_props%get_ngpt()*nLay), &
-         fluxLW_up_allsky(blksz,nLay+1,lw_gas_props%get_nband()), &
-         fluxLW_up_clrsky(blksz,nLay+1,lw_gas_props%get_nband()), &
-         fluxLW_dn_allsky(blksz,nLay+1,lw_gas_props%get_nband()), &
-         fluxLW_dn_clrsky(blksz,nLay+1,lw_gas_props%get_nband()), &
-         lw_Ds(blksz,lw_gas_props%get_ngpt()), &
-         sfc_emiss_byband(lw_gas_props%get_nband(),blksz))
 
     ! ty_gas_concs
     call check_error_msg('rrtmgp_lw_main_gas_concs_init',gas_concs%init(active_gases_array))
 
     ! ty_optical_props
     call check_error_msg('rrtmgp_lw_main_gas_optics_init',&
-         lw_optical_props_clrsky%alloc_1scl(blksz, nLay, lw_gas_props))
+         lw_optical_props_clrsky%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props))
     call check_error_msg('rrtmgp_lw_main_sources_init',&
-         sources%alloc(blksz, nLay, lw_gas_props))
+         sources%alloc(rrtmgp_phys_blksz, nLay, lw_gas_props))
     call check_error_msg('rrtmgp_lw_main_cloud_optics_init',&
-         lw_optical_props_cloudsByBand%alloc_2str(blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
+         lw_optical_props_cloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
     call check_error_msg('rrtmgp_lw_main_precip_optics_init',&
-         lw_optical_props_precipByBand%alloc_2str(blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
+         lw_optical_props_precipByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
     call check_error_msg('rrtmgp_lw_mian_cloud_sampling_init', & 
-         lw_optical_props_clouds%alloc_2str(blksz, nLay, lw_gas_props))
+         lw_optical_props_clouds%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props))
     call check_error_msg('rrtmgp_lw_main_aerosol_optics_init',&
-         lw_optical_props_aerosol_local%alloc_1scl(blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
+         lw_optical_props_aerosol_local%alloc_1scl(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
     if (doGP_sgs_cnv) then
        call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics_init',&
-            lw_optical_props_cnvcloudsByBand%alloc_2str(blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
+            lw_optical_props_cnvcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
     endif
     if (doGP_sgs_pbl) then
        call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics_init',&
-            lw_optical_props_pblcloudsByBand%alloc_2str(blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
+            lw_optical_props_pblcloudsByBand%alloc_2str(rrtmgp_phys_blksz, nLay, lw_gas_props%get_band_lims_wavenumber()))
     endif
 
     ! ######################################################################################
     !
     ! Loop over all columns...
     !
     ! ###################################################################################### 
-    do iCol=1,nCol,blksz
-       iCol2 = iCol + blksz - 1
+    do iCol=1,nCol,rrtmgp_phys_blksz
+       iCol2 = iCol + rrtmgp_phys_blksz - 1
 
        ! Create clear/cloudy indicator
        zcf0(:) = 1._kind_phys
        zcf1(:) = 1._kind_phys
-       do iblck = 1, blksz
+       do iblck = 1, rrtmgp_phys_blksz
           do iLay=1,nLay
              zcf0(iblck) = min(zcf0(iblck), 1._kind_phys - cld_frac(iCol+iblck-1,iLay))
           enddo
@@ -334,7 +323,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
        !
        ! ###################################################################################
        ! Assign same emissivity to all band
-       do iblck=1,blksz
+       do iblck=1,rrtmgp_phys_blksz
           if (semis(iCol+iblck-1) > eps .and. semis(iCol+iblck-1) <= 1._kind_phys) then
              do iBand=1,lw_gas_props%get_nband()
                 sfc_emiss_byband(iBand,iblck) = semis(iCol+iblck-1)
@@ -409,20 +398,22 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
        ! Cloud precipitation optics: rain and snow(+groupel)
        !
        ! ###################################################################################
-       do ix=1,blksz
+       tau_rain(:) = 0._kind_phys
+       tau_snow(:) = 0._kind_phys
+       do ix=1,rrtmgp_phys_blksz
           do iLay=1,nLay
              if (cld_frac(iCol+ix-1,iLay) .gt. eps) then
                 ! Rain optical-depth (No band dependence)
-                tau_rain = absrain*cld_rwp(iCol+ix-1,iLay)
+                tau_rain(ix) = absrain*cld_rwp(iCol+ix-1,iLay)
 
                 ! Snow (+groupel) optical-depth (No band dependence)
                 if (cld_swp(iCol+ix-1,iLay) .gt. 0. .and. cld_resnow(iCol+ix-1,iLay) .gt. 10._kind_phys) then
-                   tau_snow = abssnow0*1.05756*cld_swp(iCol+ix-1,iLay)/cld_resnow(iCol+ix-1,iLay)
+                   tau_snow(ix) = abssnow0*1.05756*cld_swp(iCol+ix-1,iLay)/cld_resnow(iCol+ix-1,iLay)
                 else
-                   tau_snow = 0.0
+                   tau_snow(ix) = 0.0
                 endif
                 do iBand=1,lw_gas_props%get_nband()
-                   lw_optical_props_precipByBand%tau(ix,iLay,iBand) = tau_rain + tau_snow
+                   lw_optical_props_precipByBand%tau(ix,iLay,iBand) = tau_rain(ix) + tau_snow(ix)
                 enddo
              endif
           enddo
@@ -440,17 +431,17 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
        if (any(zcf1 .gt. eps)) then
           ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2).
           if(isubc_lw == 1) then      ! advance prescribed permutation seed
-             do ix=1,blksz
+             do ix=1,rrtmgp_phys_blksz
                 ipseed_lw(ix) = lw_gas_props%get_ngpt() + iCol + ix - 1
              enddo
           elseif (isubc_lw == 2) then ! use input array of permutaion seeds
-             do ix=1,blksz
+             do ix=1,rrtmgp_phys_blksz
                 ipseed_lw(ix) = icseed_lw(iCol+ix-1)
              enddo
           endif
 
           ! Call RNG
-          do ix=1,blksz
+          do ix=1,rrtmgp_phys_blksz
              call random_setseed(ipseed_lw(ix),rng_stat)
              ! Use same rng for each layer
              if (iovr == iovr_max) then
@@ -473,7 +464,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat,
           endif
           ! Exponential decorrelation length overlap
           if (iovr == iovr_dcorr) then
-             do ix=1,blksz
+             do ix=1,rrtmgp_phys_blksz
                 ! Generate second RNG
                 call random_setseed(ipseed_lw(ix),rng_stat)
                 call random_number(rng2D,rng_stat)