Merge pull request #749 from climbfuji/debug-array-alloc-ccpp-caps

Metadata bug fixes, cleanup of active_gases_array use in RRTMGP, cleanup of Ferrier-Aligo variables, remove redundant consistency checks

physics/GFS_DCNV_generic.meta

@@ -477,7 +477,7 @@
   standard_name = cumulative_change_of_state_variables
   long_name = diagnostic tendencies for state variables
   units = various
-  dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_cumulative_change_processes)
+  dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max)
   type = real
   kind = kind_phys
   intent = inout

physics/GFS_GWD_generic.meta

@@ -186,7 +186,7 @@
   standard_name = cumulative_change_of_state_variables
   long_name = diagnostic tendencies for state variables
   units = various
-  dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_cumulative_change_processes)
+  dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max)
   type = real
   kind = kind_phys
   intent = inout
@@ -368,7 +368,7 @@
   standard_name = cumulative_change_of_state_variables
   long_name = diagnostic tendencies for state variables
   units = various
-  dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_cumulative_change_processes)
+  dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max)
   type = real
   kind = kind_phys
   intent = inout

physics/GFS_MP_generic.meta

@@ -823,7 +823,7 @@
   standard_name = cumulative_change_of_state_variables
   long_name = diagnostic tendencies for state variables
   units = various
-  dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_cumulative_change_processes)
+  dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max)
   type = real
   kind = kind_phys
   intent = inout

physics/GFS_PBL_generic.meta

@@ -820,7 +820,7 @@
   standard_name = cumulative_change_of_state_variables
   long_name = diagnostic tendencies for state variables
   units = various
-  dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_cumulative_change_processes)
+  dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max)
   type = real
   kind = kind_phys
   intent = inout

physics/GFS_SCNV_generic.meta

@@ -433,7 +433,7 @@
   standard_name = cumulative_change_of_state_variables
   long_name = diagnostic tendencies for state variables
   units = various
-  dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_cumulative_change_processes)
+  dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max)
   type = real
   kind = kind_phys
   intent = inout

physics/GFS_debug.F90

@@ -1393,12 +1393,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup
                          call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icemp               ', Interstitial%icemp                   )
                          call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%rainmp              ', Interstitial%rainmp                  )
                          call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowmp              ', Interstitial%snowmp                  )
-                     ! Ferrier-Aligo
-                     else if (Model%imp_physics == Model%imp_physics_fer_hires) then
-                         call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%f_ice               ', Interstitial%f_ice                   )
-                         call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%f_rain              ', Interstitial%f_rain                  )
-                         call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%f_rimef             ', Interstitial%f_rimef                 )
-                         call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cwm                 ', Interstitial%cwm                     )
                      ! Morrison-Gettelman
                      else if (Model%imp_physics == Model%imp_physics_mg) then
                          call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ncgl                ', Interstitial%ncgl                    )

physics/GFS_radiation_surface.F90

@@ -13,31 +13,21 @@ module GFS_radiation_surface
 !> \section arg_table_GFS_radiation_surface_init Argument Table
 !! \htmlinclude GFS_radiation_surface_init.html
 !!
-      subroutine GFS_radiation_surface_init (me, sfcalb, ialb, iems, errmsg, errflg)
+      subroutine GFS_radiation_surface_init (me, ialb, iems, errmsg, errflg)
 
       use physparam,                only: ialbflg, iemsflg
-      use module_radiation_surface, only: NF_ALBD, sfc_init
+      use module_radiation_surface, only: sfc_init
 
       implicit none
 
       integer,                              intent(in)  :: me, ialb, iems
-      real(kind=kind_phys), dimension(:,:), intent(in)  :: sfcalb
       character(len=*),                     intent(out) :: errmsg
       integer,                              intent(out) :: errflg
 
       ! Initialize CCPP error handling variables
       errmsg = ''
       errflg = 0
 
