LCOV - code coverage report
Current view: | top level - chemistry/modal_aero - modal_aero_rename.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 371 | 650 | 57.1 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 4 | 6 | 66.7 %

              Line data    Source code
           1             : ! modal_aero_rename.F90
           2             : !----------------------------------------------------------------------
           3             : !BOP
           4             : !
           5             : ! !MODULE: modal_aero_rename --- modal aerosol mode merging (renaming)
           6             : !
           7             : ! !INTERFACE:
           8             :   module modal_aero_rename
           9             :
          10             : ! !USES:
          11             :   use shr_kind_mod,    only: r8 => shr_kind_r8
          12             :   use cam_abortutils,  only: endrun
          13             :   use cam_logfile,     only: iulog
          14             :   use mo_constants,    only: pi
          15             :   use chem_mods,       only: gas_pcnst
          16             :   use ppgrid,          only: pcols, pver
          17             :   use constituents,    only: pcnst, cnst_name
          18             :   use spmd_utils,      only: masterproc
          19             :   use modal_aero_data, only: maxspec_renamexf=>nspec_max, ntot_amode
          20             :   use modal_aero_data, only: alnsg_amode, voltonumblo_amode, voltonumbhi_amode, dgnum_amode, nspec_amode
          21             :   use modal_aero_data, only: specmw_amode, specdens_amode, lmassptr_amode, lmassptrcw_amode
          22             :   use modal_aero_data, only: numptr_amode, numptrcw_amode, modeptr_coarse, modeptr_accum
          23             :   use modal_aero_data, only: modeptr_stracoar
          24             :   use modal_aero_data, only: specmw_amode, specdens_amode, lmassptr_amode, lmassptrcw_amode, numptr_amode, numptrcw_amode
          25             :   use modal_aero_data, only: dgnumhi_amode, dgnumlo_amode, cnst_name_cw, modeptr_aitken
          26             :   use rad_constituents,only: rad_cnst_get_mode_idx
          27             :
          28             :   implicit none
          29             :   private
          30             :   save
          31             :
          32             : ! !PUBLIC MEMBER FUNCTIONS:
          33             :   public modal_aero_rename_sub, modal_aero_rename_init
          34             :
          35             : ! !PUBLIC DATA MEMBERS:
          36             :   integer, parameter :: pcnstxx = gas_pcnst
          37             :
          38             :   integer, parameter, public :: maxpair_renamexf = 3
          39             :
          40             :   integer, protected, public :: ipair_select_renamexf(maxpair_renamexf)
          41             : ! ipair_select_renamexf defines the mode_from and mode_too for each renaming pair
          42             : ! 2001 = aitken --> accum
          43             : ! 1003 = accum  --> coarse
          44             : ! 3001 = coarse --> accum
          45             : ! 1005 = accum  --> stracoar
          46             : ! 5001 = stracoar --> accum
          47             :
          48             :   integer, parameter, public :: method_optbb_renamexf = 2
          49             :
          50             :   integer, public :: npair_renamexf = -123456789
          51             :   integer, protected, public :: modefrm_renamexf(maxpair_renamexf)
          52             :   integer, protected, public :: modetoo_renamexf(maxpair_renamexf)
          53             :   integer, protected, public :: nspecfrm_renamexf(maxpair_renamexf)
          54             :
          55             :   integer, allocatable, protected, public :: lspecfrma_renamexf(:,:)
          56             :   integer, allocatable, protected, public :: lspecfrmc_renamexf(:,:)
          57             :   integer, allocatable, protected, public :: lspectooa_renamexf(:,:)
          58             :   integer, allocatable, protected, public :: lspectooc_renamexf(:,:)
          59             :
          60             :   integer, protected, public :: igrow_shrink_renamexf(maxpair_renamexf)
          61             :   integer, protected, public :: ixferable_all_renamexf(maxpair_renamexf)
          62             :   integer, protected, public :: ixferable_all_needed_renamexf(maxpair_renamexf)
          63             :   integer, allocatable, protected, public :: ixferable_a_renamexf(:,:)
          64             :   integer, allocatable, protected, public :: ixferable_c_renamexf(:,:)
          65             :
          66             :   logical, public :: strat_only_renamexf(maxpair_renamexf)
          67             : ! strat_only_renamexf - when true for a particular renaming pair, renaming is only
          68             : !                       done in stratosphere (when k < troplev(icol) )
          69             :
          70             : ! !PRIVATE DATA MEMBERS:
          71             :   integer, allocatable :: ido_mode_calcaa(:)
          72             :   real (r8) :: dp_belowcut(maxpair_renamexf)
          73             :   real (r8) :: dp_cut(maxpair_renamexf)
          74             :   real (r8) :: dp_xferall_thresh(maxpair_renamexf)
          75             :   real (r8) :: dp_xfernone_threshaa(maxpair_renamexf)
          76             :   real (r8), allocatable :: dryvol_smallest(:)
          77             :   real (r8), allocatable :: factoraa(:)
          78             :   real (r8), allocatable :: factoryy(:)
          79             :   real (r8) :: lndp_cut(maxpair_renamexf)
          80             :   real (r8) :: factor_3alnsg2(maxpair_renamexf)
          81             :   real (r8), allocatable :: v2nhirlx(:), v2nlorlx(:)
          82             :
          83             :   logical :: modal_accum_coarse_exch = .false.
          84             :
          85             : ! !DESCRIPTION: This module implements ...
          86             : !
          87             : ! !REVISION HISTORY:
          88             : !
          89             : !   RCE 07.04.13:  Adapted from MIRAGE2 code
          90             : !
          91             : !EOP
          92             : !----------------------------------------------------------------------
          93             : !BOC
          94             :
          95             : ! list private module data here
          96             :
          97             : !EOC
          98             : !----------------------------------------------------------------------
          99             : contains
         100             :
         101             :   !------------------------------------------------------------------
         102             :   !------------------------------------------------------------------
         103        1536 :   subroutine modal_aero_rename_init(modal_accum_coarse_exch_in)
         104             :     logical, optional, intent(in) :: modal_accum_coarse_exch_in
         105             :
         106             :     ! ipair_select_renamexf defines the mode_from and mode_too for each renaming pair
         107             :     ! 2001 = aitken --> accum
         108             :     ! 1003 = accum  --> coarse
         109             :     ! 3001 = coarse --> accum
         110             :     ! 1005 = accum  --> stracoar
         111             :     ! 5001 = stracoar --> accum
         112        1536 :     if( rad_cnst_get_mode_idx(0,'coarse_strat') > 0 ) then
         113           0 :        ipair_select_renamexf(1:maxpair_renamexf) = (/ 2001, 1005, 5001 /)
         114             :     else
         115        1536 :        ipair_select_renamexf(1:maxpair_renamexf) = (/ 2001, 1003, 3001 /)
         116             :     endif
         117             :
         118        4608 :     allocate( lspecfrma_renamexf(maxspec_renamexf,maxpair_renamexf) )
         119        3072 :     allocate( lspecfrmc_renamexf(maxspec_renamexf,maxpair_renamexf) )
         120        3072 :     allocate( lspectooa_renamexf(maxspec_renamexf,maxpair_renamexf) )
         121        3072 :     allocate( lspectooc_renamexf(maxspec_renamexf,maxpair_renamexf) )
         122             :
         123        3072 :     allocate( ixferable_a_renamexf(maxspec_renamexf,maxpair_renamexf) )
         124        3072 :     allocate( ixferable_c_renamexf(maxspec_renamexf,maxpair_renamexf) )
         125        4608 :     allocate( ido_mode_calcaa(ntot_amode) )
         126             :
         127        4608 :     allocate( dryvol_smallest(ntot_amode) )
         128        3072 :     allocate( factoraa(ntot_amode) )
         129        3072 :     allocate( factoryy(ntot_amode) )
         130             :
         131        4608 :     allocate( v2nhirlx(ntot_amode), v2nlorlx(ntot_amode) )
         132             :
         133        1536 :     if (present(modal_accum_coarse_exch_in)) then
         134        1536 :        modal_accum_coarse_exch = modal_accum_coarse_exch_in
         135             :     endif
         136             :
         137        1536 :     if (modal_accum_coarse_exch) then
         138        1536 :        call modal_aero_rename_acc_crs_init()
         139             :     else
         140           0 :        call modal_aero_rename_no_acc_crs_init()
         141             :     endif
         142             :
         143        1536 :   end subroutine modal_aero_rename_init
         144             :
         145             :   !------------------------------------------------------------------
         146             :   !------------------------------------------------------------------
         147     1489176 :   subroutine modal_aero_rename_sub(                       &
         148             :        fromwhere,         lchnk,               &
         149             :        ncol,              nstep,               &
         150             :        loffset,           deltat,              &
         151             :        pdel,              troplev,             &
         152     1489176 :        dotendrn,          q,                   &
         153     1489176 :        dqdt,              dqdt_other,          &
         154     1489176 :        dotendqqcwrn,      qqcw,                &
         155     1489176 :        dqqcwdt,           dqqcwdt_other,       &
         156     1489176 :        is_dorename_atik,  dorename_atik,       &
         157             :        jsrflx_rename,     nsrflx,              &
         158     1489176 :        qsrflx,            qqcwsrflx,           &
         159             :        dqdt_rnpos                              )
         160             :
         161             :
         162             :     ! !PARAMETERS:
         163             :     character(len=*), intent(in) :: fromwhere    ! identifies which module
         164             :     ! is making the call
         165             :     integer,  intent(in)    :: lchnk                ! chunk identifier
         166             :     integer,  intent(in)    :: ncol                 ! number of atmospheric column
         167             :     integer,  intent(in)    :: nstep                ! model time-step number
         168             :     integer,  intent(in)    :: loffset              ! offset applied to modal aero "ptrs"
         169             :     real(r8), intent(in)    :: deltat               ! time step (s)
         170             :     integer,  intent(in)    :: troplev(pcols)
         171             :
         172             :     real(r8), intent(in)    :: pdel(pcols,pver)     ! pressure thickness of levels (Pa)
         173             :     real(r8), intent(in)    :: q(ncol,pver,pcnstxx) ! tracer mixing ratio array
         174             :     ! *** MUST BE mol/mol-air or #/mol-air
         175             :     ! *** NOTE ncol and pcnstxx dimensions
         176             :     real(r8), intent(in)    :: qqcw(ncol,pver,pcnstxx) ! like q but for cloud-borne species
         177             :
         178             :     real(r8), intent(inout) :: dqdt(ncol,pver,pcnstxx)  ! TMR tendency array;
         179             :     ! incoming dqdt = tendencies for the
         180             :     !     "fromwhere" continuous growth process
         181             :     ! the renaming tendencies are added on
         182             :     ! *** NOTE ncol and pcnstxx dimensions
         183             :     real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx)
         184             :     real(r8), intent(in)    :: dqdt_other(ncol,pver,pcnstxx)
         185             :     ! tendencies for "other" continuous growth process
         186             :     ! *** NOTE ncol and pcnstxx dimensions
         187             :     real(r8), intent(in)    :: dqqcwdt_other(ncol,pver,pcnstxx)
         188             :     logical,  intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which
         189             :     !     renaming dqdt is computed
         190             :     logical,  intent(inout) :: dotendqqcwrn(pcnstxx)
         191             :
         192             :     logical,  intent(in)    :: is_dorename_atik          ! true if dorename_atik is provided
         193             :     logical,  intent(in)    :: dorename_atik(ncol,pver) ! true if renaming should
         194             :     ! be done at i,k
         195             :     integer,  intent(in)    :: jsrflx_rename        ! qsrflx index for renaming
         196             :     integer,  intent(in)    :: nsrflx               ! last dimension of qsrflx
         197             :
         198             :     real(r8), intent(inout) :: qsrflx(pcols,pcnstxx,nsrflx)
         199             :     ! process-specific column tracer tendencies
         200             :     real(r8), intent(inout) :: qqcwsrflx(pcols,pcnstxx,nsrflx)
         201             :     real(r8), optional, intent(out) &
         202             :          :: dqdt_rnpos(ncol,pver,pcnstxx)
         203             :     ! the positive (production) part of the renaming tendency
         204             :
         205     1489176 :     if (modal_accum_coarse_exch) then
         206             :        call modal_aero_rename_acc_crs_sub(        &
         207             :             fromwhere,         lchnk,               &
         208             :             ncol,              nstep,               &
         209             :             loffset,           deltat,              &
         210             :             pdel,              troplev,             &
         211             :             dotendrn,          q,                   &
         212             :             dqdt,              dqdt_other,          &
         213             :             dotendqqcwrn,      qqcw,                &
         214             :             dqqcwdt,           dqqcwdt_other,       &
         215             :             is_dorename_atik,  dorename_atik,       &
         216             :             jsrflx_rename,     nsrflx,              &
         217             :             qsrflx,            qqcwsrflx,           &
         218     1489176 :             dqdt_rnpos                              )
         219             :     else
         220             :        call modal_aero_rename_no_acc_crs_sub(             &
         221             :             fromwhere,         lchnk,               &
         222             :             ncol,              nstep,               &
         223             :             loffset,           deltat,              &
         224             :             pdel,                                   &
         225             :             dotendrn,          q,                   &
         226             :             dqdt,              dqdt_other,          &
         227             :             dotendqqcwrn,      qqcw,                &
         228             :             dqqcwdt,           dqqcwdt_other,       &
         229             :             is_dorename_atik,  dorename_atik,       &
         230             :             jsrflx_rename,     nsrflx,              &
         231           0 :             qsrflx,            qqcwsrflx            )
         232             :     endif
         233     1489176 :   end subroutine modal_aero_rename_sub
         234             :
         235             : !----------------------------------------------------------------------
         236             : !----------------------------------------------------------------------
         237             : ! private methods
         238             : !----------------------------------------------------------------------
         239             : !BOP
         240             : ! !ROUTINE:  modal_aero_rename_no_acc_crs_sub --- ...
         241             : !
         242             : ! !INTERFACE:
         243           0 :         subroutine modal_aero_rename_no_acc_crs_sub(                       &
         244             :                         fromwhere,         lchnk,               &
         245             :                         ncol,              nstep,               &
         246             :                         loffset,           deltat,              &
         247             :                         pdel,                                   &
         248           0 :                         dotendrn,          q,                   &
         249           0 :                         dqdt,              dqdt_other,          &
         250           0 :                         dotendqqcwrn,      qqcw,                &
         251           0 :                         dqqcwdt,           dqqcwdt_other,       &
         252           0 :                         is_dorename_atik,  dorename_atik,       &
         253             :                         jsrflx_rename,     nsrflx,              &
         254           0 :                         qsrflx,            qqcwsrflx            )
         255             :
         256             : ! !USES:
         257             :    use physconst, only: gravit, mwdry
         258             :    use shr_spfn_mod, only: erfc => shr_spfn_erfc
         259             :
         260             :    implicit none
         261             :
         262             :
         263             : ! !PARAMETERS:
         264             :    character(len=*), intent(in) :: fromwhere    ! identifies which module
         265             :                                                 ! is making the call
         266             :    integer,  intent(in)    :: lchnk                ! chunk identifier
         267             :    integer,  intent(in)    :: ncol                 ! number of atmospheric column
         268             :    integer,  intent(in)    :: nstep                ! model time-step number
         269             :    integer,  intent(in)    :: loffset              ! offset applied to modal aero "ptrs"
         270             :    real(r8), intent(in)    :: deltat               ! time step (s)
         271             :
         272             :    real(r8), intent(in)    :: pdel(pcols,pver)     ! pressure thickness of levels (Pa)
         273             :    real(r8), intent(in)    :: q(ncol,pver,pcnstxx) ! tracer mixing ratio array
         274             :                                                    ! *** MUST BE mol/mol-air or #/mol-air
         275             :                                                    ! *** NOTE ncol and pcnstxx dimensions
         276             :    real(r8), intent(in)    :: qqcw(ncol,pver,pcnstxx) ! like q but for cloud-borne species
         277             :
         278             :    real(r8), intent(inout) :: dqdt(ncol,pver,pcnstxx)  ! TMR tendency array;
         279             :                               ! incoming dqdt = tendencies for the
         280             :                               !     "fromwhere" continuous growth process
         281             :                               ! the renaming tendencies are added on
         282             :                               ! *** NOTE ncol and pcnstxx dimensions
         283             :    real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx)
         284             :    real(r8), intent(in)    :: dqdt_other(ncol,pver,pcnstxx)
         285             :                               ! tendencies for "other" continuous growth process
         286             :                               ! *** NOTE ncol and pcnstxx dimensions
         287             :    real(r8), intent(in)    :: dqqcwdt_other(ncol,pver,pcnstxx)
         288             :    logical,  intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which
         289             :                               !     renaming dqdt is computed
         290             :    logical,  intent(inout) :: dotendqqcwrn(pcnstxx)
         291             :
         292             :    logical,  intent(in)    :: is_dorename_atik          ! true if dorename_atik is provided
         293             :    logical,  intent(in)    :: dorename_atik(ncol,pver) ! true if renaming should
         294             :                                                         ! be done at i,k
         295             :    integer,  intent(in)    :: jsrflx_rename        ! qsrflx index for renaming
         296             :    integer,  intent(in)    :: nsrflx               ! last dimension of qsrflx
         297             :
         298             :    real(r8), intent(inout) :: qsrflx(pcols,pcnstxx,nsrflx)
         299             :                               ! process-specific column tracer tendencies
         300             :    real(r8), intent(inout) :: qqcwsrflx(pcols,pcnstxx,nsrflx)
         301             :
         302             : ! !DESCRIPTION:
         303             : ! computes TMR (tracer mixing ratio) tendencies for "mode renaming"
         304             : !    during a continuous growth process
         305             : ! currently this transfers number and mass (and surface) from the aitken
         306             : !    to accumulation mode after gas condensation or stratiform-cloud
         307             : !    aqueous chemistry
         308             : ! (convective cloud aqueous chemistry not yet implemented)
         309             : !
         310             : ! !REVISION HISTORY:
         311             : !   RCE 07.04.13:  Adapted from MIRAGE2 code
         312             : !
         313             : !EOP
         314             : !----------------------------------------------------------------------
         315             : !BOC
         316             :
         317             : ! local variables
         318             :    integer, parameter :: ldiag1=-1
         319             :    integer :: i, icol_diag, ipair, iq, j, k, l, l1, la, lc, lunout
         320             :    integer :: lsfrma, lsfrmc, lstooa, lstooc
         321             :    integer :: mfrm, mtoo, n, n1, n2, ntot_msa_a
         322           0 :    integer :: idomode(ntot_amode)
         323             :
         324           0 :    real (r8) :: deldryvol_a(ncol,pver,ntot_amode)
         325           0 :    real (r8) :: deldryvol_c(ncol,pver,ntot_amode)
         326             :    real (r8) :: deltatinv
         327             :    real (r8) :: dp_belowcut(maxpair_renamexf)
         328             :    real (r8) :: dp_cut(maxpair_renamexf)
         329             :    real (r8) :: dgn_aftr, dgn_xfer
         330             :    real (r8) :: dgn_t_new, dgn_t_old
         331             :    real (r8) :: dryvol_t_del, dryvol_t_new
         332             :    real (r8) :: dryvol_t_old, dryvol_t_oldbnd
         333           0 :    real (r8) :: dryvol_a(ncol,pver,ntot_amode)
         334           0 :    real (r8) :: dryvol_c(ncol,pver,ntot_amode)
         335           0 :    real (r8) :: dryvol_smallest(ntot_amode)
         336             :    real (r8) :: dum
         337             :    real (r8) :: dum3alnsg2(maxpair_renamexf)
         338             :    real (r8) :: dum_m2v, dum_m2vdt
         339           0 :    real (r8) :: factoraa(ntot_amode)
         340           0 :    real (r8) :: factoryy(ntot_amode)
         341             :    real (r8) :: frelax
         342             :    real (r8) :: lndp_cut(maxpair_renamexf)
         343             :    real (r8) :: lndgn_new, lndgn_old
         344             :    real (r8) :: lndgv_new, lndgv_old
         345             :    real (r8) :: num_t_old, num_t_oldbnd
         346             :    real (r8) :: onethird
         347             :    real (r8) :: pdel_fac
         348             :    real (r8) :: tailfr_volnew, tailfr_volold
         349             :    real (r8) :: tailfr_numnew, tailfr_numold
         350           0 :    real (r8) :: v2nhirlx(ntot_amode), v2nlorlx(ntot_amode)
         351             :    real (r8) :: xfercoef, xfertend
         352             :    real (r8) :: xferfrac_vol, xferfrac_num, xferfrac_max
         353             :
         354             :    real (r8) :: yn_tail, yv_tail
         355             :
         356             : ! begin
         357           0 :         lunout = iulog
         358             :
         359             : !
         360             : !   calculations done once on initial entry
         361             : !
         362             : !   "init" is now done through chem_init (and things under it)
         363             : !       if (npair_renamexf .eq. -123456789) then
         364             : !           npair_renamexf = 0
         365             : !           call modal_aero_rename_init
         366             : !       end if
         367             :
         368             : !
         369             : !   check if any renaming pairs exist
         370             : !
         371           0 :         if (npair_renamexf .le. 0) return
         372             : !       if (ncol .ne. -123456789) return
         373             : !       if (fromwhere .eq. 'aqchem') return
         374             :
         375             : !
         376             : !   compute aerosol dry-volume for the "from mode" of each renaming pair
         377             : !   also compute dry-volume change during the continuous growth process
         378             : !       using the incoming dqdt*deltat
         379             : !
         380           0 :         deltatinv = 1.0_r8/(deltat*(1.0_r8 + 1.0e-15_r8))
         381           0 :         onethird = 1.0_r8/3.0_r8
         382           0 :         frelax = 27.0_r8
         383           0 :         xferfrac_max = 1.0_r8 - 10.0_r8*epsilon(1.0_r8)   ! 1-eps
         384             :
         385           0 :         do n = 1, ntot_amode
         386           0 :             idomode(n) = 0
         387             :         end do
         388             :
         389           0 :         do ipair = 1, npair_renamexf
         390           0 :             if (ipair .gt. 1) goto 8100
         391           0 :             idomode(modefrm_renamexf(ipair)) = 1
         392             :
         393           0 :             mfrm = modefrm_renamexf(ipair)
         394           0 :             mtoo = modetoo_renamexf(ipair)
         395           0 :             factoraa(mfrm) = (pi/6._r8)*exp(4.5_r8*(alnsg_amode(mfrm)**2))
         396           0 :             factoraa(mtoo) = (pi/6._r8)*exp(4.5_r8*(alnsg_amode(mtoo)**2))
         397           0 :             factoryy(mfrm) = sqrt( 0.5_r8 )/alnsg_amode(mfrm)
         398             : !   dryvol_smallest is a very small volume mixing ratio (m3-AP/kmol-air)
         399             : !   used for avoiding overflow.  it corresponds to dp = 1 nm
         400             : !   and number = 1e-5 #/mg-air ~= 1e-5 #/cm3-air
         401           0 :             dryvol_smallest(mfrm) = 1.0e-25_r8
         402           0 :             v2nlorlx(mfrm) = voltonumblo_amode(mfrm)*frelax
         403           0 :             v2nhirlx(mfrm) = voltonumbhi_amode(mfrm)/frelax
         404             :
         405           0 :             dum3alnsg2(ipair) = 3.0_r8 * (alnsg_amode(mfrm)**2)
         406             :             dp_cut(ipair) = sqrt(   &
         407           0 :                 dgnum_amode(mfrm)*exp(1.5_r8*(alnsg_amode(mfrm)**2)) *   &
         408           0 :                 dgnum_amode(mtoo)*exp(1.5_r8*(alnsg_amode(mtoo)**2)) )
         409           0 :             lndp_cut(ipair) = log( dp_cut(ipair) )
         410           0 :             dp_belowcut(ipair) = 0.99_r8*dp_cut(ipair)
         411             :         end do
         412             :
         413           0 :         do n = 1, ntot_amode
         414           0 :             if (idomode(n) .gt. 0) then
         415           0 :                 dryvol_a(1:ncol,:,n) = 0.0_r8
         416           0 :                 dryvol_c(1:ncol,:,n) = 0.0_r8
         417           0 :                 deldryvol_a(1:ncol,:,n) = 0.0_r8
         418           0 :                 deldryvol_c(1:ncol,:,n) = 0.0_r8
         419           0 :                 do l1 = 1, nspec_amode(n)
         420             : !   dum_m2v converts (kmol-AP/kmol-air) to (m3-AP/kmol-air)
         421             : !            [m3-AP/kmol-AP]= [kg-AP/kmol-AP]  / [kg-AP/m3-AP]
         422           0 :                     dum_m2v = specmw_amode(l1,n) / specdens_amode(l1,n)
         423           0 :                     dum_m2vdt = dum_m2v*deltat
         424           0 :                     la = lmassptr_amode(l1,n)-loffset
         425           0 :                     if (la > 0) then
         426             :                     dryvol_a(1:ncol,:,n) = dryvol_a(1:ncol,:,n)    &
         427             :                         + dum_m2v*max( 0.0_r8,   &
         428           0 :                           q(1:ncol,:,la)-deltat*dqdt_other(1:ncol,:,la) )
         429             :                     deldryvol_a(1:ncol,:,n) = deldryvol_a(1:ncol,:,n)    &
         430           0 :                         + (dqdt_other(1:ncol,:,la) + dqdt(1:ncol,:,la))*dum_m2vdt
         431             :                     end if
         432             :
         433           0 :                     lc = lmassptrcw_amode(l1,n)-loffset
         434           0 :                     if (lc > 0) then
         435             :                     dryvol_c(1:ncol,:,n) = dryvol_c(1:ncol,:,n)    &
         436             :                         + dum_m2v*max( 0.0_r8,   &
         437           0 :                           qqcw(1:ncol,:,lc)-deltat*dqqcwdt_other(1:ncol,:,lc) )
         438             :                     deldryvol_c(1:ncol,:,n) = deldryvol_c(1:ncol,:,n)    &
         439             :                         + (dqqcwdt_other(1:ncol,:,lc) +   &
         440           0 :                                  dqqcwdt(1:ncol,:,lc))*dum_m2vdt
         441             :                     end if
         442             :                 end do
         443             :             end if
         444             :         end do
         445             :
         446             :
         447             :
         448             : !
         449             : !   loop over levels and columns to calc the renaming
         450             : !
         451           0 : mainloop1_k:  do k = 1, pver
         452           0 : mainloop1_i:  do i = 1, ncol
         453             :
         454             : !   if dorename_atik is provided, then check if renaming needed at this i,k
         455           0 :         if (is_dorename_atik) then
         456           0 :             if (.not. dorename_atik(i,k)) cycle mainloop1_i
         457             :         end if
         458           0 :         pdel_fac = pdel(i,k)/gravit
         459             :
         460             : !
         461             : !   loop over renameing pairs
         462             : !
         463           0 : mainloop1_ipair:  do ipair = 1, npair_renamexf
         464             :
         465           0 :         mfrm = modefrm_renamexf(ipair)
         466           0 :         mtoo = modetoo_renamexf(ipair)
         467             :
         468             : !   dryvol_t_old is the old total (a+c) dry-volume for the "from" mode
         469             : !       in m^3-AP/kmol-air
         470             : !   dryvol_t_new is the new total dry-volume
         471             : !       (old/new = before/after the continuous growth)
         472           0 :         dryvol_t_old = dryvol_a(i,k,mfrm) + dryvol_c(i,k,mfrm)
         473           0 :         dryvol_t_del = deldryvol_a(i,k,mfrm) + deldryvol_c(i,k,mfrm)
         474           0 :         dryvol_t_new = dryvol_t_old + dryvol_t_del
         475           0 :         dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) )
         476             :
         477             : !   no renaming if dryvol_t_new ~ 0 or dryvol_t_del ~ 0
         478           0 :         if (dryvol_t_new .le. dryvol_smallest(mfrm)) cycle mainloop1_ipair
         479           0 :         if (dryvol_t_del .le. 1.0e-6_r8*dryvol_t_oldbnd) cycle mainloop1_ipair
         480             :
         481             : !   num_t_old is total number in particles/kmol-air
         482           0 :         num_t_old = q(i,k,numptr_amode(mfrm)-loffset)
         483           0 :         num_t_old = num_t_old + qqcw(i,k,numptrcw_amode(mfrm)-loffset)
         484           0 :         num_t_old = max( 0.0_r8, num_t_old )
         485           0 :         dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) )
         486           0 :         num_t_oldbnd = min( dryvol_t_oldbnd*v2nlorlx(mfrm), num_t_old )
         487           0 :         num_t_oldbnd = max( dryvol_t_oldbnd*v2nhirlx(mfrm), num_t_oldbnd )
         488             :
         489             : !   no renaming if dgnum < "base" dgnum,
         490           0 :         dgn_t_new = (dryvol_t_new/(num_t_oldbnd*factoraa(mfrm)))**onethird
         491           0 :         if (dgn_t_new .le. dgnum_amode(mfrm)) cycle mainloop1_ipair
         492             :
         493             : !   compute new fraction of number and mass in the tail (dp > dp_cut)
         494           0 :         lndgn_new = log( dgn_t_new )
         495           0 :         lndgv_new = lndgn_new + dum3alnsg2(ipair)
         496           0 :         yn_tail = (lndp_cut(ipair) - lndgn_new)*factoryy(mfrm)
         497           0 :         yv_tail = (lndp_cut(ipair) - lndgv_new)*factoryy(mfrm)
         498           0 :         tailfr_numnew = 0.5_r8*erfc( yn_tail )
         499           0 :         tailfr_volnew = 0.5_r8*erfc( yv_tail )
         500             :
         501             : !   compute old fraction of number and mass in the tail (dp > dp_cut)
         502             :         dgn_t_old =   &
         503           0 :                 (dryvol_t_oldbnd/(num_t_oldbnd*factoraa(mfrm)))**onethird
         504             : !   if dgn_t_new exceeds dp_cut, use the minimum of dgn_t_old and
         505             : !   dp_belowcut to guarantee some transfer
         506           0 :         if (dgn_t_new .ge. dp_cut(ipair)) then
         507           0 :             dgn_t_old = min( dgn_t_old, dp_belowcut(ipair) )
         508             :         end if
         509           0 :         lndgn_old = log( dgn_t_old )
         510           0 :         lndgv_old = lndgn_old + dum3alnsg2(ipair)
         511           0 :         yn_tail = (lndp_cut(ipair) - lndgn_old)*factoryy(mfrm)
         512           0 :         yv_tail = (lndp_cut(ipair) - lndgv_old)*factoryy(mfrm)
         513           0 :         tailfr_numold = 0.5_r8*erfc( yn_tail )
         514           0 :         tailfr_volold = 0.5_r8*erfc( yv_tail )
         515             :
         516             : !   transfer fraction is difference between new and old tail-fractions
         517             : !   transfer fraction for number cannot exceed that of mass
         518           0 :         dum = tailfr_volnew*dryvol_t_new - tailfr_volold*dryvol_t_old
         519           0 :         if (dum .le. 0.0_r8) cycle mainloop1_ipair
         520             :
         521           0 :         xferfrac_vol = min( dum, dryvol_t_new )/dryvol_t_new
         522           0 :         xferfrac_vol = min( xferfrac_vol, xferfrac_max )
         523           0 :         xferfrac_num = tailfr_numnew - tailfr_numold
         524           0 :         xferfrac_num = max( 0.0_r8, min( xferfrac_num, xferfrac_vol ) )
         525             :
         526             : !
         527             : !   compute tendencies for the renaming transfer
         528             : !
         529           0 :         j = jsrflx_rename
         530           0 :         do iq = 1, nspecfrm_renamexf(ipair)
         531           0 :             xfercoef = xferfrac_vol*deltatinv
         532           0 :             if (iq .eq. 1) xfercoef = xferfrac_num*deltatinv
         533             :
         534           0 :             lsfrma = lspecfrma_renamexf(iq,ipair)-loffset
         535           0 :             lsfrmc = lspecfrmc_renamexf(iq,ipair)-loffset
         536           0 :             lstooa = lspectooa_renamexf(iq,ipair)-loffset
         537           0 :             lstooc = lspectooc_renamexf(iq,ipair)-loffset
         538             :
         539           0 :             if (lsfrma .gt. 0) then
         540             :                 xfertend = xfercoef*max( 0.0_r8,   &
         541           0 :                             (q(i,k,lsfrma)+dqdt(i,k,lsfrma)*deltat) )
         542             :
         543             : !   diagnostic output start ----------------------------------------
         544             :                 if (ldiag1 > 0) then
         545             :                 if ((i == icol_diag) .and. (mod(k-1,5) == 0)) then
         546             :                   if (lstooa .gt. 0) then
         547             :                     write(*,'(a,i4,2(2x,a),1p,10e14.6)') 'RENAME qdels', iq,   &
         548             :                         cnst_name(lsfrma+loffset), cnst_name(lstooa+loffset),   &
         549             :                         deltat*dqdt(i,k,lsfrma), deltat*(dqdt(i,k,lsfrma) - xfertend),   &
         550             :                         deltat*dqdt(i,k,lstooa), deltat*(dqdt(i,k,lstooa) + xfertend)
         551             :                   else
         552             :                     write(*,'(a,i4,2(2x,a),1p,10e14.6)') 'RENAME qdels', iq,   &
         553             :                         cnst_name(lsfrma+loffset), cnst_name(lstooa+loffset),   &
         554             :                         deltat*dqdt(i,k,lsfrma), deltat*(dqdt(i,k,lsfrma) - xfertend)
         555             :                   end if
         556             :                 end if
         557             :                 end if
         558             : !   diagnostic output end   ------------------------------------------
         559             :
         560             :
         561           0 :                 dqdt(i,k,lsfrma) = dqdt(i,k,lsfrma) - xfertend
         562           0 :                 qsrflx(i,lsfrma,j) = qsrflx(i,lsfrma,j) - xfertend*pdel_fac
         563           0 :                 if (lstooa .gt. 0) then
         564           0 :                     dqdt(i,k,lstooa) = dqdt(i,k,lstooa) + xfertend
         565           0 :                     qsrflx(i,lstooa,j) = qsrflx(i,lstooa,j) + xfertend*pdel_fac
         566             :                 end if
         567             :             end if
         568             :
         569           0 :             if (lsfrmc .gt. 0) then
         570             :                 xfertend = xfercoef*max( 0.0_r8,   &
         571           0 :                             (qqcw(i,k,lsfrmc)+dqqcwdt(i,k,lsfrmc)*deltat) )
         572           0 :                 dqqcwdt(i,k,lsfrmc) = dqqcwdt(i,k,lsfrmc) - xfertend
         573           0 :                 qqcwsrflx(i,lsfrmc,j) = qqcwsrflx(i,lsfrmc,j) - xfertend*pdel_fac
         574           0 :                 if (lstooc .gt. 0) then
         575           0 :                     dqqcwdt(i,k,lstooc) = dqqcwdt(i,k,lstooc) + xfertend
         576           0 :                     qqcwsrflx(i,lstooc,j) = qqcwsrflx(i,lstooc,j) + xfertend*pdel_fac
         577             :                 end if
         578             :             end if
         579             :
         580             :         end do   ! "iq = 1, nspecfrm_renamexf(ipair)"
         581             :
         582             :
         583             :         end do mainloop1_ipair
         584             :
         585             :
         586             :         end do mainloop1_i
         587             :         end do mainloop1_k
         588             :
         589             : !
         590             : !   set dotend's
         591             : !
         592           0 :         dotendrn(:) = .false.
         593           0 :         dotendqqcwrn(:) = .false.
         594           0 :         do ipair = 1, npair_renamexf
         595           0 :         do iq = 1, nspecfrm_renamexf(ipair)
         596           0 :             lsfrma = lspecfrma_renamexf(iq,ipair) - loffset
         597           0 :             lsfrmc = lspecfrmc_renamexf(iq,ipair) - loffset
         598           0 :             lstooa = lspectooa_renamexf(iq,ipair) - loffset
         599           0 :             lstooc = lspectooc_renamexf(iq,ipair) - loffset
         600           0 :             if (lsfrma .gt. 0) then
         601           0 :                 dotendrn(lsfrma) = .true.
         602           0 :                 if (lstooa .gt. 0) dotendrn(lstooa) = .true.
         603             :             end if
         604           0 :             if (lsfrmc .gt. 0) then
         605           0 :                 dotendqqcwrn(lsfrmc) = .true.
         606           0 :                 if (lstooc .gt. 0) dotendqqcwrn(lstooc) = .true.
         607             :             end if
         608             :         end do
         609             :         end do
         610             :
         611             :
         612           0 :         return
         613             :
         614             :
         615             : !
         616             : !   error -- renaming currently just works for 1 pair
         617             : !
         618           0 : 8100    write(lunout,9050) ipair
         619           0 :         call endrun( 'modal_aero_rename_no_acc_crs_sub error' )
         620             : 9050    format( / '*** subr. modal_aero_rename_no_acc_crs_sub ***' /   &
         621             :             4x, 'aerosol renaming not implemented for ipair =', i5 )
         622             :
         623             : !EOC
         624             :         end subroutine modal_aero_rename_no_acc_crs_sub
         625             :
         626             :
         627             :
         628             : !-------------------------------------------------------------------------
         629           0 :         subroutine modal_aero_rename_no_acc_crs_init
         630             : !
         631             : !   computes pointers for species transfer during aerosol renaming
         632             : !       (a2 --> a1 transfer)
         633             : !   transfers include number_a, number_c, mass_a, mass_c and
         634             : !       water_a
         635             : !
         636             :
         637             :         implicit none
         638             :
         639             : !   local variables
         640             :         integer :: ipair, iq, iqfrm, iqtoo
         641             :         integer :: lsfrma, lsfrmc, lstooa, lstooc, lunout
         642             :         integer :: mfrm, mtoo
         643             :         integer :: n1, n2, nspec
         644             :         integer :: nchfrma, nchfrmc, nchfrmskip, nchtooa, nchtooc, nchtooskip
         645             :
         646           0 :         lunout = iulog
         647             : !
         648             : !   define "from mode" and "to mode" for each tail-xfer pairing
         649             : !       currently just a2-->a1
         650             : !
         651           0 :         n1 = modeptr_accum
         652           0 :         n2 = modeptr_aitken
         653           0 :         if ((n1 .gt. 0) .and. (n2 .gt. 0)) then
         654           0 :             npair_renamexf = 1
         655           0 :             modefrm_renamexf(1) = n2
         656           0 :             modetoo_renamexf(1) = n1
         657             :         else
         658           0 :             npair_renamexf = 0
         659           0 :             return
         660             :         end if
         661             :
         662             : !
         663             : !   define species involved in each tail-xfer pairing
         664             : !       (include aerosol water)
         665             : !
         666           0 : aa_ipair: do ipair = 1, npair_renamexf
         667           0 :         mfrm = modefrm_renamexf(ipair)
         668           0 :         mtoo = modetoo_renamexf(ipair)
         669           0 :         if (mfrm < 10) then
         670             :             nchfrmskip = 1
         671           0 :         else if (mfrm < 100) then
         672             :             nchfrmskip = 2
         673             :         else
         674           0 :             nchfrmskip = 3
         675             :         end if
         676           0 :         if (mtoo < 10) then
         677             :             nchtooskip = 1
         678           0 :         else if (mtoo < 100) then
         679             :             nchtooskip = 2
         680             :         else
         681           0 :             nchtooskip = 3
         682             :         end if
         683           0 :         nspec = 0
         684           0 : aa_iqfrm: do iqfrm = -1, nspec_amode(mfrm)
         685           0 :             if (iqfrm == -1) then
         686           0 :                 lsfrma = numptr_amode(mfrm)
         687           0 :                 lstooa = numptr_amode(mtoo)
         688           0 :                 lsfrmc = numptrcw_amode(mfrm)
         689           0 :                 lstooc = numptrcw_amode(mtoo)
         690           0 :             else if (iqfrm == 0) then
         691             : !   bypass transfer of aerosol water due to renaming
         692             :                 cycle aa_iqfrm
         693             : !               lsfrma = lwaterptr_amode(mfrm)
         694             : !               lsfrmc = 0
         695             : !               lstooa = lwaterptr_amode(mtoo)
         696             : !               lstooc = 0
         697             :             else
         698           0 :                 lsfrma = lmassptr_amode(iqfrm,mfrm)
         699           0 :                 lsfrmc = lmassptrcw_amode(iqfrm,mfrm)
         700           0 :                 lstooa = 0
         701           0 :                 lstooc = 0
         702             :             end if
         703             :
         704             :
         705           0 :             if ((lsfrma < 1) .or. (lsfrma > pcnst)) then
         706           0 :                 write(lunout,9100) mfrm, iqfrm, lsfrma
         707           0 :                 call endrun( 'modal_aero_rename_init error aa' )
         708             :             end if
         709           0 :             if ((lsfrmc < 1) .or. (lsfrmc > pcnst)) then
         710           0 :                 write(lunout,9102) mfrm, iqfrm, lsfrmc
         711           0 :                 call endrun( 'modal_aero_rename_init error bb' )
         712             :             end if
         713             :
         714             :
         715           0 :             if (iqfrm > 0) then
         716           0 :                 nchfrma = len( trim( cnst_name(lsfrma) ) ) - nchfrmskip
         717             :
         718             : ! find "too" species having same lspectype_amode as the "frm" species
         719             : ! AND same cnst_name (except for last 1/2/3 characters which are the mode index)
         720           0 :                 do iqtoo = 1, nspec_amode(mtoo)
         721             : !                   if ( lspectype_amode(iqtoo,mtoo) .eq.   &
         722             : !                        lspectype_amode(iqfrm,mfrm) ) then
         723           0 :                         lstooa = lmassptr_amode(iqtoo,mtoo)
         724           0 :                         nchtooa = len( trim( cnst_name(lstooa) ) ) - nchtooskip
         725           0 :                         if (cnst_name(lsfrma)(1:nchfrma) == cnst_name(lstooa)(1:nchtooa)) then
         726             :                         ! interstitial names match, so check cloudborne names too
         727           0 :                             nchfrmc = len( trim( cnst_name_cw(lsfrmc) ) ) - nchfrmskip
         728           0 :                             lstooc = lmassptrcw_amode(iqtoo,mtoo)
         729           0 :                             nchtooc = len( trim( cnst_name_cw(lstooc) ) ) - nchtooskip
         730           0 :                             if (cnst_name_cw(lsfrmc)(1:nchfrmc) /= &
         731           0 :                                 cnst_name_cw(lstooc)(1:nchtooc)) lstooc = 0
         732             :                             exit
         733             :                         else
         734           0 :                             lstooa = 0
         735             :                         end if
         736             : !                   end if
         737             :                 end do
         738             :             end if ! (iqfrm > 0)
         739             :
         740           0 :             if ((lstooc < 1) .or. (lstooc > pcnst)) lstooc = 0
         741           0 :             if ((lstooa < 1) .or. (lstooa > pcnst)) lstooa = 0
         742           0 :             if (lstooa == 0) then
         743           0 :                 write(lunout,9104) mfrm, iqfrm, lsfrma, iqtoo, lstooa
         744           0 :                 call endrun( 'modal_aero_rename_init error cc' )
         745             :             end if
         746           0 :             if ((lstooc == 0) .and. (iqfrm /= 0)) then
         747           0 :                 write(lunout,9104) mfrm, iqfrm, lsfrmc, iqtoo, lstooc
         748           0 :                 call endrun( 'modal_aero_rename_init error dd' )
         749             :             end if
         750             :
         751           0 :             nspec = nspec + 1
         752           0 :             lspecfrma_renamexf(nspec,ipair) = lsfrma
         753           0 :             lspectooa_renamexf(nspec,ipair) = lstooa
         754           0 :             lspecfrmc_renamexf(nspec,ipair) = lsfrmc
         755           0 :             lspectooc_renamexf(nspec,ipair) = lstooc
         756             :         end do aa_iqfrm
         757             :
         758           0 :         nspecfrm_renamexf(ipair) = nspec
         759             :         end do aa_ipair
         760             :
         761             : 9100    format( / '*** subr. modal_aero_rename_no_acc_crs_init' /   &
         762             :         'lspecfrma out of range' /   &
         763             :         'modefrm, ispecfrm, lspecfrma =', 3i6 / )
         764             : 9102    format( / '*** subr. modal_aero_rename_no_acc_crs_init' /   &
         765             :         'lspecfrmc out of range' /   &
         766             :         'modefrm, ispecfrm, lspecfrmc =', 3i6 / )
         767             : 9104    format( / '*** subr. modal_aero_rename_no_acc_crs_init' /   &
         768             :         'lspectooa out of range' /   &
         769             :         'modefrm, ispecfrm, lspecfrma, ispectoo, lspectooa =', 5i6 / )
         770             : 9106    format( / '*** subr. modal_aero_rename_no_acc_crs_init' /   &
         771             :         'lspectooc out of range' /   &
         772             :         'modefrm, ispecfrm, lspecfrmc, ispectoo, lspectooc =', 5i6 / )
         773             :
         774             : !
         775             : !   output results
         776             : !
         777           0 :         if ( masterproc ) then
         778             :
         779           0 :         write(lunout,9310)
         780             :
         781           0 :         do 2900 ipair = 1, npair_renamexf
         782           0 :         mfrm = modefrm_renamexf(ipair)
         783           0 :         mtoo = modetoo_renamexf(ipair)
         784           0 :         write(lunout,9320) ipair, mfrm, mtoo
         785             :
         786           0 :         do iq = 1, nspecfrm_renamexf(ipair)
         787           0 :             lsfrma = lspecfrma_renamexf(iq,ipair)
         788           0 :             lstooa = lspectooa_renamexf(iq,ipair)
         789           0 :             lsfrmc = lspecfrmc_renamexf(iq,ipair)
         790           0 :             lstooc = lspectooc_renamexf(iq,ipair)
         791           0 :             if (lstooa .gt. 0) then
         792           0 :                 write(lunout,9330) lsfrma, cnst_name(lsfrma),   &
         793           0 :                                    lstooa, cnst_name(lstooa)
         794             :             else
         795           0 :                 write(lunout,9340) lsfrma, cnst_name(lsfrma)
         796             :             end if
         797           0 :             if (lstooc .gt. 0) then
         798           0 :                 write(lunout,9330) lsfrmc, cnst_name_cw(lsfrmc),   &
         799           0 :                                    lstooc, cnst_name_cw(lstooc)
         800           0 :             else if (lsfrmc .gt. 0) then
         801           0 :                 write(lunout,9340) lsfrmc, cnst_name_cw(lsfrmc)
         802             :             else
         803           0 :                 write(lunout,9350)
         804             :             end if
         805             :         end do
         806             :
         807           0 : 2900    continue
         808           0 :         write(lunout,*)
         809             :
         810             :         end if ! ( masterproc )
         811             :
         812             : 9310    format( / 'subr. modal_aero_rename_no_acc_crs_init' )
         813             : 9320    format( 'pair', i3, 5x, 'mode', i3, ' ---> mode', i3 )
         814             : 9330    format( 5x, 'spec', i3, '=', a, ' ---> spec', i3, '=', a )
         815             : 9340    format( 5x, 'spec', i3, '=', a, ' ---> LOSS' )
         816             : 9350    format( 5x, 'no corresponding activated species' )
         817             :
         818             :         return
         819             :         end subroutine modal_aero_rename_no_acc_crs_init
         820             :
         821             : !----------------------------------------------------------------------
         822             : ! code for troposphere and stratosphere
         823             : ! -- allows accumulation to coarse mode exchange
         824             : !----------------------------------------------------------------------
         825             : !BOP
         826             : ! !ROUTINE:  modal_aero_rename_acc_crs_sub --- ...
         827             : !
         828             : ! !INTERFACE:
         829     1489176 :         subroutine modal_aero_rename_acc_crs_sub(                       &
         830             :                         fromwhere,         lchnk,               &
         831             :                         ncol,              nstep,               &
         832             :                         loffset,           deltat,              &
         833             :                         pdel,              troplev,             &
         834     1489176 :                         dotendrn,          q,                   &
         835     1489176 :                         dqdt,              dqdt_other,          &
         836     1489176 :                         dotendqqcwrn,      qqcw,                &
         837     1489176 :                         dqqcwdt,           dqqcwdt_other,       &
         838     1489176 :                         is_dorename_atik,  dorename_atik,       &
         839             :                         jsrflx_rename,     nsrflx,              &
         840     1489176 :                         qsrflx,            qqcwsrflx,           &
         841           0 :                         dqdt_rnpos                              )
         842             :
         843             : ! !USES:
         844             :
         845             :    use physconst, only: gravit, mwdry
         846             :    use shr_spfn_mod, only: erfc => shr_spfn_erfc
         847             :
         848             :    implicit none
         849             :
         850             :
         851             : ! !PARAMETERS:
         852             :    character(len=*), intent(in) :: fromwhere    ! identifies which module
         853             :                                                 ! is making the call
         854             :    integer,  intent(in)    :: lchnk                ! chunk identifier
         855             :    integer,  intent(in)    :: ncol                 ! number of atmospheric column
         856             :    integer,  intent(in)    :: nstep                ! model time-step number
         857             :    integer,  intent(in)    :: loffset              ! offset applied to modal aero "ptrs"
         858             :    real(r8), intent(in)    :: deltat               ! time step (s)
         859             :    integer,  intent(in)    :: troplev(pcols)
         860             :
         861             :    real(r8), intent(in)    :: pdel(pcols,pver)     ! pressure thickness of levels (Pa)
         862             :    real(r8), intent(in)    :: q(ncol,pver,pcnstxx) ! tracer mixing ratio array
         863             :                                                    ! *** MUST BE mol/mol-air or #/mol-air
         864             :                                                    ! *** NOTE ncol and pcnstxx dimensions
         865             :    real(r8), intent(in)    :: qqcw(ncol,pver,pcnstxx) ! like q but for cloud-borne species
         866             :
         867             :    real(r8), intent(inout) :: dqdt(ncol,pver,pcnstxx)  ! TMR tendency array;
         868             :                               ! incoming dqdt = tendencies for the
         869             :                               !     "fromwhere" continuous growth process
         870             :                               ! the renaming tendencies are added on
         871             :                               ! *** NOTE ncol and pcnstxx dimensions
         872             :    real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx)
         873             :    real(r8), intent(in)    :: dqdt_other(ncol,pver,pcnstxx)
         874             :                               ! tendencies for "other" continuous growth process
         875             :                               ! *** NOTE ncol and pcnstxx dimensions
         876             :    real(r8), intent(in)    :: dqqcwdt_other(ncol,pver,pcnstxx)
         877             :    logical,  intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which
         878             :                               !     renaming dqdt is computed
         879             :    logical,  intent(inout) :: dotendqqcwrn(pcnstxx)
         880             :
         881             :    logical,  intent(in)    :: is_dorename_atik          ! true if dorename_atik is provided
         882             :    logical,  intent(in)    :: dorename_atik(ncol,pver) ! true if renaming should
         883             :                                                         ! be done at i,k
         884             :    integer,  intent(in)    :: jsrflx_rename        ! qsrflx index for renaming
         885             :    integer,  intent(in)    :: nsrflx               ! last dimension of qsrflx
         886             :
         887             :    real(r8), intent(inout) :: qsrflx(pcols,pcnstxx,nsrflx)
         888             :                               ! process-specific column tracer tendencies
         889             :    real(r8), intent(inout) :: qqcwsrflx(pcols,pcnstxx,nsrflx)
         890             :    real(r8), optional, intent(out) &
         891             :                            :: dqdt_rnpos(ncol,pver,pcnstxx)
         892             :                               ! the positive (production) part of the renaming tendency
         893             :
         894             : ! !DESCRIPTION:
         895             : ! computes TMR (tracer mixing ratio) tendencies for "mode renaming"
         896             : !    during a continuous growth process
         897             : ! currently this transfers number and mass (and surface) from the aitken
         898             : !    to accumulation mode after gas condensation or stratiform-cloud
         899             : !    aqueous chemistry
         900             : ! (convective cloud aqueous chemistry not yet implemented)
         901             : !
         902             : ! !REVISION HISTORY:
         903             : !   RCE 07.04.13:  Adapted from MIRAGE2 code
         904             : !
         905             : !EOP
         906             : !----------------------------------------------------------------------
         907             : !BOC
         908             :
         909             : ! local variables
         910             :    integer, parameter :: ldiag1 = -1
         911             :    integer :: i, icol_diag, ipair, iq
         912             :    integer :: j, k
         913             :    integer :: l, l1, la, lc, lunout
         914             :    integer :: lsfrma, lsfrmc, lstooa, lstooc
         915             :    integer :: mfrm, mtoo, n, n1, n2, ntot_msa_a
         916             :
         917             :    logical :: l_dqdt_rnpos
         918             :    logical :: flagaa_shrink, flagbb_shrink
         919             :
         920     2978352 :    real (r8) :: deldryvol_a(ncol,pver)
         921     2978352 :    real (r8) :: deldryvol_c(ncol,pver)
         922             :    real (r8) :: deltatinv
         923             :    real (r8) :: dgn_aftr, dgn_xfer
         924             :    real (r8) :: dgn_t_new, dgn_t_old, dgn_t_oldb
         925             :    real (r8) :: dryvol_t_del, dryvol_t_new, dryvol_t_new_xfab
         926             :    real (r8) :: dryvol_t_old, dryvol_t_oldb, dryvol_t_oldbnd
         927     2978352 :    real (r8) :: dryvol_a(ncol,pver)
         928     2978352 :    real (r8) :: dryvol_c(ncol,pver)
         929     2978352 :    real (r8) :: dryvol_a_xfab(ncol,pver)
         930     2978352 :    real (r8) :: dryvol_c_xfab(ncol,pver)
         931             :    real (r8) :: dryvol_xferamt
         932             :    real (r8) :: lndgn_new, lndgn_old
         933             :    real (r8) :: lndgv_new, lndgv_old
         934             :    real (r8) :: num_t_old, num_t_oldbnd
         935             :    real (r8) :: onethird
         936             :    real (r8) :: pdel_fac
         937             :    real (r8) :: tailfr_volnew, tailfr_volold
         938             :    real (r8) :: tailfr_numnew, tailfr_numold
         939             :    real (r8) :: tmpa, tmpf
         940             :    real (r8) :: tmp_m2v, tmp_m2vdt
         941             :    real (r8) :: xfercoef, xfertend
         942             :    real (r8) :: xferfrac_vol, xferfrac_num, xferfrac_max
         943             :
         944             :    real (r8) :: yn_tail, yv_tail
         945             :
         946             : ! begin
         947     1489176 :         lunout = iulog
         948             :
         949             : !
         950             : !   calculations done once on initial entry
         951             : !
         952             : !   "init" is now done through chem_init (and things under it)
         953             : !       if (npair_renamexf .eq. -123456789) then
         954             : !           npair_renamexf = 0
         955             : !           call modal_aero_rename_init
         956             : !       end if
         957             :
         958             : !
         959             : !   check if any renaming pairs exist
         960             : !
         961     1489176 :         if (npair_renamexf .le. 0) return
         962             : !       if (ncol .ne. -123456789) return
         963             : !       if (fromwhere .eq. 'aqchem') return
         964             :
         965             :
         966     1489176 :         deltatinv = 1.0_r8/(deltat*(1.0_r8 + 1.0e-15_r8))
         967     1489176 :         onethird = 1.0_r8/3.0_r8
         968     1489176 :         xferfrac_max = 1.0_r8 - 10.0_r8*epsilon(1.0_r8)   ! 1-eps
         969             :
         970     1489176 :         if ( present( dqdt_rnpos ) ) then
         971           0 :             l_dqdt_rnpos = .true.
         972           0 :             dqdt_rnpos(:,:,:) = 0.0_r8
         973             :         else
         974             :             l_dqdt_rnpos = .false.
         975             :         end if
         976             :
         977             :
         978             :
         979             : !
         980             : !   loop over renaming pairs
         981             : !
         982     5956704 : mainloop1_ipair:  do ipair = 1, npair_renamexf
         983             :
         984     4467528 :         mfrm = modefrm_renamexf(ipair)
         985     4467528 :         mtoo = modetoo_renamexf(ipair)
         986             :
         987             :         flagaa_shrink = &
         988             :             ((mfrm==modeptr_coarse) .and.  (mtoo==modeptr_accum)) .or. &
         989     4467528 :             ((mfrm==modeptr_stracoar) .and. (mtoo==modeptr_accum))
         990             :
         991             : !
         992             : !   compute aerosol dry-volume for the "from mode" of each renaming pair
         993             : !   also compute dry-volume change during the continuous growth process
         994             : !       using the incoming dqdt*deltat
         995             : !
         996  6942019032 :         dryvol_a(:,:) = 0.0_r8
         997  6942019032 :         dryvol_c(:,:) = 0.0_r8
         998  6942019032 :         deldryvol_a(:,:) = 0.0_r8
         999  6942019032 :         deldryvol_c(:,:) = 0.0_r8
        1000     4467528 :         if (ixferable_all_renamexf(ipair) <= 0) then
        1001  2314006344 :             dryvol_a_xfab(:,:) = 0.0_r8
        1002  2314006344 :             dryvol_c_xfab(:,:) = 0.0_r8
        1003             :         end if
        1004             :
        1005     4467528 :         n = mfrm
        1006    23826816 :         do l1 = 1, nspec_amode(n)
        1007             : !   tmp_m2v converts (kmol-AP/kmol-air) to (m3-AP/kmol-air)
        1008             : !            [m3-AP/kmol-AP]= [kg-AP/kmol-AP]  / [kg-AP/m3-AP]
        1009    19359288 :             tmp_m2v = specmw_amode(l1,n) / specdens_amode(l1,n)
        1010    19359288 :             tmp_m2vdt = tmp_m2v*deltat
        1011    19359288 :             la = lmassptr_amode(l1,n)-loffset
        1012    19359288 :             if (la > 0) then
        1013    19359288 :                 dryvol_a(1:ncol,:) = dryvol_a(1:ncol,:)    &
        1014             :                     + tmp_m2v*max( 0.0_r8,   &
        1015 30101441760 :                       q(1:ncol,:,la)-deltat*dqdt_other(1:ncol,:,la) )
        1016             :                 deldryvol_a(1:ncol,:) = deldryvol_a(1:ncol,:)    &
        1017 30082082472 :                     + (dqdt_other(1:ncol,:,la) + dqdt(1:ncol,:,la))*tmp_m2vdt
        1018    19359288 :                 if ( (ixferable_all_renamexf(ipair) <= 0) .and. &
        1019    19359288 :                      (ixferable_a_renamexf(l1,ipair) > 0) ) then
        1020             :                     dryvol_a_xfab(1:ncol,:) = dryvol_a_xfab(1:ncol,:)    &
        1021             :                         + tmp_m2v*max( 0.0_r8,   &
        1022  6942019032 :                         q(1:ncol,:,la)+deltat*dqdt(1:ncol,:,la) )
        1023             :                 end if
        1024             :             end if
        1025             :
        1026    19359288 :             lc = lmassptrcw_amode(l1,n)-loffset
        1027    23826816 :             if (lc > 0) then
        1028    19359288 :                 dryvol_c(1:ncol,:) = dryvol_c(1:ncol,:)    &
        1029             :                     + tmp_m2v*max( 0.0_r8,   &
        1030 30101441760 :                       qqcw(1:ncol,:,lc)-deltat*dqqcwdt_other(1:ncol,:,lc) )
        1031             :                 deldryvol_c(1:ncol,:) = deldryvol_c(1:ncol,:)    &
        1032             :                     + (dqqcwdt_other(1:ncol,:,lc) +   &
        1033 30082082472 :                              dqqcwdt(1:ncol,:,lc))*tmp_m2vdt
        1034    19359288 :                 if ( (ixferable_all_renamexf(ipair) <= 0) .and. &
        1035    19359288 :                      (ixferable_c_renamexf(l1,ipair) > 0) ) then
        1036             :                     dryvol_c_xfab(1:ncol,:) = dryvol_c_xfab(1:ncol,:)    &
        1037             :                         + tmp_m2v*max( 0.0_r8,   &
        1038  6942019032 :                           qqcw(1:ncol,:,lc)+deltat*dqqcwdt(1:ncol,:,lc) )
        1039             :                 end if
        1040             :             end if
        1041             :         end do
        1042             :
        1043             : !
        1044             : !
        1045             : !   loop over levels and columns to calc the renaming
        1046             : !
        1047             : !
        1048   421436808 : mainloop1_k:  do k = 1, pver
        1049  6942019032 : mainloop1_i:  do i = 1, ncol
        1050             :
        1051             : !   if dorename_atik is provided, then check if renaming needed at this i,k
        1052  6522071400 :         if (is_dorename_atik) then
        1053  6522071400 :             if (.not. dorename_atik(i,k)) cycle mainloop1_i
        1054             :         end if
        1055             :
        1056             : !   if strat_only_renamexf is true, then cycle when at or below the tropopause level
        1057  6522071400 :         if ( strat_only_renamexf(ipair) ) then
        1058  4348047600 :             if ( k >= troplev(i) ) cycle mainloop1_i
        1059             :         end if
        1060             :
        1061             :
        1062             : !   dryvol_t_old is the old total (a+c) dry-volume for the "from" mode
        1063             : !       in m^3-AP/kmol-air
        1064             : !   dryvol_t_new is the new total dry-volume
        1065             : !       (old/new = before/after the continuous growth)
        1066  4570304978 :         dryvol_t_old = dryvol_a(i,k) + dryvol_c(i,k)
        1067  4570304978 :         dryvol_t_del = deldryvol_a(i,k) + deldryvol_c(i,k)
        1068  4570304978 :         dryvol_t_new = dryvol_t_old + dryvol_t_del
        1069  4570304978 :         dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) )
        1070             :
        1071             : grow_shrink_conditional1: &
        1072  4570304978 :         if (igrow_shrink_renamexf(ipair) > 0) then
        1073             : !   do renaming for growing particles
        1074             :
        1075             : !   no renaming if dryvol_t_new ~ 0
        1076  3372164389 :         if (dryvol_t_new .le. dryvol_smallest(mfrm)) cycle mainloop1_i
        1077             : !   no renaming if delta_dryvol is very small or negative
        1078             :         if ( (method_optbb_renamexf /= 2) .and. &
        1079             :              (dryvol_t_del .le. 1.0e-6_r8*dryvol_t_oldbnd) ) cycle mainloop1_i
        1080             :
        1081             : !   num_t_old is total number in particles/kmol-air
        1082  3372164389 :         num_t_old = q(i,k,numptr_amode(mfrm)-loffset)
        1083  3372164389 :         num_t_old = num_t_old + qqcw(i,k,numptrcw_amode(mfrm)-loffset)
        1084  3372164389 :         num_t_old = max( 0.0_r8, num_t_old )
        1085  3372164389 :         dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) )
        1086  3372164389 :         num_t_oldbnd = min( dryvol_t_oldbnd*v2nlorlx(mfrm), num_t_old )
        1087  3372164389 :         num_t_oldbnd = max( dryvol_t_oldbnd*v2nhirlx(mfrm), num_t_oldbnd )
        1088             :
        1089             : !   compute new dgnum
        1090  3372164389 :         dgn_t_new = (dryvol_t_new/(num_t_oldbnd*factoraa(mfrm)))**onethird
        1091             : !   no renaming if dgn_t_new < threshold value
        1092  3372164389 :         if (dgn_t_new .le. dp_xfernone_threshaa(ipair)) cycle mainloop1_i
        1093             :
        1094             : !   compute old dgnum and possibly a smaller value to get more renaming transfer
        1095             :         dgn_t_old =   &
        1096  1808265892 :                 (dryvol_t_oldbnd/(num_t_oldbnd*factoraa(mfrm)))**onethird
        1097  1808265892 :         dgn_t_oldb = dgn_t_old
        1098  1808265892 :         dryvol_t_oldb = dryvol_t_old
        1099             :         if ( method_optbb_renamexf == 2) then
        1100  1808265892 :             if (dgn_t_old .ge. dp_cut(ipair)) then
        1101             :                 ! this revised volume corresponds to dgn_t_old == dp_belowcut, and same number conc
        1102       82896 :                 dryvol_t_oldb = dryvol_t_old * (dp_belowcut(ipair)/dgn_t_old)**3
        1103             :                 dgn_t_oldb = dp_belowcut(ipair)
        1104             :             end if
        1105  1808265892 :             if (dgn_t_new .lt. dp_xferall_thresh(ipair)) then
        1106             :                 !   no renaming if delta_dryvol is very small or negative
        1107  1806808729 :                 if ((dryvol_t_new-dryvol_t_oldb) .le. 1.0e-6_r8*dryvol_t_oldbnd) cycle mainloop1_i
        1108             :             end if
        1109             :
        1110             :         else if (dgn_t_new .ge. dp_cut(ipair)) then
        1111             : !   if dgn_t_new exceeds dp_cut, use the minimum of dgn_t_oldb and
        1112             : !   dp_belowcut to guarantee some transfer
        1113             :             dgn_t_oldb = min( dgn_t_oldb, dp_belowcut(ipair) )
        1114             :         end if
        1115             :
        1116             : !   compute new fraction of number and mass in the tail (dp > dp_cut)
        1117   955212636 :         lndgn_new = log( dgn_t_new )
        1118   955212636 :         lndgv_new = lndgn_new + factor_3alnsg2(ipair)
        1119   955212636 :         yn_tail = (lndp_cut(ipair) - lndgn_new)*factoryy(mfrm)
        1120   955212636 :         yv_tail = (lndp_cut(ipair) - lndgv_new)*factoryy(mfrm)
        1121   955212636 :         tailfr_numnew = 0.5_r8*erfc( yn_tail )
        1122   955212636 :         tailfr_volnew = 0.5_r8*erfc( yv_tail )
        1123             :
        1124             : !   compute old fraction of number and mass in the tail (dp > dp_cut)
        1125   955212636 :         lndgn_old = log( dgn_t_oldb )
        1126   955212636 :         lndgv_old = lndgn_old + factor_3alnsg2(ipair)
        1127   955212636 :         yn_tail = (lndp_cut(ipair) - lndgn_old)*factoryy(mfrm)
        1128   955212636 :         yv_tail = (lndp_cut(ipair) - lndgv_old)*factoryy(mfrm)
        1129   955212636 :         tailfr_numold = 0.5_r8*erfc( yn_tail )
        1130   955212636 :         tailfr_volold = 0.5_r8*erfc( yv_tail )
        1131             :
        1132             : !   transfer fraction is difference between new and old tail-fractions
        1133             : !   transfer fraction for number cannot exceed that of mass
        1134   955212636 :         if ( (method_optbb_renamexf == 2) .and. &
        1135             :              (dgn_t_new .ge. dp_xferall_thresh(ipair)) ) then
        1136             :             dryvol_xferamt = dryvol_t_new
        1137             :         else
        1138   953755473 :             dryvol_xferamt = tailfr_volnew*dryvol_t_new - tailfr_volold*dryvol_t_oldb
        1139             :         end if
        1140   955212636 :         if (dryvol_xferamt .le. 0.0_r8) cycle mainloop1_i
        1141             :
        1142   955212636 :         xferfrac_vol = max( 0.0_r8, (dryvol_xferamt/dryvol_t_new) )
        1143   955212636 :         if ( method_optbb_renamexf == 2 .and. &
        1144             :              (xferfrac_vol >= xferfrac_max) ) then
        1145             :             ! transfer entire contents of mode
        1146             :             xferfrac_vol = 1.0_r8
        1147             :             xferfrac_num = 1.0_r8
        1148             :         else
        1149   953755473 :             xferfrac_vol = min( xferfrac_vol, xferfrac_max )
        1150   953755473 :             xferfrac_num = tailfr_numnew - tailfr_numold
        1151   953755473 :             xferfrac_num = max( 0.0_r8, min( xferfrac_num, xferfrac_vol ) )
        1152             :         end if
        1153             :
        1154   955212636 :         if (ixferable_all_renamexf(ipair) <= 0) then
        1155             :             ! not all species are xferable
        1156     3426977 :             dryvol_t_new_xfab = max( 0.0_r8, (dryvol_a_xfab(i,k) + dryvol_c_xfab(i,k)) )
        1157     3426977 :             dryvol_xferamt = xferfrac_vol*dryvol_t_new
        1158     3426977 :             if (dryvol_t_new_xfab >= 0.999999_r8*dryvol_xferamt) then
        1159             :                 ! xferable dryvol can supply the needed dryvol_xferamt
        1160             :                 ! but xferfrac_vol must be increased
        1161     2108937 :                 xferfrac_vol = min( 1.0_r8, (dryvol_xferamt/dryvol_t_new_xfab) )
        1162     1318040 :             else if (dryvol_t_new_xfab >= 1.0e-7_r8*dryvol_xferamt) then
        1163             :                 ! xferable dryvol cannot supply the needed dryvol_xferamt
        1164             :                 ! so transfer all of it, and reduce the number transfer
        1165     1318040 :                 xferfrac_vol = 1.0_r8
        1166     1318040 :                 xferfrac_num = xferfrac_num*(dryvol_t_new_xfab/dryvol_xferamt)
        1167             :             else
        1168             :                 ! xferable dryvol << needed dryvol_xferamt
        1169             :                 cycle mainloop1_i
        1170             :             end if
        1171             :         end if
        1172             :
        1173             :         else grow_shrink_conditional1
        1174             : !   do renaming for shrinking particles
        1175             :
        1176             : !   no renaming if (dryvol_t_old ~ 0)
        1177  1198140589 :         if (dryvol_t_old .le. dryvol_smallest(mfrm)) cycle mainloop1_i
        1178             :
        1179             : !   when (delta_dryvol is very small or positive),
        1180             : !      which means particles are not evaporating,
        1181             : !      only do renaming if [(flagaa_shrink true) and (in stratosphere)]],
        1182             : !   and set flagbb_shrink true to identify this special case
        1183  1037412738 :         if (dryvol_t_del .ge. -1.0e-6_r8*dryvol_t_oldbnd) then
        1184  1037412738 :             if ( ( flagaa_shrink ) .and. ( k < troplev(i) ) ) then
        1185             :                 flagbb_shrink = .true.
        1186             :             else
        1187             :                 cycle mainloop1_i
        1188             :             end if
        1189             :         else
        1190             :             flagbb_shrink = .false.
        1191             :         end if
        1192             :
        1193             : !   num_t_old is total number in particles/kmol-air
        1194  1037412738 :         num_t_old = q(i,k,numptr_amode(mfrm)-loffset)
        1195  1037412738 :         num_t_old = num_t_old + qqcw(i,k,numptrcw_amode(mfrm)-loffset)
        1196  1037412738 :         num_t_old = max( 0.0_r8, num_t_old )
        1197  1037412738 :         dryvol_t_oldbnd = max( dryvol_t_old, dryvol_smallest(mfrm) )
        1198  1037412738 :         num_t_oldbnd = min( dryvol_t_oldbnd*v2nlorlx(mfrm), num_t_old )
        1199  1037412738 :         num_t_oldbnd = max( dryvol_t_oldbnd*v2nhirlx(mfrm), num_t_oldbnd )
        1200             :
        1201             : !   compute new dgnum
        1202  1037412738 :         dgn_t_new = (dryvol_t_new/(num_t_oldbnd*factoraa(mfrm)))**onethird
        1203             : !   no renaming if (dgn_t_new > xfernone threshold value)
        1204  1037412738 :         if (dgn_t_new .ge. dp_xfernone_threshaa(ipair)) cycle mainloop1_i
        1205             : !   if (flagbb_shrink true), renaming only when (dgn_t_new <= dp_cut value)
        1206          83 :         if ( flagbb_shrink ) then
        1207          83 :             if (dgn_t_new .gt. dp_cut(ipair)) cycle mainloop1_i
        1208             :         end if
        1209             :
        1210          83 :         if ( dgn_t_new .le. dp_xferall_thresh(ipair) ) then
        1211             : !   special case of (dgn_t_new <= xferall threshold value)
        1212             :             tailfr_numnew = 1.0_r8
        1213             :             tailfr_volnew = 1.0_r8
        1214             :         else
        1215             : !   compute new fraction of number and mass in the tail (dp < dp_cut)
        1216          47 :             lndgn_new = log( dgn_t_new )
        1217          47 :             lndgv_new = lndgn_new + factor_3alnsg2(ipair)
        1218          47 :             yn_tail = (lndp_cut(ipair) - lndgn_new)*factoryy(mfrm)
        1219          47 :             yv_tail = (lndp_cut(ipair) - lndgv_new)*factoryy(mfrm)
        1220          47 :             tailfr_numnew = 1.0_r8 - 0.5_r8*erfc( yn_tail )
        1221          47 :             tailfr_volnew = 1.0_r8 - 0.5_r8*erfc( yv_tail )
        1222             :         end if
        1223             :
        1224             : !   compute old dgnum
        1225             :         dgn_t_old =   &
        1226          83 :                 (dryvol_t_oldbnd/(num_t_oldbnd*factoraa(mfrm)))**onethird
        1227          83 :         dgn_t_oldb = dgn_t_old
        1228          83 :         dryvol_t_oldb = dryvol_t_old
        1229             :
        1230             : !   no need to compute old fraction of number and mass in the tail
        1231          83 :         tailfr_numold = 0.0_r8
        1232          83 :         tailfr_volold = 0.0_r8
        1233             :
        1234             : !   transfer fraction is new tail-fraction
        1235          83 :         xferfrac_vol = tailfr_volnew
        1236          83 :         if (xferfrac_vol .le. 0.0_r8) cycle mainloop1_i
        1237          83 :         xferfrac_num = tailfr_numnew
        1238             :
        1239          83 :         if (xferfrac_vol >= xferfrac_max) then
        1240             :             ! transfer entire contents of mode
        1241             :             xferfrac_vol = 1.0_r8
        1242             :             xferfrac_num = 1.0_r8
        1243             :         else
        1244          47 :             xferfrac_vol = min( xferfrac_vol, xferfrac_max )
        1245             : !   transfer fraction for number cannot be less than that of volume
        1246          47 :             xferfrac_num = max( xferfrac_num, xferfrac_vol )
        1247          47 :             xferfrac_num = min( xferfrac_max, xferfrac_num )
        1248             :         end if
        1249             :
        1250          83 :         if (ixferable_all_renamexf(ipair) <= 0) then
        1251             :             ! not all species are xferable
        1252           0 :             dryvol_t_new_xfab = max( 0.0_r8, (dryvol_a_xfab(i,k) + dryvol_c_xfab(i,k)) )
        1253           0 :             dryvol_xferamt = xferfrac_vol*dryvol_t_new
        1254           0 :             if (dryvol_t_new_xfab >= 0.999999_r8*dryvol_xferamt) then
        1255             :                 ! xferable dryvol can supply the needed dryvol_xferamt
        1256             :                 ! but xferfrac_vol must be increased
        1257           0 :                 xferfrac_vol = min( 1.0_r8, (dryvol_xferamt/dryvol_t_new_xfab) )
        1258           0 :             else if (dryvol_t_new_xfab >= 1.0e-7_r8*dryvol_xferamt) then
        1259             :                 ! xferable dryvol cannot supply the needed dryvol_xferamt
        1260             :                 ! so transfer all of it, and reduce the number transfer
        1261           0 :                 xferfrac_vol = 1.0_r8
        1262           0 :                 xferfrac_num = xferfrac_num*(dryvol_t_new_xfab/dryvol_xferamt)
        1263             :             else
        1264             :                 ! xferable dryvol << needed dryvol_xferamt
        1265             :                 cycle mainloop1_i
        1266             :             end if
        1267             :         end if
        1268             :
        1269             :         endif grow_shrink_conditional1
        1270             :
        1271             : !
        1272             : !   compute tendencies for the renaming transfer
        1273             : !
        1274   955212719 :         pdel_fac = pdel(i,k)/gravit
        1275   955212719 :         j = jsrflx_rename
        1276  6143329358 :         do iq = 1, nspecfrm_renamexf(ipair)
        1277  4772636535 :             xfercoef = xferfrac_vol*deltatinv
        1278  4772636535 :             if (iq .eq. 1) xfercoef = xferfrac_num*deltatinv
        1279             :
        1280  4772636535 :             lsfrma = lspecfrma_renamexf(iq,ipair)-loffset
        1281  4772636535 :             lsfrmc = lspecfrmc_renamexf(iq,ipair)-loffset
        1282  4772636535 :             lstooa = lspectooa_renamexf(iq,ipair)-loffset
        1283  4772636535 :             lstooc = lspectooc_renamexf(iq,ipair)-loffset
        1284             :
        1285  4772636535 :             if (lsfrma .gt. 0) then
        1286             :                 xfertend = xfercoef*max( 0.0_r8,   &
        1287  4772636535 :                             (q(i,k,lsfrma)+dqdt(i,k,lsfrma)*deltat) )
        1288             :
        1289             : !   diagnostic output start ----------------------------------------
        1290             :                 if (ldiag1 > 0) then
        1291             :                 if ((i == icol_diag) .and. (mod(k-1,5) == 0)) then
        1292             :                   if (lstooa .gt. 0) then
        1293             :                     write(iulog,'(a,i4,2(2x,a),1p,10e14.6)') 'RENAME qdels', iq,   &
        1294             :                         cnst_name(lsfrma+loffset), cnst_name(lstooa+loffset),   &
        1295             :                         deltat*dqdt(i,k,lsfrma), deltat*(dqdt(i,k,lsfrma) - xfertend),   &
        1296             :                         deltat*dqdt(i,k,lstooa), deltat*(dqdt(i,k,lstooa) + xfertend)
        1297             :                   else
        1298             :                     write(iulog,'(a,i4,2(2x,a),1p,10e14.6)') 'RENAME qdels', iq,   &
        1299             :                         cnst_name(lsfrma+loffset), cnst_name(lstooa+loffset),   &
        1300             :                         deltat*dqdt(i,k,lsfrma), deltat*(dqdt(i,k,lsfrma) - xfertend)
        1301             :                   end if
        1302             :                 end if
        1303             :                 end if
        1304             : !   diagnostic output end   ------------------------------------------
        1305             :
        1306             :
        1307  4772636535 :                 dqdt(i,k,lsfrma) = dqdt(i,k,lsfrma) - xfertend
        1308  4772636535 :                 qsrflx(i,lsfrma,j) = qsrflx(i,lsfrma,j) - xfertend*pdel_fac
        1309  4772636535 :                 if (lstooa .gt. 0) then
        1310  4772636535 :                     dqdt(i,k,lstooa) = dqdt(i,k,lstooa) + xfertend
        1311  4772636535 :                     qsrflx(i,lstooa,j) = qsrflx(i,lstooa,j) + xfertend*pdel_fac
        1312  4772636535 :                     if ( l_dqdt_rnpos ) &
        1313           0 :                         dqdt_rnpos(i,k,lstooa) = dqdt_rnpos(i,k,lstooa) + xfertend
        1314             :                 end if
        1315             :             end if
        1316             :
        1317 11294707935 :             if (lsfrmc .gt. 0) then
        1318             :                 xfertend = xfercoef*max( 0.0_r8,   &
        1319  4772636535 :                             (qqcw(i,k,lsfrmc)+dqqcwdt(i,k,lsfrmc)*deltat) )
        1320  4772636535 :                 dqqcwdt(i,k,lsfrmc) = dqqcwdt(i,k,lsfrmc) - xfertend
        1321  4772636535 :                 qqcwsrflx(i,lsfrmc,j) = qqcwsrflx(i,lsfrmc,j) - xfertend*pdel_fac
        1322  4772636535 :                 if (lstooc .gt. 0) then
        1323  4772636535 :                     dqqcwdt(i,k,lstooc) = dqqcwdt(i,k,lstooc) + xfertend
        1324  4772636535 :                     qqcwsrflx(i,lstooc,j) = qqcwsrflx(i,lstooc,j) + xfertend*pdel_fac
        1325             :                 end if
        1326             :             end if
        1327             :
        1328             :         end do   ! "iq = 1, nspecfrm_renamexf(ipair)"
        1329             :
        1330             :
        1331             :         end do mainloop1_i
        1332             :         end do mainloop1_k
        1333             :
        1334             :
        1335             :         end do mainloop1_ipair
        1336             :
        1337             : !
        1338             : !   set dotend's
        1339             : !
        1340     1489176 :         dotendrn(:) = .false.
        1341     1489176 :         dotendqqcwrn(:) = .false.
        1342     5956704 :         do ipair = 1, npair_renamexf
        1343    25315992 :         do iq = 1, nspecfrm_renamexf(ipair)
        1344    19359288 :             lsfrma = lspecfrma_renamexf(iq,ipair) - loffset
        1345    19359288 :             lsfrmc = lspecfrmc_renamexf(iq,ipair) - loffset
        1346    19359288 :             lstooa = lspectooa_renamexf(iq,ipair) - loffset
        1347    19359288 :             lstooc = lspectooc_renamexf(iq,ipair) - loffset
        1348    19359288 :             if (lsfrma .gt. 0) then
        1349    19359288 :                 dotendrn(lsfrma) = .true.
        1350    19359288 :                 if (lstooa .gt. 0) dotendrn(lstooa) = .true.
        1351             :             end if
        1352    23826816 :             if (lsfrmc .gt. 0) then
        1353    19359288 :                 dotendqqcwrn(lsfrmc) = .true.
        1354    19359288 :                 if (lstooc .gt. 0) dotendqqcwrn(lstooc) = .true.
        1355             :             end if
        1356             :         end do
        1357             :         end do
        1358             :
        1359             :
        1360             :         return
        1361             :
        1362             :
        1363             : !
        1364             : !   error -- renaming currently just works for 1 pair
        1365             : !
        1366             : 8100    write(lunout,9050) ipair
        1367             :         call endrun( 'modal_aero_rename_acc_crs_sub error' )
        1368             : 9050    format( / '*** subr. modal_aero_rename_acc_crs_sub ***' /   &
        1369             :             4x, 'aerosol renaming not implemented for ipair =', i5 )
        1370             :
        1371             : !EOC
        1372     1489176 :         end subroutine modal_aero_rename_acc_crs_sub
        1373             :
        1374             :
        1375             :
        1376             : !-------------------------------------------------------------------------
        1377             : ! for modal aerosols in the troposphere and stratophere
        1378             : ! -- allows accumulation to coarse mode exchange
        1379             : !-------------------------------------------------------------------------
        1380        1536 :         subroutine modal_aero_rename_acc_crs_init
        1381             : !
        1382             : !   computes pointers for species transfer during aerosol renaming
        1383             : !       (a2 --> a1 transfer)
        1384             : !   transfers include number_a, number_c, mass_a, mass_c and
        1385             : !       water_a
        1386             : !
        1387             :
        1388             :         implicit none
        1389             :
        1390             : !   local variables
        1391             :         integer :: i, ipair, iq, iqfrm, iqtooa, iqtooc, itmpa
        1392             :         integer :: l, lsfrma, lsfrmc, lstooa, lstooc, lunout
        1393             :         integer :: mfrm, mtoo
        1394             :         integer :: n1, n2, nspec
        1395             :         integer :: nch_lfrm, nch_ltoo, nch_mfrmid, nch_mtooid
        1396             :
        1397             :         real (r8) :: frelax
        1398             :
        1399        1536 :         lunout = iulog
        1400             :
        1401             : !
        1402             : !   define "from mode" and "to mode" for each tail-xfer pairing
        1403             : !       using the values in ipair_select_renamexf(:)
        1404             : !
        1405        1536 :         npair_renamexf = 0
        1406        6144 :         do ipair = 1, maxpair_renamexf
        1407        4608 :            itmpa = ipair_select_renamexf(ipair)
        1408        4608 :            if (itmpa == 0) then
        1409             :               exit
        1410        4608 :            else if (itmpa == 2001) then  !both mam4 and mam5
        1411        1536 :               mfrm = modeptr_aitken
        1412        1536 :               mtoo = modeptr_accum
        1413        1536 :               igrow_shrink_renamexf(ipair) = 1
        1414        1536 :               ixferable_all_needed_renamexf(ipair) = 1
        1415        1536 :               strat_only_renamexf(ipair) = .false.
        1416        3072 :            else if (itmpa == 1003) then
        1417        1536 :               mfrm = modeptr_accum
        1418        1536 :               mtoo = modeptr_coarse
        1419        1536 :               igrow_shrink_renamexf(ipair) = 1
        1420        1536 :               ixferable_all_needed_renamexf(ipair) = 0
        1421        1536 :               strat_only_renamexf(ipair) = .true.
        1422        1536 :            else if (itmpa == 1005) then
        1423           0 :               mfrm = modeptr_accum
        1424           0 :               mtoo = modeptr_stracoar
        1425           0 :               igrow_shrink_renamexf(ipair) = 1
        1426           0 :               ixferable_all_needed_renamexf(ipair) = 0
        1427           0 :               strat_only_renamexf(ipair) = .true.
        1428        1536 :            else if (itmpa == 3001) then
        1429        1536 :               mfrm = modeptr_coarse
        1430        1536 :               mtoo = modeptr_accum
        1431        1536 :               igrow_shrink_renamexf(ipair) = -1
        1432        1536 :               ixferable_all_needed_renamexf(ipair) = 0
        1433        1536 :               strat_only_renamexf(ipair) = .true.
        1434           0 :            else if (itmpa == 5001) then
        1435           0 :               mfrm = modeptr_stracoar
        1436           0 :               mtoo = modeptr_accum
        1437           0 :               igrow_shrink_renamexf(ipair) = -1
        1438           0 :               ixferable_all_needed_renamexf(ipair) = 0
        1439           0 :               strat_only_renamexf(ipair) = .true.
        1440             :            else
        1441             :               write(lunout,'(/2a,3(1x,i12))') &
        1442           0 :                    '*** subr. modal_aero_rename_acc_crs_init', &
        1443           0 :                    'bad ipair_select_renamexf', ipair, itmpa
        1444           0 :               call endrun( 'modal_aero_rename_acc_crs_init error' )
        1445             :            end if
        1446             :
        1447        9216 :            do i = 1, ipair-1
        1448        9216 :               if (itmpa .eq. ipair_select_renamexf(i)) then
        1449             :                  write(lunout,'(/2a/10(1x,i12))') &
        1450           0 :                       '*** subr. modal_aero_rename_acc_crs_init', &
        1451           0 :                       'duplicates in ipair_select_renamexf', &
        1452           0 :                       ipair_select_renamexf(1:ipair)
        1453           0 :                  call endrun( 'modal_aero_rename_acc_crs_init error' )
        1454             :               end if
        1455             :            end do
        1456             :
        1457             :            if ( (mfrm .ge. 1) .and. (mfrm .le. ntot_amode) .and. &
        1458        6144 :                 (mtoo .ge. 1) .and. (mtoo .le. ntot_amode) ) then
        1459        4608 :               npair_renamexf = ipair
        1460        4608 :               modefrm_renamexf(ipair) = mfrm
        1461        4608 :               modetoo_renamexf(ipair) = mtoo
        1462             :            else
        1463             :               write(lunout,'(/2a,3(1x,i12))') &
        1464           0 :                    '*** subr. modal_aero_rename_acc_crs_init', &
        1465           0 :                    'bad mfrm or mtoo', ipair, mfrm, mtoo
        1466           0 :               call endrun( 'modal_aero_rename_acc_crs_init error' )
        1467             :            end if
        1468             :         end do ! ipair
        1469             :
        1470        1536 :         if (npair_renamexf .le. 0) then
        1471             :             write(lunout,'(/a/a,3(1x,i12))') &
        1472           0 :                 '*** subr. modal_aero_rename_acc_crs_init -- npair_renamexf = 0'
        1473           0 :             return
        1474             :         end if
        1475             :
        1476             :
        1477             : !
        1478             : !   define species involved in each tail-xfer pairing
        1479             : !       (include aerosol water)
        1480             : !
        1481        6144 :         do 1900 ipair = 1, npair_renamexf
        1482        4608 :         mfrm = modefrm_renamexf(ipair)
        1483        4608 :         mtoo = modetoo_renamexf(ipair)
        1484        4608 :         ixferable_all_renamexf(ipair) = 1
        1485             :
        1486        4608 :         if (mfrm < 10) then
        1487             :             nch_mfrmid = 1
        1488           0 :         else if (mfrm < 100) then
        1489             :             nch_mfrmid = 2
        1490             :         else
        1491           0 :             nch_mfrmid = 3
        1492             :         end if
        1493        4608 :         if (mtoo < 10) then
        1494             :             nch_mtooid = 1
        1495           0 :         else if (mtoo < 100) then
        1496             :             nch_mtooid = 2
        1497             :         else
        1498           0 :             nch_mtooid = 3
        1499             :         end if
        1500             :
        1501        4608 :         nspec = 0
        1502       33792 :         do 1490 iqfrm = -1, nspec_amode(mfrm)
        1503       29184 :             if (iqfrm .eq. -1) then
        1504        4608 :                 lsfrma = numptr_amode(mfrm)
        1505        4608 :                 lstooa = numptr_amode(mtoo)
        1506        4608 :                 lsfrmc = numptrcw_amode(mfrm)
        1507        4608 :                 lstooc = numptrcw_amode(mtoo)
        1508       24576 :             else if (iqfrm .eq. 0) then
        1509             : !   bypass transfer of aerosol water due to renaming
        1510             :                 goto 1490
        1511             : !               lsfrma = lwaterptr_amode(mfrm)
        1512             : !               lsfrmc = 0
        1513             : !               lstooa = lwaterptr_amode(mtoo)
        1514             : !               lstooc = 0
        1515             :             else
        1516       19968 :                 lsfrma = lmassptr_amode(iqfrm,mfrm)
        1517       19968 :                 lsfrmc = lmassptrcw_amode(iqfrm,mfrm)
        1518       19968 :                 lstooa = 0
        1519       19968 :                 lstooc = 0
        1520             :             end if
        1521             :
        1522       24576 :             if ((lsfrma .lt. 1) .or. (lsfrma .gt. pcnst)) then
        1523           0 :                 write(lunout,9100) ipair, mfrm, iqfrm, lsfrma
        1524           0 :                 call endrun( 'modal_aero_rename_acc_crs_init error' )
        1525             :             end if
        1526       24576 :             if (iqfrm .le. 0) goto 1430
        1527             :
        1528       19968 :             if ((lsfrmc .lt. 1) .or. (lsfrmc .gt. pcnst)) then
        1529           0 :                 write(lunout,9102) ipair, mfrm, iqfrm, lsfrmc
        1530           0 :                 call endrun( 'modal_aero_rename_acc_crs_init error' )
        1531             :             end if
        1532             :
        1533             : ! find "too" species having same name (except for mode number) as the "frm" species
        1534       19968 :             nch_lfrm = len(trim(cnst_name(lsfrma))) - nch_mfrmid
        1535       19968 :             iqtooa = -99
        1536       69120 :             do iq = 1, nspec_amode(mtoo)
        1537       64512 :                 l = lmassptr_amode(iq,mtoo)
        1538       64512 :                 if ((l .lt. 1) .or. (l .gt. pcnst)) cycle
        1539       64512 :                 nch_ltoo = len(trim(cnst_name(l))) - nch_mtooid
        1540       64512 :                 if ( cnst_name(lsfrma)(1:nch_lfrm) == &
        1541        4608 :                      cnst_name(l     )(1:nch_ltoo) ) then
        1542       15360 :                     lstooa = l
        1543       15360 :                     iqtooa = iq
        1544       15360 :                     exit
        1545             :                 end if
        1546             :             end do
        1547             :
        1548       19968 :             nch_lfrm = len(trim(cnst_name_cw(lsfrmc))) - nch_mfrmid
        1549       19968 :             iqtooc = -99
        1550       69120 :             do iq = 1, nspec_amode(mtoo)
        1551       64512 :                 l = lmassptrcw_amode(iq,mtoo)
        1552       64512 :                 if ((l .lt. 1) .or. (l .gt. pcnst)) cycle
        1553       64512 :                 nch_ltoo = len(trim(cnst_name_cw(l))) - nch_mtooid
        1554       64512 :                 if ( cnst_name_cw(lsfrmc)(1:nch_lfrm) == &
        1555        9216 :                      cnst_name_cw(l     )(1:nch_ltoo) ) then
        1556       15360 :                     lstooc = l
        1557       15360 :                     iqtooc = iq
        1558       15360 :                     exit
        1559             :                 end if
        1560             :             end do
        1561             :
        1562       24576 : 1430        if ((lstooc .lt. 1) .or. (lstooc .gt. pcnst)) lstooc = 0
        1563       24576 :             if ((lstooa .lt. 1) .or. (lstooa .gt. pcnst)) lstooa = 0
        1564             :
        1565       24576 :             if ((lstooa .eq. 0) .or. (lstooc .eq. 0)) then
        1566             :                 if ( ( masterproc                                  ) .or. &
        1567        4608 :                      ( (lstooa .ne. 0) .or. (lstooc .ne. 0)        ) .or. &
        1568        4608 :                      ( ixferable_all_needed_renamexf(ipair) .gt. 0 ) ) then
        1569           6 :                     if (lstooa .eq. 0) &
        1570           6 :                         write(lunout,9104) trim(cnst_name(lsfrma)), &
        1571          12 :                             ipair, mfrm, iqfrm, lsfrma, iqtooa, lstooa
        1572           6 :                     if (lstooc .eq. 0) &
        1573           6 :                         write(lunout,9106) trim(cnst_name_cw(lsfrmc)), &
        1574          12 :                             ipair, mfrm, iqfrm, lsfrmc, iqtooc, lstooc
        1575             :                 end if
        1576        4608 :                 if ((lstooa .ne. 0) .or. (lstooc .ne. 0)) then
        1577           0 :                     write(lunout,9108)
        1578           0 :                     call endrun( 'modal_aero_rename_acc_crs_init error' )
        1579             :                 end if
        1580        4608 :                 if (ixferable_all_needed_renamexf(ipair) .gt. 0) then
        1581           0 :                     write(lunout,9109)
        1582           0 :                     call endrun( 'modal_aero_rename_acc_crs_init error' )
        1583             :                 end if
        1584        4608 :                 ixferable_all_renamexf(ipair) = 0
        1585        4608 :                 if (iqfrm .gt. 0) then
        1586        4608 :                     ixferable_a_renamexf(iqfrm,ipair) = 0
        1587        4608 :                     ixferable_c_renamexf(iqfrm,ipair) = 0
        1588             :                 end if
        1589             :             else
        1590       19968 :                 nspec = nspec + 1
        1591       19968 :                 lspecfrma_renamexf(nspec,ipair) = lsfrma
        1592       19968 :                 lspectooa_renamexf(nspec,ipair) = lstooa
        1593       19968 :                 lspecfrmc_renamexf(nspec,ipair) = lsfrmc
        1594       19968 :                 lspectooc_renamexf(nspec,ipair) = lstooc
        1595       19968 :                 if (iqfrm .gt. 0) then
        1596       15360 :                     ixferable_a_renamexf(iqfrm,ipair) = 1
        1597       15360 :                     ixferable_c_renamexf(iqfrm,ipair) = 1
        1598             :                 end if
        1599             :             end if
        1600        4608 : 1490    continue
        1601             :
        1602        4608 :         nspecfrm_renamexf(ipair) = nspec
        1603        1536 : 1900    continue
        1604             :
        1605             : 9100    format( / '*** subr. modal_aero_rename_acc_crs_init' /   &
        1606             :         'lspecfrma out of range' /   &
        1607             :         'ipair, modefrm, ispecfrm, lspecfrma =', 4i6 )
        1608             : 9102    format( / '*** subr. modal_aero_rename_acc_crs_init' /   &
        1609             :         'lspecfrmc out of range' /   &
        1610             :         'ipair, modefrm, ispecfrm, lspecfrmc =', 4i6 )
        1611             : 9104    format( / '*** subr. modal_aero_rename_acc_crs_init' /   &
        1612             :         'lspectooa out of range for', 2x, a /   &
        1613             :         'ipair, modefrm, ispecfrm, lspecfrma, ispectoo, lspectooa =', 6i6 )
        1614             : 9106    format( / '*** subr. modal_aero_rename_acc_crs_init' /   &
        1615             :         'lspectooc out of range for', 2x, a /   &
        1616             :         'ipair, modefrm, ispecfrm, lspecfrmc, ispectoo, lspectooc =', 6i6 )
        1617             : 9108    format( / '*** subr. modal_aero_rename_acc_crs_init' /   &
        1618             :         'only one of lspectooa and lspectooc is out of range' )
        1619             : 9109    format( / '*** subr. modal_aero_rename_acc_crs_init' /   &
        1620             :         'all species must be xferable for this pair' )
        1621             :
        1622             :
        1623             : !
        1624             : !
        1625             : !   initialize some working variables
        1626             : !
        1627             : !
        1628        7680 :         ido_mode_calcaa(:) = 0
        1629        1536 :         frelax = 27.0_r8
        1630             :
        1631        6144 :         do ipair = 1, npair_renamexf
        1632        4608 :             mfrm = modefrm_renamexf(ipair)
        1633        4608 :             mtoo = modetoo_renamexf(ipair)
        1634        4608 :             ido_mode_calcaa(mfrm) = 1
        1635             :
        1636        4608 :             factoraa(mfrm) = (pi/6._r8)*exp(4.5_r8*(alnsg_amode(mfrm)**2))
        1637        4608 :             factoraa(mtoo) = (pi/6._r8)*exp(4.5_r8*(alnsg_amode(mtoo)**2))
        1638        4608 :             factoryy(mfrm) = sqrt( 0.5_r8 )/alnsg_amode(mfrm)
        1639             :
        1640             : !   dryvol_smallest is a very small volume mixing ratio (m3-AP/kmol-air)
        1641             : !   used for avoiding overflow.  it corresponds to dp = 1 nm
        1642             : !   and number = 1e-5 #/mg-air ~= 1e-5 #/cm3-air
        1643        4608 :             dryvol_smallest(mfrm) = 1.0e-25_r8
        1644        4608 :             v2nlorlx(mfrm) = voltonumblo_amode(mfrm)*frelax
        1645        4608 :             v2nhirlx(mfrm) = voltonumbhi_amode(mfrm)/frelax
        1646             :
        1647        4608 :             factor_3alnsg2(ipair) = 3.0_r8 * (alnsg_amode(mfrm)**2)
        1648             :
        1649             :             dp_cut(ipair) = sqrt( &
        1650           0 :                  dgnum_amode(mfrm)*exp(1.5_r8*(alnsg_amode(mfrm)**2)) *   &
        1651        4608 :                  dgnum_amode(mtoo)*exp(1.5_r8*(alnsg_amode(mtoo)**2)) )
        1652        4608 :             dp_xferall_thresh(ipair) = dgnum_amode(mtoo)
        1653        4608 :             dp_xfernone_threshaa(ipair) = dgnum_amode(mfrm)
        1654        4608 :             if (((mfrm == modeptr_accum) .and. (mtoo == modeptr_coarse)).or.&
        1655             :                 ((mfrm == modeptr_accum) .and. (mtoo == modeptr_stracoar))) then
        1656        1536 :                dp_cut(ipair)               = 4.4e-7_r8
        1657        1536 :                dp_xfernone_threshaa(ipair) = 1.6e-7_r8
        1658        1536 :                dp_xferall_thresh(ipair)    = 4.7e-7_r8
        1659        3072 :             else if (((mfrm == modeptr_coarse) .and. (mtoo == modeptr_accum)).or.&
        1660             :                      ((mfrm == modeptr_stracoar) .and. (mtoo == modeptr_accum))) then
        1661        1536 :                dp_cut(ipair)               = 4.4e-7_r8
        1662        1536 :                dp_xfernone_threshaa(ipair) = 4.4e-7_r8
        1663        1536 :                dp_xferall_thresh(ipair)    = 4.1e-7_r8
        1664             :             end if
        1665             :
        1666        4608 :             lndp_cut(ipair) = log( dp_cut(ipair) )
        1667        6144 :             dp_belowcut(ipair) = 0.99_r8*dp_cut(ipair)
        1668             :          end do
        1669             :
        1670             :
        1671             : !
        1672             : !   output results
        1673             : !
        1674        1536 :         if ( masterproc ) then
        1675             :
        1676           2 :         write(lunout,9310)
        1677           2 :         write(lunout,'(a,1x,i12)') 'method_optbb_renamexf', method_optbb_renamexf
        1678             :
        1679           8 :         do 2900 ipair = 1, npair_renamexf
        1680           6 :         mfrm = modefrm_renamexf(ipair)
        1681           6 :         mtoo = modetoo_renamexf(ipair)
        1682          12 :         write(lunout,9320) ipair, mfrm, mtoo, &
        1683          18 :             igrow_shrink_renamexf(ipair), ixferable_all_renamexf(ipair)
        1684             :
        1685          32 :         do iq = 1, nspecfrm_renamexf(ipair)
        1686          26 :             lsfrma = lspecfrma_renamexf(iq,ipair)
        1687          26 :             lstooa = lspectooa_renamexf(iq,ipair)
        1688          26 :             lsfrmc = lspecfrmc_renamexf(iq,ipair)
        1689          26 :             lstooc = lspectooc_renamexf(iq,ipair)
        1690          26 :             if (lstooa .gt. 0) then
        1691          26 :                 write(lunout,9330) lsfrma, cnst_name(lsfrma),   &
        1692          52 :                                    lstooa, cnst_name(lstooa)
        1693             :             else
        1694           0 :                 write(lunout,9340) lsfrma, cnst_name(lsfrma)
        1695             :             end if
        1696          32 :             if (lstooc .gt. 0) then
        1697          26 :                 write(lunout,9330) lsfrmc, cnst_name_cw(lsfrmc),   &
        1698          52 :                                    lstooc, cnst_name_cw(lstooc)
        1699           0 :             else if (lsfrmc .gt. 0) then
        1700           0 :                 write(lunout,9340) lsfrmc, cnst_name_cw(lsfrmc)
        1701             :             else
        1702           0 :                 write(lunout,9350)
        1703             :             end if
        1704             :         end do
        1705             :
        1706           6 :         if (igrow_shrink_renamexf(ipair) > 0) then
        1707           4 :         write(lunout,'(5x,a,1p,2e12.3)') 'mfrm dgnum, dgnumhi ', &
        1708           8 :                 dgnum_amode(mfrm), dgnumhi_amode(mfrm)
        1709           4 :         write(lunout,'(5x,a,1p,2e12.3)') 'mtoo dgnum, dgnumlo ', &
        1710           8 :                 dgnum_amode(mtoo), dgnumlo_amode(mtoo)
        1711             :         else
        1712           2 :         write(lunout,'(5x,a,1p,2e12.3)') 'mfrm dgnum, dgnumlo ', &
        1713           4 :                 dgnum_amode(mfrm), dgnumlo_amode(mfrm)
        1714           2 :         write(lunout,'(5x,a,1p,2e12.3)') 'mtoo dgnum, dgnumhi ', &
        1715           4 :                 dgnum_amode(mtoo), dgnumhi_amode(mtoo)
        1716             :         end if
        1717             :
        1718          12 :         write(lunout,'(5x,a,1p,2e12.3)') 'dp_cut              ', &
        1719          18 :                 dp_cut(ipair)
        1720          12 :         write(lunout,'(5x,a,1p,2e12.3)') 'dp_xfernone_threshaa', &
        1721          18 :                 dp_xfernone_threshaa(ipair)
        1722          12 :         write(lunout,'(5x,a,1p,2e12.3)') 'dp_xferall_thresh   ', &
        1723          18 :                 dp_xferall_thresh(ipair)
        1724             :
        1725           2 : 2900    continue
        1726           2 :         write(lunout,*)
        1727             :
        1728             :         end if ! ( masterproc )
        1729             :
        1730             : 9310    format( / 'subr. modal_aero_rename_acc_crs_init' )
        1731             : 9320    format( / 'pair', i3, 5x, 'mode', i3, ' ---> mode', i3, &
        1732             :                 5x, 'igrow_shrink', i3, 5x, 'ixferable_all', i3 )
        1733             : 9330    format( 5x, 'spec', i3, '=', a, ' ---> spec', i3, '=', a )
        1734             : 9340    format( 5x, 'spec', i3, '=', a, ' ---> LOSS' )
        1735             : 9350    format( 5x, 'no corresponding activated species' )
        1736             :
        1737             :
        1738             :         return
        1739             :         end subroutine modal_aero_rename_acc_crs_init
        1740             :
        1741             : !----------------------------------------------------------------------
        1742             :
        1743             :    end module modal_aero_rename

Generated by: LCOV version 1.14