rrtmgp_sw_gas_optics.F90

 
 
module rrtmgp_sw_gas_optics
  use mo_rte_kind,            only: wl, wp
  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
  use mpi_f08
 
  implicit none
  real(wp),parameter :: &
       tsi_default = 1360.85767381726, &
       mg_default  = 0.1567652,        &
       sb_default  = 902.7126
 
  ! RRTMGP k-distribution LUTs.
  type(ty_gas_optics_rrtmgp) :: sw_gas_props
  integer :: &
       ntempssw, npresssw, ngptssw, nabsorberssw, nextrabsorberssw, nminorabsorberssw, &
       nmixingfracssw, nlayerssw, nbndssw, npairssw, nminor_absorber_intervals_lowersw,&
       nminor_absorber_intervals_uppersw, ncontributors_lowersw, ncontributors_uppersw
  integer, dimension(:), allocatable :: &
       kminor_start_lowersw,              & !< Starting index in the [1, nContributors] vector for a contributor
 
       kminor_start_uppersw                 
  integer, dimension(:,:), allocatable :: &
       band2gptsw,                        & !< Beginning and ending gpoint for each band
       minor_limits_gpt_lowersw,          & !< Beginning and ending gpoint for each minor interval in lower atmosphere
       minor_limits_gpt_uppersw
  integer, dimension(:,:,:), allocatable :: &
       key_speciessw
  real(wp) :: &
       press_ref_tropsw,                  & !< Reference pressure separating the lower and upper atmosphere [Pa]
       temp_ref_psw,                      & !< Standard spectroscopic reference pressure [Pa]
       temp_ref_tsw,                      & !< Standard spectroscopic reference temperature [K]
       tsi_defaultsw,                     & !< 
       mg_defaultsw,                      & !< Mean value of Mg2 index over the average solar cycle from the NRLSSI2 model of solar variability
       sb_defaultsw
  real(wp), dimension(:), allocatable :: &
       press_refsw,                       & !< Pressures for reference atmosphere; press_ref(# reference layers) [Pa]
       temp_refsw,                        & !< Temperatures for reference atmosphere; temp_ref(# reference layers) [K]
       solar_quietsw,                     & !< Spectrally-dependent quiet sun irradiance from the NRLSSI2 model of solar variability
       solar_facularsw,                   & !< Spectrally-dependent facular term from the NRLSSI2 model of solar variability
       solar_sunspotsw
  real(wp), dimension(:,:), allocatable :: &
       band_limssw
  real(wp), dimension(:,:,:), allocatable :: &
       vmr_refsw,                         & !< Volume mixing ratios for reference atmosphere
       kminor_lowersw,                    & !< (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to
 
       kminor_uppersw,                    & 
       rayl_lowersw,                      & 
       rayl_uppersw                         
  real(wp), dimension(:,:,:,:), allocatable :: &
       kmajorsw
  character(len=32),  dimension(:), allocatable :: &
       gas_namessw,                       & !< Names of absorbing gases
       gas_minorsw,                       & !< Name of absorbing minor gas
       identifier_minorsw,                & !< Unique string identifying minor gas
       minor_gases_lowersw,               & !< Names of minor absorbing gases in lower atmosphere
       minor_gases_uppersw,               & !< Names of minor absorbing gases in upper atmosphere
       scaling_gas_lowersw,               & !< Absorption also depends on the concentration of this gas
       scaling_gas_uppersw
  logical(wl), dimension(:), allocatable :: &
       minor_scales_with_density_lowersw, & !< Density scaling is applied to minor absorption coefficients
       minor_scales_with_density_uppersw, & !< Density scaling is applied to minor absorption coefficients
       scale_by_complement_lowersw,       & !< Absorption is scaled by concentration of scaling_gas (F) or its complement (T)
       scale_by_complement_uppersw
contains
 
  subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas,              &
       active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg)
 
    ! Inputs
    character(len=128),intent(in) :: &
         rrtmgp_root_dir,  & !< RTE-RRTMGP root directory
         rrtmgp_sw_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 :: status, ncid, dimid, varID, mpierr, iChar
    integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4
    character(len=264) :: sw_gas_props_file
    type(ty_gas_concs) :: gas_concs  ! RRTMGP DDT containing active trace gases
 
    ! Initialize
    errmsg = ''
    errflg = 0
 
    ! Filenames are set in the gfphysics_nml
    sw_gas_props_file   = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas)
 
    ! #######################################################################################
    !
    ! Read dimensions for k-distribution fields...
    ! (ONLY master processor(0), if MPI enabled)
    !
    ! #######################################################################################
    if (mpirank .eq. mpiroot) then
       write (*,*) 'Reading RRTMGP shortwave k-distribution metadata ... '
 
       ! Open file
       status = nf90_open(trim(sw_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=ntempssw)
       status = nf90_inq_dimid(ncid, 'pressure', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=npresssw)
       status = nf90_inq_dimid(ncid, 'absorber', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=nabsorberssw)
       status = nf90_inq_dimid(ncid, 'minor_absorber',dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=nminorabsorberssw)
       status = nf90_inq_dimid(ncid, 'absorber_ext', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=nextrabsorberssw)
       status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=nmixingfracssw)
       status = nf90_inq_dimid(ncid, 'atmos_layer', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=nlayerssw)
       status = nf90_inq_dimid(ncid, 'bnd', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=nbndssw)
       status = nf90_inq_dimid(ncid, 'gpt', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=ngptssw)
       status = nf90_inq_dimid(ncid, 'pair', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=npairssw)
       status = nf90_inq_dimid(ncid, 'contributors_lower',dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_lowersw)
       status = nf90_inq_dimid(ncid, 'contributors_upper', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_uppersw)
       status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_lowersw)
       status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid)
       status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_uppersw)
 
    endif ! On master processor
 
    ! Other processors waiting...
    call mpi_barrier(mpicomm, mpierr)
 
    ! #######################################################################################
    !
    ! Broadcast dimensions...
    ! (ALL processors)
    !
    ! #######################################################################################
    call mpi_bcast(nbndssw,                           1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(ngptssw,                           1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nmixingfracssw,                    1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(ntempssw,                          1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(npresssw,                          1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nabsorberssw,                      1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nextrabsorberssw,                  1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nminorabsorberssw,                 1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nlayerssw,                         1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(npairssw,                          1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(ncontributors_uppersw,             1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(ncontributors_lowersw,             1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nminor_absorber_intervals_uppersw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
    call mpi_bcast(nminor_absorber_intervals_lowersw, 1, mpi_integer, mpiroot, mpicomm, mpierr)
 
    ! #######################################################################################
    !
    ! Allocate space for arrays...
    ! (ALL processors)
    !
    ! #######################################################################################
    if (.not. allocated(gas_namessw))         &
         allocate(gas_namessw(nabsorberssw))
    if (.not. allocated(scaling_gas_lowersw)) &
         allocate(scaling_gas_lowersw(nminor_absorber_intervals_lowersw))
    if (.not. allocated(scaling_gas_uppersw)) &
         allocate(scaling_gas_uppersw(nminor_absorber_intervals_uppersw))
    if (.not. allocated(gas_minorsw))         &
         allocate(gas_minorsw(nminorabsorberssw))
    if (.not. allocated(identifier_minorsw))  &
         allocate(identifier_minorsw(nminorabsorberssw))
    if (.not. allocated(minor_gases_lowersw)) &
         allocate(minor_gases_lowersw(nminor_absorber_intervals_lowersw))
    if (.not. allocated(minor_gases_uppersw)) &
         allocate(minor_gases_uppersw(nminor_absorber_intervals_uppersw))
    if (.not. allocated(minor_limits_gpt_lowersw)) &
         allocate(minor_limits_gpt_lowersw(npairssw,nminor_absorber_intervals_lowersw))
    if (.not. allocated(minor_limits_gpt_uppersw)) &
         allocate(minor_limits_gpt_uppersw(npairssw,nminor_absorber_intervals_uppersw))
    if (.not. allocated(band2gptsw)) &
         allocate(band2gptsw(2,nbndssw))
    if (.not. allocated(key_speciessw)) &
         allocate(key_speciessw(2,nlayerssw,nbndssw))
    if (.not. allocated(band_limssw)) &
         allocate(band_limssw(2,nbndssw))
    if (.not. allocated(press_refsw)) &
         allocate(press_refsw(npresssw))
    if (.not. allocated(temp_refsw)) &
         allocate(temp_refsw(ntempssw))
    if (.not. allocated(vmr_refsw)) &
         allocate(vmr_refsw(nlayerssw, nextrabsorberssw, ntempssw))
    if (.not. allocated(kminor_lowersw)) &
         allocate(kminor_lowersw(ncontributors_lowersw, nmixingfracssw, ntempssw))
    if (.not. allocated(kmajorsw)) &
         allocate(kmajorsw(ngptssw, nmixingfracssw,  npresssw+1, ntempssw))
    if (.not. allocated(kminor_start_lowersw)) &
         allocate(kminor_start_lowersw(nminor_absorber_intervals_lowersw))
    if (.not. allocated(kminor_uppersw)) &
         allocate(kminor_uppersw(ncontributors_uppersw, nmixingfracssw, ntempssw))
    if (.not. allocated(kminor_start_uppersw)) &
         allocate(kminor_start_uppersw(nminor_absorber_intervals_uppersw))
    if (.not. allocated(minor_scales_with_density_lowersw)) &
         allocate(minor_scales_with_density_lowersw(nminor_absorber_intervals_lowersw))
    if (.not. allocated(minor_scales_with_density_uppersw)) &
         allocate(minor_scales_with_density_uppersw(nminor_absorber_intervals_uppersw))
    if (.not. allocated(scale_by_complement_lowersw)) &
         allocate(scale_by_complement_lowersw(nminor_absorber_intervals_lowersw))
    if (.not. allocated(scale_by_complement_uppersw)) &
         allocate(scale_by_complement_uppersw(nminor_absorber_intervals_uppersw))
    if (.not. allocated(rayl_uppersw)) &
         allocate(rayl_uppersw(ngptssw, nmixingfracssw, ntempssw))
    if (.not. allocated(rayl_lowersw)) &
         allocate(rayl_lowersw(ngptssw, nmixingfracssw, ntempssw))
    if (.not. allocated(solar_quietsw)) &
         allocate(solar_quietsw(ngptssw))
    if (.not. allocated(solar_facularsw)) &
         allocate(solar_facularsw(ngptssw)) 
    if (.not. allocated(solar_sunspotsw)) &
         allocate(solar_sunspotsw(ngptssw))
    if (.not. allocated(temp1)) &
         allocate(temp1(nminor_absorber_intervals_lowersw))
    if (.not. allocated(temp2)) &
         allocate(temp2(nminor_absorber_intervals_uppersw))
    if (.not. allocated(temp3)) &
         allocate(temp3(nminor_absorber_intervals_lowersw))
    if (.not. allocated(temp4)) &
         allocate(temp4(nminor_absorber_intervals_uppersw))
 
    ! #######################################################################################
    !
    ! Read in data ...
    ! (ONLY master processor(0), if MPI enabled) 
    !
    ! #######################################################################################
    if (mpirank .eq. mpiroot) then
       write (*,*) 'Reading RRTMGP shortwave k-distribution data ... '
       status = nf90_inq_varid(ncid, 'gas_names', varid)
       status = nf90_get_var(  ncid, varid, gas_namessw)       
       status = nf90_inq_varid(ncid, 'scaling_gas_lower', varid)
       status = nf90_get_var(  ncid, varid, scaling_gas_lowersw)       
       status = nf90_inq_varid(ncid, 'scaling_gas_upper', varid)
       status = nf90_get_var(  ncid, varid, scaling_gas_uppersw)       
       status = nf90_inq_varid(ncid, 'gas_minor', varid)
       status = nf90_get_var(  ncid, varid, gas_minorsw)       
       status = nf90_inq_varid(ncid, 'identifier_minor', varid)
       status = nf90_get_var(  ncid, varid, identifier_minorsw)       
       status = nf90_inq_varid(ncid, 'minor_gases_lower', varid)
       status = nf90_get_var(  ncid, varid, minor_gases_lowersw)       
       status = nf90_inq_varid(ncid, 'minor_gases_upper', varid)
       status = nf90_get_var(  ncid, varid, minor_gases_uppersw)       
       status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varid)
       status = nf90_get_var(  ncid, varid, minor_limits_gpt_lowersw)       
       status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varid)
       status = nf90_get_var(  ncid, varid, minor_limits_gpt_uppersw)       
       status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varid)
       status = nf90_get_var(  ncid, varid, band2gptsw)       
       status = nf90_inq_varid(ncid, 'key_species', varid)
       status = nf90_get_var(  ncid, varid, key_speciessw)       
       status = nf90_inq_varid(ncid,'bnd_limits_wavenumber', varid)
       status = nf90_get_var(  ncid, varid, band_limssw)       
       status = nf90_inq_varid(ncid, 'press_ref', varid)
       status = nf90_get_var(  ncid, varid, press_refsw)       
       status = nf90_inq_varid(ncid, 'temp_ref', varid)
       status = nf90_get_var(  ncid, varid, temp_refsw)       
       status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varid)
       status = nf90_get_var(  ncid, varid, temp_ref_psw)
       status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varid)
       status = nf90_get_var(  ncid, varid, temp_ref_tsw) 
       status = nf90_inq_varid(ncid, 'tsi_default', varid)
       if (status .eq. 0) then
          status = nf90_get_var(  ncid, varid, tsi_defaultsw)
       else
          tsi_defaultsw = tsi_default
       endif
       status = nf90_inq_varid(ncid, 'mg_default', varid)
       if (status .eq. 0) then
          status =  nf90_get_var(  ncid, varid, mg_defaultsw)
       else
          mg_defaultsw = mg_default
       endif
       status = nf90_inq_varid(ncid, 'sb_default', varid)
       if (status .eq. 0) then
          status =  nf90_get_var(  ncid, varid, sb_defaultsw)
       else
          sb_defaultsw = sb_default
       endif
       status = nf90_inq_varid(ncid, 'press_ref_trop', varid)
       status = nf90_get_var(  ncid, varid, press_ref_tropsw)       
       status = nf90_inq_varid(ncid, 'kminor_lower', varid)
       status = nf90_get_var(  ncid, varid, kminor_lowersw)       
       status = nf90_inq_varid(ncid, 'kminor_upper', varid)
       status = nf90_get_var(  ncid, varid, kminor_uppersw)       
       status = nf90_inq_varid(ncid, 'vmr_ref', varid)
       status = nf90_get_var(  ncid, varid, vmr_refsw)       
       status = nf90_inq_varid(ncid, 'kmajor', varid)
       status = nf90_get_var(  ncid, varid, kmajorsw)      
       status = nf90_inq_varid(ncid, 'kminor_start_lower', varid)
       status = nf90_get_var(  ncid, varid, kminor_start_lowersw)       
       status = nf90_inq_varid(ncid, 'kminor_start_upper', varid)
       status = nf90_get_var(  ncid, varid, kminor_start_uppersw)       
       status = nf90_inq_varid(ncid, 'solar_source_quiet', varid)
       status = nf90_get_var(  ncid, varid, solar_quietsw)
       status = nf90_inq_varid(ncid, 'solar_source_facular', varid)
       status = nf90_get_var(  ncid, varid, solar_facularsw)
       status = nf90_inq_varid(ncid, 'solar_source_sunspot', varid)
       status = nf90_get_var(  ncid, varid, solar_sunspotsw)       
       status = nf90_inq_varid(ncid, 'rayl_lower', varid)
       status = nf90_get_var(  ncid, varid, rayl_lowersw)
       status = nf90_inq_varid(ncid, 'rayl_upper', varid)
       status = nf90_get_var(  ncid, varid, rayl_uppersw)
 
       ! 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)
       minor_scales_with_density_lowersw(:) = .false.
       where(temp1 .eq. 1) minor_scales_with_density_lowersw(:) = .true.
       status = nf90_inq_varid(ncid,'minor_scales_with_density_upper', varid)
       status = nf90_get_var(  ncid, varid,temp2)
       minor_scales_with_density_uppersw(:) = .false.
       where(temp2 .eq. 1) minor_scales_with_density_uppersw(:) = .true.
       status = nf90_inq_varid(ncid,'scale_by_complement_lower', varid)
       status = nf90_get_var(  ncid, varid,temp3)
       scale_by_complement_lowersw(:) = .false.
       where(temp3 .eq. 1) scale_by_complement_lowersw(:) = .true.       
       status = nf90_inq_varid(ncid,'scale_by_complement_upper', varid)
       status = nf90_get_var(  ncid, varid,temp4)
       scale_by_complement_uppersw(:) = .false.
       where(temp4 .eq. 1) scale_by_complement_uppersw(:) = .true.
       
       ! Close
       status = nf90_close(ncid)
    endif ! Master process
 
    ! Other processors waiting...
    call mpi_barrier(mpicomm, mpierr)
 
    ! #######################################################################################
    !
    ! Broadcast data... 
    ! (ALL processors)
    !
    ! #######################################################################################
 
    ! Real scalars
#ifdef RTE_USE_SP
    call mpi_bcast(press_ref_tropsw, 1,           mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(temp_ref_psw,     1,           mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(temp_ref_tsw,     1,           mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(tsi_defaultsw,    1,           mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(mg_defaultsw,     1,           mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(sb_defaultsw,     1,           mpi_real,             mpiroot, mpicomm, mpierr)
#else
    call mpi_bcast(press_ref_tropsw, 1,           mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(temp_ref_psw,     1,           mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(temp_ref_tsw,     1,           mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(tsi_defaultsw,    1,           mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(mg_defaultsw,     1,           mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(sb_defaultsw,     1,           mpi_double_precision, mpiroot, mpicomm, mpierr)
#endif
 
    ! Integer arrays
    call mpi_bcast(kminor_start_lowersw,               &
         size(kminor_start_lowersw),              mpi_integer,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(kminor_start_uppersw,               &
         size(kminor_start_uppersw),              mpi_integer,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(band2gptsw,                         &
         size(band2gptsw),                        mpi_integer,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(minor_limits_gpt_lowersw,           &
         size(minor_limits_gpt_lowersw),          mpi_integer,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(minor_limits_gpt_uppersw,           &
         size(minor_limits_gpt_uppersw),          mpi_integer,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(key_speciessw,                      &
         size(key_speciessw),                     mpi_integer,          mpiroot, mpicomm, mpierr)
    
    ! Real arrays
#ifdef RTE_USE_SP
    call mpi_bcast(press_refsw,                        &
         size(press_refsw),                       mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(temp_refsw,                         &
         size(temp_refsw),                        mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(solar_quietsw,                      &
         size(solar_quietsw),                     mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(solar_facularsw,                    &
         size(solar_facularsw),                   mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(solar_sunspotsw,                    &
         size(solar_sunspotsw),                   mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(band_limssw,                        &
         size(band_limssw),                       mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(vmr_refsw,                          &
         size(vmr_refsw),                         mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(kminor_lowersw,                     &
         size(kminor_lowersw),                    mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(kminor_uppersw,                     &
         size(kminor_uppersw),                    mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(rayl_lowersw,                       &
         size(rayl_lowersw),                      mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(rayl_uppersw,                       &
         size(rayl_uppersw),                      mpi_real,             mpiroot, mpicomm, mpierr)
    call mpi_bcast(kmajorsw,                           &
         size(kmajorsw),                          mpi_real,             mpiroot, mpicomm, mpierr)
#else
    call mpi_bcast(press_refsw,                        &
         size(press_refsw),                       mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(temp_refsw,                         &
         size(temp_refsw),                        mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(solar_quietsw,                      &
         size(solar_quietsw),                     mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(solar_facularsw,                    &
         size(solar_facularsw),                   mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(solar_sunspotsw,                    &
         size(solar_sunspotsw),                   mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(band_limssw,                        &
         size(band_limssw),                       mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(vmr_refsw,                          &
         size(vmr_refsw),                         mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(kminor_lowersw,                     &
         size(kminor_lowersw),                    mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(kminor_uppersw,                     &
         size(kminor_uppersw),                    mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(rayl_lowersw,                       &
         size(rayl_lowersw),                      mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(rayl_uppersw,                       &
         size(rayl_uppersw),                      mpi_double_precision, mpiroot, mpicomm, mpierr)
    call mpi_bcast(kmajorsw,                           &
         size(kmajorsw),                          mpi_double_precision, mpiroot, mpicomm, mpierr)
#endif
    ! Characters
    do ichar=1,nabsorberssw
       call mpi_bcast(gas_namessw(ichar),              &
         len(gas_namessw(ichar)),                 mpi_character,        mpiroot, mpicomm, mpierr)
    enddo
    do ichar=1,nminorabsorberssw
       call mpi_bcast(gas_minorsw(ichar),              &
            len(gas_minorsw(ichar)),              mpi_character,        mpiroot, mpicomm, mpierr)
       call mpi_bcast(identifier_minorsw(ichar),       &
            len(identifier_minorsw(ichar)),       mpi_character,        mpiroot, mpicomm, mpierr)
    enddo
    do ichar=1,nminor_absorber_intervals_lowersw
       call mpi_bcast(minor_gases_lowersw(ichar),      &
            len(minor_gases_lowersw(ichar)),      mpi_character,        mpiroot, mpicomm, mpierr)
       call mpi_bcast(scaling_gas_lowersw(ichar),      &
            len(scaling_gas_lowersw(ichar)),      mpi_character,        mpiroot, mpicomm, mpierr)
    enddo
 
    do ichar=1,nminor_absorber_intervals_uppersw
       call mpi_bcast(minor_gases_uppersw(ichar),      &
            len(minor_gases_uppersw(ichar)),      mpi_character,        mpiroot, mpicomm, mpierr)
       call mpi_bcast(scaling_gas_uppersw(ichar),      &
            len(scaling_gas_uppersw(ichar)),      mpi_character,        mpiroot, mpicomm, mpierr)
    enddo
    
    ! Logicals
    call mpi_bcast(minor_scales_with_density_lowersw,  &
         size(minor_scales_with_density_lowersw), mpi_logical,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(minor_scales_with_density_uppersw,  &
         size(minor_scales_with_density_uppersw), mpi_logical,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(scale_by_complement_lowersw,        &
         size(scale_by_complement_lowersw),       mpi_logical,          mpiroot, mpicomm, mpierr)
    call mpi_bcast(scale_by_complement_uppersw,        &
         size(scale_by_complement_uppersw),       mpi_logical,          mpiroot, mpicomm, mpierr)
 
    call mpi_barrier(mpicomm, mpierr)
 
    ! #######################################################################################
    !   
    ! Initialize RRTMGP DDT's...
    !
    ! #######################################################################################
    call check_error_msg('rrtmgp_sw_gas_optics_init_gas_concs',gas_concs%init(active_gases_array))
    call check_error_msg('rrtmgp_sw_gas_optics_init_load',sw_gas_props%load(gas_concs,      &
         gas_namessw, key_speciessw, band2gptsw, band_limssw, press_refsw, press_ref_tropsw,&
         temp_refsw, temp_ref_psw, temp_ref_tsw, vmr_refsw, kmajorsw, kminor_lowersw,       &
         kminor_uppersw, gas_minorsw, identifier_minorsw, minor_gases_lowersw,              &
         minor_gases_uppersw, minor_limits_gpt_lowersw, minor_limits_gpt_uppersw,           &
         minor_scales_with_density_lowersw, minor_scales_with_density_uppersw,              &
         scaling_gas_lowersw, scaling_gas_uppersw, scale_by_complement_lowersw,             &
         scale_by_complement_uppersw, kminor_start_lowersw, kminor_start_uppersw,           &
         solar_quietsw, solar_facularsw, solar_sunspotsw, tsi_defaultsw, mg_defaultsw,      &
         sb_defaultsw, rayl_lowersw, rayl_uppersw))
 
  end subroutine rrtmgp_sw_gas_optics_init
end module rrtmgp_sw_gas_optics