LCOV - code coverage report
Current view: | top level - chemistry/aerosol - modal_aero_data.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 371 | 462 | 80.3 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 9 | 9 | 100.0 %

              Line data    Source code
           1             :       module modal_aero_data
           2             :
           3             : !--------------------------------------------------------------
           4             : ! ... Basic aerosol mode parameters and arrays
           5             : !--------------------------------------------------------------
           6             :       use shr_kind_mod,    only: r8 => shr_kind_r8
           7             :       use constituents,    only: pcnst, cnst_mw, cnst_name, cnst_get_ind, cnst_set_convtran2, &
           8             :                                  cnst_set_spec_class, cnst_spec_class_aerosol, cnst_spec_class_undefined, &
           9             :                                  cnst_species_class, cnst_spec_class_gas
          10             :       use physics_buffer,  only: pbuf_add_field, dtype_r8
          11             :       use time_manager,    only: is_first_step
          12             :       use phys_control,    only: phys_getopts
          13             :       use infnan,          only: nan, assignment(=)
          14             :       use cam_logfile,     only: iulog
          15             :       use cam_abortutils,  only: endrun
          16             :       use spmd_utils,      only: masterproc
          17             :       use ppgrid,          only: pcols, pver, begchunk, endchunk
          18             :       use mo_tracname,     only: solsym
          19             :       use chem_mods,       only: gas_pcnst
          20             :       use radconstants,    only: nswbands, nlwbands
          21             :       use shr_const_mod,   only: pi => shr_const_pi
          22             :       use rad_constituents,only: rad_cnst_get_info, rad_cnst_get_aer_props, rad_cnst_get_mode_props
          23             :       use physics_buffer,  only: physics_buffer_desc, pbuf_get_chunk
          24             :
          25             :       implicit none
          26             :       private
          27             :
          28             :       public :: modal_aero_data_init
          29             :       public :: modal_aero_data_reg
          30             :       public :: qqcw_get_field
          31             :
          32             :       integer, public, protected :: nsoa = 0
          33             :       integer, public, protected :: npoa = 0
          34             :       integer, public, protected :: nbc = 0
          35             :       integer, public, protected :: nspec_max = 0
          36             :       integer, public, protected :: ntot_amode = 0
          37             :       integer, public, protected :: nSeaSalt=0, nDust=0
          38             :       integer, public, protected :: nSO4=0, nNH4=0
          39             :
          40             :       !
          41             :       ! definitions for aerosol chemical components
          42             :       !
          43             :
          44             :       real(r8), public, protected, allocatable :: specmw_amode(:,:)
          45             :       character(len=16), public, protected, allocatable :: modename_amode(:)
          46             :
          47             :       integer, public, protected, allocatable :: nspec_amode(:)
          48             :
          49             :       character(len=20), public, protected :: cnst_name_cw( pcnst )
          50             :
          51             :       !   input mprognum_amode, mdiagnum_amode, mprogsfc_amode, mcalcwater_amode
          52             :       integer, public, protected, allocatable :: mprognum_amode(:)
          53             :       integer, public, protected, allocatable :: mdiagnum_amode(:)
          54             :       integer, public, protected, allocatable :: mprogsfc_amode(:)
          55             :       integer, public, protected, allocatable :: mcalcwater_amode(:)
          56             :
          57             :       !   input dgnum_amode, dgnumlo_amode, dgnumhi_amode (units = m)
          58             :       real(r8), public, protected, allocatable :: dgnum_amode(:)
          59             :       real(r8), public, protected, allocatable :: dgnumlo_amode(:)
          60             :       real(r8), public, protected, allocatable :: dgnumhi_amode(:)
          61             :       integer,  public, protected, allocatable :: mode_size_order(:)
          62             :
          63             :       !   input sigmag_amode
          64             :       real(r8), public, protected, allocatable :: sigmag_amode(:)
          65             :
          66             :       !   input crystalization and deliquescence points
          67             :       real(r8), allocatable :: rhcrystal_amode(:)
          68             :       real(r8), allocatable :: rhdeliques_amode(:)
          69             :
          70             :
          71             :       integer, public, protected, allocatable :: &
          72             :            lmassptr_amode( :, : ),   &
          73             :            lmassptrcw_amode( :, : ), &
          74             :            numptr_amode( : ),        &
          75             :            numptrcw_amode( : )
          76             :
          77             :       real(r8), public, protected, allocatable :: &
          78             :            alnsg_amode( : ),              &
          79             :            voltonumb_amode( : ),          &
          80             :            voltonumblo_amode( : ),        &
          81             :            voltonumbhi_amode( : ),        &
          82             :            alnv2n_amode( : ),             &
          83             :            alnv2nlo_amode( : ),           &
          84             :            alnv2nhi_amode( : ),           &
          85             :            specdens_amode(:,:),   &
          86             :            spechygro(:,:)
          87             :
          88             :       integer, public, protected, allocatable ::  &
          89             :            lptr_so4_a_amode(:),     lptr_so4_cw_amode(:), &
          90             :            lptr_msa_a_amode(:),     lptr_msa_cw_amode(:), &
          91             :            lptr_nh4_a_amode(:),     lptr_nh4_cw_amode(:), &
          92             :            lptr_no3_a_amode(:),     lptr_no3_cw_amode(:), &
          93             :            lptr_nacl_a_amode(:),    lptr_nacl_cw_amode(:),&
          94             :            lptr_dust_a_amode(:),    lptr_dust_cw_amode(:)
          95             :
          96             :       integer, public, protected :: &
          97             :            modeptr_accum,  modeptr_aitken,                               &
          98             :            modeptr_ufine,  modeptr_coarse,                               &
          99             :            modeptr_pcarbon,                                              &
         100             :            modeptr_finedust,  modeptr_fineseas,                          &
         101             :            modeptr_coardust,  modeptr_coarseas, modeptr_stracoar
         102             :
         103             :       !2D lptr variables added by RCE to access speciated species
         104             :       integer, public, protected, allocatable :: &
         105             :            lptr2_bc_a_amode(:,:),   lptr2_bc_cw_amode(:,:), &
         106             :            lptr2_pom_a_amode(:,:),  lptr2_pom_cw_amode(:,:), &
         107             :            lptr2_soa_a_amode(:,:),  lptr2_soa_cw_amode(:,:), &
         108             :            lptr2_soa_g_amode(:)
         109             :
         110             :       real(r8), public, protected :: specmw_so4_amode
         111             :
         112             :       logical, public, protected :: soa_multi_species = .false.
         113             :
         114             :       character(len=16), allocatable :: xname_massptr(:,:)     ! names of species in each mode
         115             :       character(len=16), allocatable :: xname_massptrcw(:,:)   ! names of cloud-borne species in each mode
         116             :
         117             :       complex(r8), allocatable :: &
         118             :            specrefndxsw( :,:,: ), &
         119             :            specrefndxlw( :,:,: )
         120             :
         121             :       character(len=8), allocatable :: &
         122             :            aodvisname(: ), &
         123             :            ssavisname(: )
         124             :       character(len=48), allocatable :: &
         125             :            aodvislongname(: ), &
         126             :            ssavislongname(: )
         127             :
         128             :       character(len=8), allocatable :: &
         129             :            fnactname(: ), &
         130             :            fmactname(: ), &
         131             :            nactname(: )
         132             :
         133             :       character(len=48), allocatable :: &
         134             :            fnactlongname(: ), &
         135             :            fmactlongname(: ), &
         136             :            nactlongname(: )
         137             :
         138             :
         139             :       !   threshold for reporting negatives from subr qneg3
         140             :       real(r8) :: qneg3_worst_thresh_amode(pcnst)
         141             :
         142             :       integer :: qqcw(pcnst)=-1 ! Remaps modal_aero indices into pbuf
         143             :
         144             :       logical :: convproc_do_aer
         145             :       logical :: cam_do_aero_conv = .true.
         146             :     contains
         147             :
         148             : !--------------------------------------------------------------
         149             : !--------------------------------------------------------------
         150        1536 :   subroutine modal_aero_data_reg
         151             :
         152             :     character(len=6) :: xname_numptr, xname_numptrcw
         153             :     character(len=1) :: modechr
         154             :     integer :: m, l, iptr,i, idx
         155             :     character(len=3) :: trnum       ! used to hold mode number (as characters)
         156             :
         157             :     character(len=32) :: spec_name, mode_type
         158             :     character(len=1) :: modestr
         159             :
         160        1536 :     call rad_cnst_get_info( 0, nmodes=ntot_amode )
         161        4608 :     allocate( nspec_amode(ntot_amode) )
         162        3072 :     allocate( numptr_amode(ntot_amode) )
         163        3072 :     allocate( numptrcw_amode(ntot_amode) )
         164        4608 :     allocate(modename_amode(ntot_amode))
         165        3072 :     allocate(mprognum_amode(ntot_amode))
         166        3072 :     allocate(mdiagnum_amode(ntot_amode))
         167        3072 :     allocate(mprogsfc_amode(ntot_amode))
         168        3072 :     allocate(mcalcwater_amode(ntot_amode))
         169        7680 :     mprognum_amode(:) = 1
         170        7680 :     mdiagnum_amode(:) = 0
         171        7680 :     mprogsfc_amode(:) = 0
         172        1536 :     if (ntot_amode==7) then
         173           0 :        mcalcwater_amode(:) = 1
         174             :     else
         175        7680 :        mcalcwater_amode(:) = 0
         176             :     endif
         177        4608 :     allocate(dgnum_amode(ntot_amode))
         178        4608 :     allocate(mode_size_order(ntot_amode))
         179        3072 :     allocate(dgnumlo_amode(ntot_amode))
         180        3072 :     allocate(dgnumhi_amode(ntot_amode))
         181        3072 :     allocate(sigmag_amode(ntot_amode))
         182        3072 :     allocate(rhcrystal_amode(ntot_amode))
         183        3072 :     allocate(rhdeliques_amode(ntot_amode))
         184             :     allocate( &
         185           0 :          alnsg_amode( ntot_amode ),              &   !
         186           0 :          voltonumb_amode( ntot_amode ),          &   !
         187           0 :          voltonumblo_amode( ntot_amode ),        &   !
         188           0 :          voltonumbhi_amode( ntot_amode ),        &   !
         189           0 :          alnv2n_amode( ntot_amode ),             &   !
         190           0 :          alnv2nlo_amode( ntot_amode ),           &   !
         191           0 :          alnv2nhi_amode( ntot_amode ),           &   !
         192           0 :          aodvisname(ntot_amode ), &
         193           0 :          ssavisname(ntot_amode ), &
         194           0 :          fnactname(ntot_amode ), &
         195           0 :          fmactname(ntot_amode ), &
         196           0 :          nactname(ntot_amode ), &
         197           0 :          fnactlongname(ntot_amode ), &
         198           0 :          fmactlongname(ntot_amode ), &
         199           0 :          nactlongname(ntot_amode ), &
         200           0 :          lptr_so4_a_amode(ntot_amode), lptr_so4_cw_amode(ntot_amode), &
         201           0 :          lptr_msa_a_amode(ntot_amode), lptr_msa_cw_amode(ntot_amode), &
         202           0 :          lptr_nh4_a_amode(ntot_amode), lptr_nh4_cw_amode(ntot_amode), &
         203           0 :          lptr_nacl_a_amode(ntot_amode), lptr_nacl_cw_amode(ntot_amode), &
         204           0 :          lptr_dust_a_amode(ntot_amode), lptr_dust_cw_amode(ntot_amode), &
         205           0 :          lptr_no3_a_amode(ntot_amode), lptr_no3_cw_amode(ntot_amode) &
         206       44544 :     )
         207             :
         208             :     allocate( &
         209           0 :          aodvislongname(ntot_amode ), &
         210           0 :          ssavislongname(ntot_amode ) &
         211        4608 :     )
         212             :
         213        7680 :     do m = 1, ntot_amode
         214        6144 :        call rad_cnst_get_info(0, m, mode_type=mode_type, nspec=nspec_amode(m))
         215        6144 :        modename_amode(m) = mode_type
         216             :        ! count number of soa, poa, and bc bins in mode 1
         217        7680 :        if (m==1) then
         218       10752 :           do l = 1, nspec_amode(m)
         219        9216 :              call rad_cnst_get_info(0, m, l, spec_name=spec_name )
         220        9216 :              if (spec_name(:3) == 'soa') nsoa=nsoa+1
         221        9216 :              if (spec_name(:3) == 'pom') npoa=npoa+1
         222       10752 :              if (spec_name(:2) == 'bc' ) nbc =nbc +1
         223             :           enddo
         224             :        endif
         225             :     enddo
         226             :
         227        1536 :     soa_multi_species = nsoa > 1
         228             :
         229        7680 :     nspec_max = maxval( nspec_amode )
         230             :
         231        6144 :     allocate ( specdens_amode(nspec_max,ntot_amode) )
         232        4608 :     allocate ( spechygro(nspec_max,ntot_amode) )
         233        4608 :     allocate ( specmw_amode(nspec_max,ntot_amode) )
         234        6144 :     allocate ( xname_massptr(nspec_max,ntot_amode) )
         235        4608 :     allocate ( xname_massptrcw(nspec_max,ntot_amode) )
         236        1536 :     specmw_amode = nan
         237       44544 :     xname_massptr(:,:) = ' '
         238       44544 :     xname_massptrcw(:,:) = ' '
         239             :
         240        7680 :     do m = 1, ntot_amode
         241       30720 :        do l = 1, nspec_amode(m)
         242       23040 :           call rad_cnst_get_info(0, m, l, spec_name=spec_name )
         243       23040 :           xname_massptr(l,m) = spec_name
         244       23040 :           write(modestr,'(I1)') m
         245       23040 :           idx = index( xname_massptr(l,m), '_' )
         246       23040 :           xname_massptrcw(l,m) = xname_massptr(l,m)(:idx-1)//'_c'//modestr
         247       23040 :           if (xname_massptr(l,m)(:3) == 'dst') nDust=nDust+1
         248       23040 :           if (xname_massptr(l,m)(:3) == 'ncl') nSeaSalt=nSeaSalt+1
         249       23040 :           if (xname_massptr(l,m)(:3) == 'nh4') nNH4=nNH4+1
         250       29184 :           if (xname_massptr(l,m)(:3) == 'so4') nSO4=nSO4+1
         251             :        enddo
         252             :     enddo
         253             :
         254             :     allocate( &
         255           0 :          lmassptr_amode( nspec_max, ntot_amode ),&
         256           0 :          lmassptrcw_amode( nspec_max, ntot_amode ),&
         257           0 :          lptr2_pom_a_amode(ntot_amode,npoa),  lptr2_pom_cw_amode(ntot_amode,npoa), &
         258           0 :          lptr2_soa_a_amode(ntot_amode,nsoa),  lptr2_soa_cw_amode(ntot_amode,nsoa), &
         259           0 :          lptr2_bc_a_amode(ntot_amode,nbc),   lptr2_bc_cw_amode(ntot_amode,nbc), &
         260           0 :          lptr2_soa_g_amode(nsoa) &
         261       35328 :          )
         262       44544 :     lmassptr_amode = -999999
         263        3072 :     lptr2_soa_g_amode = -999999
         264             :
         265        6144 :     allocate( specrefndxsw(nswbands,nspec_max,ntot_amode ) )
         266        6144 :     allocate( specrefndxlw(nlwbands,nspec_max,ntot_amode) )
         267             :
         268        7680 :     do m = 1, ntot_amode
         269        7680 :        if(nspec_amode(m).gt.nspec_max)then
         270           0 :           write(iulog,*)'modal_aero_data_reg: nspec_amode(m).gt.nspec_max '
         271           0 :           write(iulog,*)'modal_aero_data_reg: m,nspec_amode(m), nspec_max=',m, nspec_amode(m), nspec_max
         272           0 :           call endrun('modal_aero_data_reg: nspec_amode(m).gt.nspec_max ')
         273             :        end if
         274             :     end do
         275             :
         276        1536 :     call phys_getopts(convproc_do_aer_out = convproc_do_aer)
         277        1536 :     if (convproc_do_aer) cam_do_aero_conv = .false.
         278             :
         279        7680 :     do m = 1, ntot_amode
         280        6144 :        write(modechr,fmt='(I1)') m
         281        6144 :        xname_numptr = 'num_a'//modechr
         282        6144 :        xname_numptrcw  = 'num_c'//modechr
         283             :
         284        6144 :        if (masterproc) then
         285           8 :           write(iulog,9231) m, modename_amode(m)
         286             :           write(iulog,9232)                                          &
         287           8 :                'nspec                       ',                         &
         288          16 :                nspec_amode(m)
         289             :           write(iulog,9232)                                          &
         290           8 :                'mprognum, mdiagnum, mprogsfc',                         &
         291          16 :                mprognum_amode(m), mdiagnum_amode(m), mprogsfc_amode(m)
         292             :           write(iulog,9232)                                          &
         293           8 :                'mcalcwater                  ',                         &
         294          16 :                mcalcwater_amode(m)
         295             :        endif
         296             :
         297             :        !    define species to hold interstitial & activated number
         298             :        call search_list_of_names(                                      &
         299        6144 :             xname_numptr, numptr_amode(m), cnst_name, pcnst )
         300        6144 :        if (numptr_amode(m) .le. 0) then
         301           0 :           write(iulog,9061) 'xname_numptr', xname_numptr, m
         302           0 :           call endrun('modal_aero_data_reg: numptr_amode(m) .le. 0')
         303             :        end if
         304        6144 :        if (numptr_amode(m) .gt. pcnst) then
         305           0 :           write(iulog,9061) 'numptr_amode', numptr_amode(m), m
         306           0 :           write(iulog,9061) 'xname_numptr', xname_numptr, m
         307           0 :           call endrun('modal_aero_data_reg: numptr_amode(m) .gt. pcnst')
         308             :        end if
         309             :
         310        6144 :        call cnst_set_spec_class(numptr_amode(m), cnst_spec_class_aerosol)
         311        6144 :        call cnst_set_convtran2(numptr_amode(m), cam_do_aero_conv)
         312             :
         313        6144 :        numptrcw_amode(m) = numptr_amode(m)  !use the same index for Q and QQCW arrays
         314        6144 :        if (numptrcw_amode(m) .le. 0) then
         315           0 :           write(iulog,9061) 'xname_numptrcw', xname_numptrcw, m
         316           0 :           call endrun('modal_aero_data_reg: numptrcw_amode(m) .le. 0')
         317             :        end if
         318        6144 :        if (numptrcw_amode(m) .gt. pcnst) then
         319           0 :           write(iulog,9061) 'numptrcw_amode', numptrcw_amode(m), m
         320           0 :           write(iulog,9061) 'xname_numptrcw', xname_numptrcw, m
         321           0 :           call endrun('modal_aero_data_reg: numptrcw_amode(m) .gt. pcnst')
         322             :        end if
         323             :
         324        6144 :        call pbuf_add_field(xname_numptrcw,'global',dtype_r8,(/pcols,pver/),iptr)
         325        6144 :        call qqcw_set_ptr(numptrcw_amode(m),iptr)
         326             :
         327             :        !   output mode information
         328        6144 :        if ( masterproc ) then
         329           8 :           write(iulog,9233) 'numptr         ',                           &
         330          16 :                numptr_amode(m), xname_numptr
         331           8 :           write(iulog,9233) 'numptrcw       ',                           &
         332          16 :                numptrcw_amode(m), xname_numptrcw
         333             :        end if
         334             :
         335             :        !   define the chemical species for the mode
         336       29184 :        do l = 1, nspec_amode(m)
         337             :
         338             :           call search_list_of_names(                                  &
         339       23040 :                xname_massptr(l,m), lmassptr_amode(l,m), cnst_name, pcnst )
         340       23040 :           if (lmassptr_amode(l,m) .le. 0) then
         341           0 :              write(iulog,9062) 'xname_massptr', xname_massptr(l,m), l, m
         342           0 :              write(iulog,'(10(a8,1x))')(cnst_name(i),i=1,pcnst)
         343           0 :              call endrun('modal_aero_data_reg: lmassptr_amode(l,m) .le. 0')
         344             :           end if
         345       23040 :           call cnst_set_spec_class(lmassptr_amode(l,m), cnst_spec_class_aerosol)
         346       23040 :           call cnst_set_convtran2(lmassptr_amode(l,m), cam_do_aero_conv)
         347             :
         348       23040 :           lmassptrcw_amode(l,m) = lmassptr_amode(l,m)  !use the same index for Q and QQCW arrays
         349       23040 :           if (lmassptrcw_amode(l,m) .le. 0) then
         350           0 :              write(iulog,9062) 'xname_massptrcw', xname_massptrcw(l,m), l, m
         351           0 :              call endrun('modal_aero_data_reg: lmassptrcw_amode(l,m) .le. 0')
         352             :           end if
         353       23040 :           call pbuf_add_field(xname_massptrcw(l,m),'global',dtype_r8,(/pcols,pver/),iptr)
         354       23040 :           call qqcw_set_ptr(lmassptrcw_amode(l,m), iptr)
         355             :
         356       52224 :           if ( masterproc ) then
         357          30 :              write(iulog,9236) 'spec, massptr  ', l,                    &
         358          60 :                   lmassptr_amode(l,m), xname_massptr(l,m)
         359          30 :              write(iulog,9236) 'spec, massptrcw', l,                    &
         360          60 :                   lmassptrcw_amode(l,m), xname_massptrcw(l,m)
         361             :           end if
         362             :
         363             :        end do
         364             :
         365             :        !   set names for aodvis and ssavis
         366        6144 :        write(unit=trnum,fmt='(i3)') m+100
         367             :
         368        6144 :        aodvisname(m) = 'AODVIS'//trnum(2:3)
         369        6144 :        aodvislongname(m) = 'Aerosol optical depth for mode '//trnum(2:3)
         370        6144 :        ssavisname(m) = 'SSAVIS'//trnum(2:3)
         371        6144 :        ssavislongname(m) = 'Single-scatter albedo for mode '//trnum(2:3)
         372        6144 :        fnactname(m) = 'FNACT'//trnum(2:3)
         373        6144 :        fnactlongname(m) = 'Number faction activated for mode '//trnum(2:3)
         374        6144 :        fmactname(m) = 'FMACT'//trnum(2:3)
         375       19968 :        fmactlongname(m) = 'Fraction mass activated for mode'//trnum(2:3)
         376             :     end do
         377             :
         378             :     ! At this point, species_class is either undefined or aerosol.
         379             :     ! For the "chemistry species" set the undefined ones to gas,
         380             :     ! and leave the aerosol ones as is
         381       49152 :     do i = 1, gas_pcnst
         382       47616 :        call cnst_get_ind(solsym(i), idx, abort=.false.)
         383       49152 :        if (idx > 0) then
         384       46080 :           if (cnst_species_class(idx) == cnst_spec_class_undefined) then
         385       16896 :              call cnst_set_spec_class(idx, cnst_spec_class_gas)
         386             :           end if
         387             :        end if
         388             :     end do
         389             :
         390        1536 :        if (masterproc) write(iulog,9230)
         391             : 9230   format( // '*** init_aer_modes mode definitions' )
         392             : 9231   format( 'mode = ', i4, ' = "', a, '"' )
         393             : 9232   format( 4x, a, 4(1x, i5 ) )
         394             : 9233   format( 4x, a15, 4x, i7, '="', a, '"' )
         395             : 9236   format( 4x, a15, i4, i7, '="', a, '"' )
         396             : 9061   format( '*** subr modesmodal_aero_data_reg - bad ', a /                   &
         397             :             5x, 'name, m =  ', a, 5x, i5 )
         398             : 9062   format( '*** subr modal_aero_data_reg - bad ', a /                       &
         399             :             5x, 'name, l, m =  ', a, 5x, 2i5 )
         400        1536 :  end subroutine modal_aero_data_reg
         401             :
         402             : !--------------------------------------------------------------
         403             : !--------------------------------------------------------------
         404        1536 :     subroutine modal_aero_data_init(pbuf2d)
         405             :
         406             :        type(physics_buffer_desc), pointer :: pbuf2d(:,:)
         407             :
         408             :        !--------------------------------------------------------------
         409             :        ! ... local variables
         410             :        !--------------------------------------------------------------
         411             :        integer :: l, m, i, lchnk, tmp
         412             :
         413             :        integer :: qArrIndex
         414        1536 :        complex(r8), pointer  :: refindex_aer_sw(:), &
         415        1536 :             refindex_aer_lw(:)
         416        1536 :        real(r8), pointer :: qqcw(:,:)
         417             :        real(r8), parameter :: huge_r8 = huge(1._r8)
         418             :        character(len=*), parameter :: routine='modal_aero_initialize'
         419             :        character(len=32) :: spec_type
         420             :        integer :: soa_ndx
         421             :
         422             :        !-----------------------------------------------------------------------
         423             :
         424             :        ! Mode specific properties.
         425        7680 :        do m = 1, ntot_amode
         426             :           call rad_cnst_get_mode_props(0, m, &
         427           0 :              sigmag=sigmag_amode(m), dgnum=dgnum_amode(m), dgnumlo=dgnumlo_amode(m), &
         428        6144 :              dgnumhi=dgnumhi_amode(m), rhcrystal=rhcrystal_amode(m), rhdeliques=rhdeliques_amode(m))
         429             :
         430        6144 :           mode_size_order(m) = m
         431             :
         432             :           !   compute frequently used parameters: ln(sigmag),
         433             :           !   volume-to-number and volume-to-surface conversions, ...
         434        6144 :           alnsg_amode(m) = log( sigmag_amode(m) )
         435             :
         436           0 :           voltonumb_amode(m) = 1._r8 / ( (pi/6._r8)*                            &
         437        6144 :              (dgnum_amode(m)**3._r8)*exp(4.5_r8*alnsg_amode(m)**2._r8) )
         438           0 :           voltonumblo_amode(m) = 1._r8 / ( (pi/6._r8)*                          &
         439        6144 :              (dgnumlo_amode(m)**3._r8)*exp(4.5_r8*alnsg_amode(m)**2._r8) )
         440           0 :           voltonumbhi_amode(m) = 1._r8 / ( (pi/6._r8)*                          &
         441        6144 :              (dgnumhi_amode(m)**3._r8)*exp(4.5_r8*alnsg_amode(m)**2._r8) )
         442             :
         443        6144 :           alnv2n_amode(m)   = log( voltonumb_amode(m) )
         444        6144 :           alnv2nlo_amode(m) = log( voltonumblo_amode(m) )
         445        7680 :           alnv2nhi_amode(m) = log( voltonumbhi_amode(m) )
         446             :
         447             :        end do
         448             :
         449        6144 :        do i = 1, ntot_amode-1 ! order from largest to smallest
         450       19968 :           do m = 2, ntot_amode
         451       18432 :              if (dgnum_amode(mode_size_order(m-1))<dgnum_amode(mode_size_order(m))) then
         452        4608 :                 tmp = mode_size_order(m-1)
         453        4608 :                 mode_size_order(m-1)= mode_size_order(m)
         454        4608 :                 mode_size_order(m) = tmp
         455             :              endif
         456             :           enddo
         457             :        enddo
         458             :
         459        3072 :        lptr2_soa_g_amode(:) = -1
         460        1536 :        soa_ndx = 0
         461       64512 :        do i = 1, pcnst
         462       64512 :           if (cnst_name(i)(:4) == 'SOAG' .and. cnst_name(i)(:5) /= 'SOAGX') then
         463        1536 :              soa_ndx = soa_ndx+1
         464        1536 :              lptr2_soa_g_amode(soa_ndx) = i
         465             :           endif
         466             :        enddo
         467        1536 :        if (.not.any(lptr2_soa_g_amode>0)) call endrun('modal_aero_data_init: lptr2_soa_g_amode is not set properly')
         468             :        ! Properties of mode specie types.
         469             :
         470             :        !     values from Koepke, Hess, Schult and Shettle, Global Aerosol Data Set
         471             :        !     Report #243, Max-Planck Institute for Meteorology, 1997a
         472             :        !     See also Hess, Koepke and Schult, Optical Properties of Aerosols and Clouds (OPAC)
         473             :        !     BAMS, 1998.
         474             :
         475             :        !      specrefndxsw(:ntot_aspectype)     = (/ (1.53,  0.01),   (1.53,  0.01),  (1.53,  0.01), &
         476             :        !                                           (1.55,  0.01),   (1.55,  0.01),  (1.90, 0.60), &
         477             :        !                                           (1.50, 1.0e-8), (1.50, 0.005) /)
         478             :        !      specrefndxlw(:ntot_aspectype)   = (/ (2.0, 0.5),   (2.0, 0.5), (2.0, 0.5), &
         479             :        !                                           (1.7, 0.5),   (1.7, 0.5), (2.22, 0.73), &
         480             :        !                                           (1.50, 0.02), (2.6, 0.6) /)
         481             :        !     get refractive indices from phys_prop files
         482             :
         483             :        ! The following use of the rad_constituent interfaces makes the assumption that the
         484             :        ! prognostic modes are used in the mode climate (index 0) list.
         485             :
         486        1536 :        if (masterproc) write(iulog,9210)
         487        7680 :        do m = 1, ntot_amode
         488       30720 :           do l = 1, nspec_amode(m)
         489       23040 :              qArrIndex =  lmassptr_amode(l,m)     !index of the species in the state%q array
         490             :              call rad_cnst_get_aer_props(0, m, l , &
         491             :                   refindex_aer_sw=refindex_aer_sw, &
         492             :                   refindex_aer_lw=refindex_aer_lw, &
         493           0 :                   density_aer=specdens_amode(l,m), &
         494       23040 :                   hygro_aer=spechygro(l,m)         )
         495             :
         496       23040 :                  specmw_amode(l,m) = cnst_mw(qArrIndex)
         497             :
         498       23040 :              if(masterproc) then
         499          30 :                 write(iulog,9212) '        name : ', cnst_name(qArrIndex)
         500          30 :                 write(iulog,9213) ' density, MW : ', specdens_amode(l,m), specmw_amode(l,m)
         501          30 :                 write(iulog,9213) '       hygro : ', spechygro(l,m)
         502             :              endif
         503      345600 :              do i=1,nswbands
         504      322560 :                 specrefndxsw(i,l,m)=refindex_aer_sw(i)
         505      345600 :                 if(masterproc) write(iulog,9213) 'ref index sw    ', (specrefndxsw(i,l,m))
         506             :              end do
         507      397824 :              do i=1,nlwbands
         508      368640 :                 specrefndxlw(i,l,m)=refindex_aer_lw(i)
         509      391680 :                 if(masterproc) write(iulog,9213) 'ref index ir    ', (specrefndxlw(i,l,m))
         510             :              end do
         511             :
         512             :           enddo
         513             :        enddo
         514             :
         515             : 9210   format( // '*** init_aer_modes aerosol species-types' )
         516             : 9211   format( 'spectype =', i4)
         517             : 9212   format( 4x, a, 3x, '"', a, '"' )
         518             : 9213   format( 4x, a, 5(1pe14.5) )
         519             :
         520             :        !   set cnst_name_cw
         521        1536 :        call initaermodes_set_cnstnamecw()
         522             :
         523             :
         524             :        !
         525             :        !   set the lptr_so4_a_amode(m), lptr_so4_cw_amode(m), ...
         526             :        !
         527        1536 :        call initaermodes_setspecptrs
         528             :
         529             :        !
         530             :        !   set threshold for reporting negatives from subr qneg3
         531             :        !   for aerosol number species set this to
         532             :        !      1e3 #/kg ~= 1e-3 #/cm3 for accum, aitken, pcarbon, ufine modes
         533             :        !      3e1 #/kg ~= 3e-5 #/cm3 for fineseas and finedust modes
         534             :        !      1e0 #/kg ~= 1e-6 #/cm3 for other modes which are coarse
         535             :        !   for other species, set this to zero so that it will be ignored
         536             :        !      by qneg3
         537             :        !
         538        1536 :        if ( masterproc ) write(iulog,'(/a)') &
         539           2 :             'mode, modename_amode, qneg3_worst_thresh_amode'
         540        1536 :        qneg3_worst_thresh_amode(:) = 0.0_r8
         541        7680 :        do m = 1, ntot_amode
         542        6144 :           l = numptr_amode(m)
         543        6144 :           if ((l <= 0) .or. (l > pcnst)) cycle
         544             :
         545        6144 :           if      (m == modeptr_accum) then
         546        1536 :              qneg3_worst_thresh_amode(l) = 1.0e3_r8
         547        4608 :           else if (m == modeptr_aitken) then
         548        1536 :              qneg3_worst_thresh_amode(l) = 1.0e3_r8
         549        3072 :           else if (m == modeptr_pcarbon) then
         550        1536 :              qneg3_worst_thresh_amode(l) = 1.0e3_r8
         551        1536 :           else if (m == modeptr_ufine) then
         552           0 :              qneg3_worst_thresh_amode(l) = 1.0e3_r8
         553             :
         554        1536 :           else if (m == modeptr_fineseas) then
         555           0 :              qneg3_worst_thresh_amode(l) = 3.0e1_r8
         556        1536 :           else if (m == modeptr_finedust) then
         557           0 :              qneg3_worst_thresh_amode(l) = 3.0e1_r8
         558             :
         559             :           else
         560        1536 :              qneg3_worst_thresh_amode(l) = 1.0e0_r8
         561             :           end if
         562             :
         563        6144 :           if ( masterproc ) write(iulog,'(i3,2x,a,1p,e12.3)') &
         564        1544 :                m, modename_amode(m), qneg3_worst_thresh_amode(l)
         565             :        end do
         566             :
         567        1536 :        if (is_first_step()) then
         568             :           ! initialize cloud bourne constituents in physics buffer
         569             :
         570       32256 :           do i = 1, pcnst
         571      159192 :              do lchnk = begchunk, endchunk
         572      126936 :                 qqcw => qqcw_get_field(pbuf_get_chunk(pbuf2d,lchnk), i, lchnk, .true.)
         573      158424 :                 if (associated(qqcw)) then
         574    93059568 :                    qqcw = 1.e-38_r8
         575             :                 end if
         576             :              end do
         577             :           end do
         578             :        end if
         579             :
         580        1536 :     end subroutine modal_aero_data_init
         581             :
         582             : !--------------------------------------------------------------
         583             : !--------------------------------------------------------------
         584       29184 :         subroutine qqcw_set_ptr(index, iptr)
         585             :           use cam_abortutils, only : endrun
         586             :
         587             :
         588             :           integer, intent(in) :: index, iptr
         589             :
         590       29184 :           if(index>0 .and. index <= pcnst ) then
         591       29184 :              qqcw(index)=iptr
         592             :           else
         593           0 :              call endrun('qqcw_set_ptr: attempting to set qqcw pointer already defined')
         594             :           end if
         595       29184 :         end subroutine qqcw_set_ptr
         596             :
         597             : !--------------------------------------------------------------
         598             : !--------------------------------------------------------------
         599  3882229808 :         function qqcw_get_field(pbuf, index, lchnk, errorhandle)
         600             :           use cam_abortutils, only : endrun
         601             :           use physics_buffer, only : physics_buffer_desc, pbuf_get_field
         602             :
         603             :           integer, intent(in) :: index, lchnk
         604             :           real(r8), pointer :: qqcw_get_field(:,:)
         605             :           logical, optional :: errorhandle
         606             :           type(physics_buffer_desc), pointer :: pbuf(:)
         607             :
         608             :           logical :: error
         609             :
         610  1941114904 :           nullify(qqcw_get_field)
         611  1941114904 :           error = .false.
         612  1941114904 :           if (index>0 .and. index <= pcnst) then
         613  1938136552 :              if (qqcw(index)>0) then
         614             :                 call pbuf_get_field(pbuf, qqcw(index), qqcw_get_field)
         615             :              else
         616             :                 error = .true.
         617             :              endif
         618             :           else
         619             :              error = .true.
         620             :           end if
         621             :
         622  1941114904 :           if (error .and. .not. present(errorhandle)) then
         623           0 :              call endrun('qqcw_get_field: attempt to access undefined qqcw')
         624             :           end if
         625             :
         626  1941114904 :         end function qqcw_get_field
         627             :
         628             : !----------------------------------------------------------------
         629             : !
         630             : !   nspec_max = maximum allowable number of chemical species
         631             : !       in each aerosol mode
         632             : !
         633             : !   ntot_amode = number of aerosol modes
         634             : !   ( ntot_amode_gchm = number of aerosol modes in gchm
         635             : !     ntot_amode_ccm2 = number of aerosol modes to be made known to ccm2
         636             : !       These are temporary until multi-mode activation scavenging is going.
         637             : !       Until then, ntot_amode is set to either ntot_amode_gchm or
         638             : !       ntot_amode_ccm2 depending on which code is active )
         639             : !
         640             : !   msectional - if positive, moving-center sectional code is utilized,
         641             : !       and each mode is actually a section.
         642             : !   msectional_concinit - if positive, special code is used to initialize
         643             : !       the mixing ratios of all the sections.
         644             : !
         645             : !   nspec_amode(m) = number of chemical species in aerosol mode m
         646             : !   nspec_amode_ccm2(m) = . . .  while in ccm2 code
         647             : !   nspec_amode_gchm(m) = . . .  while in gchm code
         648             : !   nspec_amode_nontracer(m) = number of "non-tracer" chemical
         649             : !       species while in gchm code
         650             : !   lspectype_amode(l,m) = species type/i.d. for chemical species l
         651             : !       in aerosol mode m.  (1=sulfate, others to be defined)
         652             : !   lmassptr_amode(l,m) = gchm r-array index for the mixing ratio
         653             : !       (moles-x/mole-air) for chemical species l in aerosol mode m
         654             : !       that is in clear air or interstitial air (but not in cloud water)
         655             : !   lmassptrcw_amode(l,m) = gchm r-array index for the mixing ratio
         656             : !       (moles-x/mole-air) for chemical species l in aerosol mode m
         657             : !       that is currently bound/dissolved in cloud water
         658             : !   lwaterptr_amode(m) = gchm r-array index for the mixing ratio
         659             : !       (moles-water/mole-air) for water associated with aerosol mode m
         660             : !       that is in clear air or interstitial air
         661             : !   lkohlercptr_amode(m) = gchm r-array index for the kohler "c" parameter
         662             : !       for aerosol mode m.  This is defined on a per-dry-particle-mass basis:
         663             : !           c = r(i,j,k,lkohlercptr_amode) * [rhodry * (4*pi/3) * rdry^3]
         664             : !   numptr_amode(m) = gchm r-array index for the number mixing ratio
         665             : !       (particles/mole-air) for aerosol mode m that is in clear air or
         666             : !       interstitial are (but not in cloud water).  If zero or negative,
         667             : !       then number is not being simulated.
         668             : !   ( numptr_amode_gchm(m) = same thing but for within gchm
         669             : !     numptr_amode_ccm2(m) = same thing but for within ccm2
         670             : !       These are temporary, to allow testing number in gchm before ccm2 )
         671             : !   numptrcw_amode(m) = gchm r-array index for the number mixing ratio
         672             : !       (particles/mole-air) for aerosol mode m
         673             : !       that is currently bound/dissolved in cloud water
         674             : !   lsfcptr_amode(m) = gchm r-array index for the surface area mixing ratio
         675             : !       (cm^2/mole-air) for aerosol mode m that is in clear air or
         676             : !       interstitial are (but not in cloud water).  If zero or negative,
         677             : !       then surface area is not being simulated.
         678             : !   lsfcptrcw_amode(m) = gchm r-array index for the surface area mixing ratio
         679             : !       (cm^2/mole-air) for aerosol mode m that is currently
         680             : !       bound/dissolved in cloud water.
         681             : !   lsigptr_amode(m) = gchm r-array index for sigmag for aerosol mode m
         682             : !       that is in clear air or interstitial are (but not in cloud water).
         683             : !       If zero or negative, then the constant sigmag_amode(m) is used.
         684             : !   lsigptrcw_amode(m) = gchm r-array index for sigmag for aerosol mode m
         685             : !       that is currently bound/dissolved in cloud water.
         686             : !       If zero or negative, then the constant sigmag_amode(m) is used.
         687             : !   lsigptrac_amode(m) = gchm r-array index for sigmag for aerosol mode m
         688             : !       for combined clear-air/interstial plus bound/dissolved in cloud water.
         689             : !       If zero or negative, then the constant sigmag_amode(m) is used.
         690             : !
         691             : !   dgnum_amode(m) = geometric dry mean diameter (m) of the number
         692             : !       distribution for aerosol mode m.
         693             : !       (Only used when numptr_amode(m) is zero or negative.)
         694             : !   dgnumlo_amode(m), dgnumhi_amode(m) = lower and upper limits on the
         695             : !       geometric dry mean diameter (m) of the number distribution
         696             : !       (Used when mprognum_amode>0, to limit dgnum to reasonable values)
         697             : !   sigmag_amode(m) = geometric standard deviation for aerosol mode m
         698             : !   sigmaglo_amode(m), sigmaghi_amode(m) = lower and upper limits on the
         699             : !       geometric standard deviation of the number distribution
         700             : !       (Used when mprogsfc_amode>0, to limit sigmag to reasonable values)
         701             : !   alnsg_amode(m) = alog( sigmag_amode(m) )
         702             : !   alnsglo_amode(m), alnsghi_amode(m) = alog( sigmaglo/hi_amode(m) )
         703             : !   voltonumb_amode(m) = ratio of number to volume for mode m
         704             : !   voltonumblo_amode(m), voltonumbhi_amode(m) = ratio of number to volume
         705             : !       when dgnum = dgnumlo_amode or dgnumhi_amode, respectively
         706             : !   voltosfc_amode(m), voltosfclo_amode(m), voltosfchi_amode(m) - ratio of
         707             : !       surface to volume for mode m (like the voltonumb_amode's)
         708             : !   alnv2n_amode(m), alnv2nlo_amode(m), alnv2nhi_amode(m) -
         709             : !       alnv2n_amode(m) = alog( voltonumblo_amode(m) ), ...
         710             : !   alnv2s_amode(m), alnv2slo_amode(m), alnv2shi_amode(m) -
         711             : !       alnv2s_amode(m) = alog( voltosfclo_amode(m) ), ...
         712             : !   rhcrystal_amode(m) = crystalization r.h. for mode m
         713             : !   rhdeliques_amode(m) = deliquescence r.h. for mode m
         714             : !   (*** these r.h. values are 0-1 fractions, not 0-100 percentages)
         715             : !
         716             : !   mcalcwater_amode(m) - if positive, water content for mode m will be
         717             : !       calculated and stored in rclm(k,lwaterptr_amode(m)).  Otherwise, no.
         718             : !   mprognum_amode(m) - if positive, number mixing-ratio for mode m will
         719             : !       be prognosed.  Otherwise, no.
         720             : !   mdiagnum_amode(m) - if positive, number mixing-ratio for mode m will
         721             : !       be diagnosed and put into rclm(k,numptr_amode(m)).  Otherwise, no.
         722             : !   mprogsfc_amode(m) - if positive, surface area mixing-ratio for mode m will
         723             : !       be prognosed, and sigmag will vary temporally and spatially.
         724             : !       Otherwise, sigmag is constant.
         725             : !       *** currently surface area is not prognosed when msectional>0 ***
         726             : !
         727             : !   ntot_aspectype = overall number of aerosol chemical species defined (over all modes)
         728             : !   specdens_amode(l) = dry density (kg/m^3) of aerosol chemical species type l
         729             : !   specmw_amode(l) = molecular weight (kg/kmol) of aerosol chemical species type l
         730             : !   specname_amode(l) = name of aerosol chemical species type l
         731             : !   specrefndxsw(l) = complex refractive index (visible wavelengths)
         732             : !                   of aerosol chemical species type l
         733             : !   specrefndxlw(l) = complex refractive index (infrared wavelengths)
         734             : !                   of aerosol chemical species type l
         735             : !   spechygro(l) = hygroscopicity of aerosol chemical species type l
         736             : !
         737             : !   lptr_so4_a_amode(m), lptr_so4_cw_amode(m) = gchm r-array index for the
         738             : !       mixing ratio for sulfate associated with aerosol mode m
         739             : !       ("a" and "cw" phases)
         740             : !   (similar for msa, oc, bc, nacl, dust)
         741             : !
         742             : !   modename_amode(m) = character-variable name for mode m,
         743             : !       read from mirage2.inp
         744             : !   modeptr_accum - mode index for the main accumulation mode
         745             : !       if modeptr_accum = 1, then mode 1 is the main accumulation mode,
         746             : !       and modename_amode(1) = "accum"
         747             : !   modeptr_aitken - mode index for the main aitken mode
         748             : !       if modeptr_aitken = 2, then mode 2 is the main aitken mode,
         749             : !       and modename_amode(2) = "aitken"
         750             : !   modeptr_ufine - mode index for the ultrafine mode
         751             : !       if modeptr_ufine = 3, then mode 3 is the ultrafine mode,
         752             : !       and modename_amode(3) = "ufine"
         753             : !   modeptr_coarseas - mode index for the coarse sea-salt mode
         754             : !       if modeptr_coarseas = 4, then mode 4 is the coarse sea-salt mode,
         755             : !       and modename_amode(4) = "coarse_seasalt"
         756             : !   modeptr_coardust - mode index for the coarse dust mode
         757             : !       if modeptr_coardust = 5, then mode 5 is the coarse dust mode,
         758             : !       and modename_amode(5) = "coarse_dust"
         759             : !
         760             : !   specdens_XX_amode = dry density (kg/m^3) of aerosol chemical species type XX
         761             : !       where XX is so4, om, bc, dust, seasalt
         762             : !       contains same values as the specdens_amode array
         763             : !       allows values to be referenced differently
         764             : !   specmw_XX_amode = molecular weight (kg/kmol) of aerosol chemical species type XX
         765             : !       contains same values as the specmw_amode array
         766             : !
         767             : !-----------------------------------------------------------------------
         768             :
         769             :
         770             : !--------------------------------------------------------------
         771             : !
         772             : ! ... aerosol size information for the current chunk
         773             : !
         774             : !--------------------------------------------------------------
         775             : !
         776             : !  dgncur = current geometric mean diameters (cm) for number distributions
         777             : !  dgncur_a - for unactivated particles, dry
         778             : !             (in physics buffer as DGNUM)
         779             : !  dgncur_awet - for unactivated particles, wet at grid-cell ambient RH
         780             : !             (in physics buffer as DGNUMWET)
         781             : !
         782             : !  the dgncur are computed from current mass and number
         783             : !  mixing ratios in the grid cell, BUT are then adjusted to be within
         784             : !  the bounds defined by dgnumlo/hi_amode
         785             : !
         786             : !  v2ncur = current (number/volume) ratio based on dgncur and sgcur
         787             : !              (volume in cm^3/whatever, number in particles/whatever)
         788             : !         == 1.0 / ( pi/6 * dgncur**3 * exp(4.5*((log(sgcur))**2)) )
         789             : !  v2ncur_a - for unactivated particles
         790             : !             (currently just defined locally)
         791             : !
         792             :
         793             :      !==============================================================
         794       29184 :      subroutine search_list_of_names(                                &
         795       29184 :           name_to_find, name_id, list_of_names, list_length )
         796             :        !
         797             :        !   searches for a name in a list of names
         798             :        !
         799             :        !   name_to_find - the name to be found in the list  [input]
         800             :        !   name_id - the position of "name_to_find" in the "list_of_names".
         801             :        !       If the name is not found in the list, then name_id=0.  [output]
         802             :        !   list_of_names - the list of names to be searched  [input]
         803             :        !   list_length - the number of names in the list  [input]
         804             :        !
         805             :        character(len=*), intent(in):: name_to_find, list_of_names(:)
         806             :        integer, intent(in) :: list_length
         807             :        integer, intent(out) :: name_id
         808             :
         809             :        integer :: i
         810       29184 :        name_id = -999888777
         811       29184 :        if (name_to_find .ne. ' ') then
         812      815616 :           do i = 1, list_length
         813      815616 :              if (name_to_find .eq. list_of_names(i)) then
         814       29184 :                 name_id = i
         815       29184 :                 exit
         816             :              end if
         817             :           end do
         818             :        end if
         819  1941114904 :      end subroutine search_list_of_names
         820             :
         821             :
         822             :      !==============================================================
         823        1536 :      subroutine initaermodes_setspecptrs
         824             :        !
         825             :        !   sets the lptr_so4_a_amode(m), lptr_so4_cw_amode(m), ...
         826             :        !       and writes them to iulog
         827             :        !   ALSO sets the mode-pointers:  modeptr_accum, modeptr_aitken, ...
         828             :        !       and writes them to iulog
         829             :        !   ALSO sets values of specdens_XX_amode and specmw_XX_amode
         830             :        !       (XX = so4, om, bc, dust, seasalt)
         831             :        !
         832             :        implicit none
         833             :
         834             :        !   local variables
         835             :        integer :: i, l, lmassa, lmassc, m
         836             :        character(len=1000) :: msg
         837             :        character*8 :: dumname
         838             :        character*3 :: tmpch3
         839             :        integer, parameter :: init_val=-999888777
         840             :        integer :: bc_ndx, soa_ndx, pom_ndx
         841             :
         842             :        !   all processes set the pointers
         843             :
         844        1536 :        modeptr_accum = init_val
         845        1536 :        modeptr_aitken = init_val
         846        1536 :        modeptr_ufine = init_val
         847        1536 :        modeptr_coarse = init_val
         848        1536 :        modeptr_pcarbon = init_val
         849        1536 :        modeptr_fineseas = init_val
         850        1536 :        modeptr_finedust = init_val
         851        1536 :        modeptr_coarseas = init_val
         852        1536 :        modeptr_coardust = init_val
         853        1536 :        modeptr_stracoar = init_val
         854             :
         855        7680 :        do m = 1, ntot_amode
         856        7680 :           if (modename_amode(m) .eq. 'accum') then
         857        1536 :              modeptr_accum = m
         858        4608 :           else if (modename_amode(m) .eq. 'aitken') then
         859        1536 :              modeptr_aitken = m
         860        3072 :           else if (modename_amode(m) .eq. 'ufine') then
         861           0 :              modeptr_ufine = m
         862        3072 :           else if (modename_amode(m) .eq. 'coarse') then
         863        1536 :              modeptr_coarse = m
         864        1536 :           else if (modename_amode(m) .eq. 'primary_carbon') then
         865        1536 :              modeptr_pcarbon = m
         866           0 :           else if (modename_amode(m) .eq. 'fine_seasalt') then
         867           0 :              modeptr_fineseas = m
         868           0 :           else if (modename_amode(m) .eq. 'fine_dust') then
         869           0 :              modeptr_finedust = m
         870           0 :           else if (modename_amode(m) .eq. 'coarse_seasalt') then
         871           0 :              modeptr_coarseas = m
         872           0 :           else if (modename_amode(m) .eq. 'coarse_dust') then
         873           0 :              modeptr_coardust = m
         874           0 :           else if (modename_amode(m) .eq. 'coarse_strat') then
         875           0 :              modeptr_stracoar = m
         876             :           end if
         877             :        end do
         878             :
         879        9216 :        lptr2_pom_a_amode   = init_val
         880        9216 :        lptr2_pom_cw_amode  = init_val
         881        9216 :        lptr2_soa_a_amode   = init_val
         882        9216 :        lptr2_soa_cw_amode  = init_val
         883        9216 :        lptr2_bc_a_amode    = init_val
         884        9216 :        lptr2_bc_cw_amode   = init_val
         885             :
         886        7680 :        do m = 1, ntot_amode
         887             :
         888        6144 :           lptr_so4_a_amode(m)    = init_val
         889        6144 :           lptr_so4_cw_amode(m)   = init_val
         890        6144 :           lptr_msa_a_amode(m)    = init_val
         891        6144 :           lptr_msa_cw_amode(m)   = init_val
         892        6144 :           lptr_nh4_a_amode(m)    = init_val
         893        6144 :           lptr_nh4_cw_amode(m)   = init_val
         894        6144 :           lptr_no3_a_amode(m)    = init_val
         895        6144 :           lptr_no3_cw_amode(m)   = init_val
         896        6144 :           lptr_nacl_a_amode(m)   = init_val
         897        6144 :           lptr_nacl_cw_amode(m)  = init_val
         898        6144 :           lptr_dust_a_amode(m)   = init_val
         899        6144 :           lptr_dust_cw_amode(m)  = init_val
         900             :
         901        6144 :           pom_ndx = 0
         902        6144 :           soa_ndx = 0
         903        6144 :           bc_ndx = 0
         904             :
         905       30720 :           do l = 1, nspec_amode(m)
         906       23040 :              lmassa  = lmassptr_amode(l,m)
         907       23040 :              lmassc = lmassptrcw_amode(l,m)
         908             :
         909       23040 :              if (lmassa > 0 .and. lmassa <= pcnst) then
         910             :                 write( msg, '(2a,3(1x,i12),2x,a)' ) &
         911       23040 :                      'subr initaermodes_setspecptrs error setting lptr_', &
         912       46080 :                      ' - m, l, lmassa, cnst_name = ', m, l, lmassa, cnst_name(lmassa)
         913             :              else
         914             :                 write( msg, '(2a,3(1x,i12),2x,a)' ) &
         915           0 :                      'subr initaermodes_setspecptrs error setting lptr_', &
         916           0 :                      ' - m, l, lmassa, cnst_name = ', m, l, lmassa, 'UNDEF '
         917           0 :                 call endrun( trim(msg) )
         918             :              end if
         919             :
         920       23040 :              tmpch3 = cnst_name(lmassa)(:3)
         921        6144 :              select case (tmpch3)
         922             :              case('so4')
         923        4608 :                 lptr_so4_a_amode(m)  = lmassa
         924        4608 :                 lptr_so4_cw_amode(m) = lmassc
         925             :              case('msa')
         926           0 :                 lptr_msa_a_amode(m)  = lmassa
         927           0 :                 lptr_msa_cw_amode(m) = lmassc
         928             :              case('nh4')
         929           0 :                 lptr_nh4_a_amode(m)  = lmassa
         930           0 :                 lptr_nh4_cw_amode(m) = lmassc
         931             :              case('no3')
         932           0 :                 lptr_no3_a_amode(m)  = lmassa
         933           0 :                 lptr_no3_cw_amode(m) = lmassc
         934             :              case('dst')
         935        4608 :                 lptr_dust_a_amode(m)  = lmassa
         936        4608 :                 lptr_dust_cw_amode(m) = lmassc
         937             :              case('ncl')
         938        4608 :                 lptr_nacl_a_amode(m)  = lmassa
         939        4608 :                 lptr_nacl_cw_amode(m) = lmassc
         940             :              case('pom')
         941        3072 :                 pom_ndx = pom_ndx+1
         942        3072 :                 lptr2_pom_a_amode(m,pom_ndx)  = lmassa
         943        3072 :                 lptr2_pom_cw_amode(m,pom_ndx) = lmassc
         944             :              case('soa')
         945        3072 :                 soa_ndx = soa_ndx+1
         946        3072 :                 lptr2_soa_a_amode(m,soa_ndx)  = lmassa
         947        3072 :                 lptr2_soa_cw_amode(m,soa_ndx) = lmassc
         948             :              case('bc_','bcf','bcb')
         949        3072 :                 bc_ndx = bc_ndx+1
         950        3072 :                 lptr2_bc_a_amode(m,bc_ndx)  = lmassa
         951        3072 :                 lptr2_bc_cw_amode(m,bc_ndx) = lmassc
         952             :              case default
         953       23040 :                 call endrun( trim(msg) )
         954             :              end select
         955             :           end do ! l
         956             :        end do ! m
         957             :
         958        1536 :        specmw_so4_amode = 1.0_r8
         959             :
         960        7680 :        do m = 1, ntot_amode
         961       30720 :           do l = 1, nspec_amode(m)
         962       23040 :              dumname = trim(adjustl(xname_massptr(l,m)))
         963       23040 :              tmpch3  = trim(adjustl(dumname(:3)))
         964       29184 :              if(trim(adjustl(tmpch3)) == 'so4' .or. trim(adjustl(tmpch3)) == 'SO4') then
         965        4608 :                 specmw_so4_amode = specmw_amode(l,m)
         966             :              endif
         967             :           enddo
         968             :        enddo
         969             :
         970             :
         971             :        !   masterproc writes out the pointers
         972        1536 :        if ( .not. ( masterproc ) ) return
         973             :
         974           2 :        write(iulog,9230)
         975           2 :        write(iulog,*) 'modeptr_accum    =', modeptr_accum
         976           2 :        write(iulog,*) 'modeptr_aitken   =', modeptr_aitken
         977           2 :        write(iulog,*) 'modeptr_ufine    =', modeptr_ufine
         978           2 :        write(iulog,*) 'modeptr_coarse   =', modeptr_coarse
         979           2 :        write(iulog,*) 'modeptr_pcarbon  =', modeptr_pcarbon
         980           2 :        write(iulog,*) 'modeptr_fineseas =', modeptr_fineseas
         981           2 :        write(iulog,*) 'modeptr_finedust =', modeptr_finedust
         982           2 :        write(iulog,*) 'modeptr_coarseas =', modeptr_coarseas
         983           2 :        write(iulog,*) 'modeptr_coardust =', modeptr_coardust
         984           2 :        write(iulog,*) 'modeptr_stracoar =', modeptr_stracoar
         985             :
         986           2 :        dumname = 'none'
         987           2 :        write(iulog,9240)
         988           2 :        write(iulog,9000) 'sulfate    '
         989          10 :        do m = 1, ntot_amode
         990             :           call initaermodes_setspecptrs_write2( m,                    &
         991          10 :                lptr_so4_a_amode(m), lptr_so4_cw_amode(m),  'so4' )
         992             :        end do
         993             :
         994           2 :        write(iulog,9000) 'msa        '
         995          10 :        do m = 1, ntot_amode
         996             :           call initaermodes_setspecptrs_write2( m,                    &
         997          10 :                lptr_msa_a_amode(m), lptr_msa_cw_amode(m),  'msa' )
         998             :        end do
         999             :
        1000           2 :        write(iulog,9000) 'ammonium   '
        1001          10 :        do m = 1, ntot_amode
        1002             :           call initaermodes_setspecptrs_write2( m,                    &
        1003          10 :                lptr_nh4_a_amode(m), lptr_nh4_cw_amode(m),  'nh4' )
        1004             :        end do
        1005             :
        1006           2 :        write(iulog,9000) 'nitrate    '
        1007          10 :        do m = 1, ntot_amode
        1008             :           call initaermodes_setspecptrs_write2( m,                    &
        1009          10 :                lptr_no3_a_amode(m), lptr_no3_cw_amode(m),  'no3' )
        1010             :        end do
        1011             :
        1012           2 :        write(iulog,9000) 'p-organic  '
        1013          10 :        do m = 1, ntot_amode
        1014          18 :           do i = 1, npoa
        1015           8 :              write(dumname,'(a,i2.2)') 'pom', i
        1016             :              call initaermodes_setspecptrs_write2b( m, &
        1017          16 :                   lptr2_pom_a_amode(m,i), lptr2_pom_cw_amode(m,i),  dumname(1:5) )
        1018             :           end do
        1019             :        end do
        1020             :
        1021           2 :        write(iulog,9000) 's-organic  '
        1022          10 :        do m = 1, ntot_amode
        1023          18 :           do i = 1, nsoa
        1024           8 :              write(dumname,'(a,i2.2)') 'soa', i
        1025             :              call initaermodes_setspecptrs_write2b( m, &
        1026          16 :                   lptr2_soa_a_amode(m,i), lptr2_soa_cw_amode(m,i), dumname(1:5) )
        1027             :           end do
        1028             :        end do
        1029           4 :        do i = 1, nsoa
        1030           2 :           l = lptr2_soa_g_amode(i)
        1031           4 :           write(iulog,'(i4,2x,i12,2x,a,20x,a,i2.2,a)') i, l, cnst_name(l), 'lptr2_soa', i, '_g'
        1032             :        end do
        1033             :
        1034           2 :        write(iulog,9000) 'black-c    '
        1035          10 :        do m = 1, ntot_amode
        1036          18 :           do i = 1, nbc
        1037           8 :              write(dumname,'(a,i2.2)') 'bc', i
        1038             :              call initaermodes_setspecptrs_write2b( m, &
        1039          16 :                   lptr2_bc_a_amode(m,i), lptr2_bc_cw_amode(m,i), dumname(1:5) )
        1040             :           end do
        1041             :        end do
        1042             :
        1043           2 :        write(iulog,9000) 'seasalt   '
        1044          10 :        do m = 1, ntot_amode
        1045             :           call initaermodes_setspecptrs_write2( m,                    &
        1046          10 :                lptr_nacl_a_amode(m), lptr_nacl_cw_amode(m),  'nacl' )
        1047             :        end do
        1048             :
        1049           2 :        write(iulog,9000) 'dust       '
        1050          10 :        do m = 1, ntot_amode
        1051             :           call initaermodes_setspecptrs_write2( m,                    &
        1052          10 :                lptr_dust_a_amode(m), lptr_dust_cw_amode(m),  'dust' )
        1053             :        end do
        1054             :
        1055             : 9000   format( a )
        1056             : 9230   format(                                                         &
        1057             :             / 'mode-pointer output from subr initaermodes_setspecptrs' )
        1058             : 9240   format(                                                         &
        1059             :             / 'species-pointer output from subr initaermodes_setspecptrs' / &
        1060             :             'mode', 12x, 'id  name_a  ', 12x, 'id  name_cw' )
        1061             :
        1062             :        return
        1063             :      end subroutine initaermodes_setspecptrs
        1064             :
        1065             :
        1066             :      !==============================================================
        1067          48 :      subroutine initaermodes_setspecptrs_write2(                     &
        1068             :           m, laptr, lcptr, txtdum )
        1069             :        !
        1070             :        !   does some output for initaermodes_setspecptrs
        1071             :
        1072             :        use constituents, only: pcnst, cnst_name
        1073             :
        1074             :        implicit none
        1075             :
        1076             :        !   subr arguments
        1077             :        integer, intent(in) :: m, laptr, lcptr
        1078             :        character*(*), intent(in) ::  txtdum
        1079             :
        1080             :        !   local variables
        1081             :        character*8 dumnamea, dumnamec
        1082             :
        1083          48 :        dumnamea = 'none'
        1084          48 :        dumnamec = 'none'
        1085          48 :        if (laptr > pcnst .or. lcptr > pcnst ) then
        1086           0 :           call endrun('initaermodes_setspecptrs_write2: ERROR')
        1087             :        endif
        1088          48 :        if (laptr .gt. 0) dumnamea = cnst_name(laptr)
        1089          48 :        if (lcptr .gt. 0) dumnamec = cnst_name(lcptr)
        1090          48 :        write(iulog,9241) m, laptr, dumnamea, lcptr, dumnamec, txtdum
        1091             :
        1092             : 9241   format( i4, 2( 2x, i12, 2x, a ),                                &
        1093             :             4x, 'lptr_', a, '_a/cw_amode' )
        1094             :
        1095          48 :        return
        1096             :      end subroutine initaermodes_setspecptrs_write2
        1097             :
        1098             :
        1099             :      !==============================================================
        1100          24 :      subroutine initaermodes_setspecptrs_write2b( &
        1101             :           m, laptr, lcptr, txtdum )
        1102             :        !
        1103             :        !   does some output for initaermodes_setspecptrs
        1104             :
        1105             :        implicit none
        1106             :
        1107             :        !   subr arguments
        1108             :        integer, intent(in) :: m, laptr, lcptr
        1109             :        character*(*), intent(in) :: txtdum
        1110             :
        1111             :        !   local variables
        1112             :        character*8 dumnamea, dumnamec
        1113             :
        1114          24 :        dumnamea = 'none'
        1115          24 :        dumnamec = 'none'
        1116          24 :        if (laptr .gt. 0) dumnamea = cnst_name(laptr)
        1117          24 :        if (lcptr .gt. 0) dumnamec = cnst_name(lcptr)
        1118          24 :        write(iulog,9241) m, laptr, dumnamea, lcptr, dumnamec, txtdum
        1119             :
        1120             : 9241   format( i4, 2( 2x, i12, 2x, a ),                                &
        1121             :             4x, 'lptr2_', a, '_a/cw_amode' )
        1122             :
        1123          24 :        return
        1124             :      end subroutine initaermodes_setspecptrs_write2b
        1125             :
        1126             :      !==============================================================
        1127        1536 :      subroutine initaermodes_set_cnstnamecw
        1128             :        !
        1129             :        !   sets the cnst_name_cw
        1130             :        !
        1131             :        use constituents, only: pcnst, cnst_name
        1132             :        implicit none
        1133             :
        1134             :        !   subr arguments (none)
        1135             :
        1136             :        !   local variables
        1137             :        integer j, l, la, lc, ll, m
        1138             :
        1139             :        !   set cnst_name_cw
        1140       64512 :        cnst_name_cw = ' '
        1141        7680 :        do m = 1, ntot_amode
        1142       36864 :           do ll = 0, nspec_amode(m)
        1143       29184 :              if (ll == 0) then
        1144        6144 :                 la = numptr_amode(m)
        1145        6144 :                 lc = numptrcw_amode(m)
        1146             :              else
        1147       23040 :                 la = lmassptr_amode(ll,m)
        1148       23040 :                 lc = lmassptrcw_amode(ll,m)
        1149             :              end if
        1150             :              if ((la < 1) .or. (la > pcnst) .or.   &
        1151       29184 :                   (lc < 1) .or. (lc > pcnst)) then
        1152             :                 write(*,'(/2a/a,5(1x,i10))')   &
        1153           0 :                      '*** initaermodes_set_cnstnamecw error',   &
        1154           0 :                      ' -- bad la or lc',   &
        1155           0 :                      '    m, ll, la, lc, pcnst =', m, ll, la, lc, pcnst
        1156           0 :                 call endrun( '*** initaermodes_set_cnstnamecw error' )
        1157             :              end if
        1158       84480 :              do j = 2, len( cnst_name(la) ) - 1
        1159       84480 :                 if (cnst_name(la)(j:j+1) == '_a') then
        1160       29184 :                    cnst_name_cw(lc) = cnst_name(la)
        1161       29184 :                    cnst_name_cw(lc)(j:j+1) = '_c'
        1162       29184 :                    exit
        1163       55296 :                 else if (cnst_name(la)(j:j+1) == '_A') then
        1164           0 :                    cnst_name_cw(lc) = cnst_name(la)
        1165           0 :                    cnst_name_cw(lc)(j:j+1) = '_C'
        1166           0 :                    exit
        1167             :                 end if
        1168             :              end do
        1169       35328 :              if (cnst_name_cw(lc) == ' ') then
        1170             :                 write(*,'(/2a/a,3(1x,i10),2x,a)')   &
        1171           0 :                      '*** initaermodes_set_cnstnamecw error',   &
        1172           0 :                      ' -- bad cnst_name(la)',   &
        1173           0 :                      '    m, ll, la, cnst_name(la) =',   &
        1174           0 :                      m, ll, la, cnst_name(la)
        1175           0 :                 call endrun( '*** initaermodes_set_cnstnamecw error' )
        1176             :              end if
        1177             :           end do   ! ll = 0, nspec_amode(m)
        1178             :        end do   ! m = 1, ntot_amode
        1179             :
        1180        1536 :        if ( masterproc ) then
        1181           2 :           write(*,'(/a)') 'l, cnst_name(l), cnst_name_cw(l)'
        1182          84 :           do l = 1, pcnst
        1183          84 :              write(*,'(i4,2(2x,a))') l, cnst_name(l), cnst_name_cw(l)
        1184             :           end do
        1185             :        end if
        1186             :
        1187        1536 :        return
        1188             :      end subroutine initaermodes_set_cnstnamecw
        1189             :
        1190             :   end module modal_aero_data

Generated by: LCOV version 1.14