LCOV - code coverage report
Current view: | top level - physics/cam - rad_constituents.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 605 | 785 | 77.1 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 29 | 41 | 70.7 %

              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        7680 :    do i = 1, modes%nmodes
         366       12288 :       allocate(ctype(modes%comps(i)%nspec))
         367       29184 :       ctype = 'A'
         368        6144 :       call physprop_accum_unique_files(modes%comps(i)%props, ctype)
         369        7680 :       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     2429952 :    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     9083192 : 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     9083192 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
         468     9083192 :       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     9083192 :    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     9083192 :    igas = rad_gas_index(trim(gasname))
         479             :
         480             :    ! Get data source
         481     9083192 :    source = list%gas(igas)%source
         482     9083192 :    idx    = list%gas(igas)%idx
         483     5676995 :    select case( source )
         484             :    case ('A')
         485     5676995 :       mmr => state%q(:,:,idx)
         486             :    case ('N')
         487     3406197 :       call pbuf_get_field(pbuf, idx, mmr)
         488             :    case ('Z')
         489     9083192 :       mmr => zero_cols
         490             :    end select
         491             :
         492     9083192 : 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    16424064 : 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    16424064 :    g_list => gaslist(list_idx)
         577    16424064 :    a_list => aerosollist(list_idx)
         578    16424064 :    m_list => ma_list(list_idx)
         579             :
         580             :    ! number of bulk aerosols in list
         581    16424064 :    if (present(naero)) then
         582     1493808 :       naero = a_list%numaerosols
         583             :    endif
         584             :
         585             :    ! number of aerosol modes in list
         586    16424064 :    if (present(nmodes)) then
         587    16422528 :       nmodes = m_list%nmodes
         588             :    endif
         589             :
         590             :    ! number of gases in list
         591    16424064 :    if (present(ngas)) then
         592           0 :       ngas = g_list%ngas
         593             :    endif
         594             :
         595             :    ! names of aerosols in list
         596    16424064 :    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        6144 :       do i = 1, a_list%numaerosols
         606        6144 :          aernames(i) = a_list%aer(i)%camname
         607             :       end do
         608             :
         609             :    end if
         610             :
         611             :    ! names of gas in list
         612    16424064 :    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    16424064 :    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    16424064 : end subroutine rad_cnst_get_info
         641             :
         642             : !================================================================================================
         643             :
         644 49937302520 : 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 49937302520 :    m_list => ma_list(list_idx)
         667             :
         668             :    ! check for valid mode index
         669 49937302520 :    nmodes = m_list%nmodes
         670 49937302520 :    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 49937302520 :    mm = m_list%idx(m_idx)
         677             :
         678             :    ! mode type
         679 49937302520 :    if (present(mode_type)) then
         680 37027470584 :       mode_type = modes%types(mm)
         681             :    endif
         682             :
         683             :    ! number of species in the mode
         684 49937302520 :    if (present(nspec)) then
         685 12704941344 :       nspec = modes%comps(mm)%nspec
         686             :    endif
         687             :
         688             :    ! name of interstitial number mixing ratio
         689 49937302520 :    if (present(num_name)) then
         690   204902880 :       num_name = modes%comps(mm)%camname_num_a
         691             :    endif
         692             :
         693             :    ! name of cloud borne number mixing ratio
         694 49937302520 :    if (present(num_name_cw)) then
         695   204901344 :       num_name_cw = modes%comps(mm)%camname_num_c
         696             :    endif
         697             :
         698    16424064 : end subroutine rad_cnst_get_info_by_mode
         699             :
         700             : !================================================================================================
         701             :
         702 66026092819 : 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 66026092819 :    m_list => ma_list(list_idx)
         726             :
         727             :    ! check for valid mode index
         728 66026092819 :    nmodes = m_list%nmodes
         729 66026092819 :    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 66026092819 :    mm = m_list%idx(m_idx)
         736             :
         737             :    ! check for valid specie index
         738 66026092819 :    nspec = modes%comps(mm)%nspec
         739 66026092819 :    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 66026092819 :    if (present(spec_type)) then
         746 65257563787 :       spec_type = modes%comps(mm)%type(s_idx)
         747             :    endif
         748             :
         749             :    ! interstitial specie name
         750 66026092819 :    if (present(spec_name)) then
         751   768549000 :       spec_name = modes%comps(mm)%camname_mmr_a(s_idx)
         752             :    endif
         753             :
         754             :    ! cloud borne specie name
         755 66026092819 :    if (present(spec_name_cw)) then
         756    67082040 :       spec_name_cw = modes%comps(mm)%camname_mmr_c(s_idx)
         757             :    endif
         758             :
         759 49937302520 : 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 66026092819 : end subroutine rad_cnst_get_info_by_spectype
         817             :
         818             : !================================================================================================
         819             :
         820        1536 : 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        1536 :    mode_idx = -1
         842             :
         843             :    ! specified mode list
         844        1536 :    m_list => ma_list(list_idx)
         845             :
         846             :    ! number of modes in specified list
         847        1536 :    nmodes = m_list%nmodes
         848             :
         849             :    ! loop through modes in specified climate/diagnostic list
         850        7680 :    do i = 1, nmodes
         851             :
         852             :       ! get index of the mode in the definition object
         853        6144 :       m_idx = m_list%idx(i)
         854             :
         855             :       ! look in mode definition object (modes) for the mode types
         856        7680 :       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        1536 : 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        3072 : 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        3072 :    call_list(:) = active_calls(:)
         926             :
         927        3072 : end subroutine rad_cnst_get_call_list
         928             :
         929             : !================================================================================================
         930             :
         931      746136 : 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      746136 :    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      746136 :    lchnk = state%lchnk
         956      746136 :    ncol  = state%ncol
         957             :
         958             :    ! Associate pointer with requested aerosol list
         959      746136 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
         960      746136 :       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      746136 :    naer = aerlist%numaerosols
         967     2984544 :    do i = 1, naer
         968             :
         969     2238408 :       source = aerlist%aer(i)%source
         970     2238408 :       idx    = aerlist%aer(i)%idx
         971     2238408 :       name   = aerlist%aer(i)%mass_name
         972             :       ! construct name for column burden field by replacing the 'm_' prefix by 'cb_'
         973     2238408 :       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     2238408 :          call pbuf_get_field(pbuf, idx, mmr)
         980             :       end select
         981             :
         982  3478225752 :       mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga
         983     2238408 :       call outfld(trim(name), mass, pcols, lchnk)
         984             :
         985  3305191608 :       cb(:ncol) = sum(mass(:ncol,:),2)
         986     2984544 :       call outfld(trim(cbname), cb, pcols, lchnk)
         987             :
         988             :    end do
         989             :
         990             :    ! Associate pointer with requested gas list
         991      746136 :    g_list => gaslist(list_idx)
         992             :
         993      746136 :    ngas = g_list%ngas
         994     6715224 :    do i = 1, ngas
         995             :
         996     5969088 :       source = g_list%gas(i)%source
         997     5969088 :       idx    = g_list%gas(i)%idx
         998     5969088 :       name   = g_list%gas(i)%mass_name
         999     5969088 :       cbname = 'cb_' // name(3:len_trim(name))
        1000     3730680 :       select case( source )
        1001             :       case ('A')
        1002     3730680 :          mmr => state%q(:,:,idx)
        1003             :       case ('N')
        1004     5969088 :          call pbuf_get_field(pbuf, idx, mmr)
        1005             :       end select
        1006             :
        1007  9275268672 :       mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga
        1008     5969088 :       call outfld(trim(name), mass, pcols, lchnk)
        1009             :
        1010  8813844288 :       cb(:ncol) = sum(mass(:ncol,:),2)
        1011     6715224 :       call outfld(trim(cbname), cb, pcols, lchnk)
        1012             :
        1013             :    end do
        1014             :
        1015      746136 : 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        7680 :    do m = 1, modes%nmodes
        1036             :
        1037             :       ! indices for number mixing ratio components
        1038        6144 :       modes%comps(m)%idx_num_a = get_cam_idx(modes%comps(m)%source_num_a, modes%comps(m)%camname_num_a, routine)
        1039        6144 :       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        6144 :       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       30720 :          modes%comps(m)%idx_props(nspec)  )
        1047             :
        1048       30720 :       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       23040 :                                                    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       23040 :                                                    modes%comps(m)%camname_mmr_c(ispec), routine)
        1055             :
        1056             :          ! get physprop ID
        1057       23040 :          modes%comps(m)%idx_props(ispec) = physprop_get_id(modes%comps(m)%props(ispec))
        1058       29184 :          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       75264 : 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       75264 :    if (source(1:1) == 'N') then
        1084             :
        1085       38400 :       idx = pbuf_get_index(trim(name),errcode)
        1086       38400 :       if (errcode < 0) then
        1087           0 :          call endrun(routine//' ERROR: cannot find physics buffer field '//trim(name))
        1088             :       end if
        1089             :
        1090       36864 :    else if (source(1:1) == 'A') then
        1091             :
        1092       36864 :       call cnst_get_ind(trim(name), idx, abort=.false.)
        1093       36864 :       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       75264 :    get_cam_idx = idx
        1108             :
        1109       75264 : 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       24576 :    do ii = 1, namelist%ncnst
        1142       23040 :       if (trim(namelist%type(ii)) == 'A') naero  = naero + 1
        1143       24576 :       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       15360 :       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       24576 :    do ii = 1, namelist%ncnst
        1170             :
        1171       23040 :       if (masterproc .and. verbose) &
        1172           0 :          write(iulog,*) "  rad namelist spec: "// trim(namelist%source(ii)) &
        1173          30 :          //":"//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       23040 :           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       24576 :       if (namelist%type(ii) == 'A') then
        1184             :
        1185             :          ! Add to bulk aerosol list
        1186        4608 :          ba_idx = ba_idx + 1
        1187             :
        1188        4608 :          aerlist%aer(ba_idx)%source        = namelist%source(ii)
        1189        4608 :          aerlist%aer(ba_idx)%camname       = namelist%camname(ii)
        1190        4608 :          aerlist%aer(ba_idx)%physprop_file = namelist%radname(ii)
        1191             :
        1192       18432 :       else if (namelist%type(ii) == 'M') then
        1193             :
        1194             :          ! Add to modal aerosol list
        1195        6144 :          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        6144 :          ma_list%idx(ma_idx) = -1
        1200       15360 :          do m = 1, modes%nmodes
        1201       15360 :             if (trim(namelist%camname(ii)) == trim(modes%names(m))) then
        1202        6144 :                ma_list%idx(ma_idx) = m
        1203        6144 :                exit
        1204             :             end if
        1205             :          end do
        1206        6144 :          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        6144 :          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        6144 :    do i = 1, aerlist%numaerosols
        1262             :
        1263             :       ! locate the specie mixing ratio in the pbuf or state
        1264        4608 :       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        6144 :       aerlist%aer(i)%physprop_id = physprop_get_id(aerlist%aer(i)%physprop_file)
        1268             :
        1269             :    end do
        1270             :
        1271             :    ! Loop over modes
        1272        7680 :    do i = 1, ma_list%nmodes
        1273             :
        1274             :       ! get the physprop_id from the phys_prop module
        1275        7680 :       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        1536 :    list_id = alist%list_id
        1354        1536 :    if (len_trim(list_id) == 0) then
        1355        1536 :       suffix = '_c'
        1356        1536 :       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        6144 :    do i = 1, naer
        1363             :
        1364             :       ! construct names for mass per layer diagnostic fields
        1365        4608 :       name = 'm_' // trim(alist%aer(i)%camname) // trim(suffix)
        1366        4608 :       alist%aer(i)%mass_name = name
        1367        4608 :       long_name = trim(alist%aer(i)%camname)//' mass per layer'//long_name_description
        1368        9216 :       call addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name))
        1369             :
        1370             :       ! construct names for column burden diagnostic fields
        1371        4608 :       name = 'cb_' // trim(alist%aer(i)%camname) // trim(suffix)
        1372        4608 :       long_name = trim(alist%aer(i)%camname)//' column burden'//long_name_description
        1373        4608 :       call addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name))
        1374             :
        1375             :       ! error check for name length
        1376        6144 :       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       36864 :    do m = 1, n_mode_str
        1458             :
        1459       36864 :       if (len_trim(nl_in(m)) == 0) exit
        1460       35328 :       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       35328 :       tmpstr = adjustl(nl_in(m))
        1465       35328 :       nl_in(m) = tmpstr
        1466             :       do
        1467       35328 :          strlen = len_trim(nl_in(m))
        1468       35328 :          ipos = index(nl_in(m), ' ')
        1469       35328 :          if (ipos == 0 .or. ipos > strlen) exit
        1470           0 :          tmpstr = nl_in(m)(:ipos-1) // nl_in(m)(ipos+1:strlen)
        1471       35328 :          nl_in(m) = tmpstr
        1472             :       end do
        1473             :       ! count strings with ':=' terminator
        1474       36864 :       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        9216 :       stat=istat )
        1488        1536 :    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        1536 :    mcur = 1              ! index of current string being processed
        1495             :
        1496             :    ! loop over modes
        1497        7680 :    do m = 1, nmodes
        1498             :
        1499        6144 :       mbeg = mcur  ! remember the first string of a mode
        1500             :
        1501             :       ! check that first string in mode definition is ':=' terminated
        1502        6144 :       iend = len_trim(nl_in(mcur))
        1503        6144 :       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        6144 :       nspec = 0
        1508        6144 :       mcur = mcur + 1
        1509       23040 :       do
        1510       29184 :          iend = len_trim(nl_in(mcur))
        1511       29184 :          if (nl_in(mcur)(iend-1:iend) /= ':+') exit
        1512       23040 :          nspec = nspec + 1
        1513       23040 :          mcur = mcur + 1
        1514             :       end do
        1515             :
        1516             :       ! a mode must have at least one specie
        1517        6144 :       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       55296 :          stat=istat)
        1528             :
        1529        6144 :       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        6144 :       modes%comps(m)%nspec         = nspec
        1536        6144 :       modes%comps(m)%source_num_a  = ' '
        1537        6144 :       modes%comps(m)%camname_num_a = ' '
        1538        6144 :       modes%comps(m)%source_num_c  = ' '
        1539        6144 :       modes%comps(m)%camname_num_c = ' '
        1540       29184 :       do ispec = 1, nspec
        1541       23040 :          modes%comps(m)%source_mmr_a(ispec)  = ' '
        1542       23040 :          modes%comps(m)%camname_mmr_a(ispec) = ' '
        1543       23040 :          modes%comps(m)%source_mmr_c(ispec)  = ' '
        1544       23040 :          modes%comps(m)%camname_mmr_c(ispec) = ' '
        1545       23040 :          modes%comps(m)%type(ispec)          = ' '
        1546       29184 :          modes%comps(m)%props(ispec)         = ' '
        1547             :       end do
        1548             :
        1549             :       ! return to first string in mode definition
        1550        6144 :       mcur = mbeg
        1551        6144 :       tmpstr = nl_in(mcur)
        1552             :
        1553             :       ! mode name
        1554        6144 :       ipos = index(tmpstr, ':')
        1555        6144 :       if (ipos < 2) call parse_error('mode name not found', tmpstr)
        1556        6144 :       modes%names(m) = tmpstr(:ipos-1)
        1557        6144 :       tmpstr         = tmpstr(ipos+1:)
        1558             :
        1559             :       ! mode type
        1560        6144 :       ipos = index(tmpstr, ':')
        1561        6144 :       if (ipos == 0) call parse_error('mode type not found', tmpstr)
        1562             :       ! check for valid mode type
        1563        6144 :       call check_mode_type(tmpstr, 1, ipos-1)
        1564        6144 :       modes%types(m) = tmpstr(:ipos-1)
        1565        6144 :       tmpstr         = tmpstr(ipos+1:)
        1566             :
        1567             :       ! mode type must be followed by '='
        1568        6144 :       if (tmpstr(1:1) /= '=') call parse_error('= not found', tmpstr)
        1569             :
        1570             :       ! move to next string
        1571        6144 :       mcur = mcur + 1
        1572        6144 :       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       29184 :          ipos = index(tmpstr, ':')
        1581       29184 :          if (ipos < 2) call parse_error('expect to find source field first', tmpstr)
        1582             :          ! check for valid source
        1583       29184 :          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       29184 :          tmp_src_a = tmpstr(:ipos-1)
        1586       29184 :          tmpstr    = tmpstr(ipos+1:)
        1587             :
        1588             :          ! name of interstitial component
        1589       29184 :          ipos = index(tmpstr, ':')
        1590       29184 :          if (ipos == 0) call parse_error('next separator not found', tmpstr)
        1591       29184 :          tmp_name_a = tmpstr(:ipos-1)
        1592       29184 :          tmpstr     = tmpstr(ipos+1:)
        1593             :
        1594             :          ! source of cloud borne component
        1595       29184 :          ipos = index(tmpstr, ':')
        1596       29184 :          if (ipos < 2) call parse_error('expect to find a source field', tmpstr)
        1597             :          ! check for valid source
        1598       29184 :          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       29184 :          tmp_src_c = tmpstr(:ipos-1)
        1601       29184 :          tmpstr    = tmpstr(ipos+1:)
        1602             :
        1603             :          ! name of cloud borne component
        1604       29184 :          ipos = index(tmpstr, ':')
        1605       29184 :          if (ipos == 0) call parse_error('next separator not found', tmpstr)
        1606       29184 :          tmp_name_c = tmpstr(:ipos-1)
        1607       29184 :          tmpstr     = tmpstr(ipos+1:)
        1608             :
        1609             :          ! component type
        1610       29184 :          ipos = scan(tmpstr, ': ')
        1611       29184 :          if (ipos == 0) call parse_error('next separator not found', tmpstr)
        1612             :
        1613       29184 :          if (tmpstr(:ipos-1) == 'num_mr') then
        1614             :
        1615             :             ! there can only be one number mixing ratio component
        1616        6144 :             if (num_mr_found) call parse_error('more than 1 number component', nl_in(mcur))
        1617             :
        1618        6144 :             num_mr_found = .true.
        1619        6144 :             modes%comps(m)%source_num_a  = tmp_src_a
        1620        6144 :             modes%comps(m)%camname_num_a = tmp_name_a
        1621        6144 :             modes%comps(m)%source_num_c  = tmp_src_c
        1622        6144 :             modes%comps(m)%camname_num_c = tmp_name_c
        1623        6144 :             tmpstr                       = tmpstr(ipos+1:)
        1624             :
        1625             :          else
        1626             :
        1627             :             ! check for valid specie type
        1628       23040 :             call check_specie_type(tmpstr, 1, ipos-1)
        1629       23040 :             tmp_type = tmpstr(:ipos-1)
        1630       23040 :             tmpstr   = tmpstr(ipos+1:)
        1631             :
        1632             :             ! get the properties file
        1633       23040 :             ipos = scan(tmpstr, ': ')
        1634       23040 :             if (ipos == 0) call parse_error('next separator not found', tmpstr)
        1635             :             ! check for valid filename -- must have .nc extension
        1636       23040 :             if (tmpstr(ipos-3:ipos-1) /= '.nc') &
        1637           0 :                call parse_error('filename not valid', tmpstr)
        1638             :
        1639       23040 :             ispec = ispec + 1
        1640       23040 :             modes%comps(m)%source_mmr_a(ispec)  = tmp_src_a
        1641       23040 :             modes%comps(m)%camname_mmr_a(ispec) = tmp_name_a
        1642       23040 :             modes%comps(m)%source_mmr_c(ispec)  = tmp_src_c
        1643       23040 :             modes%comps(m)%camname_mmr_c(ispec) = tmp_name_c
        1644       23040 :             modes%comps(m)%type(ispec)          = tmp_type
        1645       23040 :             modes%comps(m)%props(ispec)         = tmpstr(:ipos-1)
        1646       23040 :             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       29184 :          if (tmpstr(1:1) == ' ') exit
        1653             :
        1654       23040 :          if (tmpstr(1:1) /= '+') &
        1655           0 :                call parse_error('+ field not found', tmpstr)
        1656             :
        1657             :          ! continue to next component...
        1658       23040 :          mcur = mcur + 1
        1659       29184 :          tmpstr = nl_in(mcur)
        1660             :       end do
        1661             :
        1662             :       ! check that a number component was found
        1663        6144 :       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        6144 :       if (ispec /= nspec) call parse_error('component parsing got wrong number of species', nl_in(mbeg))
        1667             :
        1668             :       ! continue to next mode...
        1669        6144 :       mcur = mcur + 1
        1670        7680 :       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       23040 :    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      119808 :       do i = 1, num_spec_types
        1700      119808 :          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        6144 :    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       18432 :       do i = 1, num_mode_types
        1717       18432 :          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       39936 :     parse_loop: do i = 1, n_rad_cnst
        1766       39936 :       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       23040 :       tmpstr = adjustl(specifier(i))
        1773           0 :       do
        1774       23040 :          strlen = len_trim(tmpstr)
        1775       23040 :          ipos = index(tmpstr, ' ')
        1776       23040 :          if (ipos == 0 .or. ipos > strlen) exit
        1777       23040 :          tmpstr = tmpstr(:ipos-1) // tmpstr(ipos+1:strlen)
        1778             :       end do
        1779             :
        1780             :       ! Locate the ':' separating source from camname.
        1781       23040 :       j = index(tmpstr, ':')
        1782       23040 :       source(i) = tmpstr(:j-1)
        1783       23040 :       tmpstr = tmpstr(j+1:)
        1784             :
        1785             :       ! locate the ':' separating camname from radname
        1786       23040 :       j = scan(tmpstr, ':')
        1787             :
        1788       23040 :       camname(i) = tmpstr(:j-1)
        1789       23040 :       radname(i) = tmpstr(j+1:)
        1790             :
        1791             :       ! determine the type of constituent
        1792       23040 :       if (source(i) == 'M') then
        1793        6144 :          type(i) = 'M'
        1794       16896 :       else if(index(radname(i),".nc") .gt. 0) then
        1795        4608 :          type(i) = 'A'
        1796             :       else
        1797       12288 :          type(i) = 'G'
        1798             :       end if
        1799             :
        1800       39936 :       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       24576 :     namelist_data%source(:namelist_data%ncnst)  = source (:namelist_data%ncnst)
        1817       24576 :     namelist_data%camname(:namelist_data%ncnst) = camname(:namelist_data%ncnst)
        1818       24576 :     namelist_data%radname(:namelist_data%ncnst) = radname(:namelist_data%ncnst)
        1819       24576 :     namelist_data%type(:namelist_data%ncnst)    = type(:namelist_data%ncnst)
        1820             :
        1821             : end subroutine parse_rad_specifier
        1822             :
        1823             : !================================================================================================
        1824             :
        1825     4476816 : 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     4476816 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
        1846     4476816 :       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     4476816 :    lchnk = state%lchnk
        1853             :
        1854             :    ! Check for valid input aerosol index
        1855     4476816 :    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     4476816 :    source = aerlist%aer(aer_idx)%source
        1862     4476816 :    idx    = aerlist%aer(aer_idx)%idx
        1863           0 :    select case( source )
        1864             :    case ('A')
        1865           0 :       mmr => state%q(:,:,idx)
        1866             :    case ('N')
        1867     4476816 :       call pbuf_get_field(pbuf, idx, mmr)
        1868             :    case ('Z')
        1869     4476816 :       mmr => zero_cols
        1870             :    end select
        1871             :
        1872     4476816 : end subroutine rad_cnst_get_aer_mmr_by_idx
        1873             :
        1874             : !================================================================================================
        1875             :
        1876 81659303108 : 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 81659303108 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
        1900 81659303108 :       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 81659303108 :    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 81659303108 :    m_idx = mlist%idx(mode_idx)
        1914             :
        1915             :    ! Check for valid specie index
        1916 81659303108 :    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 81659303108 :    if (phase == 'a') then
        1923 65855182486 :       source = modes%comps(m_idx)%source_mmr_a(spec_idx)
        1924 65855182486 :       idx    = modes%comps(m_idx)%idx_mmr_a(spec_idx)
        1925 15804120622 :    else if (phase == 'c') then
        1926 15804120622 :       source = modes%comps(m_idx)%source_mmr_c(spec_idx)
        1927 15804120622 :       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 81659303108 :    lchnk = state%lchnk
        1934             :
        1935 65855182486 :    select case( source )
        1936             :    case ('A')
        1937 65855182486 :       mmr => state%q(:,:,idx)
        1938             :    case ('N')
        1939 15804120622 :       call pbuf_get_field(pbuf, idx, mmr)
        1940             :    case ('Z')
        1941 81659303108 :       mmr => zero_cols
        1942             :    end select
        1943             :
        1944 81659303108 : end subroutine rad_cnst_get_mam_mmr_by_idx
        1945             :
        1946             : !================================================================================================
        1947             :
        1948       46080 : 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       46080 :    mlist => ma_list(0)
        1971             :
        1972             :    ! Check for valid mode index
        1973       46080 :    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       46080 :    m_idx = mlist%idx(mode_idx)
        1980             :
        1981             :    ! Check for valid specie index
        1982       46080 :    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       46080 :    idx    = modes%comps(m_idx)%idx_mmr_a(spec_idx)
        1989             :
        1990       46080 : end subroutine rad_cnst_get_mam_mmr_idx
        1991             :
        1992             : !================================================================================================
        1993             :
        1994 24360558740 : 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 24360558740 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
        2017 24360558740 :       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 24360558740 :    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 24360558740 :    m_idx = mlist%idx(mode_idx)
        2031             :
        2032             :    ! Get data source
        2033 24360558740 :    if (phase == 'a') then
        2034 12218259550 :       source = modes%comps(m_idx)%source_num_a
        2035 12218259550 :       idx    = modes%comps(m_idx)%idx_num_a
        2036 12142299190 :    else if (phase == 'c') then
        2037 12142299190 :       source = modes%comps(m_idx)%source_num_c
        2038 12142299190 :       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 24360558740 :    lchnk = state%lchnk
        2045             :
        2046 12218259550 :    select case( source )
        2047             :    case ('A')
        2048 12218259550 :       num => state%q(:,:,idx)
        2049             :    case ('N')
        2050 12142299190 :       call pbuf_get_field(pbuf, idx, num)
        2051             :    case ('Z')
        2052 24360558740 :       num => zero_cols
        2053             :    end select
        2054             :
        2055 24360558740 : end subroutine rad_cnst_get_mode_num
        2056             :
        2057             : !================================================================================================
        2058             :
        2059       12288 : 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       12288 :    mlist => ma_list(0)
        2082             :
        2083             :    ! Check for valid mode index
        2084       12288 :    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       12288 :    m_idx = mlist%idx(mode_idx)
        2091             :
        2092             :    ! Check that source is 'A' which means the index is for the constituent array
        2093       12288 :    source = modes%comps(m_idx)%source_num_a
        2094       12288 :    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       12288 :    cnst_idx = modes%comps(m_idx)%idx_num_a
        2101             :
        2102       12288 : 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     8953632 : 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     8953632 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
        2195     8953632 :       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     8953632 :    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     8953632 :    id = aerlist%aer(aer_idx)%physprop_id
        2207             :
        2208     8953632 :    if (present(opticstype))        call physprop_get(id, opticstype=opticstype)
        2209             :
        2210     8953632 :    if (present(sw_hygro_ext))      call physprop_get(id, sw_hygro_ext=sw_hygro_ext)
        2211     8953632 :    if (present(sw_hygro_ssa))      call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa)
        2212     8953632 :    if (present(sw_hygro_asm))      call physprop_get(id, sw_hygro_asm=sw_hygro_asm)
        2213     8953632 :    if (present(lw_hygro_ext))      call physprop_get(id, lw_hygro_abs=lw_hygro_ext)
        2214             :
        2215     8953632 :    if (present(sw_nonhygro_ext))   call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext)
        2216     8953632 :    if (present(sw_nonhygro_ssa))   call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa)
        2217     8953632 :    if (present(sw_nonhygro_asm))   call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm)
        2218     8953632 :    if (present(sw_nonhygro_scat))  call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat)
        2219     8953632 :    if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat)
        2220     8953632 :    if (present(lw_ext))            call physprop_get(id, lw_abs=lw_ext)
        2221             :
        2222     8953632 :    if (present(refindex_aer_sw))   call physprop_get(id, refindex_aer_sw=refindex_aer_sw)
        2223     8953632 :    if (present(refindex_aer_lw))   call physprop_get(id, refindex_aer_lw=refindex_aer_lw)
        2224             :
        2225     8953632 :    if (present(aername))           call physprop_get(id, aername=aername)
        2226     8953632 :    if (present(density_aer))       call physprop_get(id, density_aer=density_aer)
        2227     8953632 :    if (present(hygro_aer))         call physprop_get(id, hygro_aer=hygro_aer)
        2228     8953632 :    if (present(dryrad_aer))        call physprop_get(id, dryrad_aer=dryrad_aer)
        2229     8953632 :    if (present(dispersion_aer))    call physprop_get(id, dispersion_aer=dispersion_aer)
        2230     8953632 :    if (present(num_to_mass_aer))   call physprop_get(id, num_to_mass_aer=num_to_mass_aer)
        2231             :
        2232     8953632 :    if (present(r_lw_abs))          call physprop_get(id, r_lw_abs=r_lw_abs)
        2233     8953632 :    if (present(r_sw_ext))          call physprop_get(id, r_sw_ext=r_sw_ext)
        2234     8953632 :    if (present(r_sw_scat))         call physprop_get(id, r_sw_scat=r_sw_scat)
        2235     8953632 :    if (present(r_sw_ascat))        call physprop_get(id, r_sw_ascat=r_sw_ascat)
        2236     8953632 :    if (present(mu))                call physprop_get(id, mu=mu)
        2237             :
        2238     8953632 : end subroutine rad_cnst_get_aer_props_by_idx
        2239             :
        2240             : !================================================================================================
        2241             :
        2242 63059704242 : 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     8953632 :    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 63059704242 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
        2296 63059704242 :       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 63059704242 :    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 63059704242 :    m_idx = mlist%idx(mode_idx)
        2310             :
        2311             :    ! Check for valid specie index
        2312 63059704242 :    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 63059704242 :    id = modes%comps(m_idx)%idx_props(spec_idx)
        2318             :
        2319 63059704242 :    if (present(opticstype))        call physprop_get(id, opticstype=opticstype)
        2320             :
        2321 63059704242 :    if (present(sw_hygro_ext))      call physprop_get(id, sw_hygro_ext=sw_hygro_ext)
        2322 63059704242 :    if (present(sw_hygro_ssa))      call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa)
        2323 63059704242 :    if (present(sw_hygro_asm))      call physprop_get(id, sw_hygro_asm=sw_hygro_asm)
        2324 63059704242 :    if (present(lw_hygro_ext))      call physprop_get(id, lw_hygro_abs=lw_hygro_ext)
        2325             :
        2326 63059704242 :    if (present(sw_nonhygro_ext))   call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext)
        2327 63059704242 :    if (present(sw_nonhygro_ssa))   call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa)
        2328 63059704242 :    if (present(sw_nonhygro_asm))   call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm)
        2329 63059704242 :    if (present(sw_nonhygro_scat))  call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat)
        2330 63059704242 :    if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat)
        2331 63059704242 :    if (present(lw_ext))            call physprop_get(id, lw_abs=lw_ext)
        2332             :
        2333 63059704242 :    if (present(refindex_aer_sw))   call physprop_get(id, refindex_aer_sw=refindex_aer_sw)
        2334 63059704242 :    if (present(refindex_aer_lw))   call physprop_get(id, refindex_aer_lw=refindex_aer_lw)
        2335             :
        2336 63059704242 :    if (present(r_lw_abs))          call physprop_get(id, r_lw_abs=r_lw_abs)
        2337 63059704242 :    if (present(r_sw_ext))          call physprop_get(id, r_sw_ext=r_sw_ext)
        2338 63059704242 :    if (present(r_sw_scat))         call physprop_get(id, r_sw_scat=r_sw_scat)
        2339 63059704242 :    if (present(r_sw_ascat))        call physprop_get(id, r_sw_ascat=r_sw_ascat)
        2340 63059704242 :    if (present(mu))                call physprop_get(id, mu=mu)
        2341             :
        2342 63059704242 :    if (present(aername))           call physprop_get(id, aername=aername)
        2343 63059704242 :    if (present(density_aer))       call physprop_get(id, density_aer=density_aer)
        2344 63059704242 :    if (present(hygro_aer))         call physprop_get(id, hygro_aer=hygro_aer)
        2345 63059704242 :    if (present(dryrad_aer))        call physprop_get(id, dryrad_aer=dryrad_aer)
        2346 63059704242 :    if (present(dispersion_aer))    call physprop_get(id, dispersion_aer=dispersion_aer)
        2347 63059704242 :    if (present(num_to_mass_aer))   call physprop_get(id, num_to_mass_aer=num_to_mass_aer)
        2348             :
        2349 63059704242 :    if (present(spectype)) spectype = modes%comps(m_idx)%type(spec_idx)
        2350             :
        2351 63059704242 : 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 63059704242 :    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   161327348 :    if (list_idx >= 0 .and. list_idx <= N_DIAG) then
        2395   161327348 :       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   161327348 :    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   161327348 :    id = mlist%idx_props(mode_idx)
        2409             :
        2410   161327348 :    if (present(opticstype))  call physprop_get(id, opticstype=opticstype)
        2411   161327348 :    if (present(extpsw))      call physprop_get(id, extpsw=extpsw)
        2412   161327348 :    if (present(abspsw))      call physprop_get(id, abspsw=abspsw)
        2413   161327348 :    if (present(asmpsw))      call physprop_get(id, asmpsw=asmpsw)
        2414   161327348 :    if (present(absplw))      call physprop_get(id, absplw=absplw)
        2415             :
        2416   161327348 :    if (present(refrtabsw))   call physprop_get(id, refrtabsw=refrtabsw)
        2417   161327348 :    if (present(refitabsw))   call physprop_get(id, refitabsw=refitabsw)
        2418   161327348 :    if (present(refrtablw))   call physprop_get(id, refrtablw=refrtablw)
        2419   161327348 :    if (present(refitablw))   call physprop_get(id, refitablw=refitablw)
        2420             :
        2421   161327348 :    if (present(ncoef))       call physprop_get(id, ncoef=ncoef)
        2422   161327348 :    if (present(prefr))       call physprop_get(id, prefr=prefr)
        2423   161327348 :    if (present(prefi))       call physprop_get(id, prefi=prefi)
        2424   161327348 :    if (present(sigmag))      call physprop_get(id, sigmag=sigmag)
        2425   161327348 :    if (present(dgnum))       call physprop_get(id, dgnum=dgnum)
        2426   161327348 :    if (present(dgnumlo))     call physprop_get(id, dgnumlo=dgnumlo)
        2427   161327348 :    if (present(dgnumhi))     call physprop_get(id, dgnumhi=dgnumhi)
        2428   161327348 :    if (present(rhcrystal))   call physprop_get(id, rhcrystal=rhcrystal)
        2429   161327348 :    if (present(rhdeliques))  call physprop_get(id, rhdeliques=rhdeliques)
        2430             :
        2431   161327348 : 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          10 :    do m = 1, modes%nmodes
        2445             :
        2446           8 :       write(iulog,*) nl//' name=',trim(modes%names(m)),'  type=',trim(modes%types(m))
        2447           8 :       write(iulog,*) ' src_a=',trim(modes%comps(m)%source_num_a),'  num_a=',trim(modes%comps(m)%camname_num_a), &
        2448          16 :                      ' src_c=',trim(modes%comps(m)%source_num_c),'  num_c=',trim(modes%comps(m)%camname_num_c)
        2449             :
        2450          40 :       do i = 1, modes%comps(m)%nspec
        2451             :
        2452          30 :          write(iulog,*) ' src_a=',trim(modes%comps(m)%source_mmr_a(i)), '  mmr_a=',trim(modes%comps(m)%camname_mmr_a(i)), &
        2453          30 :                        '  src_c=',trim(modes%comps(m)%source_mmr_c(i)), '  mmr_c=',trim(modes%comps(m)%camname_mmr_c(i)), &
        2454          60 :                        '  type=',trim(modes%comps(m)%type(i))
        2455          38 :          write(iulog,*) '     prop file=', trim(modes%comps(m)%props(i))
        2456             :       end do
        2457             :
        2458             :    end do
        2459             :
        2460   161327348 : 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           6 :          write(iulog,*) '  '//gas_list%gas(i)%source//':'//gascnst(i)//' has pbuf name:'//&
        2486          12 :                         trim(gas_list%gas(i)%camname)
        2487          10 :       else if (gas_list%gas(i)%source .eq. 'A') then
        2488          10 :          write(iulog,*) '  '//gas_list%gas(i)%source//':'//gascnst(i)//' has constituents name:'//&
        2489          20 :                         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           8 :    do i = 1, aer_list%numaerosols
        2500           0 :       write(iulog,*) '  '//trim(aer_list%aer(i)%source)//':'//trim(aer_list%aer(i)%camname)//&
        2501           8 :                      ' 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          10 :    do i = 1, ma_list%nmodes
        2511           8 :       id = ma_list%idx(i)
        2512          10 :       write(iulog,*) '  '//trim(modes%names(id))
        2513             :    enddo
        2514             :
        2515           2 : end subroutine print_lists
        2516             :
        2517             : !================================================================================================
        2518             :
        2519           0 : end module rad_constituents

Generated by: LCOV version 1.14