-      ! Consistency check that the number of albedo components in array
-      ! sfcalb matches the parameter NF_ALBD from radiation_surface.f
-      if (size(sfcalb,dim=2)/=NF_ALBD) then
-        errmsg = 'Error in GFS_radiation_surface_init: second' // &
-                 ' dimension of array sfcalb does not match' //   &
-                 ' parameter NF_ALBD in radiation_surface.f'
-        errflg = 1
-      end if
-
       ialbflg= ialb                     ! surface albedo control flag
       iemsflg= iems                     ! surface emissivity control flag
 

physics/GFS_radiation_surface.meta

@@ -15,15 +15,6 @@
   type = integer
   intent = in
   optional = F
-[sfcalb]
-  standard_name = surface_albedo_components
-  long_name = surface albedo IR/UV/VIS components
-  units = frac
-  dimensions = (horizontal_dimension,number_of_components_for_surface_albedo)
-  type = real
-  kind = kind_phys
-  intent = in
-  optional = F
 [ialb]
   standard_name = control_for_surface_albedo
   long_name = flag for using climatology alb, based on sfc type

physics/GFS_rrtmg_setup.F90

@@ -48,8 +48,7 @@ subroutine GFS_rrtmg_setup_init (                          &
           icliq_sw, crick_proof, ccnorm,                      &
           imp_physics,                                        &
           norad_precip, idate, iflip,                         &
-          do_RRTMGP, im, faerlw, faersw, aerodp,              & ! for consistency checks
-          me, errmsg, errflg)
+          do_RRTMGP, me, errmsg, errflg)
 ! =================   subprogram documentation block   ================ !
 !                                                                       !
 ! subprogram:   GFS_rrtmg_setup_init - a subprogram to initialize radiation !
@@ -145,10 +144,6 @@ subroutine GFS_rrtmg_setup_init (                          &
 !                                                                       !
 !  ===================================================================  !
 !
-      use module_radsw_parameters,  only: NBDSW
-      use module_radlw_parameters,  only: NBDLW
-      use module_radiation_aerosols,only: NF_AELW, NF_AESW, NSPC1
-
       implicit none
 
       ! interface variables
@@ -172,24 +167,11 @@ subroutine GFS_rrtmg_setup_init (                          &
       logical, intent(in) :: norad_precip
       integer, intent(in) :: idate(:)
       integer, intent(in) :: iflip
-      ! For consistency checks
-
-      logical, intent(in)         :: do_RRTMGP
-      integer, intent(in)         :: im
-      real(kind_phys), intent(in) :: faerlw(:,:,:,:)
-      real(kind_phys), intent(in) :: faersw(:,:,:,:)
-      real(kind_phys), intent(in) :: aerodp(:,:)
-      ! End for consistency checks
-      integer, intent(in)           :: me
+      logical, intent(in) :: do_RRTMGP
+      integer, intent(in) :: me
       character(len=*), intent(out) :: errmsg
       integer,          intent(out) :: errflg
 
-      ! For consistency checks
-      real(kind_phys), dimension(im,levr+ltp,NBDLW,NF_AELW) :: faerlw_check
-      real(kind_phys), dimension(im,levr+ltp,NBDSW,NF_AESW) :: faersw_check
-      real(kind_phys), dimension(im,NSPC1)                  :: aerodp_check
-      ! End for consistency checks
-
       ! Initialize the CCPP error handling variables
       errmsg = ''
       errflg = 0
@@ -202,41 +184,7 @@ subroutine GFS_rrtmg_setup_init (                          &
         return
       end if
 
-      ! Consistency checks for dimensions of arrays, this is required
-      ! to detect differences in FV3's parameters that are used to
-      ! dimension certain arrays and the values in ccpp-physics
-      if (size(faerlw(1,:,:,:)).ne.size(faerlw_check(1,:,:,:))) then
-         write(errmsg,"(3a,4i4,a,4i4)") &
-               "Runtime error: dimension mismatch for faerlw,",        &
-               " check definitions of levr, ltp, nbdlw, nf_aelw:",     &
-               " expected shape ", shape(faerlw_check(:,:,:,:)),       &
-               " but got ", shape(faerlw(:,:,:,:))
-         errflg = 1
-         return
-      end if
-      if (size(faersw(1,:,:,:)).ne.size(faersw_check(1,:,:,:))) then
-         write(errmsg,"(3a,4i4,a,4i4)") &
-               "Runtime error: dimension mismatch for faersw,",        &
-               " check definitions of levr, ltp, nbdsw, nf_aesw:",     &
-               " expected shape ", shape(faersw_check(:,:,:,:)),       &
-               " but got ", shape(faersw(:,:,:,:))
-         errflg = 1
-         return
-      end if
-      if (size(aerodp(1,:)).ne.size(aerodp_check(1,:))) then
-         write(errmsg,"(3a,2i4,a,2i4)") &
-               "Runtime error: dimension mismatch for aerodp,",        &
-               " check definitions of nspc1:",                         &
-               " expected shape ", shape(aerodp_check(:,:)),           &
-               " but got ", shape(aerodp(:,:))
-         errflg = 1
-         return
-      end if
-
-      ! End of consistency checks
-
       isolar = isol                     ! solar constant control flag
-
       ictmflg= ictm                     ! data ic time/date control flag
       ico2flg= ico2                     ! co2 data source control flag
       ioznflg= ntoz                     ! ozone data source control flag

physics/GFS_rrtmg_setup.meta

@@ -177,41 +177,6 @@
   type = logical
   intent = in
   optional = F
-[im]
-  standard_name = horizontal_dimension
-  long_name = horizontal dimension
-  units = count
-  dimensions = ()
-  type = integer
-  intent = in
-  optional = F
-[faerlw]
-  standard_name = aerosol_optical_properties_for_longwave_bands_01_16
-  long_name = optical properties for longwave bands 01-16
-  units = various
-  dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation,number_of_aerosol_output_fields_for_longwave_radiation)
-  type = real
-  kind = kind_phys
-  intent = in
-  optional = F
-[faersw]
-  standard_name = aerosol_optical_properties_for_shortwave_bands_01_16
-  long_name = aerosol optical properties for shortwave bands 01-16
-  units = various
-  dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation,number_of_aerosol_output_fields_for_shortwave_radiation)
-  type = real
-  kind = kind_phys
-  intent = in
-  optional = F
-[aerodp]
-  standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles
-  long_name = vertical integrated optical depth for various aerosol species
-  units = none
-  dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth)
-  type = real
-  kind = kind_phys
-  intent = in
-  optional = F
 [me]
   standard_name = mpi_rank
   long_name = current MPI-rank

