Line data    Source code

       1             : module rad_constituents
       2             : 
       3             : !------------------------------------------------------------------------------------------------
       4             : !
       5             : ! Provide constituent distributions and properties to the radiation and
       6             : ! cloud microphysics routines.
       7             : !
       8             : ! The logic to control which constituents are used in the climate calculations
       9             : ! and which are used in diagnostic radiation calculations is contained in this module.
      10             : !
      11             : !------------------------------------------------------------------------------------------------
      12             : 
      13             : use shr_kind_mod,   only: r8 => shr_kind_r8
      14             : use spmd_utils,     only: masterproc
      15             : use ppgrid,         only: pcols, pver
      16             : use physconst,      only: rga
      17             : use physics_types,  only: physics_state
      18             : use phys_control,   only: use_simple_phys
      19             : use constituents,   only: cnst_get_ind
      20             : use radconstants,   only: nradgas, rad_gas_index
      21             : use phys_prop,      only: physprop_accum_unique_files, physprop_init, &
      22             :                           physprop_get_id, ot_length
      23             : use cam_history,    only: addfld, fieldname_len, outfld, horiz_only
      24             : use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index
      25             : 
      26             : 
      27             : use cam_abortutils, only: endrun
      28             : use cam_logfile,    only: iulog
      29             : 
      30             : implicit none
      31             : private
      32             : save
      33             : 
      34             : ! Public interfaces
      35             : 
      36             : public :: &
      37             :    rad_cnst_readnl,             &! read namelist values and parse
      38             :    rad_cnst_init,               &! find optics files and all constituents
      39             :    rad_cnst_get_info,           &! return info about climate/diagnostic lists
      40             :    rad_cnst_get_mode_idx,       &! return mode index of specified mode type
      41             :    rad_cnst_get_spec_idx,       &! return specie index of specified specie type
      42             :    rad_cnst_get_gas,            &! return pointer to mmr for gasses
      43             :    rad_cnst_get_aer_mmr,        &! return pointer to mmr for aerosols
      44             :    rad_cnst_get_mam_mmr_idx,    &! get constituent index of mam specie mmr (climate list only)
      45             :    rad_cnst_get_aer_props,      &! return physical properties for aerosols
      46             :    rad_cnst_get_mode_props,     &! return physical properties for aerosol modes
      47             :    rad_cnst_get_mode_num,       &! return mode number mixing ratio
      48             :    rad_cnst_get_mode_num_idx,   &! get constituent index of mode number m.r. (climate list only)
      49             :    rad_cnst_out,                &! output constituent diagnostics (mass per layer and column burden)
      50             :    rad_cnst_get_call_list        ! return list of active climate/diagnostic calls to radiation
      51             : 
      52             : public :: rad_cnst_num_name
      53             : 
      54             : integer, parameter :: cs1 = 256
      55             : integer, public, parameter :: N_DIAG = 10
      56             : character(len=cs1), public :: iceopticsfile, liqopticsfile
      57             : character(len=32),  public :: icecldoptics,liqcldoptics
      58             : logical,            public :: oldcldoptics = .false.
      59             : 
      60             : ! Private module data
      61             : 
      62             : ! max number of strings in mode definitions
      63             : integer, parameter :: n_mode_str = 120
      64             : 
      65             : ! max number of externally mixed entities in the climate/diag lists
      66             : integer, parameter :: n_rad_cnst = N_RAD_CNST
      67             : 
      68             : ! Namelist variables
      69             : character(len=cs1), dimension(n_mode_str) :: mode_defs   = ' '
      70             : character(len=cs1) :: rad_climate(n_rad_cnst) = ' '
      71             : character(len=cs1) :: rad_diag_1(n_rad_cnst) = ' '
      72             : character(len=cs1) :: rad_diag_2(n_rad_cnst) = ' '
      73             : character(len=cs1) :: rad_diag_3(n_rad_cnst) = ' '
      74             : character(len=cs1) :: rad_diag_4(n_rad_cnst) = ' '
      75             : character(len=cs1) :: rad_diag_5(n_rad_cnst) = ' '
      76             : character(len=cs1) :: rad_diag_6(n_rad_cnst) = ' '
      77             : character(len=cs1) :: rad_diag_7(n_rad_cnst) = ' '
      78             : character(len=cs1) :: rad_diag_8(n_rad_cnst) = ' '
      79             : character(len=cs1) :: rad_diag_9(n_rad_cnst) = ' '
      80             : character(len=cs1) :: rad_diag_10(n_rad_cnst) = ' '
      81             : 
      82             : ! type to provide access to the components of a mode
      83             : type :: mode_component_t
      84             :    integer :: nspec
      85             :    ! For "source" variables below, value is:
      86             :    ! 'N' if in pbuf (non-advected)
      87             :    ! 'A' if in state (advected)
      88             :    character(len=  1) :: source_num_a  ! source of interstitial number conc field
      89             :    character(len= 32) :: camname_num_a ! name registered in pbuf or constituents for number mixing ratio of interstitial species
      90             :    character(len=  1) :: source_num_c  ! source of cloud borne number conc field
      91             :    character(len= 32) :: camname_num_c ! name registered in pbuf or constituents for number mixing ratio of cloud borne species
      92             :    character(len=  1), pointer :: source_mmr_a(:)  ! source of interstitial specie mmr fields
      93             :    character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr of interstitial components
      94             :    character(len=  1), pointer :: source_mmr_c(:)  ! source of cloud borne specie mmr fields
      95             :    character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components
      96             :    character(len= 32), pointer :: type(:)          ! specie type (as used in MAM code)
      97             :    character(len=cs1), pointer :: props(:)         ! file containing specie properties
      98             :    integer          :: idx_num_a    ! index in pbuf or constituents for number mixing ratio of interstitial species
      99             :    integer          :: idx_num_c    ! index in pbuf for number mixing ratio of interstitial species
     100             :    integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species
     101             :    integer, pointer :: idx_mmr_c(:) ! index in pbuf for mmr of interstitial species
     102             :    integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module
     103             : end type mode_component_t
     104             : 
     105             : ! type to provide access to all modes
     106             : type :: modes_t
     107             :    integer :: nmodes
     108             :    character(len= 32),     pointer :: names(:) ! names used to identify a mode in the climate/diag lists
     109             :    character(len= 32),     pointer :: types(:) ! type of mode (as used in MAM code)
     110             :    type(mode_component_t), pointer :: comps(:) ! components which define the mode
     111             : end type modes_t
     112             : 
     113             : type(modes_t), target :: modes  ! mode definitions
     114             : 
     115             : ! type to provide access to the data parsed from the rad_climate and rad_diag_* strings
     116             : type :: rad_cnst_namelist_t
     117             :    integer :: ncnst
     118             :    character(len=  1), pointer :: source(:)  ! 'A' for state (advected), 'N' for pbuf (non-advected),
     119             :                                              ! 'M' for mode, 'Z' for zero
     120             :    character(len= 64), pointer :: camname(:) ! name registered in pbuf or constituents
     121             :    character(len=cs1), pointer :: radname(:) ! radname is the name as identfied in radiation,
     122             :                                              ! must be one of (rgaslist if a gas) or
     123             :                                              ! (/fullpath/filename.nc if an aerosol)
     124             :    character(len=  1), pointer :: type(:)    ! 'A' if aerosol, 'G' if gas, 'M' if mode
     125             : end type rad_cnst_namelist_t
     126             : 
     127             : type(rad_cnst_namelist_t) :: namelist(0:N_DIAG) ! gas, bulk aerosol, and modal components used in
     128             :                                                 ! climate/diagnostic calculations
     129             : 
     130             : logical :: active_calls(0:N_DIAG)     ! active_calls(i) is true if the i-th call to radiation is
     131             :                                       ! specified.  Note that the 0th call is for the climate
     132             :                                       ! calculation which is always made.
     133             : 
     134             : ! Storage for gas components in the climate/diagnostic lists
     135             : 
     136             : type :: gas_t
     137             :    character(len=1)  :: source       ! A for state (advected), N for pbuf (non-advected), Z for zero
     138             :    character(len=64) :: camname      ! name of constituent in physics state or buffer
     139             :    character(len=32) :: mass_name    ! name for mass per layer field in history output
     140             :    integer           :: idx          ! index from constituents or from pbuf
     141             : end type gas_t
     142             : 
     143             : type :: gaslist_t
     144             :    integer                :: ngas
     145             :    character(len=2)       :: list_id  ! set to "  " for climate list, or two character integer
     146             :                                       ! (include leading zero) to identify diagnostic list
     147             :    type(gas_t), pointer   :: gas(:)   ! dimension(ngas) where ngas = nradgas is from radconstants
     148             : end type gaslist_t
     149             : 
     150             : type(gaslist_t), target :: gaslist(0:N_DIAG)  ! gasses used in climate/diagnostic calculations
     151             : 
     152             : ! Storage for bulk aerosol components in the climate/diagnostic lists
     153             : 
     154             : type :: aerosol_t
     155             :    character(len=1)   :: source         ! A for state (advected), N for pbuf (non-advected), Z for zero
     156             :    character(len=64)  :: camname        ! name of constituent in physics state or buffer
     157             :    character(len=cs1) :: physprop_file  ! physprop filename
     158             :    character(len=32)  :: mass_name      ! name for mass per layer field in history output
     159             :    integer            :: idx            ! index of constituent in physics state or buffer
     160             :    integer            :: physprop_id    ! ID used to access physical properties from phys_prop module
     161             : end type aerosol_t
     162             : 
     163             : type :: aerlist_t
     164             :    integer                  :: numaerosols  ! number of aerosols
     165             :    character(len=2)         :: list_id      ! set to "  " for climate list, or two character integer
     166             :                                             ! (include leading zero) to identify diagnostic list
     167             :    type(aerosol_t), pointer :: aer(:)       ! dimension(numaerosols)
     168             : end type aerlist_t
     169             : 
     170             : type(aerlist_t), target :: aerosollist(0:N_DIAG) ! list of aerosols used in climate/diagnostic calcs
     171             : 
     172             : ! storage for modal aerosol components in the climate/diagnostic lists
     173             : 
     174             : type :: modelist_t
     175             :    integer          :: nmodes              ! number of modes
     176             :    character(len=2) :: list_id             ! set to "  " for climate list, or two character integer
     177             :                                            ! (include leading zero) to identify diagnostic list
     178             :    integer,   pointer :: idx(:)            ! index of the mode in the mode definition object
     179             :    character(len=cs1), pointer :: physprop_files(:) ! physprop filename
     180             :    integer,   pointer :: idx_props(:)      ! index of the mode properties in the physprop object
     181             : end type modelist_t
     182             : 
     183             : type(modelist_t), target :: ma_list(0:N_DIAG) ! list of aerosol modes used in climate/diagnostic calcs
     184             : 
     185             : 
     186             : ! values for constituents with requested value of zero
     187             : real(r8), allocatable, target :: zero_cols(:,:)
     188             : 
     189             : ! define generic interface routines
     190             : interface rad_cnst_get_info
     191             :    module procedure rad_cnst_get_info
     192             :    module procedure rad_cnst_get_info_by_mode
     193             :    module procedure rad_cnst_get_info_by_mode_spec
     194             :    module procedure rad_cnst_get_info_by_spectype
     195             : end interface
     196             : 
     197             : interface rad_cnst_get_aer_mmr
     198             :    module procedure rad_cnst_get_aer_mmr_by_idx
     199             :    module procedure rad_cnst_get_mam_mmr_by_idx
     200             : end interface
     201             : 
     202             : interface rad_cnst_get_aer_props
     203             :    module procedure rad_cnst_get_aer_props_by_idx
     204             :    module procedure rad_cnst_get_mam_props_by_idx
     205             : end interface
     206             : 
     207             : logical :: verbose = .true.
     208             : character(len=1), parameter :: nl = achar(10)
     209             : 
     210             : integer, parameter :: num_mode_types = 9
     211             : integer, parameter :: num_spec_types = 8
     212             : character(len=14), parameter :: mode_type_names(num_mode_types) = (/ &
     213             :    'accum         ', 'aitken        ', 'primary_carbon', 'fine_seasalt  ', &
     214             :    'fine_dust     ', 'coarse        ', 'coarse_seasalt', 'coarse_dust   ', &
     215             :    'coarse_strat  '  /)
     216             : character(len=9), parameter :: spec_type_names(num_spec_types) = (/ &
     217             :    'sulfate  ', 'ammonium ', 'nitrate  ', 'p-organic', &
     218             :    's-organic', 'black-c  ', 'seasalt  ', 'dust     '/)
     219             : 
     220             : 
     221             : !==============================================================================
     222             : contains
     223             : !==============================================================================
     224             : 
     225        1536 : subroutine rad_cnst_readnl(nlfile)
     226             : 
     227             :    ! Read rad_cnst_nl namelist group.  Parse input.
     228             : 
     229             :    use namelist_utils,  only: find_group_name
     230             :    use units,           only: getunit, freeunit
     231             :    use mpishorthand
     232             : 
     233             :    character(len=*), intent(in) :: nlfile  ! filepath for file containing namelist input
     234             : 
     235             :    ! Local variables
     236             :    integer :: unitn, ierr, i
     237             :    character(len=2) :: suffix
     238        1536 :    character(len=1), pointer   :: ctype(:)
     239             :    character(len=*), parameter :: subname = 'rad_cnst_readnl'
     240             : 
     241             :    namelist /rad_cnst_nl/ mode_defs,     &
     242             :                           rad_climate,   &
     243             :                           rad_diag_1,    &
     244             :                           rad_diag_2,    &
     245             :                           rad_diag_3,    &
     246             :                           rad_diag_4,    &
     247             :                           rad_diag_5,    &
     248             :                           rad_diag_6,    &
     249             :                           rad_diag_7,    &
     250             :                           rad_diag_8,    &
     251             :                           rad_diag_9,    &
     252             :                           rad_diag_10,   &
     253             :                           iceopticsfile, &
     254             :                           liqopticsfile, &
     255             :                           icecldoptics,  &
     256             :                           liqcldoptics,  &
     257             :                           oldcldoptics
     258             : 
     259             :    !-----------------------------------------------------------------------------
     260             : 
     261           0 :    if (use_simple_phys) return
     262             : 
     263        1536 :    if (masterproc) then
     264           2 :       unitn = getunit()
     265           2 :       open( unitn, file=trim(nlfile), status='old' )
     266           2 :       call find_group_name(unitn, 'rad_cnst_nl', status=ierr)
     267           2 :       if (ierr == 0) then
     268           2 :          read(unitn, rad_cnst_nl, iostat=ierr)
     269           2 :          if (ierr /= 0) then
     270           0 :             call endrun(subname // ':: ERROR reading namelist')
     271             :          end if
     272             :       end if
     273           2 :       close(unitn)
     274           2 :       call freeunit(unitn)
     275             :    end if
     276             : 
     277             : #ifdef SPMD
     278             :    ! Broadcast namelist variables
     279        1536 :    call mpibcast (mode_defs,     len(mode_defs(1))*n_mode_str,     mpichar, 0, mpicom)
     280        1536 :    call mpibcast (rad_climate,   len(rad_climate(1))*n_rad_cnst,   mpichar, 0, mpicom)
     281        1536 :    call mpibcast (rad_diag_1,    len(rad_diag_1(1))*n_rad_cnst,    mpichar, 0, mpicom)
     282        1536 :    call mpibcast (rad_diag_2,    len(rad_diag_2(1))*n_rad_cnst,    mpichar, 0, mpicom)
     283        1536 :    call mpibcast (rad_diag_3,    len(rad_diag_3(1))*n_rad_cnst,    mpichar, 0, mpicom)
     284        1536 :    call mpibcast (rad_diag_4,    len(rad_diag_4(1))*n_rad_cnst,    mpichar, 0, mpicom)
     285        1536 :    call mpibcast (rad_diag_5,    len(rad_diag_5(1))*n_rad_cnst,    mpichar, 0, mpicom)
     286        1536 :    call mpibcast (rad_diag_6,    len(rad_diag_6(1))*n_rad_cnst,    mpichar, 0, mpicom)
     287        1536 :    call mpibcast (rad_diag_7,    len(rad_diag_7(1))*n_rad_cnst,    mpichar, 0, mpicom)
     288        1536 :    call mpibcast (rad_diag_8,    len(rad_diag_8(1))*n_rad_cnst,    mpichar, 0, mpicom)
     289        1536 :    call mpibcast (rad_diag_9,    len(rad_diag_9(1))*n_rad_cnst,    mpichar, 0, mpicom)
     290        1536 :    call mpibcast (rad_diag_10,   len(rad_diag_10(1))*n_rad_cnst,   mpichar, 0, mpicom)
     291        1536 :    call mpibcast (iceopticsfile, len(iceopticsfile),               mpichar, 0, mpicom)
     292        1536 :    call mpibcast (liqopticsfile, len(liqopticsfile),               mpichar, 0, mpicom)
     293        1536 :    call mpibcast (liqcldoptics,  len(liqcldoptics),                mpichar, 0, mpicom)
     294        1536 :    call mpibcast (icecldoptics,  len(icecldoptics),                mpichar, 0, mpicom)
     295        1536 :    call mpibcast (oldcldoptics,  1,                                mpilog , 0, mpicom)
     296             : #endif
     297             : 
     298             :    ! Parse the namelist input strings
     299             : 
     300             :    ! Mode definition stings
     301        1536 :    call parse_mode_defs(mode_defs, modes)
     302             : 
     303             :    ! Lists of externally mixed entities for climate and diagnostic calculations
     304       18432 :    do i = 0,N_DIAG
     305        1536 :       select case (i)
     306             :       case(0)
     307        1536 :          call parse_rad_specifier(rad_climate, namelist(i))
     308             :       case (1)
     309        1536 :          call parse_rad_specifier(rad_diag_1, namelist(i))
     310             :       case (2)
     311        1536 :          call parse_rad_specifier(rad_diag_2, namelist(i))
     312             :       case (3)
     313        1536 :          call parse_rad_specifier(rad_diag_3, namelist(i))
     314             :       case (4)
     315        1536 :          call parse_rad_specifier(rad_diag_4, namelist(i))
     316             :       case (5)
     317        1536 :          call parse_rad_specifier(rad_diag_5, namelist(i))
     318             :       case (6)
     319        1536 :          call parse_rad_specifier(rad_diag_6, namelist(i))
     320             :       case (7)
     321        1536 :          call parse_rad_specifier(rad_diag_7, namelist(i))
     322             :       case (8)
     323        1536 :          call parse_rad_specifier(rad_diag_8, namelist(i))
     324             :       case (9)
     325        1536 :          call parse_rad_specifier(rad_diag_9, namelist(i))
     326             :       case (10)
     327       16896 :          call parse_rad_specifier(rad_diag_10, namelist(i))
     328             :       end select
     329             :    enddo
     330             : 
     331             :    ! were there any constituents specified for the nth diagnostic call?
     332             :    ! if so, radiation will make a call with those consituents
     333       18432 :    active_calls(:) = (namelist(:)%ncnst > 0)
     334             : 
     335             :    ! Initialize the gas and aerosol lists with the information from the
     336             :    ! namelist.  This is done here so that this information is available via
     337             :    ! the query functions at the time when the register methods are called.
     338             : 
     339             :    ! Set the list_id fields which distinquish the climate and diagnostic lists
     340       18432 :    do i = 0, N_DIAG
     341       18432 :       if (active_calls(i)) then
     342        1536 :          if (i > 0) then
     343           0 :             write(suffix, fmt = '(i2.2)') i
     344             :          else
     345        1536 :             suffix='  '
     346             :          end if
     347        1536 :          aerosollist(i)%list_id = suffix
     348        1536 :          gaslist(i)%list_id     = suffix
     349        1536 :          ma_list(i)%list_id     = suffix
     350             :       end if
     351             :    end do
     352             : 
     353             :    ! Create a list of the unique set of filenames containing property data
     354             : 
     355             :    ! Start with the bulk aerosol species in the climate/diagnostic lists.
     356             :    ! The physprop_accum_unique_files routine has the side effect of returning the number
     357             :    ! of bulk aerosols in each list (they're identified by type='A').
     358       18432 :    do i = 0, N_DIAG
     359       18432 :       if (active_calls(i)) then
     360             :          call physprop_accum_unique_files(namelist(i)%radname, namelist(i)%type)
     361             :       endif
     362             :    enddo
     363             : 
     364             :    ! Add physprop files for the species from the mode definitions.
     365        1536 :    do i = 1, modes%nmodes
     366           0 :       allocate(ctype(modes%comps(i)%nspec))
     367           0 :       ctype = 'A'
     368           0 :       call physprop_accum_unique_files(modes%comps(i)%props, ctype)
     369        1536 :       deallocate(ctype)
     370             :    end do
     371             : 
     372             :    ! Initialize the gas, bulk aerosol, and modal aerosol lists.  This step splits the
     373             :    ! input climate/diagnostic lists into the corresponding gas, bulk and modal aerosol
     374             :    ! lists.
     375        1536 :    if (masterproc) write(iulog,*) nl//subname//': Radiation constituent lists:'
     376       18432 :    do i = 0, N_DIAG
     377       18432 :       if (active_calls(i)) then
     378             :          call list_init1(namelist(i), gaslist(i), aerosollist(i), ma_list(i))
     379             : 
     380        1538 :          if (masterproc .and. verbose) then
     381           2 :             call print_lists(gaslist(i), aerosollist(i), ma_list(i))
     382             :          end if
     383             : 
     384             :       end if
     385             :    end do
     386             : 
     387        1536 :    if (masterproc .and. verbose) call print_modes(modes)
     388             : 
     389        1536 : end subroutine rad_cnst_readnl
     390             : 
     391             : !================================================================================================
     392             : 
     393        1536 : subroutine rad_cnst_init()
     394             : 
     395             :    ! The initialization of the gas and aerosol lists is finished by
     396             :    ! 1) read the physprop files
     397             :    ! 2) find the index of each constituent in the constituent or physics buffer arrays
     398             :    ! 3) find the index of the aerosol constituents used to access its properties from the
     399             :    !    physprop module.
     400             : 
     401             :    integer :: i
     402             :    logical, parameter :: stricttest = .true.
     403             :    character(len=*), parameter :: subname = 'rad_cnst_init'
     404             :    !-----------------------------------------------------------------------------
     405             : 
     406             :    ! memory to point to if zero value requested
     407        1536 :    allocate(zero_cols(pcols,pver))
     408      680448 :    zero_cols = 0._r8
     409             : 
     410             :    ! Allocate storage for the physical properties of each aerosol; read properties from
     411             :    ! the data files.
     412        1536 :    call physprop_init()
     413             : 
     414             :    ! Start checking that specified radiative constituents are present in the constituent
     415             :    ! or physics buffer arrays.
     416        1536 :    if (masterproc) write(iulog,*) nl//subname//': checking for radiative constituents'
     417             : 
     418             :    ! Finish initializing the mode definitions.
     419        1536 :    call init_mode_comps(modes)
     420             : 
     421             :    ! Finish initializing the gas, bulk aerosol, and mode lists.
     422       18432 :    do i = 0, N_DIAG
     423       18432 :       if (active_calls(i)) then
     424             :          call list_init2(gaslist(i), aerosollist(i), ma_list(i))
     425             :       end if
     426             :    end do
     427             : 
     428             :    ! Check that all gases supported by the radiative transfer code have been specified.
     429             :    if (stricttest) then
     430       13824 :       do i = 1, nradgas
     431       13824 :          if (gaslist(0)%gas(i)%source .eq. 'Z' ) then
     432           0 :             call endrun(subname//': list of radiative gasses must include all radiation gasses for the climate specication')
     433             :          endif
     434             :       enddo
     435             :    endif
     436             : 
     437             :    ! Initialize history output of climate diagnostic quantities
     438        1536 :    call rad_gas_diag_init(gaslist(0))
     439        1536 :    call rad_aer_diag_init(aerosollist(0))
     440             : 
     441             : 
     442        1536 : end subroutine rad_cnst_init
     443             : 
     444             : !================================================================================================
     445             : 
     446     7489224 : subroutine rad_cnst_get_gas(list_idx, gasname, state, pbuf, mmr)
     447             : 
     448             :    ! Return pointer to mass mixing ratio for the gas from the specified
     449             :    ! climate or diagnostic list.
     450             : 
     451             :    ! Arguments
     452             :    integer,                     intent(in) :: list_idx    ! index of the climate or a diagnostic list
     453             :    character(len=*),            intent(in) :: gasname
     454             :    type(physics_state), target, intent(in) :: state
     455             :    type(physics_buffer_desc),   pointer    :: pbuf(:)
     456             :    real(r8),                    pointer    :: mmr(:,:)
     457             : 
     458             :    ! Local variables
     459             :    integer :: lchnk
     460             :    integer :: igas
     461             :    integer :: idx
     462             :    character(len=1) :: source
     463             :    type(gaslist_t), pointer :: list
     464             :    character(len=*), parameter :: subname = 'rad_cnst_get_gas'
     465             :    !-----------------------------------------------------------------------------
     466             : 
     467     7489224 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
     468     7489224 :       list => gaslist(list_idx)
     469             :    else
     470           0 :       write(iulog,*) subname//': list_idx =', list_idx
     471           0 :       call endrun(subname//': list_idx out of bounds')
     472             :    endif
     473             : 
     474     7489224 :    lchnk = state%lchnk
     475             : 
     476             :    ! Get index of gas in internal arrays.  rad_gas_index will abort if the
     477             :    ! specified gasname is not recognized by the radiative transfer code.
     478     7489224 :    igas = rad_gas_index(trim(gasname))
     479             : 
     480             :    ! Get data source
     481     7489224 :    source = list%gas(igas)%source
     482     7489224 :    idx    = list%gas(igas)%idx
     483      749232 :    select case( source )
     484             :    case ('A')
     485      749232 :       mmr => state%q(:,:,idx)
     486             :    case ('N')
     487     6739992 :       call pbuf_get_field(pbuf, idx, mmr)
     488             :    case ('Z')
     489     7489224 :       mmr => zero_cols
     490             :    end select
     491             : 
     492     7489224 : end subroutine rad_cnst_get_gas
     493             : 
     494             : !================================================================================================
     495             : 
     496           0 : function rad_cnst_num_name(list_idx, spc_name_in, num_name_out, mode_out, spec_out ) result(found)
     497             : 
     498             :   ! for a given species name spc_name_in return (optionals):
     499             :   !   num_name_out -- corresponding number density species name
     500             :   !   mode_out -- corresponding mode number
     501             :   !   spec_out -- corresponding species number within the mode
     502             : 
     503             :   integer,         intent(in) :: list_idx ! index of the climate or a diagnostic list
     504             :   character(len=*),intent(in) :: spc_name_in
     505             :   character(len=*),intent(out):: num_name_out
     506             :   integer,optional,intent(out):: mode_out
     507             :   integer,optional,intent(out):: spec_out
     508             : 
     509             :   logical :: found
     510             : 
     511             :   ! Local variables
     512             :   type(modelist_t), pointer :: m_list ! local pointer to mode list of interest
     513             :   integer :: n,m, mm
     514             :   integer :: nmodes
     515             :   integer :: nspecs
     516             :   character(len= 32) :: spec_name
     517             : 
     518           0 :   found = .false.
     519             : 
     520           0 :   m_list => ma_list(list_idx)
     521           0 :   nmodes = m_list%nmodes
     522             : 
     523           0 :   do n = 1,nmodes
     524           0 :      mm = m_list%idx(n)
     525           0 :      nspecs = modes%comps(mm)%nspec
     526           0 :      do m = 1,nspecs
     527           0 :         spec_name = modes%comps(mm)%camname_mmr_a(m)
     528           0 :         if (spc_name_in == spec_name) then
     529           0 :            num_name_out = modes%comps(mm)%camname_num_a
     530           0 :            found = .true.
     531           0 :            if (present(mode_out)) then
     532           0 :               mode_out = n
     533             :            endif
     534           0 :            if (present(spec_out)) then
     535           0 :               spec_out = m
     536             :            endif
     537           0 :            return
     538             :         endif
     539             :      enddo
     540             :   enddo
     541             : 
     542             :   return
     543             : 
     544           0 : end function
     545             : 
     546             : !================================================================================================
     547             : 
     548      821952 : subroutine rad_cnst_get_info(list_idx, gasnames, aernames, &
     549             :                              use_data_o3, ngas, naero, nmodes)
     550             : 
     551             :    ! Return info about gas and aerosol lists
     552             : 
     553             :    ! Arguments
     554             :    integer,                     intent(in)  :: list_idx    ! index of the climate or a diagnostic list
     555             :    character(len=64), optional, intent(out) :: gasnames(:)
     556             :    character(len=64), optional, intent(out) :: aernames(:)
     557             :    logical,           optional, intent(out) :: use_data_o3
     558             :    integer,           optional, intent(out) :: naero
     559             :    integer,           optional, intent(out) :: ngas
     560             :    integer,           optional, intent(out) :: nmodes
     561             : 
     562             :    ! Local variables
     563             :    type(gaslist_t),  pointer :: g_list ! local pointer to gas list of interest
     564             :    type(aerlist_t),  pointer :: a_list ! local pointer to aerosol list of interest
     565             :    type(modelist_t), pointer :: m_list ! local pointer to mode list of interest
     566             : 
     567             :    integer          :: i
     568             :    integer          :: arrlen  ! length of assumed shape array
     569             :    integer          :: gaslen  ! length of assumed shape array
     570             :    integer          :: igas    ! index of a gas in the gas list
     571             :    character(len=1) :: source  ! A for state, N for pbuf, Z for zero
     572             : 
     573             :    character(len=*), parameter :: subname = 'rad_cnst_get_info'
     574             :    !-----------------------------------------------------------------------------
     575             : 
     576      821952 :    g_list => gaslist(list_idx)
     577      821952 :    a_list => aerosollist(list_idx)
     578      821952 :    m_list => ma_list(list_idx)
     579             : 
     580             :    ! number of bulk aerosols in list
     581      821952 :    if (present(naero)) then
     582      818880 :       naero = a_list%numaerosols
     583             :    endif
     584             : 
     585             :    ! number of aerosol modes in list
     586      821952 :    if (present(nmodes)) then
     587      820416 :       nmodes = m_list%nmodes
     588             :    endif
     589             : 
     590             :    ! number of gases in list
     591      821952 :    if (present(ngas)) then
     592           0 :       ngas = g_list%ngas
     593             :    endif
     594             : 
     595             :    ! names of aerosols in list
     596      821952 :    if (present(aernames)) then
     597             : 
     598             :       ! check that output array is long enough
     599        1536 :       arrlen = size(aernames)
     600        1536 :       if (arrlen < a_list%numaerosols) then
     601           0 :          write(iulog,*) subname//': ERROR: naero=', a_list%numaerosols, '  arrlen=', arrlen
     602           0 :          call endrun(subname//': ERROR: aernames too short')
     603             :       end if
     604             : 
     605        1536 :       do i = 1, a_list%numaerosols
     606        1536 :          aernames(i) = a_list%aer(i)%camname
     607             :       end do
     608             : 
     609             :    end if
     610             : 
     611             :    ! names of gas in list
     612      821952 :    if (present(gasnames)) then
     613             : 
     614             :       ! check that output array is long enough
     615           0 :       gaslen = size(gasnames)
     616           0 :       if (gaslen < g_list%ngas) then
     617           0 :          write(iulog,*) subname//': ERROR: ngas=', g_list%ngas, '  gaslen=', gaslen
     618           0 :          call endrun(subname//': ERROR: gasnames too short')
     619             :       end if
     620             : 
     621           0 :       do i = 1, g_list%ngas
     622           0 :          gasnames(i) = g_list%gas(i)%camname
     623             :       end do
     624             : 
     625             :    end if
     626             : 
     627             :    ! Does the climate calculation use data ozone?
     628      821952 :    if (present(use_data_o3)) then
     629             : 
     630             :       ! get index of O3 in gas list
     631           0 :       igas = rad_gas_index('O3')
     632             : 
     633             :       ! Get data source
     634           0 :       source = g_list%gas(igas)%source
     635             : 
     636           0 :       use_data_o3 = .false.
     637           0 :       if (source == 'N') use_data_o3 = .true.
     638             :    endif
     639             : 
     640      821952 : end subroutine rad_cnst_get_info
     641             : 
     642             : !================================================================================================
     643             : 
     644           0 : subroutine rad_cnst_get_info_by_mode(list_idx, m_idx, &
     645           0 :    mode_type, num_name, num_name_cw, nspec)
     646             : 
     647             :    ! Return info about modal aerosol lists
     648             : 
     649             :    ! Arguments
     650             :    integer,                     intent(in)  :: list_idx    ! index of the climate or a diagnostic list
     651             :    integer,                     intent(in)  :: m_idx       ! index of mode in the specified list
     652             :    character(len=32), optional, intent(out) :: mode_type   ! type of mode (as used in MAM code)
     653             :    character(len=32), optional, intent(out) :: num_name    ! name of interstitial number mixing ratio
     654             :    character(len=32), optional, intent(out) :: num_name_cw ! name of cloud borne number mixing ratio
     655             :    integer,           optional, intent(out) :: nspec       ! number of species in the mode
     656             : 
     657             :    ! Local variables
     658             :    type(modelist_t), pointer :: m_list ! local pointer to mode list of interest
     659             : 
     660             :    integer          :: nmodes
     661             :    integer          :: mm
     662             : 
     663             :    character(len=*), parameter :: subname = 'rad_cnst_get_info_by_mode'
     664             :    !-----------------------------------------------------------------------------
     665             : 
     666           0 :    m_list => ma_list(list_idx)
     667             : 
     668             :    ! check for valid mode index
     669           0 :    nmodes = m_list%nmodes
     670           0 :    if (m_idx < 1 .or. m_idx > nmodes) then
     671           0 :       write(iulog,*) subname//': ERROR - invalid mode index: ', m_idx
     672           0 :       call endrun(subname//': ERROR - invalid mode index')
     673             :    end if
     674             : 
     675             :    ! get index into the mode definition object
     676           0 :    mm = m_list%idx(m_idx)
     677             : 
     678             :    ! mode type
     679           0 :    if (present(mode_type)) then
     680           0 :       mode_type = modes%types(mm)
     681             :    endif
     682             : 
     683             :    ! number of species in the mode
     684           0 :    if (present(nspec)) then
     685           0 :       nspec = modes%comps(mm)%nspec
     686             :    endif
     687             : 
     688             :    ! name of interstitial number mixing ratio
     689           0 :    if (present(num_name)) then
     690           0 :       num_name = modes%comps(mm)%camname_num_a
     691             :    endif
     692             : 
     693             :    ! name of cloud borne number mixing ratio
     694           0 :    if (present(num_name_cw)) then
     695           0 :       num_name_cw = modes%comps(mm)%camname_num_c
     696             :    endif
     697             : 
     698      821952 : end subroutine rad_cnst_get_info_by_mode
     699             : 
     700             : !================================================================================================
     701             : 
     702           0 : subroutine rad_cnst_get_info_by_mode_spec(list_idx, m_idx, s_idx, &
     703           0 :    spec_type, spec_name, spec_name_cw)
     704             : 
     705             :    ! Return info about modal aerosol lists
     706             : 
     707             :    ! Arguments
     708             :    integer,                     intent(in)  :: list_idx    ! index of the climate or a diagnostic list
     709             :    integer,                     intent(in)  :: m_idx       ! index of mode in the specified list
     710             :    integer,                     intent(in)  :: s_idx       ! index of specie in the specified mode
     711             :    character(len=32), optional, intent(out) :: spec_type   ! type of specie
     712             :    character(len=32), optional, intent(out) :: spec_name   ! name of interstitial specie
     713             :    character(len=32), optional, intent(out) :: spec_name_cw ! name of cloud borne specie
     714             : 
     715             :    ! Local variables
     716             :    type(modelist_t), pointer :: m_list ! local pointer to mode list of interest
     717             : 
     718             :    integer          :: nmodes
     719             :    integer          :: nspec
     720             :    integer          :: mm
     721             : 
     722             :    character(len=*), parameter :: subname = 'rad_cnst_get_info_by_mode_spec'
     723             :    !-----------------------------------------------------------------------------
     724             : 
     725           0 :    m_list => ma_list(list_idx)
     726             : 
     727             :    ! check for valid mode index
     728           0 :    nmodes = m_list%nmodes
     729           0 :    if (m_idx < 1 .or. m_idx > nmodes) then
     730           0 :       write(iulog,*) subname//': ERROR - invalid mode index: ', m_idx
     731           0 :       call endrun(subname//': ERROR - invalid mode index')
     732             :    end if
     733             : 
     734             :    ! get index into the mode definition object
     735           0 :    mm = m_list%idx(m_idx)
     736             : 
     737             :    ! check for valid specie index
     738           0 :    nspec = modes%comps(mm)%nspec
     739           0 :    if (s_idx < 1 .or. s_idx > nspec) then
     740           0 :       write(iulog,*) subname//': ERROR - invalid specie index: ', s_idx
     741           0 :       call endrun(subname//': ERROR - invalid specie index')
     742             :    end if
     743             : 
     744             :    ! specie type
     745           0 :    if (present(spec_type)) then
     746           0 :       spec_type = modes%comps(mm)%type(s_idx)
     747             :    endif
     748             : 
     749             :    ! interstitial specie name
     750           0 :    if (present(spec_name)) then
     751           0 :       spec_name = modes%comps(mm)%camname_mmr_a(s_idx)
     752             :    endif
     753             : 
     754             :    ! cloud borne specie name
     755           0 :    if (present(spec_name_cw)) then
     756           0 :       spec_name_cw = modes%comps(mm)%camname_mmr_c(s_idx)
     757             :    endif
     758             : 
     759           0 : end subroutine rad_cnst_get_info_by_mode_spec
     760             : 
     761             : !================================================================================================
     762             : 
     763           0 : subroutine rad_cnst_get_info_by_spectype(list_idx, spectype, mode_idx, spec_idx)
     764             : 
     765             :    ! Return info about modes in the specified climate/diagnostics list
     766             : 
     767             :    ! Arguments
     768             :    integer,                     intent(in)  :: list_idx    ! index of the climate or a diagnostic list
     769             :    character(len=*),            intent(in)  :: spectype    ! species type
     770             :    integer,           optional, intent(out) :: mode_idx    ! index of a mode that contains a specie of spectype
     771             :    integer,           optional, intent(out) :: spec_idx    ! index of the species of spectype
     772             : 
     773             :    ! Local variables
     774             :    type(modelist_t), pointer :: m_list ! local pointer to mode list of interest
     775             : 
     776             :    integer  :: i, nmodes, m_idx, nspec, ispec
     777             :    logical  :: found_spectype
     778             : 
     779             :    character(len=*), parameter :: subname = 'rad_cnst_get_info_by_spectype'
     780             :    !-----------------------------------------------------------------------------
     781             : 
     782           0 :    m_list => ma_list(list_idx)
     783             : 
     784             :    ! number of modes in specified list
     785           0 :    nmodes = m_list%nmodes
     786             : 
     787             :    ! loop through modes in specified climate/diagnostic list
     788           0 :    found_spectype = .false.
     789           0 :    do i = 1, nmodes
     790             : 
     791             :       ! get index of the mode in the definition object
     792           0 :       m_idx = m_list%idx(i)
     793             : 
     794             :       ! number of species in the mode
     795           0 :       nspec = modes%comps(m_idx)%nspec
     796             : 
     797             :       ! loop through species looking for spectype
     798           0 :       do ispec = 1, nspec
     799             : 
     800           0 :          if (trim(modes%comps(m_idx)%type(ispec)) == trim(spectype)) then
     801           0 :             if (present(mode_idx)) mode_idx = i
     802           0 :             if (present(spec_idx)) spec_idx = ispec
     803           0 :             found_spectype = .true.
     804           0 :             exit
     805             :          end if
     806             :       end do
     807             : 
     808           0 :       if (found_spectype) exit
     809             :    end do
     810             : 
     811           0 :    if (.not. found_spectype) then
     812           0 :       if (present(mode_idx)) mode_idx = -1
     813           0 :       if (present(spec_idx)) spec_idx = -1
     814             :    end if
     815             : 
     816           0 : end subroutine rad_cnst_get_info_by_spectype
     817             : 
     818             : !================================================================================================
     819             : 
     820           0 : function rad_cnst_get_mode_idx(list_idx, mode_type) result(mode_idx)
     821             : 
     822             :    ! Return mode index of the specified type in the specified climate/diagnostics list.
     823             :    ! Return -1 if not found.
     824             : 
     825             :    ! Arguments
     826             :    integer,           intent(in)  :: list_idx    ! index of the climate or a diagnostic list
     827             :    character(len=*),  intent(in)  :: mode_type   ! mode type
     828             : 
     829             :    ! Return value
     830             :    integer                        :: mode_idx    ! mode index
     831             : 
     832             :    ! Local variables
     833             :    type(modelist_t), pointer :: m_list
     834             : 
     835             :    integer  :: i, nmodes, m_idx
     836             : 
     837             :    character(len=*), parameter :: subname = 'rad_cnst_get_mode_idx'
     838             :    !-----------------------------------------------------------------------------
     839             : 
     840             :    ! if mode type not found return -1
     841           0 :    mode_idx = -1
     842             : 
     843             :    ! specified mode list
     844           0 :    m_list => ma_list(list_idx)
     845             : 
     846             :    ! number of modes in specified list
     847           0 :    nmodes = m_list%nmodes
     848             : 
     849             :    ! loop through modes in specified climate/diagnostic list
     850           0 :    do i = 1, nmodes
     851             : 
     852             :       ! get index of the mode in the definition object
     853           0 :       m_idx = m_list%idx(i)
     854             : 
     855             :       ! look in mode definition object (modes) for the mode types
     856           0 :       if (trim(modes%types(m_idx)) == trim(mode_type)) then
     857           0 :          mode_idx = i
     858           0 :          exit
     859             :       end if
     860             :    end do
     861             : 
     862           0 : end function rad_cnst_get_mode_idx
     863             : 
     864             : !================================================================================================
     865             : 
     866           0 : function rad_cnst_get_spec_idx(list_idx, mode_idx, spec_type) result(spec_idx)
     867             : 
     868             :    ! Return specie index of the specified type in the specified mode of the specified
     869             :    ! climate/diagnostics list.  Return -1 if not found.
     870             : 
     871             :    ! Arguments
     872             :    integer,           intent(in)  :: list_idx    ! index of the climate or a diagnostic list
     873             :    integer,           intent(in)  :: mode_idx    ! mode index
     874             :    character(len=*),  intent(in)  :: spec_type   ! specie type
     875             : 
     876             :    ! Return value
     877             :    integer                        :: spec_idx    ! specie index
     878             : 
     879             :    ! Local variables
     880             :    type(modelist_t),       pointer :: m_list
     881             :    type(mode_component_t), pointer :: mode_comps
     882             : 
     883             :    integer  :: i, m_idx, nspec
     884             : 
     885             :    character(len=*), parameter :: subname = 'rad_cnst_get_spec_idx'
     886             :    !-----------------------------------------------------------------------------
     887             : 
     888             :    ! if specie type not found return -1
     889           0 :    spec_idx = -1
     890             : 
     891             :    ! modes in specified list
     892           0 :    m_list => ma_list(list_idx)
     893             : 
     894             :    ! get index of the specified mode in the definition object
     895           0 :    m_idx = m_list%idx(mode_idx)
     896             : 
     897             :    ! object containing the components of the mode
     898           0 :    mode_comps => modes%comps(m_idx)
     899             : 
     900             :    ! number of species in specified mode
     901           0 :    nspec = mode_comps%nspec
     902             : 
     903             :    ! loop through species in specified mode
     904           0 :    do i = 1, nspec
     905             : 
     906             :       ! look in mode definition object (modes) for the mode types
     907           0 :       if (trim(mode_comps%type(i)) == trim(spec_type)) then
     908           0 :          spec_idx = i
     909           0 :          exit
     910             :       end if
     911             :    end do
     912             : 
     913           0 : end function rad_cnst_get_spec_idx
     914             : 
     915             : !================================================================================================
     916             : 
     917           0 : subroutine rad_cnst_get_call_list(call_list)
     918             : 
     919             :    ! Return info about which climate/diagnostic calculations are requested
     920             : 
     921             :    ! Arguments
     922             :    logical, intent(out) :: call_list(0:N_DIAG)
     923             :    !-----------------------------------------------------------------------------
     924             : 
     925           0 :    call_list(:) = active_calls(:)
     926             : 
     927           0 : end subroutine rad_cnst_get_call_list
     928             : 
     929             : !================================================================================================
     930             : 
     931      749232 : subroutine rad_cnst_out(list_idx, state, pbuf)
     932             : 
     933             :    ! Output the mass per layer, and total column burdens for gas and aerosol
     934             :    ! constituents in either the climate or diagnostic lists
     935             : 
     936             :    ! Arguments
     937             :    integer,                     intent(in) :: list_idx
     938             :    type(physics_state), target, intent(in) :: state
     939             :    type(physics_buffer_desc), pointer      :: pbuf(:)
     940             : 
     941             : 
     942             :    ! Local variables
     943             :    integer :: i, naer, ngas, lchnk, ncol
     944             :    integer :: idx
     945             :    character(len=1)  :: source
     946             :    character(len=32) :: name, cbname
     947             :    real(r8)          :: mass(pcols,pver)
     948             :    real(r8)          :: cb(pcols)
     949      749232 :    real(r8), pointer :: mmr(:,:)
     950             :    type(aerlist_t), pointer :: aerlist
     951             :    type(gaslist_t), pointer :: g_list
     952             :    character(len=*), parameter :: subname = 'rad_cnst_out'
     953             :    !-----------------------------------------------------------------------------
     954             : 
     955      749232 :    lchnk = state%lchnk
     956      749232 :    ncol  = state%ncol
     957             : 
     958             :    ! Associate pointer with requested aerosol list
     959      749232 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
     960      749232 :       aerlist => aerosollist(list_idx)
     961             :    else
     962           0 :       write(iulog,*) subname//': list_idx = ', list_idx
     963           0 :       call endrun(subname//': list_idx out of range')
     964             :    endif
     965             : 
     966      749232 :    naer = aerlist%numaerosols
     967      749232 :    do i = 1, naer
     968             : 
     969           0 :       source = aerlist%aer(i)%source
     970           0 :       idx    = aerlist%aer(i)%idx
     971           0 :       name   = aerlist%aer(i)%mass_name
     972             :       ! construct name for column burden field by replacing the 'm_' prefix by 'cb_'
     973           0 :       cbname = 'cb_' // name(3:len_trim(name))
     974             : 
     975           0 :       select case( source )
     976             :       case ('A')
     977           0 :          mmr => state%q(:,:,idx)
     978             :       case ('N')
     979           0 :          call pbuf_get_field(pbuf, idx, mmr)
     980             :       end select
     981             : 
     982           0 :       mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga
     983           0 :       call outfld(trim(name), mass, pcols, lchnk)
     984             : 
     985           0 :       cb(:ncol) = sum(mass(:ncol,:),2)
     986      749232 :       call outfld(trim(cbname), cb, pcols, lchnk)
     987             : 
     988             :    end do
     989             : 
     990             :    ! Associate pointer with requested gas list
     991      749232 :    g_list => gaslist(list_idx)
     992             : 
     993      749232 :    ngas = g_list%ngas
     994     6743088 :    do i = 1, ngas
     995             : 
     996     5993856 :       source = g_list%gas(i)%source
     997     5993856 :       idx    = g_list%gas(i)%idx
     998     5993856 :       name   = g_list%gas(i)%mass_name
     999     5993856 :       cbname = 'cb_' // name(3:len_trim(name))
    1000      749232 :       select case( source )
    1001             :       case ('A')
    1002      749232 :          mmr => state%q(:,:,idx)
    1003             :       case ('N')
    1004     5993856 :          call pbuf_get_field(pbuf, idx, mmr)
    1005             :       end select
    1006             : 
    1007  2608163712 :       mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga
    1008     5993856 :       call outfld(trim(name), mass, pcols, lchnk)
    1009             : 
    1010  2546413056 :       cb(:ncol) = sum(mass(:ncol,:),2)
    1011     6743088 :       call outfld(trim(cbname), cb, pcols, lchnk)
    1012             : 
    1013             :    end do
    1014             : 
    1015      749232 : end subroutine rad_cnst_out
    1016             : 
    1017             : !================================================================================================
    1018             : ! Private methods
    1019             : !================================================================================================
    1020             : 
    1021        1536 : subroutine init_mode_comps(modes)
    1022             : 
    1023             :    ! Initialize the mode definitions by looking up the relevent indices in the
    1024             :    ! constituent and pbuf arrays, and getting the physprop IDs
    1025             : 
    1026             :    ! Arguments
    1027             :    type(modes_t), intent(inout) :: modes
    1028             : 
    1029             :    ! Local variables
    1030             :    integer :: m, ispec, nspec
    1031             : 
    1032             :    character(len=*), parameter :: routine = 'init_modes'
    1033             :    !-----------------------------------------------------------------------------
    1034             : 
    1035        1536 :    do m = 1, modes%nmodes
    1036             : 
    1037             :       ! indices for number mixing ratio components
    1038           0 :       modes%comps(m)%idx_num_a = get_cam_idx(modes%comps(m)%source_num_a, modes%comps(m)%camname_num_a, routine)
    1039           0 :       modes%comps(m)%idx_num_c = get_cam_idx(modes%comps(m)%source_num_c, modes%comps(m)%camname_num_c, routine)
    1040             : 
    1041             :       ! allocate memory for species
    1042           0 :       nspec = modes%comps(m)%nspec
    1043             :       allocate( &
    1044             :          modes%comps(m)%idx_mmr_a(nspec), &
    1045           0 :          modes%comps(m)%idx_mmr_c(nspec), &
    1046           0 :          modes%comps(m)%idx_props(nspec)  )
    1047             : 
    1048        1536 :       do ispec = 1, nspec
    1049             : 
    1050             :          ! indices for species mixing ratio components
    1051           0 :          modes%comps(m)%idx_mmr_a(ispec) = get_cam_idx(modes%comps(m)%source_mmr_a(ispec), &
    1052           0 :                                                    modes%comps(m)%camname_mmr_a(ispec), routine)
    1053           0 :          modes%comps(m)%idx_mmr_c(ispec) = get_cam_idx(modes%comps(m)%source_mmr_c(ispec), &
    1054           0 :                                                    modes%comps(m)%camname_mmr_c(ispec), routine)
    1055             : 
    1056             :          ! get physprop ID
    1057           0 :          modes%comps(m)%idx_props(ispec) = physprop_get_id(modes%comps(m)%props(ispec))
    1058           0 :          if (modes%comps(m)%idx_props(ispec) == -1) then
    1059           0 :             call endrun(routine//' : ERROR idx not found for '//trim(modes%comps(m)%props(ispec)))
    1060             :          end if
    1061             : 
    1062             :       end do
    1063             : 
    1064             :    end do
    1065             : 
    1066        1536 : end subroutine init_mode_comps
    1067             : 
    1068             : !================================================================================================
    1069             : 
    1070       12288 : integer function get_cam_idx(source, name, routine)
    1071             : 
    1072             :    ! get index of name in internal CAM array; either the constituent array
    1073             :    ! or the physics buffer
    1074             : 
    1075             :    character(len=*), intent(in) :: source
    1076             :    character(len=*), intent(in) :: name
    1077             :    character(len=*), intent(in) :: routine  ! name of calling routine
    1078             : 
    1079             :    integer :: idx
    1080             :    integer :: errcode
    1081             :    !-----------------------------------------------------------------------------
    1082             : 
    1083       12288 :    if (source(1:1) == 'N') then
    1084             : 
    1085       10752 :       idx = pbuf_get_index(trim(name),errcode)
    1086       10752 :       if (errcode < 0) then
    1087           0 :          call endrun(routine//' ERROR: cannot find physics buffer field '//trim(name))
    1088             :       end if
    1089             : 
    1090        1536 :    else if (source(1:1) == 'A') then
    1091             : 
    1092        1536 :       call cnst_get_ind(trim(name), idx, abort=.false.)
    1093        1536 :       if (idx < 0) then
    1094           0 :          call endrun(routine//' ERROR: cannot find constituent field '//trim(name))
    1095             :       end if
    1096             : 
    1097           0 :    else if (source(1:1) == 'Z') then
    1098             : 
    1099           0 :       idx = -1
    1100             : 
    1101             :    else
    1102             : 
    1103           0 :       call endrun(routine//' ERROR: invalid source for specie '//trim(name))
    1104             : 
    1105             :    end if
    1106             : 
    1107       12288 :    get_cam_idx = idx
    1108             : 
    1109       12288 : end function get_cam_idx
    1110             : 
    1111             : !================================================================================================
    1112             : 
    1113        1536 : subroutine list_init1(namelist, gaslist, aerlist, ma_list)
    1114             : 
    1115             :    ! Initialize the gas and bulk and modal aerosol lists with the
    1116             :    ! entities specified in the climate or diagnostic lists.
    1117             : 
    1118             :    ! This first phase initialization just sets the information that
    1119             :    ! is available at the time the namelist is read.
    1120             : 
    1121             :    type(rad_cnst_namelist_t), intent(in) :: namelist ! parsed namelist input for climate or diagnostic lists
    1122             : 
    1123             :    type(gaslist_t),        intent(inout) :: gaslist
    1124             :    type(aerlist_t),        intent(inout) :: aerlist
    1125             :    type(modelist_t),       intent(inout) :: ma_list
    1126             : 
    1127             : 
    1128             :    ! Local variables
    1129             :    integer :: ii, m, naero, nmodes
    1130             :    integer :: igas, ba_idx, ma_idx
    1131             :    integer :: istat
    1132             :    character(len=*), parameter :: routine = 'list_init1'
    1133             :    !-----------------------------------------------------------------------------
    1134             : 
    1135             :    ! nradgas is set by the radiative transfer code
    1136        1536 :    gaslist%ngas = nradgas
    1137             : 
    1138             :    ! Determine the number of bulk aerosols and aerosol modes in the list
    1139        1536 :    naero = 0
    1140        1536 :    nmodes = 0
    1141       13824 :    do ii = 1, namelist%ncnst
    1142       12288 :       if (trim(namelist%type(ii)) == 'A') naero  = naero + 1
    1143       13824 :       if (trim(namelist%type(ii)) == 'M') nmodes = nmodes + 1
    1144             :    end do
    1145        1536 :    aerlist%numaerosols = naero
    1146        1536 :    ma_list%nmodes      = nmodes
    1147             : 
    1148             :    ! allocate storage for the aerosol, gas, and mode lists
    1149             :    allocate( &
    1150             :       aerlist%aer(aerlist%numaerosols),      &
    1151             :       gaslist%gas(gaslist%ngas),             &
    1152             :       ma_list%idx(ma_list%nmodes),           &
    1153             :       ma_list%physprop_files(ma_list%nmodes), &
    1154             :       ma_list%idx_props(ma_list%nmodes),     &
    1155        9216 :       stat=istat)
    1156        1536 :    if (istat /= 0) call endrun(routine//': allocate ERROR; aero and gas list components')
    1157             : 
    1158        1536 :    if (masterproc .and. verbose) then
    1159           2 :       if (len_trim(gaslist%list_id) == 0) then
    1160           2 :          write(iulog,*) nl//' '//routine//': namelist input for climate list'
    1161             :       else
    1162           0 :          write(iulog,*) nl//' '//routine//': namelist input for diagnostic list:'//gaslist%list_id
    1163             :       end if
    1164             :    end if
    1165             : 
    1166             :    ! Loop over the radiatively active components specified in the namelist
    1167        1536 :    ba_idx = 0
    1168        1536 :    ma_idx = 0
    1169       13824 :    do ii = 1, namelist%ncnst
    1170             : 
    1171       12288 :       if (masterproc .and. verbose) &
    1172           0 :          write(iulog,*) "  rad namelist spec: "// trim(namelist%source(ii)) &
    1173          16 :          //":"//trim(namelist%camname(ii))//":"//trim(namelist%radname(ii))
    1174             : 
    1175             :       ! Check that the source specifier is legal.
    1176           0 :       if (namelist%source(ii) /= 'A' .and. namelist%source(ii) /= 'M' .and. &
    1177       12288 :           namelist%source(ii) /= 'N' .and. namelist%source(ii) /= 'Z' ) then
    1178             :          call endrun(routine//": source must either be A, M, N or Z:"//&
    1179           0 :                      " illegal specifier in namelist input: "//namelist%source(ii))
    1180             :       end if
    1181             : 
    1182             :       ! Add component to appropriate list (gas, modal or bulk aerosol)
    1183       13824 :       if (namelist%type(ii) == 'A') then
    1184             : 
    1185             :          ! Add to bulk aerosol list
    1186           0 :          ba_idx = ba_idx + 1
    1187             : 
    1188           0 :          aerlist%aer(ba_idx)%source        = namelist%source(ii)
    1189           0 :          aerlist%aer(ba_idx)%camname       = namelist%camname(ii)
    1190           0 :          aerlist%aer(ba_idx)%physprop_file = namelist%radname(ii)
    1191             : 
    1192       12288 :       else if (namelist%type(ii) == 'M') then
    1193             : 
    1194             :          ! Add to modal aerosol list
    1195           0 :          ma_idx = ma_idx + 1
    1196             : 
    1197             :          ! Look through the mode definitions for the name of the specified mode.  The
    1198             :          ! index into the modes object all the information relevent to the mode definition.
    1199           0 :          ma_list%idx(ma_idx) = -1
    1200           0 :          do m = 1, modes%nmodes
    1201           0 :             if (trim(namelist%camname(ii)) == trim(modes%names(m))) then
    1202           0 :                ma_list%idx(ma_idx) = m
    1203           0 :                exit
    1204             :             end if
    1205             :          end do
    1206           0 :          if (ma_list%idx(ma_idx) == -1) &
    1207           0 :             call endrun(routine//' ERROR cannot find mode name '//trim(namelist%camname(ii)))
    1208             : 
    1209             :          ! Also save the name of the physprop file
    1210           0 :          ma_list%physprop_files(ma_idx) = namelist%radname(ii)
    1211             : 
    1212             :       else
    1213             : 
    1214             :          ! Add to gas list
    1215             : 
    1216             :          ! The radiative transfer code requires the input of a specific set of gases
    1217             :          ! which is hardwired into the code.  The CAM interface to the RT code uses
    1218             :          ! the names in the radconstants module to refer to these gases.  The user
    1219             :          ! interface (namelist) also uses these names to identify the gases treated
    1220             :          ! by the RT code.  We use the index order set in radconstants for convenience
    1221             :          ! only.
    1222             : 
    1223             :          ! First check that the gas name specified by the user is allowed.
    1224             :          ! rad_gas_index will abort on illegal names.
    1225       12288 :          igas = rad_gas_index(namelist%radname(ii))
    1226             : 
    1227             :          ! Set values in the igas index
    1228       12288 :          gaslist%gas(igas)%source  = namelist%source(ii)
    1229       12288 :          gaslist%gas(igas)%camname = namelist%camname(ii)
    1230             : 
    1231             :       end if
    1232             :    end do
    1233             : 
    1234        1536 : end subroutine list_init1
    1235             : 
    1236             : !================================================================================================
    1237             : 
    1238        1536 : subroutine list_init2(gaslist, aerlist, ma_list)
    1239             : 
    1240             :    ! Final initialization phase gets the component indices in the constituent array
    1241             :    ! and the physics buffer, and indices into physprop module.
    1242             : 
    1243             :    type(gaslist_t),        intent(inout) :: gaslist
    1244             :    type(aerlist_t),        intent(inout) :: aerlist
    1245             :    type(modelist_t),       intent(inout) :: ma_list
    1246             : 
    1247             :    ! Local variables
    1248             :    integer :: i
    1249             :    character(len=*), parameter :: routine = 'list_init2'
    1250             :    !-----------------------------------------------------------------------------
    1251             : 
    1252             :    ! Loop over gases
    1253       13824 :    do i = 1, gaslist%ngas
    1254             : 
    1255             :       ! locate the specie mixing ratio in the pbuf or state
    1256       13824 :       gaslist%gas(i)%idx = get_cam_idx(gaslist%gas(i)%source, gaslist%gas(i)%camname, routine)
    1257             : 
    1258             :    end do
    1259             : 
    1260             :    ! Loop over bulk aerosols
    1261        1536 :    do i = 1, aerlist%numaerosols
    1262             : 
    1263             :       ! locate the specie mixing ratio in the pbuf or state
    1264           0 :       aerlist%aer(i)%idx = get_cam_idx(aerlist%aer(i)%source, aerlist%aer(i)%camname, routine)
    1265             : 
    1266             :       ! get the physprop_id from the phys_prop module
    1267        1536 :       aerlist%aer(i)%physprop_id = physprop_get_id(aerlist%aer(i)%physprop_file)
    1268             : 
    1269             :    end do
    1270             : 
    1271             :    ! Loop over modes
    1272        1536 :    do i = 1, ma_list%nmodes
    1273             : 
    1274             :       ! get the physprop_id from the phys_prop module
    1275        1536 :       ma_list%idx_props(i) = physprop_get_id(ma_list%physprop_files(i))
    1276             : 
    1277             :    end do
    1278             : 
    1279        1536 : end subroutine list_init2
    1280             : 
    1281             : !================================================================================================
    1282             : 
    1283        1536 : subroutine rad_gas_diag_init(glist)
    1284             : 
    1285             : ! Add diagnostic fields to the master fieldlist.
    1286             : 
    1287             :    type(gaslist_t), intent(inout) :: glist
    1288             : 
    1289             :    integer :: i, ngas
    1290             :    character(len=64) :: name
    1291             :    character(len=2)  :: list_id
    1292             :    character(len=4)  :: suffix
    1293             :    character(len=128):: long_name
    1294             :    character(len=32) :: long_name_description
    1295             :    !-----------------------------------------------------------------------------
    1296             : 
    1297        1536 :    ngas = glist%ngas
    1298        1536 :    if (ngas == 0) return
    1299             : 
    1300             :    ! Determine whether this is a climate or diagnostic list.
    1301        1536 :    list_id = glist%list_id
    1302        1536 :    if (len_trim(list_id) == 0) then
    1303        1536 :       suffix = '_c'
    1304        1536 :       long_name_description = ' used in climate calculation'
    1305             :    else
    1306           0 :       suffix = '_d' // list_id
    1307           0 :       long_name_description = ' used in diagnostic calculation'
    1308             :    end if
    1309             : 
    1310       13824 :    do i = 1, ngas
    1311             : 
    1312             :       ! construct names for mass per layer diagnostics
    1313       12288 :       name = 'm_' // trim(glist%gas(i)%camname) // trim(suffix)
    1314       12288 :       glist%gas(i)%mass_name = name
    1315       12288 :       long_name = trim(glist%gas(i)%camname)//' mass per layer'//long_name_description
    1316       24576 :       call addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name))
    1317             : 
    1318             :       ! construct names for column burden diagnostics
    1319       12288 :       name = 'cb_' // trim(glist%gas(i)%camname) // trim(suffix)
    1320       12288 :       long_name = trim(glist%gas(i)%camname)//' column burden'//long_name_description
    1321       12288 :       call addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name))
    1322             : 
    1323             :       ! error check for name length
    1324       13824 :       if (len_trim(name) > fieldname_len) then
    1325           0 :          write(iulog,*) 'rad_gas_diag_init: '//trim(name)//' longer than ', fieldname_len, ' characters'
    1326           0 :          call endrun('rad_gas_diag_init: name too long: '//trim(name))
    1327             :       end if
    1328             : 
    1329             :    end do
    1330             : 
    1331             : end subroutine rad_gas_diag_init
    1332             : 
    1333             : !================================================================================================
    1334             : 
    1335        1536 : subroutine rad_aer_diag_init(alist)
    1336             : 
    1337             : ! Add diagnostic fields to the master fieldlist.
    1338             : 
    1339             :    type(aerlist_t), intent(inout) :: alist
    1340             : 
    1341             :    integer :: i, naer
    1342             :    character(len=64) :: name
    1343             :    character(len=2)  :: list_id
    1344             :    character(len=4)  :: suffix
    1345             :    character(len=128):: long_name
    1346             :    character(len=32) :: long_name_description
    1347             :    !-----------------------------------------------------------------------------
    1348             : 
    1349        1536 :    naer = alist%numaerosols
    1350        1536 :    if (naer == 0) return
    1351             : 
    1352             :    ! Determine whether this is a climate or diagnostic list.
    1353           0 :    list_id = alist%list_id
    1354           0 :    if (len_trim(list_id) == 0) then
    1355           0 :       suffix = '_c'
    1356           0 :       long_name_description = ' used in climate calculation'
    1357             :    else
    1358           0 :       suffix = '_d' // list_id
    1359           0 :       long_name_description = ' used in diagnostic calculation'
    1360             :    end if
    1361             : 
    1362           0 :    do i = 1, naer
    1363             : 
    1364             :       ! construct names for mass per layer diagnostic fields
    1365           0 :       name = 'm_' // trim(alist%aer(i)%camname) // trim(suffix)
    1366           0 :       alist%aer(i)%mass_name = name
    1367           0 :       long_name = trim(alist%aer(i)%camname)//' mass per layer'//long_name_description
    1368           0 :       call addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name))
    1369             : 
    1370             :       ! construct names for column burden diagnostic fields
    1371           0 :       name = 'cb_' // trim(alist%aer(i)%camname) // trim(suffix)
    1372           0 :       long_name = trim(alist%aer(i)%camname)//' column burden'//long_name_description
    1373           0 :       call addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name))
    1374             : 
    1375             :       ! error check for name length
    1376           0 :       if (len_trim(name) > fieldname_len) then
    1377           0 :          write(iulog,*) 'rad_aer_diag_init: '//trim(name)//' longer than ', fieldname_len, ' characters'
    1378           0 :          call endrun('rad_aer_diag_init: name too long: '//trim(name))
    1379             :       end if
    1380             : 
    1381             :    end do
    1382             : 
    1383             : end subroutine rad_aer_diag_init
    1384             : 
    1385             : 
    1386             : !================================================================================================
    1387             : 
    1388        1536 : subroutine parse_mode_defs(nl_in, modes)
    1389             : 
    1390             :    ! Parse the mode definition specifiers.  The specifiers are of the form:
    1391             :    !
    1392             :    ! 'mode_name:mode_type:=',
    1393             :    !  'source_num_a:camname_num_a:source_num_c:camname_num_c:num_mr:+',
    1394             :    !  'source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file[:+]'[,]
    1395             :    !  ['source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file][:+][']
    1396             :    !
    1397             :    ! where the ':' separated fields are:
    1398             :    ! mode_name -- name of the mode.
    1399             :    ! mode_type -- type of mode.  Valid values are from the MAM code.
    1400             :    ! =         -- this line terminator identifies the initial string in a
    1401             :    !              mode definition
    1402             :    ! +         -- this line terminator indicates that the mode definition is
    1403             :    !              continued in the next string
    1404             :    ! source_num_a  -- Source of interstitial number mixing ratio,  'A', 'N', or 'Z'
    1405             :    ! camname_num_a -- the name of the interstitial number component.  This name must be
    1406             :    !                  registered in the constituent arrays when source=A or in the
    1407             :    !                  physics buffer when source=N
    1408             :    ! source_num_c  -- Source of cloud borne number mixing ratio,  'A', 'N', or 'Z'
    1409             :    ! camname_num_c -- the name of the cloud borne number component.  This name must be
    1410             :    !                  registered in the constituent arrays when source=A or in the
    1411             :    !                  physics buffer when source=N
    1412             :    ! source_mmr_a  -- Source of interstitial specie mass mixing ratio,  'A', 'N' or 'Z'
    1413             :    ! camname_mmr_a -- the name of the interstitial specie.  This name must be
    1414             :    !                  registered in the constituent arrays when source=A or in the
    1415             :    !                  physics buffer when source=N
    1416             :    ! source_mmr_c  -- Source of cloud borne specie mass mixing ratio,  'A', 'N' or 'Z'
    1417             :    ! camname_mmr_c -- the name of the cloud borne specie.  This name must be
    1418             :    !                  registered in the constituent arrays when source=A or in the
    1419             :    !                  physics buffer when source=N
    1420             :    ! spec_type -- species type.  Valid values far from the MAM code, except that
    1421             :    !              the value 'num_mr' designates a number mixing ratio and has no
    1422             :    !              associated field for the prop_file.  There can only be one entry
    1423             :    !              with the num_mr type in a mode definition.
    1424             :    ! prop_file -- For aerosol species this is a filename, which is
    1425             :    !              identified by a ".nc" suffix.  The file contains optical and
    1426             :    !              other physical properties of the aerosol.
    1427             :    !
    1428             :    ! A mode definition must contain only 1 string for the number mixing ratio components
    1429             :    ! and at least 1 string for the species.
    1430             : 
    1431             : 
    1432             :    character(len=*), intent(inout) :: nl_in(:)    ! namelist input (blanks are removed on output)
    1433             :    type(modes_t),    intent(inout) :: modes       ! structure containing parsed input
    1434             : 
    1435             :    ! Local variables
    1436             :    integer :: m
    1437             :    integer :: istat
    1438             :    integer :: nmodes, nstr
    1439             :    integer :: mbeg, mcur
    1440             :    integer :: nspec, ispec
    1441             :    integer :: strlen, iend, ipos
    1442             :    logical :: num_mr_found
    1443             :    character(len=*), parameter :: routine = 'parse_mode_defs'
    1444        1536 :    character(len=len(nl_in(1))) :: tmpstr
    1445             :    character(len=1)  :: tmp_src_a
    1446             :    character(len=32) :: tmp_name_a
    1447             :    character(len=1)  :: tmp_src_c
    1448             :    character(len=32) :: tmp_name_c
    1449             :    character(len=32) :: tmp_type
    1450             :    !-------------------------------------------------------------------------
    1451             : 
    1452             :    ! Determine number of modes defined by counting number of strings that are
    1453             :    ! terminated by ':='
    1454             :    ! (algorithm stops counting at first blank element).
    1455        1536 :    nmodes = 0
    1456        1536 :    nstr = 0
    1457        1536 :    do m = 1, n_mode_str
    1458             : 
    1459        1536 :       if (len_trim(nl_in(m)) == 0) exit
    1460           0 :       nstr = nstr + 1
    1461             : 
    1462             :       ! There are no fields in the input strings in which a blank character is allowed.
    1463             :       ! To simplify the parsing go through the input strings and remove blanks.
    1464           0 :       tmpstr = adjustl(nl_in(m))
    1465           0 :       nl_in(m) = tmpstr
    1466             :       do
    1467           0 :          strlen = len_trim(nl_in(m))
    1468           0 :          ipos = index(nl_in(m), ' ')
    1469           0 :          if (ipos == 0 .or. ipos > strlen) exit
    1470           0 :          tmpstr = nl_in(m)(:ipos-1) // nl_in(m)(ipos+1:strlen)
    1471           0 :          nl_in(m) = tmpstr
    1472             :       end do
    1473             :       ! count strings with ':=' terminator
    1474        1536 :       if (nl_in(m)(strlen-1:strlen) == ':=') nmodes = nmodes + 1
    1475             : 
    1476             :    end do
    1477        1536 :    modes%nmodes = nmodes
    1478             : 
    1479             :    ! return if no modes defined
    1480        1536 :    if (nmodes == 0) return
    1481             : 
    1482             :    ! allocate components that depend on nmodes
    1483             :    allocate( &
    1484             :       modes%names(nmodes),  &
    1485             :       modes%types(nmodes),  &
    1486             :       modes%comps(nmodes),  &
    1487           0 :       stat=istat )
    1488           0 :    if (istat > 0) then
    1489           0 :       write(iulog,*) routine//': ERROR: cannot allocate storage for modes.  nmodes=', nmodes
    1490           0 :       call endrun(routine//': ERROR allocating storage for modes')
    1491             :    end if
    1492             : 
    1493             : 
    1494           0 :    mcur = 1              ! index of current string being processed
    1495             : 
    1496             :    ! loop over modes
    1497           0 :    do m = 1, nmodes
    1498             : 
    1499           0 :       mbeg = mcur  ! remember the first string of a mode
    1500             : 
    1501             :       ! check that first string in mode definition is ':=' terminated
    1502           0 :       iend = len_trim(nl_in(mcur))
    1503           0 :       if (nl_in(mcur)(iend-1:iend) /= ':=') call parse_error('= not found', nl_in(mcur))
    1504             : 
    1505             :       ! count species in mode definition.  definition will contain 1 string with
    1506             :       ! with a ':+' terminator for each specie
    1507           0 :       nspec = 0
    1508           0 :       mcur = mcur + 1
    1509           0 :       do
    1510           0 :          iend = len_trim(nl_in(mcur))
    1511           0 :          if (nl_in(mcur)(iend-1:iend) /= ':+') exit
    1512           0 :          nspec = nspec + 1
    1513           0 :          mcur = mcur + 1
    1514             :       end do
    1515             : 
    1516             :       ! a mode must have at least one specie
    1517           0 :       if (nspec == 0) call parse_error('mode must have at least one specie', nl_in(mbeg))
    1518             : 
    1519             :       ! allocate components that depend on number of species
    1520             :       allocate( &
    1521           0 :          modes%comps(m)%source_mmr_a(nspec),  &
    1522           0 :          modes%comps(m)%camname_mmr_a(nspec), &
    1523           0 :          modes%comps(m)%source_mmr_c(nspec),  &
    1524           0 :          modes%comps(m)%camname_mmr_c(nspec), &
    1525           0 :          modes%comps(m)%type(nspec),          &
    1526           0 :          modes%comps(m)%props(nspec),         &
    1527           0 :          stat=istat)
    1528             : 
    1529           0 :       if (istat > 0) then
    1530           0 :          write(iulog,*) routine//': ERROR: cannot allocate storage for species.  nspec=', nspec
    1531           0 :          call endrun(routine//': ERROR allocating storage for species')
    1532             :       end if
    1533             : 
    1534             :       ! initialize components
    1535           0 :       modes%comps(m)%nspec         = nspec
    1536           0 :       modes%comps(m)%source_num_a  = ' '
    1537           0 :       modes%comps(m)%camname_num_a = ' '
    1538           0 :       modes%comps(m)%source_num_c  = ' '
    1539           0 :       modes%comps(m)%camname_num_c = ' '
    1540           0 :       do ispec = 1, nspec
    1541           0 :          modes%comps(m)%source_mmr_a(ispec)  = ' '
    1542           0 :          modes%comps(m)%camname_mmr_a(ispec) = ' '
    1543           0 :          modes%comps(m)%source_mmr_c(ispec)  = ' '
    1544           0 :          modes%comps(m)%camname_mmr_c(ispec) = ' '
    1545           0 :          modes%comps(m)%type(ispec)          = ' '
    1546           0 :          modes%comps(m)%props(ispec)         = ' '
    1547             :       end do
    1548             : 
    1549             :       ! return to first string in mode definition
    1550           0 :       mcur = mbeg
    1551           0 :       tmpstr = nl_in(mcur)
    1552             : 
    1553             :       ! mode name
    1554           0 :       ipos = index(tmpstr, ':')
    1555           0 :       if (ipos < 2) call parse_error('mode name not found', tmpstr)
    1556           0 :       modes%names(m) = tmpstr(:ipos-1)
    1557           0 :       tmpstr         = tmpstr(ipos+1:)
    1558             : 
    1559             :       ! mode type
    1560           0 :       ipos = index(tmpstr, ':')
    1561           0 :       if (ipos == 0) call parse_error('mode type not found', tmpstr)
    1562             :       ! check for valid mode type
    1563           0 :       call check_mode_type(tmpstr, 1, ipos-1)
    1564           0 :       modes%types(m) = tmpstr(:ipos-1)
    1565           0 :       tmpstr         = tmpstr(ipos+1:)
    1566             : 
    1567             :       ! mode type must be followed by '='
    1568           0 :       if (tmpstr(1:1) /= '=') call parse_error('= not found', tmpstr)
    1569             : 
    1570             :       ! move to next string
    1571           0 :       mcur = mcur + 1
    1572           0 :       tmpstr = nl_in(mcur)
    1573             : 
    1574             :       ! process mode component strings
    1575             :       num_mr_found = .false.   ! keep track of whether number mixing ratio component is found
    1576             :       ispec = 0                ! keep track of the number of species found
    1577             :       do
    1578             : 
    1579             :          ! source of interstitial component
    1580           0 :          ipos = index(tmpstr, ':')
    1581           0 :          if (ipos < 2) call parse_error('expect to find source field first', tmpstr)
    1582             :          ! check for valid source
    1583           0 :          if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') &
    1584           0 :             call parse_error('source must be A, N or Z', tmpstr)
    1585           0 :          tmp_src_a = tmpstr(:ipos-1)
    1586           0 :          tmpstr    = tmpstr(ipos+1:)
    1587             : 
    1588             :          ! name of interstitial component
    1589           0 :          ipos = index(tmpstr, ':')
    1590           0 :          if (ipos == 0) call parse_error('next separator not found', tmpstr)
    1591           0 :          tmp_name_a = tmpstr(:ipos-1)
    1592           0 :          tmpstr     = tmpstr(ipos+1:)
    1593             : 
    1594             :          ! source of cloud borne component
    1595           0 :          ipos = index(tmpstr, ':')
    1596           0 :          if (ipos < 2) call parse_error('expect to find a source field', tmpstr)
    1597             :          ! check for valid source
    1598           0 :          if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') &
    1599           0 :             call parse_error('source must be A, N or Z', tmpstr)
    1600           0 :          tmp_src_c = tmpstr(:ipos-1)
    1601           0 :          tmpstr    = tmpstr(ipos+1:)
    1602             : 
    1603             :          ! name of cloud borne component
    1604           0 :          ipos = index(tmpstr, ':')
    1605           0 :          if (ipos == 0) call parse_error('next separator not found', tmpstr)
    1606           0 :          tmp_name_c = tmpstr(:ipos-1)
    1607           0 :          tmpstr     = tmpstr(ipos+1:)
    1608             : 
    1609             :          ! component type
    1610           0 :          ipos = scan(tmpstr, ': ')
    1611           0 :          if (ipos == 0) call parse_error('next separator not found', tmpstr)
    1612             : 
    1613           0 :          if (tmpstr(:ipos-1) == 'num_mr') then
    1614             : 
    1615             :             ! there can only be one number mixing ratio component
    1616           0 :             if (num_mr_found) call parse_error('more than 1 number component', nl_in(mcur))
    1617             : 
    1618           0 :             num_mr_found = .true.
    1619           0 :             modes%comps(m)%source_num_a  = tmp_src_a
    1620           0 :             modes%comps(m)%camname_num_a = tmp_name_a
    1621           0 :             modes%comps(m)%source_num_c  = tmp_src_c
    1622           0 :             modes%comps(m)%camname_num_c = tmp_name_c
    1623           0 :             tmpstr                       = tmpstr(ipos+1:)
    1624             : 
    1625             :          else
    1626             : 
    1627             :             ! check for valid specie type
    1628           0 :             call check_specie_type(tmpstr, 1, ipos-1)
    1629           0 :             tmp_type = tmpstr(:ipos-1)
    1630           0 :             tmpstr   = tmpstr(ipos+1:)
    1631             : 
    1632             :             ! get the properties file
    1633           0 :             ipos = scan(tmpstr, ': ')
    1634           0 :             if (ipos == 0) call parse_error('next separator not found', tmpstr)
    1635             :             ! check for valid filename -- must have .nc extension
    1636           0 :             if (tmpstr(ipos-3:ipos-1) /= '.nc') &
    1637           0 :                call parse_error('filename not valid', tmpstr)
    1638             : 
    1639           0 :             ispec = ispec + 1
    1640           0 :             modes%comps(m)%source_mmr_a(ispec)  = tmp_src_a
    1641           0 :             modes%comps(m)%camname_mmr_a(ispec) = tmp_name_a
    1642           0 :             modes%comps(m)%source_mmr_c(ispec)  = tmp_src_c
    1643           0 :             modes%comps(m)%camname_mmr_c(ispec) = tmp_name_c
    1644           0 :             modes%comps(m)%type(ispec)          = tmp_type
    1645           0 :             modes%comps(m)%props(ispec)         = tmpstr(:ipos-1)
    1646           0 :             tmpstr                              = tmpstr(ipos+1:)
    1647             :          end if
    1648             : 
    1649             :          ! check if there are more components.  either the current character is
    1650             :          ! a ' ' which means this string is the final mode component, or the character
    1651             :          ! is a '+' which means there are more components
    1652           0 :          if (tmpstr(1:1) == ' ') exit
    1653             : 
    1654           0 :          if (tmpstr(1:1) /= '+') &
    1655           0 :                call parse_error('+ field not found', tmpstr)
    1656             : 
    1657             :          ! continue to next component...
    1658           0 :          mcur = mcur + 1
    1659           0 :          tmpstr = nl_in(mcur)
    1660             :       end do
    1661             : 
    1662             :       ! check that a number component was found
    1663           0 :       if (.not. num_mr_found) call parse_error('number component not found', nl_in(mbeg))
    1664             : 
    1665             :       ! check that the right number of species were found
    1666           0 :       if (ispec /= nspec) call parse_error('component parsing got wrong number of species', nl_in(mbeg))
    1667             : 
    1668             :       ! continue to next mode...
    1669           0 :       mcur = mcur + 1
    1670           0 :       tmpstr = nl_in(mcur)
    1671             :    end do
    1672             : 
    1673             :    !------------------------------------------------------------------------------------------------
    1674             :    contains
    1675             :    !------------------------------------------------------------------------------------------------
    1676             : 
    1677             :    ! internal subroutines used for error checking and reporting
    1678             : 
    1679           0 :    subroutine parse_error(msg, str)
    1680             : 
    1681             :       character(len=*), intent(in) :: msg
    1682             :       character(len=*), intent(in) :: str
    1683             : 
    1684           0 :       write(iulog,*) routine//': ERROR: '//msg
    1685           0 :       write(iulog,*) ' input string: '//trim(str)
    1686           0 :       call endrun(routine//': ERROR: '//msg)
    1687             : 
    1688           0 :    end subroutine parse_error
    1689             : 
    1690             :    !------------------------------------------------------------------------------------------------
    1691             : 
    1692           0 :    subroutine check_specie_type(str, ib, ie)
    1693             : 
    1694             :       character(len=*), intent(in) :: str
    1695             :       integer,          intent(in) :: ib, ie
    1696             : 
    1697             :       integer :: i
    1698             : 
    1699           0 :       do i = 1, num_spec_types
    1700           0 :          if (str(ib:ie) == trim(spec_type_names(i))) return
    1701             :       end do
    1702             : 
    1703           0 :       call parse_error('specie type not valid', str(ib:ie))
    1704             : 
    1705             :    end subroutine check_specie_type
    1706             : 
    1707             :    !------------------------------------------------------------------------------------------------
    1708             : 
    1709           0 :    subroutine check_mode_type(str, ib, ie)
    1710             : 
    1711             :       character(len=*), intent(in) :: str
    1712             :       integer,          intent(in) :: ib, ie  ! begin, end character of mode type substring
    1713             : 
    1714             :       integer :: i
    1715             : 
    1716           0 :       do i = 1, num_mode_types
    1717           0 :          if (str(ib:ie) == trim(mode_type_names(i))) return
    1718             :       end do
    1719             : 
    1720           0 :       call parse_error('mode type not valid', str(ib:ie))
    1721             : 
    1722             :    end subroutine check_mode_type
    1723             : 
    1724             :    !------------------------------------------------------------------------------------------------
    1725             : 
    1726             : end subroutine parse_mode_defs
    1727             : 
    1728             : !================================================================================================
    1729             : 
    1730       16896 : subroutine parse_rad_specifier(specifier, namelist_data)
    1731             : 
    1732             : !-----------------------------------------------------------------------------
    1733             : ! Private method for parsing the radiation namelist specifiers.  The specifiers
    1734             : ! are of the form 'source_camname:radname' where:
    1735             : ! source  -- either 'N' for pbuf (non-advected) or 'A' for state (advected)
    1736             : ! camname -- the name of a constituent that must be found in the constituent
    1737             : !            component of the state when source=A or in the physics buffer
    1738             : !            when source=N
    1739             : ! radname -- For gases this is a name that identifies the constituent to the
    1740             : !            radiative transfer codes.  These names are contained in the
    1741             : !            radconstants module.  For aerosols this is a filename, which is
    1742             : !            identified by a ".nc" suffix.  The file contains optical and
    1743             : !            other physical properties of the aerosol.
    1744             : !
    1745             : ! This code also identifies whether the constituent is a gas or an aerosol
    1746             : ! and adds that info to a structure that stores the parsed data.
    1747             : !-----------------------------------------------------------------------------
    1748             : 
    1749             :     character(len=*), dimension(:), intent(in) :: specifier
    1750             :     type(rad_cnst_namelist_t),   intent(inout) :: namelist_data
    1751             : 
    1752             :     ! Local variables
    1753             :     integer            :: number, i, j
    1754             :     integer            :: ipos, strlen
    1755             :     integer            :: astat
    1756             :     character(len=cs1) :: tmpstr
    1757             :     character(len=1)   :: source(n_rad_cnst)
    1758             :     character(len=64)  :: camname(n_rad_cnst)
    1759             :     character(len=cs1) :: radname(n_rad_cnst)
    1760             :     character(len=1)   :: type(n_rad_cnst)
    1761             :     !-------------------------------------------------------------------------
    1762             : 
    1763       16896 :     number = 0
    1764             : 
    1765       29184 :     parse_loop: do i = 1, n_rad_cnst
    1766       29184 :       if ( len_trim(specifier(i)) == 0 ) then
    1767             :          exit parse_loop
    1768             :       endif
    1769             : 
    1770             :       ! There are no fields in the input strings in which a blank character is allowed.
    1771             :       ! To simplify the parsing go through the input strings and remove blanks.
    1772       12288 :       tmpstr = adjustl(specifier(i))
    1773           0 :       do
    1774       12288 :          strlen = len_trim(tmpstr)
    1775       12288 :          ipos = index(tmpstr, ' ')
    1776       12288 :          if (ipos == 0 .or. ipos > strlen) exit
    1777       12288 :          tmpstr = tmpstr(:ipos-1) // tmpstr(ipos+1:strlen)
    1778             :       end do
    1779             : 
    1780             :       ! Locate the ':' separating source from camname.
    1781       12288 :       j = index(tmpstr, ':')
    1782       12288 :       source(i) = tmpstr(:j-1)
    1783       12288 :       tmpstr = tmpstr(j+1:)
    1784             : 
    1785             :       ! locate the ':' separating camname from radname
    1786       12288 :       j = scan(tmpstr, ':')
    1787             : 
    1788       12288 :       camname(i) = tmpstr(:j-1)
    1789       12288 :       radname(i) = tmpstr(j+1:)
    1790             : 
    1791             :       ! determine the type of constituent
    1792       12288 :       if (source(i) == 'M') then
    1793           0 :          type(i) = 'M'
    1794       12288 :       else if(index(radname(i),".nc") .gt. 0) then
    1795           0 :          type(i) = 'A'
    1796             :       else
    1797       12288 :          type(i) = 'G'
    1798             :       end if
    1799             : 
    1800       29184 :       number = number+1
    1801             :     end do parse_loop
    1802             : 
    1803       16896 :     namelist_data%ncnst = number
    1804             : 
    1805       16896 :     if (number == 0) return
    1806             : 
    1807        3072 :     allocate(namelist_data%source (number), stat=astat)
    1808        1536 :     if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%source')
    1809        4608 :     allocate(namelist_data%camname(number), stat=astat)
    1810           0 :     if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%camname')
    1811        4608 :     allocate(namelist_data%radname(number), stat=astat)
    1812           0 :     if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%radname')
    1813        3072 :     allocate(namelist_data%type(number), stat=astat)
    1814           0 :     if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%type')
    1815             : 
    1816       13824 :     namelist_data%source(:namelist_data%ncnst)  = source (:namelist_data%ncnst)
    1817       13824 :     namelist_data%camname(:namelist_data%ncnst) = camname(:namelist_data%ncnst)
    1818       13824 :     namelist_data%radname(:namelist_data%ncnst) = radname(:namelist_data%ncnst)
    1819       13824 :     namelist_data%type(:namelist_data%ncnst)    = type(:namelist_data%ncnst)
    1820             : 
    1821             : end subroutine parse_rad_specifier
    1822             : 
    1823             : !================================================================================================
    1824             : 
    1825           0 : subroutine rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, state, pbuf, mmr)
    1826             : 
    1827             :    ! Return pointer to mass mixing ratio for the aerosol from the specified
    1828             :    ! climate or diagnostic list.
    1829             : 
    1830             :    ! Arguments
    1831             :    integer,                     intent(in) :: list_idx    ! index of the climate or a diagnostic list
    1832             :    integer,                     intent(in) :: aer_idx
    1833             :    type(physics_state), target, intent(in) :: state
    1834             :    type(physics_buffer_desc), pointer      :: pbuf(:)
    1835             :    real(r8),                    pointer    :: mmr(:,:)
    1836             : 
    1837             :    ! Local variables
    1838             :    integer :: lchnk
    1839             :    integer :: idx
    1840             :    character(len=1) :: source
    1841             :    type(aerlist_t), pointer :: aerlist
    1842             :    character(len=*), parameter :: subname = 'rad_cnst_get_aer_mmr_by_idx'
    1843             :    !-----------------------------------------------------------------------------
    1844             : 
    1845           0 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
    1846           0 :       aerlist => aerosollist(list_idx)
    1847             :    else
    1848           0 :       write(iulog,*) subname//': list_idx =', list_idx
    1849           0 :       call endrun(subname//': list_idx out of bounds')
    1850             :    endif
    1851             : 
    1852           0 :    lchnk = state%lchnk
    1853             : 
    1854             :    ! Check for valid input aerosol index
    1855           0 :    if (aer_idx < 1  .or.  aer_idx > aerlist%numaerosols) then
    1856           0 :       write(iulog,*) subname//': aer_idx= ', aer_idx, '  numaerosols= ', aerlist%numaerosols
    1857           0 :       call endrun(subname//': aerosol list index out of range')
    1858             :    end if
    1859             : 
    1860             :    ! Get data source
    1861           0 :    source = aerlist%aer(aer_idx)%source
    1862           0 :    idx    = aerlist%aer(aer_idx)%idx
    1863           0 :    select case( source )
    1864             :    case ('A')
    1865           0 :       mmr => state%q(:,:,idx)
    1866             :    case ('N')
    1867           0 :       call pbuf_get_field(pbuf, idx, mmr)
    1868             :    case ('Z')
    1869           0 :       mmr => zero_cols
    1870             :    end select
    1871             : 
    1872           0 : end subroutine rad_cnst_get_aer_mmr_by_idx
    1873             : 
    1874             : !================================================================================================
    1875             : 
    1876           0 : subroutine rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, state, pbuf, mmr)
    1877             : 
    1878             :    ! Return pointer to mass mixing ratio for the modal aerosol specie from the specified
    1879             :    ! climate or diagnostic list.
    1880             : 
    1881             :    ! Arguments
    1882             :    integer,                     intent(in) :: list_idx    ! index of the climate or a diagnostic list
    1883             :    integer,                     intent(in) :: mode_idx    ! mode index
    1884             :    integer,                     intent(in) :: spec_idx    ! index of specie in the mode
    1885             :    character(len=1),            intent(in) :: phase       ! 'a' for interstitial, 'c' for cloud borne
    1886             :    type(physics_state), target, intent(in) :: state
    1887             :    type(physics_buffer_desc),   pointer    :: pbuf(:)
    1888             :    real(r8),                    pointer    :: mmr(:,:)
    1889             : 
    1890             :    ! Local variables
    1891             :    integer :: m_idx
    1892             :    integer :: idx
    1893             :    integer :: lchnk
    1894             :    character(len=1) :: source
    1895             :    type(modelist_t), pointer :: mlist
    1896             :    character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_by_idx'
    1897             :    !-----------------------------------------------------------------------------
    1898             : 
    1899           0 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
    1900           0 :       mlist => ma_list(list_idx)
    1901             :    else
    1902           0 :       write(iulog,*) subname//': list_idx =', list_idx
    1903           0 :       call endrun(subname//': list_idx out of bounds')
    1904             :    endif
    1905             : 
    1906             :    ! Check for valid mode index
    1907           0 :    if (mode_idx < 1  .or.  mode_idx > mlist%nmodes) then
    1908           0 :       write(iulog,*) subname//': mode_idx= ', mode_idx, '  nmodes= ', mlist%nmodes
    1909           0 :       call endrun(subname//': mode list index out of range')
    1910             :    end if
    1911             : 
    1912             :    ! Get the index for the corresponding mode in the mode definition object
    1913           0 :    m_idx = mlist%idx(mode_idx)
    1914             : 
    1915             :    ! Check for valid specie index
    1916           0 :    if (spec_idx < 1  .or.  spec_idx > modes%comps(m_idx)%nspec) then
    1917           0 :       write(iulog,*) subname//': spec_idx= ', spec_idx, '  nspec= ', modes%comps(m_idx)%nspec
    1918           0 :       call endrun(subname//': specie list index out of range')
    1919             :    end if
    1920             : 
    1921             :    ! Get data source
    1922           0 :    if (phase == 'a') then
    1923           0 :       source = modes%comps(m_idx)%source_mmr_a(spec_idx)
    1924           0 :       idx    = modes%comps(m_idx)%idx_mmr_a(spec_idx)
    1925           0 :    else if (phase == 'c') then
    1926           0 :       source = modes%comps(m_idx)%source_mmr_c(spec_idx)
    1927           0 :       idx    = modes%comps(m_idx)%idx_mmr_c(spec_idx)
    1928             :    else
    1929           0 :       write(iulog,*) subname//': phase= ', phase
    1930           0 :       call endrun(subname//': unrecognized phase; must be "a" or "c"')
    1931             :    end if
    1932             : 
    1933           0 :    lchnk = state%lchnk
    1934             : 
    1935           0 :    select case( source )
    1936             :    case ('A')
    1937           0 :       mmr => state%q(:,:,idx)
    1938             :    case ('N')
    1939           0 :       call pbuf_get_field(pbuf, idx, mmr)
    1940             :    case ('Z')
    1941           0 :       mmr => zero_cols
    1942             :    end select
    1943             : 
    1944           0 : end subroutine rad_cnst_get_mam_mmr_by_idx
    1945             : 
    1946             : !================================================================================================
    1947             : 
    1948           0 : subroutine rad_cnst_get_mam_mmr_idx(mode_idx, spec_idx, idx)
    1949             : 
    1950             :    ! Return constituent index of mam specie mass mixing ratio for aerosol modes in
    1951             :    ! the climate list.
    1952             : 
    1953             :    ! This is a special routine to allow direct access to information in the
    1954             :    ! constituent array inside physics parameterizations that have been passed,
    1955             :    ! and are operating over the entire constituent array.  The interstitial phase
    1956             :    ! is assumed since that's what is contained in the constituent array.
    1957             : 
    1958             :    ! Arguments
    1959             :    integer, intent(in)  :: mode_idx    ! mode index
    1960             :    integer, intent(in)  :: spec_idx    ! index of specie in the mode
    1961             :    integer, intent(out) :: idx         ! index of specie in the constituent array
    1962             : 
    1963             :    ! Local variables
    1964             :    integer :: m_idx
    1965             :    type(modelist_t), pointer :: mlist
    1966             :    character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_idx'
    1967             :    !-----------------------------------------------------------------------------
    1968             : 
    1969             :    ! assume climate list (i.e., species are in the constituent array)
    1970           0 :    mlist => ma_list(0)
    1971             : 
    1972             :    ! Check for valid mode index
    1973           0 :    if (mode_idx < 1  .or.  mode_idx > mlist%nmodes) then
    1974           0 :       write(iulog,*) subname//': mode_idx= ', mode_idx, '  nmodes= ', mlist%nmodes
    1975           0 :       call endrun(subname//': mode list index out of range')
    1976             :    end if
    1977             : 
    1978             :    ! Get the index for the corresponding mode in the mode definition object
    1979           0 :    m_idx = mlist%idx(mode_idx)
    1980             : 
    1981             :    ! Check for valid specie index
    1982           0 :    if (spec_idx < 1  .or.  spec_idx > modes%comps(m_idx)%nspec) then
    1983           0 :       write(iulog,*) subname//': spec_idx= ', spec_idx, '  nspec= ', modes%comps(m_idx)%nspec
    1984           0 :       call endrun(subname//': specie list index out of range')
    1985             :    end if
    1986             : 
    1987             :    ! Assume data source is interstitial since that's what's in the constituent array
    1988           0 :    idx    = modes%comps(m_idx)%idx_mmr_a(spec_idx)
    1989             : 
    1990           0 : end subroutine rad_cnst_get_mam_mmr_idx
    1991             : 
    1992             : !================================================================================================
    1993             : 
    1994           0 : subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num)
    1995             : 
    1996             :    ! Return pointer to number mixing ratio for the aerosol mode from the specified
    1997             :    ! climate or diagnostic list.
    1998             : 
    1999             :    ! Arguments
    2000             :    integer,                     intent(in) :: list_idx    ! index of the climate or a diagnostic list
    2001             :    integer,                     intent(in) :: mode_idx    ! mode index
    2002             :    character(len=1),            intent(in) :: phase       ! 'a' for interstitial, 'c' for cloud borne
    2003             :    type(physics_state), target, intent(in) :: state
    2004             :    type(physics_buffer_desc),   pointer    :: pbuf(:)
    2005             :    real(r8),                    pointer    :: num(:,:)
    2006             : 
    2007             :    ! Local variables
    2008             :    integer :: m_idx
    2009             :    integer :: idx
    2010             :    integer :: lchnk
    2011             :    character(len=1) :: source
    2012             :    type(modelist_t), pointer :: mlist
    2013             :    character(len=*), parameter :: subname = 'rad_cnst_get_mode_num'
    2014             :    !-----------------------------------------------------------------------------
    2015             : 
    2016           0 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
    2017           0 :       mlist => ma_list(list_idx)
    2018             :    else
    2019           0 :       write(iulog,*) subname//': list_idx =', list_idx
    2020           0 :       call endrun(subname//': list_idx out of bounds')
    2021             :    endif
    2022             : 
    2023             :    ! Check for valid mode index
    2024           0 :    if (mode_idx < 1  .or.  mode_idx > mlist%nmodes) then
    2025           0 :       write(iulog,*) subname//': mode_idx= ', mode_idx, '  nmodes= ', mlist%nmodes
    2026           0 :       call endrun(subname//': mode list index out of range')
    2027             :    end if
    2028             : 
    2029             :    ! Get the index for the corresponding mode in the mode definition object
    2030           0 :    m_idx = mlist%idx(mode_idx)
    2031             : 
    2032             :    ! Get data source
    2033           0 :    if (phase == 'a') then
    2034           0 :       source = modes%comps(m_idx)%source_num_a
    2035           0 :       idx    = modes%comps(m_idx)%idx_num_a
    2036           0 :    else if (phase == 'c') then
    2037           0 :       source = modes%comps(m_idx)%source_num_c
    2038           0 :       idx    = modes%comps(m_idx)%idx_num_c
    2039             :    else
    2040           0 :       write(iulog,*) subname//': phase= ', phase
    2041           0 :       call endrun(subname//': unrecognized phase; must be "a" or "c"')
    2042             :    end if
    2043             : 
    2044           0 :    lchnk = state%lchnk
    2045             : 
    2046           0 :    select case( source )
    2047             :    case ('A')
    2048           0 :       num => state%q(:,:,idx)
    2049             :    case ('N')
    2050           0 :       call pbuf_get_field(pbuf, idx, num)
    2051             :    case ('Z')
    2052           0 :       num => zero_cols
    2053             :    end select
    2054             : 
    2055           0 : end subroutine rad_cnst_get_mode_num
    2056             : 
    2057             : !================================================================================================
    2058             : 
    2059           0 : subroutine rad_cnst_get_mode_num_idx(mode_idx, cnst_idx)
    2060             : 
    2061             :    ! Return constituent index of mode number mixing ratio for the aerosol mode in
    2062             :    ! the climate list.
    2063             : 
    2064             :    ! This is a special routine to allow direct access to information in the
    2065             :    ! constituent array inside physics parameterizations that have been passed,
    2066             :    ! and are operating over the entire constituent array.  The interstitial phase
    2067             :    ! is assumed since that's what is contained in the constituent array.
    2068             : 
    2069             :    ! Arguments
    2070             :    integer,  intent(in)  :: mode_idx    ! mode index
    2071             :    integer,  intent(out) :: cnst_idx    ! constituent index
    2072             : 
    2073             :    ! Local variables
    2074             :    integer :: m_idx
    2075             :    character(len=1) :: source
    2076             :    type(modelist_t), pointer :: mlist
    2077             :    character(len=*), parameter :: subname = 'rad_cnst_get_mode_num'
    2078             :    !-----------------------------------------------------------------------------
    2079             : 
    2080             :    ! assume climate list
    2081           0 :    mlist => ma_list(0)
    2082             : 
    2083             :    ! Check for valid mode index
    2084           0 :    if (mode_idx < 1  .or.  mode_idx > mlist%nmodes) then
    2085           0 :       write(iulog,*) subname//': mode_idx= ', mode_idx, '  nmodes= ', mlist%nmodes
    2086           0 :       call endrun(subname//': mode list index out of range')
    2087             :    end if
    2088             : 
    2089             :    ! Get the index for the corresponding mode in the mode definition object
    2090           0 :    m_idx = mlist%idx(mode_idx)
    2091             : 
    2092             :    ! Check that source is 'A' which means the index is for the constituent array
    2093           0 :    source = modes%comps(m_idx)%source_num_a
    2094           0 :    if (source /= 'A') then
    2095           0 :       write(iulog,*) subname//': source= ', source
    2096           0 :       call endrun(subname//': requested mode number index not in constituent array')
    2097             :    end if
    2098             : 
    2099             :    ! Return index in constituent array
    2100           0 :    cnst_idx = modes%comps(m_idx)%idx_num_a
    2101             : 
    2102           0 : end subroutine rad_cnst_get_mode_num_idx
    2103             : 
    2104             : !================================================================================================
    2105             : 
    2106             : integer function rad_cnst_get_aer_idx(list_idx, aer_name)
    2107             : 
    2108             :    ! Return the index of aerosol aer_name in the list specified by list_idx.
    2109             : 
    2110             :     ! Arguments
    2111             :    integer,             intent(in) :: list_idx    ! 0 for climate list, 1-N_DIAG for diagnostic lists
    2112             :    character(len=*),    intent(in) :: aer_name    ! aerosol name (in state or pbuf)
    2113             : 
    2114             :    ! Local variables
    2115             :    integer :: i, aer_idx
    2116             :    type(aerlist_t), pointer :: aerlist
    2117             :    character(len=*), parameter :: subname = "rad_cnst_get_aer_idx"
    2118             :    !-------------------------------------------------------------------------
    2119             : 
    2120             :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
    2121             :       aerlist => aerosollist(list_idx)
    2122             :    else
    2123             :       write(iulog,*) subname//': list_idx =', list_idx
    2124             :       call endrun(subname//': list_idx out of bounds')
    2125             :    endif
    2126             : 
    2127             :    ! Get index in aerosol list for requested name
    2128             :    aer_idx = -1
    2129             :    do i = 1, aerlist%numaerosols
    2130             :       if (trim(aer_name) == trim(aerlist%aer(i)%camname)) then
    2131             :          aer_idx = i
    2132             :          exit
    2133             :       end if
    2134             :    end do
    2135             : 
    2136             :    if (aer_idx == -1) call endrun(subname//": ERROR - name not found")
    2137             : 
    2138             :    rad_cnst_get_aer_idx = aer_idx
    2139             : 
    2140             : end function rad_cnst_get_aer_idx
    2141             : 
    2142             : !================================================================================================
    2143             : 
    2144           0 : subroutine rad_cnst_get_aer_props_by_idx(list_idx, &
    2145           0 :    aer_idx,  opticstype, &
    2146             :    sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, &
    2147             :    sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, &
    2148             :    sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, &
    2149             :    refindex_aer_sw, refindex_aer_lw, &
    2150             :    r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, &
    2151           0 :    aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, num_to_mass_aer)
    2152             : 
    2153             :    ! Return requested properties for the aerosol from the specified
    2154             :    ! climate or diagnostic list.
    2155             : 
    2156             :    use phys_prop, only: physprop_get
    2157             : 
    2158             : 
    2159             :    ! Arguments
    2160             :    integer,                     intent(in)  :: list_idx ! index of the climate or a diagnostic list
    2161             :    integer,                     intent(in)  :: aer_idx  ! index of the aerosol
    2162             :    character(len=ot_length), optional, intent(out) :: opticstype
    2163             :    real(r8),          optional, pointer     :: sw_hygro_ext(:,:)
    2164             :    real(r8),          optional, pointer     :: sw_hygro_ssa(:,:)
    2165             :    real(r8),          optional, pointer     :: sw_hygro_asm(:,:)
    2166             :    real(r8),          optional, pointer     :: lw_hygro_ext(:,:)
    2167             :    real(r8),          optional, pointer     :: sw_nonhygro_ext(:)
    2168             :    real(r8),          optional, pointer     :: sw_nonhygro_ssa(:)
    2169             :    real(r8),          optional, pointer     :: sw_nonhygro_asm(:)
    2170             :    real(r8),          optional, pointer     :: sw_nonhygro_scat(:)
    2171             :    real(r8),          optional, pointer     :: sw_nonhygro_ascat(:)
    2172             :    real(r8),          optional, pointer     :: lw_ext(:)
    2173             :    complex(r8),       optional, pointer     :: refindex_aer_sw(:)
    2174             :    complex(r8),       optional, pointer     :: refindex_aer_lw(:)
    2175             :    character(len=20), optional, intent(out) :: aername
    2176             :    real(r8),          optional, intent(out) :: density_aer
    2177             :    real(r8),          optional, intent(out) :: hygro_aer
    2178             :    real(r8),          optional, intent(out) :: dryrad_aer
    2179             :    real(r8),          optional, intent(out) :: dispersion_aer
    2180             :    real(r8),          optional, intent(out) :: num_to_mass_aer
    2181             : 
    2182             :    real(r8),          optional, pointer     :: r_sw_ext(:,:)
    2183             :    real(r8),          optional, pointer     :: r_sw_scat(:,:)
    2184             :    real(r8),          optional, pointer     :: r_sw_ascat(:,:)
    2185             :    real(r8),          optional, pointer     :: r_lw_abs(:,:)
    2186             :    real(r8),          optional, pointer     :: mu(:)
    2187             : 
    2188             :    ! Local variables
    2189             :    integer :: id
    2190             :    character(len=*), parameter :: subname = 'rad_cnst_get_aer_props_by_idx'
    2191             :    type(aerlist_t), pointer :: aerlist
    2192             :    !------------------------------------------------------------------------------------
    2193             : 
    2194           0 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
    2195           0 :       aerlist => aerosollist(list_idx)
    2196             :    else
    2197           0 :       write(iulog,*) subname//': list_idx = ', list_idx
    2198           0 :       call endrun(subname//': list_idx out of range')
    2199             :    endif
    2200             : 
    2201           0 :    if (aer_idx < 1 .or. aer_idx > aerlist%numaerosols) then
    2202           0 :       write(iulog,*) subname//': aerosol list index out of range: ', aer_idx ,' list index: ',list_idx
    2203           0 :       call endrun(subname//': aer_idx out of range')
    2204             :    end if
    2205             : 
    2206           0 :    id = aerlist%aer(aer_idx)%physprop_id
    2207             : 
    2208           0 :    if (present(opticstype))        call physprop_get(id, opticstype=opticstype)
    2209             : 
    2210           0 :    if (present(sw_hygro_ext))      call physprop_get(id, sw_hygro_ext=sw_hygro_ext)
    2211           0 :    if (present(sw_hygro_ssa))      call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa)
    2212           0 :    if (present(sw_hygro_asm))      call physprop_get(id, sw_hygro_asm=sw_hygro_asm)
    2213           0 :    if (present(lw_hygro_ext))      call physprop_get(id, lw_hygro_abs=lw_hygro_ext)
    2214             : 
    2215           0 :    if (present(sw_nonhygro_ext))   call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext)
    2216           0 :    if (present(sw_nonhygro_ssa))   call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa)
    2217           0 :    if (present(sw_nonhygro_asm))   call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm)
    2218           0 :    if (present(sw_nonhygro_scat))  call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat)
    2219           0 :    if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat)
    2220           0 :    if (present(lw_ext))            call physprop_get(id, lw_abs=lw_ext)
    2221             : 
    2222           0 :    if (present(refindex_aer_sw))   call physprop_get(id, refindex_aer_sw=refindex_aer_sw)
    2223           0 :    if (present(refindex_aer_lw))   call physprop_get(id, refindex_aer_lw=refindex_aer_lw)
    2224             : 
    2225           0 :    if (present(aername))           call physprop_get(id, aername=aername)
    2226           0 :    if (present(density_aer))       call physprop_get(id, density_aer=density_aer)
    2227           0 :    if (present(hygro_aer))         call physprop_get(id, hygro_aer=hygro_aer)
    2228           0 :    if (present(dryrad_aer))        call physprop_get(id, dryrad_aer=dryrad_aer)
    2229           0 :    if (present(dispersion_aer))    call physprop_get(id, dispersion_aer=dispersion_aer)
    2230           0 :    if (present(num_to_mass_aer))   call physprop_get(id, num_to_mass_aer=num_to_mass_aer)
    2231             : 
    2232           0 :    if (present(r_lw_abs))          call physprop_get(id, r_lw_abs=r_lw_abs)
    2233           0 :    if (present(r_sw_ext))          call physprop_get(id, r_sw_ext=r_sw_ext)
    2234           0 :    if (present(r_sw_scat))         call physprop_get(id, r_sw_scat=r_sw_scat)
    2235           0 :    if (present(r_sw_ascat))        call physprop_get(id, r_sw_ascat=r_sw_ascat)
    2236           0 :    if (present(mu))                call physprop_get(id, mu=mu)
    2237             : 
    2238           0 : end subroutine rad_cnst_get_aer_props_by_idx
    2239             : 
    2240             : !================================================================================================
    2241             : 
    2242           0 : subroutine rad_cnst_get_mam_props_by_idx(list_idx, &
    2243           0 :    mode_idx, spec_idx,  opticstype, &
    2244             :    sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, &
    2245             :    sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, &
    2246             :    sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, &
    2247             :    refindex_aer_sw, refindex_aer_lw, &
    2248             :    r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, &
    2249           0 :    aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, &
    2250           0 :    num_to_mass_aer, spectype)
    2251             : 
    2252             :    ! Return requested properties for the aerosol from the specified
    2253             :    ! climate or diagnostic list.
    2254             : 
    2255           0 :    use phys_prop, only: physprop_get
    2256             : 
    2257             :    ! Arguments
    2258             :    integer,                     intent(in)  :: list_idx  ! index of the climate or a diagnostic list
    2259             :    integer,                     intent(in)  :: mode_idx  ! mode index
    2260             :    integer,                     intent(in)  :: spec_idx  ! index of specie in the mode
    2261             :    character(len=ot_length), optional, intent(out) :: opticstype
    2262             :    real(r8),          optional, pointer     :: sw_hygro_ext(:,:)
    2263             :    real(r8),          optional, pointer     :: sw_hygro_ssa(:,:)
    2264             :    real(r8),          optional, pointer     :: sw_hygro_asm(:,:)
    2265             :    real(r8),          optional, pointer     :: lw_hygro_ext(:,:)
    2266             :    real(r8),          optional, pointer     :: sw_nonhygro_ext(:)
    2267             :    real(r8),          optional, pointer     :: sw_nonhygro_ssa(:)
    2268             :    real(r8),          optional, pointer     :: sw_nonhygro_asm(:)
    2269             :    real(r8),          optional, pointer     :: sw_nonhygro_scat(:)
    2270             :    real(r8),          optional, pointer     :: sw_nonhygro_ascat(:)
    2271             :    real(r8),          optional, pointer     :: lw_ext(:)
    2272             :    complex(r8),       optional, pointer     :: refindex_aer_sw(:)
    2273             :    complex(r8),       optional, pointer     :: refindex_aer_lw(:)
    2274             : 
    2275             :    real(r8),          optional, pointer     :: r_sw_ext(:,:)
    2276             :    real(r8),          optional, pointer     :: r_sw_scat(:,:)
    2277             :    real(r8),          optional, pointer     :: r_sw_ascat(:,:)
    2278             :    real(r8),          optional, pointer     :: r_lw_abs(:,:)
    2279             :    real(r8),          optional, pointer     :: mu(:)
    2280             : 
    2281             :    character(len=20), optional, intent(out) :: aername
    2282             :    real(r8),          optional, intent(out) :: density_aer
    2283             :    real(r8),          optional, intent(out) :: hygro_aer
    2284             :    real(r8),          optional, intent(out) :: dryrad_aer
    2285             :    real(r8),          optional, intent(out) :: dispersion_aer
    2286             :    real(r8),          optional, intent(out) :: num_to_mass_aer
    2287             :    character(len=32), optional, intent(out) :: spectype
    2288             : 
    2289             :    ! Local variables
    2290             :    integer :: m_idx, id
    2291             :    type(modelist_t), pointer :: mlist
    2292             :    character(len=*), parameter :: subname = 'rad_cnst_get_mam_props_by_idx'
    2293             :    !------------------------------------------------------------------------------------
    2294             : 
    2295           0 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
    2296           0 :       mlist => ma_list(list_idx)
    2297             :    else
    2298           0 :       write(iulog,*) subname//': list_idx = ', list_idx
    2299           0 :       call endrun(subname//': list_idx out of range')
    2300             :    endif
    2301             : 
    2302             :    ! Check for valid mode index
    2303           0 :    if (mode_idx < 1  .or.  mode_idx > mlist%nmodes) then
    2304           0 :       write(iulog,*) subname//': mode_idx= ', mode_idx, '  nmodes= ', mlist%nmodes
    2305           0 :       call endrun(subname//': mode list index out of range')
    2306             :    end if
    2307             : 
    2308             :    ! Get the index for the corresponding mode in the mode definition object
    2309           0 :    m_idx = mlist%idx(mode_idx)
    2310             : 
    2311             :    ! Check for valid specie index
    2312           0 :    if (spec_idx < 1  .or.  spec_idx > modes%comps(m_idx)%nspec) then
    2313           0 :       write(iulog,*) subname//': spec_idx= ', spec_idx, '  nspec= ', modes%comps(m_idx)%nspec
    2314           0 :       call endrun(subname//': specie list index out of range')
    2315             :    end if
    2316             : 
    2317           0 :    id = modes%comps(m_idx)%idx_props(spec_idx)
    2318             : 
    2319           0 :    if (present(opticstype))        call physprop_get(id, opticstype=opticstype)
    2320             : 
    2321           0 :    if (present(sw_hygro_ext))      call physprop_get(id, sw_hygro_ext=sw_hygro_ext)
    2322           0 :    if (present(sw_hygro_ssa))      call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa)
    2323           0 :    if (present(sw_hygro_asm))      call physprop_get(id, sw_hygro_asm=sw_hygro_asm)
    2324           0 :    if (present(lw_hygro_ext))      call physprop_get(id, lw_hygro_abs=lw_hygro_ext)
    2325             : 
    2326           0 :    if (present(sw_nonhygro_ext))   call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext)
    2327           0 :    if (present(sw_nonhygro_ssa))   call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa)
    2328           0 :    if (present(sw_nonhygro_asm))   call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm)
    2329           0 :    if (present(sw_nonhygro_scat))  call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat)
    2330           0 :    if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat)
    2331           0 :    if (present(lw_ext))            call physprop_get(id, lw_abs=lw_ext)
    2332             : 
    2333           0 :    if (present(refindex_aer_sw))   call physprop_get(id, refindex_aer_sw=refindex_aer_sw)
    2334           0 :    if (present(refindex_aer_lw))   call physprop_get(id, refindex_aer_lw=refindex_aer_lw)
    2335             : 
    2336           0 :    if (present(r_lw_abs))          call physprop_get(id, r_lw_abs=r_lw_abs)
    2337           0 :    if (present(r_sw_ext))          call physprop_get(id, r_sw_ext=r_sw_ext)
    2338           0 :    if (present(r_sw_scat))         call physprop_get(id, r_sw_scat=r_sw_scat)
    2339           0 :    if (present(r_sw_ascat))        call physprop_get(id, r_sw_ascat=r_sw_ascat)
    2340           0 :    if (present(mu))                call physprop_get(id, mu=mu)
    2341             : 
    2342           0 :    if (present(aername))           call physprop_get(id, aername=aername)
    2343           0 :    if (present(density_aer))       call physprop_get(id, density_aer=density_aer)
    2344           0 :    if (present(hygro_aer))         call physprop_get(id, hygro_aer=hygro_aer)
    2345           0 :    if (present(dryrad_aer))        call physprop_get(id, dryrad_aer=dryrad_aer)
    2346           0 :    if (present(dispersion_aer))    call physprop_get(id, dispersion_aer=dispersion_aer)
    2347           0 :    if (present(num_to_mass_aer))   call physprop_get(id, num_to_mass_aer=num_to_mass_aer)
    2348             : 
    2349           0 :    if (present(spectype)) spectype = modes%comps(m_idx)%type(spec_idx)
    2350             : 
    2351           0 : end subroutine rad_cnst_get_mam_props_by_idx
    2352             : 
    2353             : !================================================================================================
    2354             : 
    2355           0 : subroutine rad_cnst_get_mode_props(list_idx, mode_idx, opticstype, &
    2356             :    extpsw, abspsw, asmpsw, absplw, refrtabsw, &
    2357             :    refitabsw, refrtablw, refitablw, ncoef, prefr, &
    2358             :    prefi, sigmag, dgnum, dgnumlo, dgnumhi, &
    2359             :    rhcrystal, rhdeliques)
    2360             : 
    2361             :    ! Return requested properties for the mode from the specified
    2362             :    ! climate or diagnostic list.
    2363             : 
    2364           0 :    use phys_prop, only: physprop_get
    2365             : 
    2366             :    ! Arguments
    2367             :    integer,             intent(in)  :: list_idx  ! index of the climate or a diagnostic list
    2368             :    integer,             intent(in)  :: mode_idx  ! mode index
    2369             :    character(len=ot_length), optional, intent(out) :: opticstype
    2370             :    real(r8),  optional, pointer     :: extpsw(:,:,:,:)
    2371             :    real(r8),  optional, pointer     :: abspsw(:,:,:,:)
    2372             :    real(r8),  optional, pointer     :: asmpsw(:,:,:,:)
    2373             :    real(r8),  optional, pointer     :: absplw(:,:,:,:)
    2374             :    real(r8),  optional, pointer     :: refrtabsw(:,:)
    2375             :    real(r8),  optional, pointer     :: refitabsw(:,:)
    2376             :    real(r8),  optional, pointer     :: refrtablw(:,:)
    2377             :    real(r8),  optional, pointer     :: refitablw(:,:)
    2378             :    integer,   optional, intent(out) :: ncoef
    2379             :    integer,   optional, intent(out) :: prefr
    2380             :    integer,   optional, intent(out) :: prefi
    2381             :    real(r8),  optional, intent(out) :: sigmag
    2382             :    real(r8),  optional, intent(out) :: dgnum
    2383             :    real(r8),  optional, intent(out) :: dgnumlo
    2384             :    real(r8),  optional, intent(out) :: dgnumhi
    2385             :    real(r8),  optional, intent(out) :: rhcrystal
    2386             :    real(r8),  optional, intent(out) :: rhdeliques
    2387             : 
    2388             :    ! Local variables
    2389             :    integer :: id
    2390             :    type(modelist_t), pointer :: mlist
    2391             :    character(len=*), parameter :: subname = 'rad_cnst_get_mode_props'
    2392             :    !------------------------------------------------------------------------------------
    2393             : 
    2394           0 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
    2395           0 :       mlist => ma_list(list_idx)
    2396             :    else
    2397           0 :       write(iulog,*) subname//': list_idx = ', list_idx
    2398           0 :       call endrun(subname//': list_idx out of range')
    2399             :    endif
    2400             : 
    2401             :    ! Check for valid mode index
    2402           0 :    if (mode_idx < 1  .or.  mode_idx > mlist%nmodes) then
    2403           0 :       write(iulog,*) subname//': mode_idx= ', mode_idx, '  nmodes= ', mlist%nmodes
    2404           0 :       call endrun(subname//': mode list index out of range')
    2405             :    end if
    2406             : 
    2407             :    ! Get the physprop index for the requested mode
    2408           0 :    id = mlist%idx_props(mode_idx)
    2409             : 
    2410           0 :    if (present(opticstype))  call physprop_get(id, opticstype=opticstype)
    2411           0 :    if (present(extpsw))      call physprop_get(id, extpsw=extpsw)
    2412           0 :    if (present(abspsw))      call physprop_get(id, abspsw=abspsw)
    2413           0 :    if (present(asmpsw))      call physprop_get(id, asmpsw=asmpsw)
    2414           0 :    if (present(absplw))      call physprop_get(id, absplw=absplw)
    2415             : 
    2416           0 :    if (present(refrtabsw))   call physprop_get(id, refrtabsw=refrtabsw)
    2417           0 :    if (present(refitabsw))   call physprop_get(id, refitabsw=refitabsw)
    2418           0 :    if (present(refrtablw))   call physprop_get(id, refrtablw=refrtablw)
    2419           0 :    if (present(refitablw))   call physprop_get(id, refitablw=refitablw)
    2420             : 
    2421           0 :    if (present(ncoef))       call physprop_get(id, ncoef=ncoef)
    2422           0 :    if (present(prefr))       call physprop_get(id, prefr=prefr)
    2423           0 :    if (present(prefi))       call physprop_get(id, prefi=prefi)
    2424           0 :    if (present(sigmag))      call physprop_get(id, sigmag=sigmag)
    2425           0 :    if (present(dgnum))       call physprop_get(id, dgnum=dgnum)
    2426           0 :    if (present(dgnumlo))     call physprop_get(id, dgnumlo=dgnumlo)
    2427           0 :    if (present(dgnumhi))     call physprop_get(id, dgnumhi=dgnumhi)
    2428           0 :    if (present(rhcrystal))   call physprop_get(id, rhcrystal=rhcrystal)
    2429           0 :    if (present(rhdeliques))  call physprop_get(id, rhdeliques=rhdeliques)
    2430             : 
    2431           0 : end subroutine rad_cnst_get_mode_props
    2432             : 
    2433             : !================================================================================================
    2434             : 
    2435           2 : subroutine print_modes(modes)
    2436             : 
    2437             :    type(modes_t), intent(inout) :: modes
    2438             : 
    2439             :    integer :: i, m
    2440             :    !---------------------------------------------------------------------------------------------
    2441             : 
    2442           2 :    write(iulog,*)' Mode Definitions'
    2443             : 
    2444           2 :    do m = 1, modes%nmodes
    2445             : 
    2446           0 :       write(iulog,*) nl//' name=',trim(modes%names(m)),'  type=',trim(modes%types(m))
    2447           0 :       write(iulog,*) ' src_a=',trim(modes%comps(m)%source_num_a),'  num_a=',trim(modes%comps(m)%camname_num_a), &
    2448           0 :                      ' src_c=',trim(modes%comps(m)%source_num_c),'  num_c=',trim(modes%comps(m)%camname_num_c)
    2449             : 
    2450           2 :       do i = 1, modes%comps(m)%nspec
    2451             : 
    2452           0 :          write(iulog,*) ' src_a=',trim(modes%comps(m)%source_mmr_a(i)), '  mmr_a=',trim(modes%comps(m)%camname_mmr_a(i)), &
    2453           0 :                        '  src_c=',trim(modes%comps(m)%source_mmr_c(i)), '  mmr_c=',trim(modes%comps(m)%camname_mmr_c(i)), &
    2454           0 :                        '  type=',trim(modes%comps(m)%type(i))
    2455           0 :          write(iulog,*) '     prop file=', trim(modes%comps(m)%props(i))
    2456             :       end do
    2457             : 
    2458             :    end do
    2459             : 
    2460           0 : end subroutine print_modes
    2461             : 
    2462             : !================================================================================================
    2463             : 
    2464           2 : subroutine print_lists(gas_list, aer_list, ma_list)
    2465             : 
    2466             :    ! Print summary of gas, bulk and modal aerosol lists.  This is just the information
    2467             :    ! read from the namelist.
    2468             : 
    2469             :    use radconstants, only: gascnst=>gaslist
    2470             : 
    2471             :    type(aerlist_t),  intent(in) :: aer_list
    2472             :    type(gaslist_t),  intent(in) :: gas_list
    2473             :    type(modelist_t), intent(in) :: ma_list
    2474             : 
    2475             :    integer :: i, id
    2476             : 
    2477           2 :    if (len_trim(gas_list%list_id) == 0) then
    2478           2 :       write(iulog,*) nl//' gas list for climate calculations'
    2479             :    else
    2480           0 :       write(iulog,*) nl//' gas list for diag'//gas_list%list_id//' calculations'
    2481             :    end if
    2482             : 
    2483          18 :    do i = 1, nradgas
    2484          18 :       if (gas_list%gas(i)%source .eq. 'N') then
    2485          14 :          write(iulog,*) '  '//gas_list%gas(i)%source//':'//gascnst(i)//' has pbuf name:'//&
    2486          28 :                         trim(gas_list%gas(i)%camname)
    2487           2 :       else if (gas_list%gas(i)%source .eq. 'A') then
    2488           2 :          write(iulog,*) '  '//gas_list%gas(i)%source//':'//gascnst(i)//' has constituents name:'//&
    2489           4 :                         trim(gas_list%gas(i)%camname)
    2490             :       endif
    2491             :    enddo
    2492             : 
    2493           2 :    if (len_trim(aer_list%list_id) == 0) then
    2494           2 :       write(iulog,*) nl//' bulk aerosol list for climate calculations'
    2495             :    else
    2496           0 :       write(iulog,*) nl//' bulk aerosol list for diag'//aer_list%list_id//' calculations'
    2497             :    end if
    2498             : 
    2499           2 :    do i = 1, aer_list%numaerosols
    2500           0 :       write(iulog,*) '  '//trim(aer_list%aer(i)%source)//':'//trim(aer_list%aer(i)%camname)//&
    2501           2 :                      ' optics and phys props in :'//trim(aer_list%aer(i)%physprop_file)
    2502             :    enddo
    2503             : 
    2504           2 :    if (len_trim(ma_list%list_id) == 0) then
    2505           2 :       write(iulog,*) nl//' modal aerosol list for climate calculations'
    2506             :    else
    2507           0 :       write(iulog,*) nl//' modal aerosol list for diag'//ma_list%list_id//' calculations'
    2508             :    end if
    2509             : 
    2510           2 :    do i = 1, ma_list%nmodes
    2511           0 :       id = ma_list%idx(i)
    2512           2 :       write(iulog,*) '  '//trim(modes%names(id))
    2513             :    enddo
    2514             : 
    2515           2 : end subroutine print_lists
    2516             : 
    2517             : !================================================================================================
    2518             : 
    2519           0 : end module rad_constituents