rrtmgp_lw_gas_optics.F90

 
 
module rrtmgp_lw_gas_optics
  use machine,               only: kind_phys
  use mo_rte_kind,           only: wl
  use mo_gas_optics_rrtmgp,  only: ty_gas_optics_rrtmgp
  use mo_gas_concentrations, only: ty_gas_concs  
  use radiation_tools,       only: check_error_msg
  use netcdf
#ifdef MPI
  use mpi_f08
#endif
 
  implicit none
 
  type(ty_gas_optics_rrtmgp) :: lw_gas_props
  integer :: &
       ntempslw, npresslw, ngptslw, nabsorberslw, nextrabsorberslw, nminorabsorberslw,&
       nmixingfracslw, nlayerslw, nbndslw, npairslw, ninternalsourcetempslw,          &
       nminor_absorber_intervals_lowerlw, nminor_absorber_intervals_upperlw,          &
       ncontributors_lowerlw, ncontributors_upperlw, nfit_coeffslw
  integer, dimension(:), allocatable :: &
       kminor_start_lowerlw,              & !< Starting index in the [1, nContributors] vector for a contributor
 
       kminor_start_upperlw                 
  integer, dimension(:,:), allocatable :: &
       band2gptlw,                        & !< Beginning and ending gpoint for each band
       minor_limits_gpt_lowerlw,          & !< Beginning and ending gpoint for each minor interval in lower atmosphere
       minor_limits_gpt_upperlw
  integer, dimension(:,:,:), allocatable :: &
       key_specieslw
  real(kind_phys) :: &
       press_ref_troplw,                  & !< Reference pressure separating the lower and upper atmosphere [Pa]
       temp_ref_plw,                      & !< Standard spectroscopic reference pressure [Pa]
       temp_ref_tlw
  real(kind_phys), dimension(:), allocatable :: &
       press_reflw,                       & !< Pressures for reference atmosphere; press_ref(# reference layers) [Pa]
       temp_reflw
  real(kind_phys), dimension(:,:), allocatable :: &
       band_limslw,                       & !< Beginning and ending wavenumber [cm -1] for each band
       totplnklw,                         & !< Integrated Planck function by band
       optimal_angle_fitlw
  real(kind_phys), dimension(:,:,:), allocatable :: &
       vmr_reflw,                         & !< volume mixing ratios for reference atmospherer
       kminor_lowerlw,                    & !< (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to
 
       kminor_upperlw,                    & 
       rayl_lowerlw,                      & 
       rayl_upperlw                         
  real(kind_phys), dimension(:,:,:,:), allocatable :: &
       kmajorlw,                          & !< Stored absorption coefficients due to major absorbing gases
       planck_fraclw
  character(len=32),  dimension(:), allocatable :: &
       gas_nameslw,                       & !< Names of absorbing gases
       gas_minorlw,                       & !< Name of absorbing minor gas
       identifier_minorlw,                & !< Unique string identifying minor gas
       minor_gases_lowerlw,               & !< Names of minor absorbing gases in lower atmosphere
       minor_gases_upperlw,               & !< Names of minor absorbing gases in upper atmosphere
       scaling_gas_lowerlw,               & !< Absorption also depends on the concentration of this gas
       scaling_gas_upperlw
  logical(wl), dimension(:), allocatable :: &
       minor_scales_with_density_lowerlw, & !< Density scaling is applied to minor absorption coefficients
       minor_scales_with_density_upperlw, & !< Density scaling is applied to minor absorption coefficients
       scale_by_complement_lowerlw,       & !< Absorption is scaled by concentration of scaling_gas (F) or its complement (T)
       scale_by_complement_upperlw
 
contains
 
  subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas,                 &
       active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg)
 
    ! Inputs
    character(len=128),intent(in) :: &
         rrtmgp_root_dir,  & !< RTE-RRTMGP root directory
         rrtmgp_lw_file_gas
    character(len=*), dimension(:), intent(in) :: &
         active_gases_array
    type(mpi_comm),intent(in) :: &
         mpicomm
    integer,intent(in) :: &
         mpirank,          & !< Current MPI rank
         mpiroot
 
    ! Outputs
    character(len=*), intent(out) :: &
         errmsg
    integer,          intent(out) :: &
         errflg
 
    ! Local variables
    integer :: ncid, dimID, varID, status, ii, mpierr, iChar
    integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4
    character(len=264) :: lw_gas_props_file
    type(ty_gas_concs) :: gas_concs  ! RRTMGP DDT: trace gas concentrations (vmr)
 
    ! Initialize
    errmsg = ''
    errflg = 0
 
    ! Filenames are set in the physics_nml
    lw_gas_props_file  = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas)
 
    ! #######################################################################################
    !
    ! Read dimensions for k-distribution fields...
    ! (ONLY master processor(0), if MPI enabled)
    !
    ! #######################################################################################