physics/GFS_rrtmgp_pre.F90

@@ -21,8 +21,6 @@ module GFS_rrtmgp_pre
   ! Save trace gas indices.
   integer :: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, iStr_o2, iStr_ccl4, &
        iStr_cfc11, iStr_cfc12, iStr_cfc22 
-    character(len=32),dimension(:),allocatable :: &
-         active_gases_array 
 
   public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize  
 contains
@@ -33,12 +31,15 @@ module GFS_rrtmgp_pre
 !! \section arg_table_GFS_rrtmgp_pre_init
 !! \htmlinclude GFS_rrtmgp_pre_init.html
 !!
-  subroutine GFS_rrtmgp_pre_init(nGases, active_gases, errmsg, errflg)
+  subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, errflg)
     ! Inputs
     integer, intent(in) :: &
          nGases       ! Number of active gases in RRTMGP
     character(len=*), intent(in) :: &
-         active_gases ! List of active gases from namelist.     
+         active_gases ! List of active gases from namelist
+    character(len=*), dimension(:), intent(out) :: &
+         active_gases_array ! List of active gases from namelist as array
+
     ! Outputs
     character(len=*), intent(out) :: &
          errmsg             ! Error message
@@ -73,7 +74,6 @@ subroutine GFS_rrtmgp_pre_init(nGases, active_gases, errmsg, errflg)
     gasIndices(nGases,2)=len(trim(active_gases))
 
     ! Now extract the gas names
-    allocate(active_gases_array(nGases))
     do ij=1,nGases
        active_gases_array(ij) = active_gases(gasIndices(ij,1):gasIndices(ij,2))
        if(trim(active_gases_array(ij)) .eq. 'h2o')   istr_h2o       = ij