#ifdef MPI
    if (mpirank .eq. mpiroot) then
#endif
       write (*,*) 'Reading RRTMGP longwave k-distribution metadata ... '
 
       ! Open file
       status = nf90_open(trim(lw_gas_props_file), nf90_nowrite, ncid)
 
       ! Read dimensions for k-distribution fields
       status = nf90_inq_dimid(ncid, 'temperature', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = ntempslw)
       status = nf90_inq_dimid(ncid, 'pressure', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = npresslw)
       status = nf90_inq_dimid(ncid, 'absorber', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = nabsorberslw)
       status = nf90_inq_dimid(ncid, 'minor_absorber', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = nminorabsorberslw)
       status = nf90_inq_dimid(ncid, 'absorber_ext', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = nextrabsorberslw)
       status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = nmixingfracslw)
       status = nf90_inq_dimid(ncid, 'atmos_layer', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = nlayerslw)
       status = nf90_inq_dimid(ncid, 'bnd', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = nbndslw)
       status = nf90_inq_dimid(ncid, 'gpt', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = ngptslw)
       status = nf90_inq_dimid(ncid, 'pair', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = npairslw)
       status = nf90_inq_dimid(ncid, 'contributors_lower', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_lowerlw)
       status = nf90_inq_dimid(ncid, 'contributors_upper', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_upperlw)
       status = nf90_inq_dimid(ncid, 'fit_coeffs',  dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = nfit_coeffslw)
       status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_lowerlw)
       status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_upperlw)
       status = nf90_inq_dimid(ncid, 'temperature_Planck', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len = ninternalsourcetempslw)
#ifdef MPI
    endif ! On master processor
 
    ! Other processors waiting...
    call mpi_barrier(mpicomm, mpierr)
 
    ! #######################################################################################
    !
    ! Broadcast dimensions...
    ! (ALL processors)
    !
    ! #######################################################################################
    call mpi_bcast(ntempslw,                          1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(npresslw,                          1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(ngptslw,                           1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nabsorberslw,                      1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nextrabsorberslw,                  1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nminorabsorberslw,                 1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nmixingfracslw,                    1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nlayerslw,                         1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nbndslw,                           1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(npairslw,                          1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(ninternalsourcetempslw,            1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nminor_absorber_intervals_lowerlw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nminor_absorber_intervals_upperlw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(ncontributors_lowerlw,             1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(ncontributors_upperlw,             1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nfit_coeffslw,                     1, mpi_integer, mpiroot, mpicomm, mpierr)
#endif
 
    ! Allocate space for arrays
    if (.not. allocated(gas_nameslw))                       &
         allocate(gas_nameslw(nabsorberslw))
    if (.not. allocated(scaling_gas_lowerlw))               &
         allocate(scaling_gas_lowerlw(nminor_absorber_intervals_lowerlw))
    if (.not. allocated(scaling_gas_upperlw))               &
         allocate(scaling_gas_upperlw(nminor_absorber_intervals_upperlw))
    if (.not. allocated(gas_minorlw))                       &
         allocate(gas_minorlw(nminorabsorberslw))
    if (.not. allocated(identifier_minorlw))                &
         allocate(identifier_minorlw(nminorabsorberslw))
    if (.not. allocated(minor_gases_lowerlw))               &
         allocate(minor_gases_lowerlw(nminor_absorber_intervals_lowerlw))
    if (.not. allocated(minor_gases_upperlw))               &
         allocate(minor_gases_upperlw(nminor_absorber_intervals_upperlw))
    if (.not. allocated(minor_limits_gpt_lowerlw))          &
         allocate(minor_limits_gpt_lowerlw(npairslw, nminor_absorber_intervals_lowerlw))
    if (.not. allocated(minor_limits_gpt_upperlw))          &
         allocate(minor_limits_gpt_upperlw(npairslw, nminor_absorber_intervals_upperlw))
    if (.not. allocated(band2gptlw))                        &
         allocate(band2gptlw(2, nbndslw))
    if (.not. allocated(key_specieslw))                     &
         allocate(key_specieslw(2, nlayerslw, nbndslw))
    if (.not. allocated(band_limslw))                       &
         allocate(band_limslw(2, nbndslw))
    if (.not. allocated(press_reflw))                       &
         allocate(press_reflw(npresslw))
    if (.not. allocated(temp_reflw))                        &
         allocate(temp_reflw(ntempslw))
    if (.not. allocated(vmr_reflw))                         &
         allocate(vmr_reflw(nlayerslw, nextrabsorberslw, ntempslw))
    if (.not. allocated(kminor_lowerlw))                    &
         allocate(kminor_lowerlw(ncontributors_lowerlw, nmixingfracslw, ntempslw))
    if (.not. allocated(kmajorlw))                          &
         allocate(kmajorlw(ngptslw, nmixingfracslw,  npresslw+1, ntempslw))
    if (.not. allocated(kminor_start_lowerlw))              &
         allocate(kminor_start_lowerlw(nminor_absorber_intervals_lowerlw))
    if (.not. allocated(kminor_upperlw))                    &
         allocate(kminor_upperlw(ncontributors_upperlw, nmixingfracslw, ntempslw))
    if (.not. allocated(kminor_start_upperlw))              &
         allocate(kminor_start_upperlw(nminor_absorber_intervals_upperlw))
    if (.not. allocated(optimal_angle_fitlw))               &
         allocate(optimal_angle_fitlw(nfit_coeffslw, nbndslw))
    if (.not. allocated(minor_scales_with_density_lowerlw)) &
         allocate(minor_scales_with_density_lowerlw(nminor_absorber_intervals_lowerlw))
    if (.not. allocated(minor_scales_with_density_upperlw)) &
         allocate(minor_scales_with_density_upperlw(nminor_absorber_intervals_upperlw))
    if (.not. allocated(scale_by_complement_lowerlw))       &
         allocate(scale_by_complement_lowerlw(nminor_absorber_intervals_lowerlw))
    if (.not. allocated(scale_by_complement_upperlw))       &
         allocate(scale_by_complement_upperlw(nminor_absorber_intervals_upperlw))
    if (.not. allocated(temp1))                             &
         allocate(temp1(nminor_absorber_intervals_lowerlw))
    if (.not. allocated(temp2))                             &
         allocate(temp2(nminor_absorber_intervals_upperlw))
    if (.not. allocated(temp3))                             &
         allocate(temp3(nminor_absorber_intervals_lowerlw))
    if (.not. allocated(temp4))                             &
         allocate(temp4(nminor_absorber_intervals_upperlw))
    if (.not. allocated(totplnklw))                         &
         allocate(totplnklw(ninternalsourcetempslw, nbndslw))
    if (.not. allocated(planck_fraclw))                     &
         allocate(planck_fraclw(ngptslw, nmixingfracslw, npresslw+1, ntempslw))
 
    ! #######################################################################################
    !
    ! Read in data ...
    ! (ONLY master processor(0), if MPI enabled) 
    !
    ! #######################################################################################
#ifdef MPI
    if (mpirank .eq. mpiroot) then
#endif
       write (*,*) 'Reading RRTMGP longwave k-distribution data ... '
       status = nf90_inq_varid(ncid, 'gas_names', varid)
       status = nf90_get_var(  ncid, varid, gas_nameslw)
       status = nf90_inq_varid(ncid, 'scaling_gas_lower', varid)
       status = nf90_get_var(  ncid, varid, scaling_gas_lowerlw)
       status = nf90_inq_varid(ncid, 'scaling_gas_upper', varid)
       status = nf90_get_var(  ncid, varid, scaling_gas_upperlw)
       status = nf90_inq_varid(ncid, 'gas_minor', varid)
       status = nf90_get_var(  ncid, varid, gas_minorlw)
       status = nf90_inq_varid(ncid, 'identifier_minor', varid)
       status = nf90_get_var(  ncid, varid, identifier_minorlw)
       status = nf90_inq_varid(ncid, 'minor_gases_lower', varid)
       status = nf90_get_var(  ncid, varid, minor_gases_lowerlw)
       status = nf90_inq_varid(ncid, 'minor_gases_upper', varid)
       status = nf90_get_var(  ncid, varid, minor_gases_upperlw)
       status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varid)
       status = nf90_get_var(  ncid, varid, minor_limits_gpt_lowerlw)
       status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varid)
       status = nf90_get_var(  ncid, varid, minor_limits_gpt_upperlw)
       status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varid)
       status = nf90_get_var(  ncid, varid, band2gptlw)
       status = nf90_inq_varid(ncid, 'key_species', varid)
       status = nf90_get_var(  ncid, varid, key_specieslw)
       status = nf90_inq_varid(ncid, 'bnd_limits_wavenumber', varid)
       status = nf90_get_var(  ncid, varid, band_limslw)
       status = nf90_inq_varid(ncid, 'press_ref', varid)
       status = nf90_get_var(  ncid, varid, press_reflw)
       status = nf90_inq_varid(ncid, 'temp_ref', varid)
       status = nf90_get_var(  ncid, varid, temp_reflw)
       status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varid)
       status = nf90_get_var(  ncid, varid, temp_ref_plw)
       status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varid)
       status = nf90_get_var(  ncid, varid, temp_ref_tlw)
       status = nf90_inq_varid(ncid, 'press_ref_trop', varid)
       status = nf90_get_var(  ncid, varid, press_ref_troplw)
       status = nf90_inq_varid(ncid, 'kminor_lower', varid)
       status = nf90_get_var(  ncid, varid, kminor_lowerlw)
       status = nf90_inq_varid(ncid, 'kminor_upper', varid)
       status = nf90_get_var(  ncid, varid, kminor_upperlw)
       status = nf90_inq_varid(ncid, 'vmr_ref', varid)
       status = nf90_get_var(  ncid, varid, vmr_reflw)
       status = nf90_inq_varid(ncid, 'optimal_angle_fit',varid)
       status = nf90_get_var(  ncid, varid, optimal_angle_fitlw)
       status = nf90_inq_varid(ncid, 'kmajor', varid)
       status = nf90_get_var(  ncid, varid, kmajorlw)
       status = nf90_inq_varid(ncid, 'kminor_start_lower', varid)
       status = nf90_get_var(  ncid, varid, kminor_start_lowerlw)
       status = nf90_inq_varid(ncid, 'kminor_start_upper', varid)
       status = nf90_get_var(  ncid, varid, kminor_start_upperlw)
       status = nf90_inq_varid(ncid, 'totplnk', varid)
       status = nf90_get_var(  ncid, varid, totplnklw)
       status = nf90_inq_varid(ncid, 'plank_fraction', varid)
       status = nf90_get_var(  ncid, varid, planck_fraclw)
 
       ! Logical fields are read in as integers and then converted to logicals.
       status = nf90_inq_varid(ncid,'minor_scales_with_density_lower', varid)
       status = nf90_get_var(  ncid, varid,temp1)
       status = nf90_inq_varid(ncid,'minor_scales_with_density_upper', varid)
       status = nf90_get_var(  ncid, varid,temp2)
       status = nf90_inq_varid(ncid,'scale_by_complement_lower', varid)
       status = nf90_get_var(  ncid, varid,temp3)
       status = nf90_inq_varid(ncid,'scale_by_complement_upper', varid)
       status = nf90_get_var(  ncid, varid,temp4)
       status = nf90_close(ncid)
 
       do ii=1,nminor_absorber_intervals_lowerlw
          if (temp1(ii) .eq. 0) minor_scales_with_density_lowerlw(ii) = .false.
          if (temp1(ii) .eq. 1) minor_scales_with_density_lowerlw(ii) = .true.
          if (temp3(ii) .eq. 0) scale_by_complement_lowerlw(ii)       = .false.
          if (temp3(ii) .eq. 1) scale_by_complement_lowerlw(ii)       = .true.
       enddo 
       do ii=1,nminor_absorber_intervals_upperlw
          if (temp2(ii) .eq. 0) minor_scales_with_density_upperlw(ii) = .false.
          if (temp2(ii) .eq. 1) minor_scales_with_density_upperlw(ii) = .true.
          if (temp4(ii) .eq. 0) scale_by_complement_upperlw(ii)       = .false.
          if (temp4(ii) .eq. 1) scale_by_complement_upperlw(ii)       = .true.
       enddo
#ifdef MPI
    endif ! Master process
 
    ! Other processors waiting...
    call mpi_barrier(mpicomm, mpierr)
 
    ! #######################################################################################
    !
    ! Broadcast data... 
    ! (ALL processors)
    !
    ! #######################################################################################
 
    ! Real scalars
    call mpi_bcast(press_ref_troplw, 1,      mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(temp_ref_plw,     1,      mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(temp_ref_tlw,     1,      mpi_double_precision, mpiroot, mpicomm, mpierr)
 
    ! Integer arrays
    call mpi_bcast(kminor_start_lowerlw,               &
         size(kminor_start_lowerlw),         mpi_integer,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(kminor_start_upperlw,               &
         size(kminor_start_upperlw),         mpi_integer,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(band2gptlw,                         &
         size(band2gptlw),                   mpi_integer,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(minor_limits_gpt_lowerlw,           &
         size(minor_limits_gpt_lowerlw),     mpi_integer,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(minor_limits_gpt_upperlw,           &
         size(minor_limits_gpt_upperlw),     mpi_integer,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(key_specieslw,                      &
         size(key_specieslw),                mpi_integer,          mpiroot, mpicomm, mpierr)
 
    ! Real arrays
    call mpi_bcast(press_reflw,                        &
         size(press_reflw),                  mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(temp_reflw,                         &
         size(temp_reflw),                   mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(band_limslw,                        &
         size(band_limslw),                  mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(totplnklw,                          &
         size(totplnklw),                    mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(optimal_angle_fitlw,                &
         size(optimal_angle_fitlw),          mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(vmr_reflw,                          &
         size(vmr_reflw),                    mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(kminor_lowerlw,                     &
         size(kminor_lowerlw),               mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(kminor_upperlw,                     &
         size(kminor_upperlw),               mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(kmajorlw,                           &
         size(kmajorlw),                     mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(planck_fraclw,                      &
         size(planck_fraclw),                mpi_double_precision, mpiroot, mpicomm, mpierr)
 
 
    ! Characters
    do ichar=1,nabsorberslw
       call mpi_bcast(gas_nameslw(ichar),              &
         len(gas_nameslw(ichar)),                 mpi_character,   mpiroot, mpicomm, mpierr)
    enddo
    do ichar=1,nminorabsorberslw
       call mpi_bcast(gas_minorlw(ichar),              &
         len(gas_minorlw(ichar)),                 mpi_character,   mpiroot, mpicomm, mpierr)
       call mpi_bcast(identifier_minorlw(ichar),       &
         len(identifier_minorlw(ichar)),          mpi_character,   mpiroot, mpicomm, mpierr)
    enddo
    do ichar=1,nminor_absorber_intervals_lowerlw
       call mpi_bcast(minor_gases_lowerlw(ichar),      &
         len(minor_gases_lowerlw(ichar)),          mpi_character,  mpiroot, mpicomm, mpierr)
       call mpi_bcast(scaling_gas_lowerlw(ichar),      &
         len(scaling_gas_lowerlw(ichar)),          mpi_character,  mpiroot, mpicomm, mpierr)
    enddo
    do ichar=1,nminor_absorber_intervals_upperlw
       call mpi_bcast(minor_gases_upperlw(ichar),      &
         len(minor_gases_upperlw(ichar)),          mpi_character,  mpiroot, mpicomm, mpierr)
       call mpi_bcast(scaling_gas_upperlw(ichar),      &
         len(scaling_gas_upperlw(ichar)),          mpi_character,  mpiroot, mpicomm, mpierr)
    enddo
 
    ! Logicals
    call mpi_bcast(minor_scales_with_density_lowerlw,  &
         size(minor_scales_with_density_lowerlw),  mpi_logical,    mpiroot, mpicomm, mpierr)
    call mpi_bcast(minor_scales_with_density_upperlw,  &
         size(minor_scales_with_density_upperlw),  mpi_logical,    mpiroot, mpicomm, mpierr)
    call mpi_bcast(scale_by_complement_lowerlw,        &
         size(scale_by_complement_lowerlw),        mpi_logical,    mpiroot, mpicomm, mpierr)
    call mpi_bcast(scale_by_complement_upperlw,        &
         size(scale_by_complement_upperlw),        mpi_logical,    mpiroot, mpicomm, mpierr)
 
    call mpi_barrier(mpicomm, mpierr)
#endif
 
    ! #######################################################################################
    !   
    ! Initialize RRTMGP DDT's...
    !
    ! #######################################################################################
    call check_error_msg('rrtmgp_lw_gas_optics_init_gas_concs',gas_concs%init(active_gases_array))
    call check_error_msg('rrtmgp_lw_gas_optics_init_load',lw_gas_props%load(gas_concs,      &
         gas_nameslw, key_specieslw, band2gptlw, band_limslw, press_reflw, press_ref_troplw,&
         temp_reflw,  temp_ref_plw, temp_ref_tlw, vmr_reflw, kmajorlw, kminor_lowerlw,      &
         kminor_upperlw, gas_minorlw, identifier_minorlw, minor_gases_lowerlw,              &
         minor_gases_upperlw, minor_limits_gpt_lowerlw, minor_limits_gpt_upperlw,           &
         minor_scales_with_density_lowerlw, minor_scales_with_density_upperlw,              &
         scaling_gas_lowerlw, scaling_gas_upperlw, scale_by_complement_lowerlw,             &
         scale_by_complement_upperlw, kminor_start_lowerlw, kminor_start_upperlw, totplnklw,&
         planck_fraclw, rayl_lowerlw, rayl_upperlw, optimal_angle_fitlw))
    
  end subroutine rrtmgp_lw_gas_optics_init
 
end module rrtmgp_lw_gas_optics