@@ -99,8 +99,8 @@ end subroutine GFS_rrtmgp_pre_init
   subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr,     &
        xlat, xlon,  prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps, con_epsm1, con_fvirt,     &
        con_epsqs, minGPpres, maxGPpres, minGPtemp, maxGPtemp, raddt, p_lay, t_lay, p_lev,   &
-       t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations,        &
-       tsfc_radtime, errmsg, errflg)
+       t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, active_gases_array,        &
+       gas_concentrations, tsfc_radtime, errmsg, errflg)
 
     ! Inputs   
     integer, intent(in)    :: &
@@ -159,7 +159,9 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f
          t_lev                ! Temperature at model-interface
     real(kind_phys), dimension(nCol, nLev, nTracers),intent(inout) :: &
          tracer               ! Array containing trace gases
-    type(ty_gas_concs),intent(inout) :: &
+    character(len=*), dimension(:), intent(in) :: &
+         active_gases_array ! List of active gases from namelist as array
+    type(ty_gas_concs), intent(inout) :: &
          gas_concentrations   ! RRTMGP DDT: gas volumne mixing ratios
 
     ! Local variables
@@ -169,7 +171,6 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f
     real(kind_phys) :: es, tem1, tem2
     real(kind_phys), dimension(nCol,nLev) :: o3_lay
     real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr
-    character(len=32), dimension(gas_concentrations%get_num_gases()) :: active_gases
 
     ! Initialize CCPP error handling variables
     errmsg = ''

physics/GFS_rrtmgp_pre.meta

@@ -8,6 +8,14 @@
 [ccpp-arg-table]
   name = GFS_rrtmgp_pre_init
   type = scheme
+[nGases]
+  standard_name = number_of_active_gases_used_by_RRTMGP
+  long_name = number of gases available used by RRTMGP (Model%nGases)
+  units = count
+  dimensions =  ()
+  type = integer  
+  intent = in
+  optional = F  
 [active_gases]
   standard_name = active_gases_used_by_RRTMGP
   long_name = active gases used by RRTMGP
@@ -17,13 +25,14 @@
   kind = len=128
   intent = in
   optional = F  
-[nGases]
-  standard_name = number_of_active_gases_used_by_RRTMGP
-  long_name = number of gases available used by RRTMGP (Model%nGases)
-  units = count
-  dimensions =  ()
-  type = integer  
-  intent = in
+[active_gases_array]
+  standard_name = list_of_active_gases_used_by_RRTMGP
+  long_name = list of active gases used by RRTMGP
+  units = none
+  dimensions =  (number_of_active_gases_used_by_RRTMGP)
+  type = character
+  kind = len=128
+  intent = out
   optional = F  
 [errmsg]
   standard_name = ccpp_error_message
@@ -374,6 +383,15 @@
   kind = kind_phys
   intent = inout
   optional = F
+[active_gases_array]
+  standard_name = list_of_active_gases_used_by_RRTMGP
+  long_name = list of active gases used by RRTMGP
+  units = none
+  dimensions =  (number_of_active_gases_used_by_RRTMGP)
+  type = character
+  kind = len=*
+  intent = in
+  optional = F
 [gas_concentrations]
   standard_name = Gas_concentrations_for_RRTMGP_suite
   long_name = DDT containing gas concentrations for RRTMGP radiation scheme

physics/GFS_suite_interstitial.meta

@@ -668,7 +668,7 @@
   standard_name = cumulative_change_of_state_variables
   long_name = diagnostic tendencies for state variables
   units = various
-  dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_cumulative_change_processes)
+  dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max)
   type = real
   kind = kind_phys
   intent = inout
@@ -1993,7 +1993,7 @@
   standard_name = cumulative_change_of_state_variables
   long_name = diagnostic tendencies for state variables
   units = various
-  dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_cumulative_change_processes)
+  dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max)
   type = real
   kind = kind_phys
   intent = inout

physics/cires_ugwp.meta

@@ -879,7 +879,7 @@
   standard_name = cumulative_change_of_state_variables
   long_name = diagnostic tendencies for state variables
   units = various
-  dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_cumulative_change_processes)
+  dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max)
   type = real
   kind = kind_phys
   active = (flag_for_diagnostics_3D)