chem/module_cam_mam_initaerodata.F

   1 ! module_cam_mam_initaerodata.F
   2 ! adapted from cam3 modal_aero_initialize_data.F90 by r.c.easter, june 2010
   3 ! Updated to CESM1.0.3 (CAM5.1.01) by Balwinder.Singh@pnnl.gov
   4 !
   5 ! 2010-06-17 rce notes
   6 !     > code involving specrefndxsw, specrefndxlw, and spechygro is temporary,
   7 !       and should be changed after cam radiation code is ported
   8 !     > subroutine modal_aero_initialize_q was used for initial development of
   9 !       cam modal aerosols, and it is no longer needed.
  10 !       I left it in, but it will now halt immediately if called.
  11 !--------------------------------------------------------------
  12 #include "MODAL_AERO_CPP_DEFINES.h"
  13 #define WRF_PORT
  14 #define MODAL_AERO
  15
  16 module modal_aero_initialize_data
  17 #ifndef WRF_PORT
  18   use cam_logfile,           only : iulog
  19   use abortutils,            only: endrun
  20   use spmd_utils,            only: masterproc, iam
  21   use ppgrid,                only: pcols, pver
  22   use phys_control,          only: phys_getopts
  23 #else
  24   use module_cam_support,    only: iulog, endrun, masterproc, iam, &
  25        pcols, pver
  26 #endif
  27   use modal_aero_data
  28
  29   implicit none
  30   private
  31   public :: modal_aero_register
  32   public :: modal_aero_initialize
  33 #ifndef WRF_PORT
  34   public :: modal_aero_initialize_q
  35 #endif
  36 #ifdef WRF_PORT
  37   public :: decouple_mam_mp
  38 #endif
  39
  40 contains
  41
  42   subroutine modal_aero_register
  43 #ifndef WRF_PORT
  44     use constituents,          only: pcnst, cnst_name
  45     use phys_buffer, only: pbuf_add
  46 #else
  47     use module_cam_support,    only: pcnst => pcnst_runtime
  48     use constituents,          only: cnst_name
  49 #endif
  50
  51     character(len=8)  :: &
  52          xname_massptr(maxd_aspectype,ntot_amode), &
  53          xname_massptrcw(maxd_aspectype,ntot_amode)
  54     character(len=10) :: xname_spectype(maxd_aspectype,ntot_amode)
  55
  56
  57     !   input species to hold interstitial & activated number
  58 #if ( defined MODAL_AERO_7MODE )
  59     character(len=*), parameter :: xname_numptr(ntot_amode)   = (/ 'num_a1  ', 'num_a2  ', 'num_a3  ', &
  60          'num_a4  ', 'num_a5  ', 'num_a6  ', 'num_a7  ' /)
  61     character(len=*), parameter ::     xname_numptrcw(ntot_amode) = (/ 'num_c1  ', 'num_c2  ', 'num_c3  ', &
  62          'num_c4  ', 'num_c5  ', 'num_c6  ', 'num_c7  ' /)
  63 #elif ( defined MODAL_AERO_3MODE )
  64     character(len=*), parameter ::     xname_numptr(ntot_amode)   = (/ 'num_a1  ', 'num_a2  ', &
  65          'num_a3  ' /)
  66     character(len=*), parameter ::     xname_numptrcw(ntot_amode) = (/ 'num_c1  ', 'num_c2  ', &
  67          'num_c3  ' /)
  68 #endif
  69
  70
  71
  72     integer :: m, l, iptr
  73     real pi
  74     character(len=3) :: trnum       ! used to hold mode number (as characters)
  75
  76     pi = 4.*atan(1._r8)
  77
  78        !   input species to hold aerosol water and "kohler-c"
  79        !     xname_waterptr(:ntot_amode)   = (/ 'wat_a1  ', 'wat_a2  ', 'wat_a3  ', &
  80        !                                        'wat_a4  ', 'wat_a5  ', 'wat_a6  ', 'wat_a7  ' /)
  81        !   input chemical species for the mode
  82        ! mode 1 (accumulation) species
  83        ! JPE 02022011: These could also be parameters but a bug in the pathscale compiler prevents
  84        !               parameter initialization of 2D variables
  85 #if ( defined MODAL_AERO_7MODE )
  86        xname_massptr(:nspec_amode(1),1)   = (/ 'so4_a1  ', 'nh4_a1  ', &
  87             'pom_a1  ', 'soa_a1  ', 'bc_a1   ', 'ncl_a1  ' /)
  88        xname_massptrcw(:nspec_amode(1),1) = (/ 'so4_c1  ', 'nh4_c1  ', &
  89             'pom_c1  ', 'soa_c1  ', 'bc_c1   ', 'ncl_c1  ' /)
  90        xname_spectype(:nspec_amode(1),1)  = (/ 'sulfate   ', 'ammonium  ', &
  91             'p-organic ', 's-organic ', 'black-c   ', 'seasalt   ' /)
  92 #elif ( defined MODAL_AERO_3MODE )
  93        xname_massptr(:nspec_amode(1),1)   = (/ 'so4_a1  ', &
  94             'pom_a1  ', 'soa_a1  ', 'bc_a1   ', &
  95             'dst_a1  ', 'ncl_a1  ' /)
  96        xname_massptrcw(:nspec_amode(1),1) = (/ 'so4_c1  ', &
  97             'pom_c1  ', 'soa_c1  ', 'bc_c1   ', &
  98             'dst_c1  ', 'ncl_c1  ' /)
  99        xname_spectype(:nspec_amode(1),1)  = (/ 'sulfate   ', &
 100             'p-organic ', 's-organic ', 'black-c   ', &
 101             'dust      ', 'seasalt   ' /)
 102 #endif
 103
 104        ! mode 2 (aitken) species
 105 #if ( defined MODAL_AERO_7MODE )
 106        xname_massptr(:nspec_amode(2),2)   = (/ 'so4_a2  ', 'nh4_a2  ', &
 107             'soa_a2  ', 'ncl_a2  ' /)
 108        xname_massptrcw(:nspec_amode(2),2) = (/ 'so4_c2  ', 'nh4_c2  ', &
 109             'soa_c2  ', 'ncl_c2  ' /)
 110        xname_spectype(:nspec_amode(2),2)  = (/ 'sulfate   ', 'ammonium  ', &
 111             's-organic ', 'seasalt   ' /)
 112 #elif ( defined MODAL_AERO_3MODE )
 113        xname_massptr(:nspec_amode(2),2)   = (/ 'so4_a2  ', &
 114             'soa_a2  ', 'ncl_a2  ' /)
 115        xname_massptrcw(:nspec_amode(2),2) = (/ 'so4_c2  ', &
 116             'soa_c2  ', 'ncl_c2  ' /)
 117        xname_spectype(:nspec_amode(2),2)  = (/ 'sulfate   ', &
 118             's-organic ', 'seasalt   ' /)
 119 #endif
 120
 121 #if ( defined MODAL_AERO_7MODE )
 122        ! mode 3 (primary carbon) species
 123        xname_massptr(:nspec_amode(3),3)   = (/ 'pom_a3  ', 'bc_a3   ' /)
 124        xname_massptrcw(:nspec_amode(3),3) = (/ 'pom_c3  ', 'bc_c3   ' /)
 125        xname_spectype(:nspec_amode(3),3)  = (/ 'p-organic ', 'black-c   ' /)
 126 #elif ( defined MODAL_AERO_3MODE )
 127        ! mode 3 (coarse dust & seasalt) species
 128        xname_massptr(:nspec_amode(3),3)   = (/ 'dst_a3  ', 'ncl_a3  ', 'so4_a3  ' /)
 129        xname_massptrcw(:nspec_amode(3),3) = (/ 'dst_c3  ', 'ncl_c3  ', 'so4_c3  ' /)
 130        xname_spectype(:nspec_amode(3),3)  = (/ 'dust      ', 'seasalt   ', 'sulfate   ' /)
 131 #endif
 132
 133
 134 #if ( defined MODAL_AERO_7MODE )
 135        ! mode 4 (fine seasalt) species
 136        xname_massptr(:nspec_amode(4),4)   = (/ 'ncl_a4  ', 'so4_a4  ', 'nh4_a4  ' /)
 137        xname_massptrcw(:nspec_amode(4),4) = (/ 'ncl_c4  ', 'so4_c4  ', 'nh4_c4  ' /)
 138        xname_spectype(:nspec_amode(4),4)  = (/ 'seasalt   ', 'sulfate   ', 'ammonium  ' /)
 139
 140        ! mode 5 (fine dust) species
 141        xname_massptr(:nspec_amode(5),5)   = (/ 'dst_a5  ', 'so4_a5  ', 'nh4_a5  ' /)
 142        xname_massptrcw(:nspec_amode(5),5) = (/ 'dst_c5  ', 'so4_c5  ', 'nh4_c5  ' /)
 143        xname_spectype(:nspec_amode(5),5)  = (/ 'dust      ', 'sulfate   ', 'ammonium  ' /)
 144
 145        ! mode 6 (coarse seasalt) species
 146        xname_massptr(:nspec_amode(6),6)   = (/ 'ncl_a6  ', 'so4_a6  ', 'nh4_a6  ' /)
 147        xname_massptrcw(:nspec_amode(6),6) = (/ 'ncl_c6  ', 'so4_c6  ', 'nh4_c6  ' /)
 148        xname_spectype(:nspec_amode(6),6)  = (/ 'seasalt   ', 'sulfate   ', 'ammonium  ' /)
 149
 150        ! mode 7 (coarse dust) species
 151        xname_massptr(:nspec_amode(7),7)   = (/ 'dst_a7  ', 'so4_a7  ', 'nh4_a7  ' /)
 152        xname_massptrcw(:nspec_amode(7),7) = (/ 'dst_c7  ', 'so4_c7  ', 'nh4_c7  ' /)
 153        xname_spectype(:nspec_amode(7),7)  = (/ 'dust      ', 'sulfate   ', 'ammonium  ' /)
 154 #endif
 155
 156     do m = 1, ntot_amode
 157
 158        if (masterproc) then
 159           write(iulog,9231) m, modename_amode(m)
 160           write(iulog,9232)                                          &
 161                'nspec                       ',                         &
 162                nspec_amode(m)
 163           write(iulog,9232)                                          &
 164                'mprognum, mdiagnum, mprogsfc',                         &
 165                mprognum_amode(m), mdiagnum_amode(m), mprogsfc_amode(m)
 166           write(iulog,9232)                                          &
 167                'mcalcwater                  ',                         &
 168                mcalcwater_amode(m)
 169        endif
 170
 171        !   compute frequently used parameters: ln(sigmag),
 172        !   volume-to-number and volume-to-surface conversions, ...
 173        alnsg_amode(m) = log( sigmag_amode(m) )
 174
 175        voltonumb_amode(m) = 1. / ( (pi/6.)*                            &
 176             (dgnum_amode(m)**3.)*exp(4.5*alnsg_amode(m)**2.) )
 177        voltonumblo_amode(m) = 1. / ( (pi/6.)*                          &
 178             (dgnumlo_amode(m)**3.)*exp(4.5*alnsg_amode(m)**2.) )
 179        voltonumbhi_amode(m) = 1. / ( (pi/6.)*                          &
 180             (dgnumhi_amode(m)**3.)*exp(4.5*alnsg_amode(m)**2.) )
 181
 182        alnv2n_amode(m)   = log( voltonumb_amode(m) )
 183        alnv2nlo_amode(m) = log( voltonumblo_amode(m) )
 184        alnv2nhi_amode(m) = log( voltonumbhi_amode(m) )
 185
 186        !    define species to hold interstitial & activated number
 187        call search_list_of_names(                                      &
 188             xname_numptr(m), numptr_amode(m), cnst_name, pcnst )
 189        if (numptr_amode(m) .le. 0) then
 190           write(iulog,9061) 'xname_numptr', xname_numptr(m), m
 191           call endrun()
 192        end if
 193        if (numptr_amode(m) .gt. pcnst) then
 194           write(iulog,9061) 'numptr_amode', numptr_amode(m), m
 195           write(iulog,9061) 'xname_numptr', xname_numptr(m), m
 196           call endrun()
 197        end if
 198
 199        species_class(numptr_amode(m)) = spec_class_aerosol
 200
 201
 202        numptrcw_amode(m) = numptr_amode(m)  !use the same index for Q and QQCW arrays
 203        if (numptrcw_amode(m) .le. 0) then
 204           write(iulog,9061) 'xname_numptrcw', xname_numptrcw(m), m
 205           call endrun()
 206        end if
 207        if (numptrcw_amode(m) .gt. pcnst) then
 208           write(iulog,9061) 'numptrcw_amode', numptrcw_amode(m), m
 209           write(iulog,9061) 'xname_numptrcw', xname_numptrcw(m), m
 210           call endrun()
 211        end if
 212        species_class(numptrcw_amode(m)) = spec_class_aerosol
 213 #ifndef WRF_PORT
 214        call pbuf_add(xname_numptrcw(m), 'global', 1, pver, 1, iptr)
 215        call qqcw_set_ptr(numptrcw_amode(m),iptr)
 216 #endif
 217
 218        !   output mode information
 219        if ( masterproc ) then
 220           write(iulog,9233) 'numptr         ',                           &
 221                numptr_amode(m), xname_numptr(m)
 222           write(iulog,9233) 'numptrcw       ',                           &
 223                numptrcw_amode(m), xname_numptrcw(m)
 224        end if
 225
 226
 227        !   define the chemical species for the mode
 228        do l = 1, nspec_amode(m)
 229
 230           call search_list_of_names(                                  &
 231                xname_spectype(l,m), lspectype_amode(l,m),              &
 232                specname_amode, ntot_aspectype )
 233           if (lspectype_amode(l,m) .le. 0) then
 234              write(iulog,9062) 'xname_spectype', xname_spectype(l,m), l, m
 235              call endrun()
 236           end if
 237
 238           call search_list_of_names(                                  &
 239                xname_massptr(l,m), lmassptr_amode(l,m), cnst_name, pcnst )
 240           if (lmassptr_amode(l,m) .le. 0) then
 241              write(iulog,9062) 'xname_massptr', xname_massptr(l,m), l, m
 242              call endrun()
 243           end if
 244           species_class(lmassptr_amode(l,m)) = spec_class_aerosol
 245
 246           lmassptrcw_amode(l,m) = lmassptr_amode(l,m)  !use the same index for Q and QQCW arrays
 247           if (lmassptrcw_amode(l,m) .le. 0) then
 248              write(iulog,9062) 'xname_massptrcw', xname_massptrcw(l,m), l, m
 249              call endrun()
 250           end if
 251 #ifndef WRF_PORT
 252           call pbuf_add(xname_massptrcw(l,m), 'global', 1, pver, 1, iptr)
 253           call qqcw_set_ptr(lmassptrcw_amode(l,m), iptr)
 254 #endif
 255           species_class(lmassptrcw_amode(l,m)) = spec_class_aerosol
 256
 257           if ( masterproc ) then
 258              write(iulog,9236) 'spec, spectype ', l,                    &
 259                   lspectype_amode(l,m), xname_spectype(l,m)
 260              write(iulog,9236) 'spec, massptr  ', l,                    &
 261                   lmassptr_amode(l,m), xname_massptr(l,m)
 262              write(iulog,9236) 'spec, massptrcw', l,                    &
 263                   lmassptrcw_amode(l,m), xname_massptrcw(l,m)
 264           end if
 265
 266        enddo
 267
 268        if ( masterproc ) write(iulog,*)
 269
 270
 271        !   set names for aodvis and ssavis
 272        write(unit=trnum,fmt='(i3)') m+100
 273        aodvisname(m) = 'AODVIS'//trnum(2:3)
 274        aodvislongname(m) = 'Aerosol optical depth for mode '//trnum(2:3)
 275        ssavisname(m) = 'SSAVIS'//trnum(2:3)
 276        ssavislongname(m) = 'Single-scatter albedo for mode '//trnum(2:3)
 277        fnactname(m) = 'FNACT'//trnum(2:3)
 278        fnactlongname(m) = 'Number faction activated for mode '//trnum(2:3)
 279        fmactname(m) = 'FMACT'//trnum(2:3)
 280        fmactlongname(m) = 'Fraction mass activated for mode'//trnum(2:3)
 281     end do
 282 #ifndef WRF_PORT
 283        if (masterproc) write(iulog,9230)
 284 #endif
 285 9230   format( // '*** init_aer_modes mode definitions' )
 286 9231   format( 'mode = ', i4, ' = "', a, '"' )
 287 9232   format( 4x, a, 4(1x, i5 ) )
 288 9233   format( 4x, a15, 4x, i7, '="', a, '"' )
 289 9236   format( 4x, a15, i4, i7, '="', a, '"' )
 290 9061   format( '*** subr init_aer_modes - bad ', a /                   &
 291             5x, 'name, m =  ', a, 5x, i5 )
 292 9062   format( '*** subr init_aer_modesaeromodeinit - bad ', a /                       &
 293             5x, 'name, l, m =  ', a, 5x, 2i5 )
 294
 295
 296   end subroutine modal_aero_register
 297
 298
 299   !==============================================================
 300   subroutine modal_aero_initialize
 301 #ifndef WRF_PORT
 302        use cam_history,           only: addfld, add_default, phys_decomp
 303        use constituents,          only: pcnst
 304 #else
 305        use module_cam_support,    only: pcnst => pcnst_runtime, &
 306             addfld, add_default, phys_decomp
 307 #endif
 308        use physconst,             only: rhoh2o, mwh2o
 309        use modal_aero_calcsize,   only: modal_aero_calcsize_init
 310        use modal_aero_coag,       only: modal_aero_coag_init
 311 #ifndef WRF_PORT
 312        use modal_aero_deposition, only: modal_aero_deposition_init
 313 #endif
 314        use modal_aero_gasaerexch, only: modal_aero_gasaerexch_init
 315        use modal_aero_newnuc,     only: modal_aero_newnuc_init
 316        use modal_aero_rename,     only: modal_aero_rename_init
 317        use mz_aerosols_intr,      only: modal_aero_bcscavcoef_init
 318 #ifndef WRF_PORT
 319        use rad_constituents,      only: rad_cnst_get_info, rad_cnst_get_aer_props
 320 #endif
 321
 322        implicit none
 323
 324        !--------------------------------------------------------------
 325        ! ... local variables
 326        !--------------------------------------------------------------
 327        integer l, m, i
 328
 329
 330        character(len=3) :: trnum       ! used to hold mode number (as characters)
 331        integer :: iaerosol, ibulk
 332        integer  :: numaerosols     ! number of bulk aerosols in climate list
 333        character(len=20) :: bulkname
 334        complex, pointer  :: refindex_aer_sw(:), &
 335             refindex_aer_lw(:)
 336        real(r8) :: hygro_aer
 337        logical  :: history_aerosol      ! Output the MAM aerosol tendencies
 338
 339        !-----------------------------------------------------------------------
 340 #ifndef WRF_PORT
 341        call phys_getopts( history_aerosol_out        = history_aerosol   )
 342 #else
 343        history_aerosol = .false.
 344 #endif
 345
 346
 347
 348        ! safety check on modal_aero, and modal_aero_3mode, modal_aero_7mode
 349 #if ( defined MODAL_AERO_3MODE ) && ( defined MODAL_AERO_7MODE )
 350        call endrun( 'Error - when modal_aero defined, just 1 of modal_aero_3/7mode must be defined'
 351 #elif ( ! ( defined MODAL_AERO_3MODE ) ) && ( ! ( defined MODAL_AERO_7MODE ) )
 352        call endrun( 'Error - when modal_aero defined, at least 1 of modal_aero_3/7mode must be defined'
 353 #endif
 354        !     values from Koepke, Hess, Schult and Shettle, Global Aerosol Data Set
 355        !     Report #243, Max-Planck Institute for Meteorology, 1997a
 356        !     See also Hess, Koepke and Schult, Optical Properties of Aerosols and Clouds (OPAC)
 357        !     BAMS, 1998.
 358
 359        !      specrefndxsw(:ntot_aspectype)     = (/ (1.53,  0.01),   (1.53,  0.01),  (1.53,  0.01), &
 360        !                                           (1.55,  0.01),   (1.55,  0.01),  (1.90, 0.60), &
 361        !                                           (1.50, 1.0e-8), (1.50, 0.005) /)
 362        !      specrefndxlw(:ntot_aspectype)   = (/ (2.0, 0.5),   (2.0, 0.5), (2.0, 0.5), &
 363        !                                           (1.7, 0.5),   (1.7, 0.5), (2.22, 0.73), &
 364        !                                           (1.50, 0.02), (2.6, 0.6) /)
 365        !     get refractive indices from phys_prop files
 366 #ifndef WRF_PORT
 367        call rad_cnst_get_info(0,naero=numaerosols)
 368        do l = 1, ntot_aspectype
 369           ibulk=0
 370           do iaerosol = 1, numaerosols
 371              call rad_cnst_get_aer_props(0, iaerosol, aername=bulkname)
 372              !      print *,'bulkname=',bulkname
 373              if(specname_amode(l).eq.'sulfate'.and.bulkname.eq.'SULFATE')ibulk=iaerosol
 374              if(specname_amode(l).eq.'ammonium'.and.bulkname.eq.'SULFATE')ibulk=iaerosol
 375              if(specname_amode(l).eq.'nitrate'.and.bulkname.eq.'SULFATE')ibulk=iaerosol
 376              if(specname_amode(l).eq.'p-organic'.and.bulkname.eq.'OCPHO')ibulk=iaerosol
 377              if(specname_amode(l).eq.'s-organic'.and.bulkname.eq.'OCPHI')ibulk=iaerosol
 378              if(specname_amode(l).eq.'black-c'.and.bulkname.eq.'BCPHO')ibulk=iaerosol
 379              if(specname_amode(l).eq.'seasalt'.and.bulkname.eq.'SSAM')ibulk=iaerosol
 380              if(specname_amode(l).eq.'dust'.and.bulkname.eq.'DUST4')ibulk=iaerosol
 381           end do
 382           if(ibulk.eq.0)then
 383              write(iulog,*) 'modal species names do not match bulk names for modal species ',specname_amode(l)
 384              call endrun('endrun modal_aero_initialize')
 385           endif
 386           call rad_cnst_get_aer_props(0, ibulk, &
 387                refindex_aer_sw=refindex_aer_sw, &
 388                refindex_aer_lw=refindex_aer_lw, &
 389                density_aer=specdens_amode(l), &
 390                hygro_aer=hygro_aer )
 391
 392           spechygro(l)=hygro_aer
 393
 394           do i=1,nswbands
 395              specrefndxsw(i,l)=refindex_aer_sw(i)
 396           end do
 397           do i=1,nlwbands
 398              specrefndxlw(i,l)=refindex_aer_lw(i)
 399           end do
 400        end do
 401
 402
 403        if (masterproc) write(iulog,9210)
 404        do l = 1, ntot_aspectype
 405           !            spechygro(l) = specnu(l)*specphi(l)*specsolfrac(l)*mwh2o*specdens_amode(l) / &
 406           !                    (rhoh2o*specmw_amode(l))
 407           if (masterproc) then
 408              write(iulog,9211) l
 409              write(iulog,9212) 'name            ', specname_amode(l)
 410              write(iulog,9213) 'density, MW     ',                  &
 411                   specdens_amode(l), specmw_amode(l)
 412              write(iulog,9213) 'hygro', spechygro(l)
 413              do i=1,nswbands
 414                 write(iulog,9213) 'ref index sw    ', (specrefndxsw(i,l))
 415              end do
 416              do i=1,nlwbands
 417                 write(iulog,9213) 'ref index ir    ', (specrefndxlw(i,l))
 418              end do
 419           end if
 420        end do
 421 #else
 422        !Balwinder.Singh@pnnl: Comments regarding spechygro:
 423        !RCE origianl comment:"code involving specrefndxsw, specrefndxlw, and spechygro is temporary,
 424        !and should be changed after cam radiation code is ported"
 425
 426        ! 2010/06/16 rce
 427        ! following code involving specrefndxsw, specrefndxlw, and spechygro is temporary,
 428        ! and should be changed after cam radiation code is ported
 429
 430        spechygro(:ntot_aspectype) = (/ 0.507, 0.507, 0.507, &
 431             0.100, 0.140, 1.0e-10, &
 432             1.160, 0.068 /)
 433        specrefndxsw(1,:ntot_aspectype)     = (/ (1.53,  0.01),   (1.53,  0.01),  (1.53,  0.01), &
 434             (1.55,  0.01),   (1.55,  0.01),  (1.90, 0.60), &
 435             (1.50, 1.0e-8), (1.50, 0.005) /)
 436        specrefndxlw(1,:ntot_aspectype)   = (/ (2.0, 0.5),   (2.0, 0.5), (2.0, 0.5), &
 437             (1.7, 0.5),   (1.7, 0.5), (2.22, 0.73), &
 438             (1.50, 0.02), (2.6, 0.6) /)
 439        do l = 1, ntot_aspectype
 440           specrefndxsw(:,l)=specrefndxsw(1,l)
 441           specrefndxlw(:,l)=specrefndxlw(1,l)
 442        end do
 443
 444        ! rce - 06-aug-2007 - changed specmw for almost everything to match mozart
 445        specdens_amode(:ntot_aspectype) = (/1770.0,1770.0,1770.0, 1000.0, 1000.0, 1700.0,1900.0,2600.0 /)
 446
 447 #endif
 448 9210   format( // '*** init_aer_modes aerosol species-types' )
 449 9211   format( 'spectype =', i4)
 450 9212   format( 4x, a, 3x, '"', a, '"' )
 451 9213   format( 4x, a, 5(1pe14.5) )
 452
 453
 454
 455
 456
 457        do i = 1, pcnst
 458           species_class(i) = spec_class_undefined
 459        end do
 460
 461
 462
 463        !   set cnst_name_cw
 464        call initaermodes_set_cnstnamecw()
 465
 466
 467        !
 468        !   set the lptr_so4_a_amode(m), lptr_so4_cw_amode(m), ...
 469        !
 470        call initaermodes_setspecptrs
 471
 472        if ( masterproc ) write(iulog,*)
 473
 474
 475
 476        !
 477        !   add to history
 478        !
 479        do m = 1, ntot_amode
 480           write( trnum, '(i3.3)' ) m
 481           ! note - eventually we should change these from "dgnd_a0N" to "dgnd_aN"
 482           call addfld( &
 483                'dgnd_a'//trnum(2:3), 'm', pver, 'A', &
 484                'dry dgnum, interstitial, mode '//trnum(2:3), phys_decomp )
 485           call addfld( &
 486                'dgnw_a'//trnum(2:3), 'm', pver, 'A', &
 487                'wet dgnum, interstitial, mode '//trnum(2:3), phys_decomp )
 488           call addfld( &
 489                'wat_a'//trnum(3:3), 'm', pver, 'A', &
 490                'aerosol water, interstitial, mode '//trnum(2:3), phys_decomp )
 491           if ( history_aerosol ) then
 492             call add_default( 'dgnd_a'//trnum(2:3), 1, ' ' )
 493             call add_default( 'dgnw_a'//trnum(2:3), 1, ' ' )
 494             call add_default( 'wat_a'//trnum(3:3),  1, ' ' )
 495           endif
 496
 497           l = lptr_so4_cw_amode(m)
 498           if (l > 0) then
 499              call addfld (&
 500                   trim(cnst_name_cw(l))//'AQSO4','kg/m2/s ',1,  'A', &
 501                   trim(cnst_name_cw(l))//' aqueous phase chemistry',phys_decomp)
 502              call addfld (&
 503                   trim(cnst_name_cw(l))//'AQH2SO4','kg/m2/s ',1,  'A', &
 504                   trim(cnst_name_cw(l))//' aqueous phase chemistry',phys_decomp)
 505              if ( history_aerosol ) then
 506                 call add_default (trim(cnst_name_cw(l))//'AQSO4', 1, ' ')
 507                 call add_default (trim(cnst_name_cw(l))//'AQH2SO4', 1, ' ')
 508              endif
 509           end if
 510
 511        end do
 512
 513        call addfld ('AQSO4_H2O2','kg/m2/s ',1,  'A', &
 514             'SO4 aqueous phase chemistry due to H2O2',phys_decomp)
 515        call addfld ('AQSO4_O3','kg/m2/s ',1,  'A', &
 516             'SO4 aqueous phase chemistry due to O3',phys_decomp)
 517        call addfld( 'XPH_LWC','kg/kg   ',pver, 'A', &
 518             'pH value multiplied by lwc', phys_decomp)
 519
 520        if ( history_aerosol ) then
 521           call add_default ('AQSO4_H2O2', 1, ' ')
 522           call add_default ('AQSO4_O3', 1, ' ')
 523           call add_default ('XPH_LWC', 1, ' ')
 524        endif
 525
 526
 527
 528        !
 529        !   set threshold for reporting negatives from subr qneg3
 530        !   for aerosol number species set this to
 531        !      1e3 #/kg ~= 1e-3 #/cm3 for accum, aitken, pcarbon, ufine modes
 532        !      3e1 #/kg ~= 3e-5 #/cm3 for fineseas and finedust modes
 533        !      1e0 #/kg ~= 1e-6 #/cm3 for other modes which are coarse
 534        !   for other species, set this to zero so that it will be ignored
 535        !      by qneg3
 536        !
 537 #ifndef WRF_PORT
 538        if ( masterproc ) write(iulog,'(/a)') &
 539             'mode, modename_amode, qneg3_worst_thresh_amode'
 540 #endif
 541        qneg3_worst_thresh_amode(:) = 0.0_r8
 542        do m = 1, ntot_amode
 543           l = numptr_amode(m)
 544           if ((l <= 0) .or. (l > pcnst)) cycle
 545
 546           if      (m == modeptr_accum) then
 547              qneg3_worst_thresh_amode(l) = 1.0e3_r8
 548           else if (m == modeptr_aitken) then
 549              qneg3_worst_thresh_amode(l) = 1.0e3_r8
 550           else if (m == modeptr_pcarbon) then
 551              qneg3_worst_thresh_amode(l) = 1.0e3_r8
 552           else if (m == modeptr_ufine) then
 553              qneg3_worst_thresh_amode(l) = 1.0e3_r8
 554
 555           else if (m == modeptr_fineseas) then
 556              qneg3_worst_thresh_amode(l) = 3.0e1_r8
 557           else if (m == modeptr_finedust) then
 558              qneg3_worst_thresh_amode(l) = 3.0e1_r8
 559
 560           else
 561              qneg3_worst_thresh_amode(l) = 1.0e0_r8
 562           end if
 563
 564           if ( masterproc ) write(iulog,'(i3,2x,a,1p,e12.3)') &
 565                m, modename_amode(m), qneg3_worst_thresh_amode(l)
 566        end do
 567
 568
 569        !
 570        !   call other initialization routines
 571        !
 572        call modal_aero_rename_init
 573        !   calcsize call must follow rename call
 574        call modal_aero_calcsize_init
 575        call modal_aero_gasaerexch_init
 576        !   coag call must follow gasaerexch call
 577        call modal_aero_coag_init
 578        call modal_aero_newnuc_init
 579        call modal_aero_bcscavcoef_init
 580 #ifndef WRF_PORT
 581        call modal_aero_deposition_init
 582 #endif
 583
 584        return
 585      end subroutine modal_aero_initialize
 586
 587
 588      !==============================================================
 589      subroutine search_list_of_names(                                &
 590           name_to_find, name_id, list_of_names, list_length )
 591        !
 592        !   searches for a name in a list of names
 593        !
 594        !   name_to_find - the name to be found in the list  [input]
 595        !   name_id - the position of "name_to_find" in the "list_of_names".
 596        !       If the name is not found in the list, then name_id=0.  [output]
 597        !   list_of_names - the list of names to be searched  [input]
 598        !   list_length - the number of names in the list  [input]
 599        !
 600        character(len=*), intent(in):: name_to_find, list_of_names(:)
 601        integer, intent(in) :: list_length
 602        integer, intent(out) :: name_id
 603
 604        integer :: i
 605        name_id = -999888777
 606        if (name_to_find .ne. ' ') then
 607           do i = 1, list_length
 608              if (name_to_find .eq. list_of_names(i)) then
 609                 name_id = i
 610                 exit
 611              end if
 612           end do
 613        end if
 614      end subroutine search_list_of_names
 615
 616
 617      !==============================================================
 618      subroutine initaermodes_setspecptrs
 619        !
 620        !   sets the lptr_so4_a_amode(m), lptr_so4_cw_amode(m), ...
 621        !       and writes them to iulog
 622        !   ALSO sets the mode-pointers:  modeptr_accum, modeptr_aitken, ...
 623        !       and writes them to iulog
 624        !   ALSO sets values of specdens_XX_amode and specmw_XX_amode
 625        !       (XX = so4, om, bc, dust, seasalt)
 626        !
 627        implicit none
 628
 629        !   local variables
 630        integer l, l2, m
 631        character*8 dumname
 632        integer, parameter :: init_val=-999888777
 633
 634        !   all processes set the pointers
 635
 636        modeptr_accum = init_val
 637        modeptr_aitken = init_val
 638        modeptr_ufine = init_val
 639        modeptr_coarse = init_val
 640        modeptr_pcarbon = init_val
 641        modeptr_fineseas = init_val
 642        modeptr_finedust = init_val
 643        modeptr_coarseas = init_val
 644        modeptr_coardust = init_val
 645        do m = 1, ntot_amode
 646           if (modename_amode(m) .eq. 'accum') then
 647              modeptr_accum = m
 648           else if (modename_amode(m) .eq. 'aitken') then
 649              modeptr_aitken = m
 650           else if (modename_amode(m) .eq. 'ufine') then
 651              modeptr_ufine = m
 652           else if (modename_amode(m) .eq. 'coarse') then
 653              modeptr_coarse = m
 654           else if (modename_amode(m) .eq. 'primary carbon') then
 655              modeptr_pcarbon = m
 656           else if (modename_amode(m) .eq. 'fine seasalt') then
 657              modeptr_fineseas = m
 658           else if (modename_amode(m) .eq. 'fine dust') then
 659              modeptr_finedust = m
 660           else if (modename_amode(m) .eq. 'coarse seasalt') then
 661              modeptr_coarseas = m
 662           else if (modename_amode(m) .eq. 'coarse dust') then
 663              modeptr_coardust = m
 664           end if
 665        end do
 666
 667        do m = 1, ntot_amode
 668           lptr_so4_a_amode(m)   = init_val
 669           lptr_so4_cw_amode(m)  = init_val
 670           lptr_msa_a_amode(m)   = init_val
 671           lptr_msa_cw_amode(m)  = init_val
 672           lptr_nh4_a_amode(m)   = init_val
 673           lptr_nh4_cw_amode(m)  = init_val
 674           lptr_no3_a_amode(m)   = init_val
 675           lptr_no3_cw_amode(m)  = init_val
 676           lptr_pom_a_amode(m)   = init_val
 677           lptr_pom_cw_amode(m)  = init_val
 678           lptr_soa_a_amode(m)   = init_val
 679           lptr_soa_cw_amode(m)  = init_val
 680           lptr_bc_a_amode(m)    = init_val
 681           lptr_bc_cw_amode(m)   = init_val
 682           lptr_nacl_a_amode(m)  = init_val
 683           lptr_nacl_cw_amode(m) = init_val
 684           lptr_dust_a_amode(m)  = init_val
 685           lptr_dust_cw_amode(m) = init_val
 686           do l = 1, nspec_amode(m)
 687              l2 = lspectype_amode(l,m)
 688              if ( (specname_amode(l2) .eq. 'sulfate') .and.  &
 689                   (lptr_so4_a_amode(m) .le. 0) ) then
 690                 lptr_so4_a_amode(m)  = lmassptr_amode(l,m)
 691                 lptr_so4_cw_amode(m) = lmassptrcw_amode(l,m)
 692              end if
 693              if ( (specname_amode(l2) .eq. 'msa') .and.      &
 694                   (lptr_msa_a_amode(m) .le. 0) ) then
 695                 lptr_msa_a_amode(m)  = lmassptr_amode(l,m)
 696                 lptr_msa_cw_amode(m) = lmassptrcw_amode(l,m)
 697              end if
 698              if ( (specname_amode(l2) .eq. 'ammonium') .and.  &
 699                   (lptr_nh4_a_amode(m) .le. 0) ) then
 700                 lptr_nh4_a_amode(m)  = lmassptr_amode(l,m)
 701                 lptr_nh4_cw_amode(m) = lmassptrcw_amode(l,m)
 702              end if
 703              if ( (specname_amode(l2) .eq. 'nitrate') .and.  &
 704                   (lptr_no3_a_amode(m) .le. 0) ) then
 705                 lptr_no3_a_amode(m)  = lmassptr_amode(l,m)
 706                 lptr_no3_cw_amode(m) = lmassptrcw_amode(l,m)
 707              end if
 708              if ( (specname_amode(l2) .eq. 'p-organic') .and.   &
 709                   (lptr_pom_a_amode(m) .le. 0) ) then
 710                 lptr_pom_a_amode(m)  = lmassptr_amode(l,m)
 711                 lptr_pom_cw_amode(m) = lmassptrcw_amode(l,m)
 712              end if
 713              if ( (specname_amode(l2) .eq. 's-organic') .and.   &
 714                   (lptr_soa_a_amode(m) .le. 0) ) then
 715                 lptr_soa_a_amode(m)  = lmassptr_amode(l,m)
 716                 lptr_soa_cw_amode(m) = lmassptrcw_amode(l,m)
 717              end if
 718              if ( (specname_amode(l2) .eq. 'black-c') .and.  &
 719                   (lptr_bc_a_amode(m) .le. 0) ) then
 720                 lptr_bc_a_amode(m)  = lmassptr_amode(l,m)
 721                 lptr_bc_cw_amode(m) = lmassptrcw_amode(l,m)
 722              end if
 723              if ( (specname_amode(l2) .eq. 'seasalt') .and.  &
 724                   (lptr_nacl_a_amode(m) .le. 0) ) then
 725                 lptr_nacl_a_amode(m)  = lmassptr_amode(l,m)
 726                 lptr_nacl_cw_amode(m) = lmassptrcw_amode(l,m)
 727              end if
 728              if ( (specname_amode(l2) .eq. 'dust') .and.     &
 729                   (lptr_dust_a_amode(m) .le. 0) ) then
 730                 lptr_dust_a_amode(m)  = lmassptr_amode(l,m)
 731                 lptr_dust_cw_amode(m) = lmassptrcw_amode(l,m)
 732              end if
 733           end do
 734        end do
 735
 736        !   all processes set values of specdens_XX_amode and specmw_XX_amode
 737        specdens_so4_amode = 2.0
 738        specdens_nh4_amode = 2.0
 739        specdens_no3_amode = 2.0
 740        specdens_pom_amode = 2.0
 741        specdens_soa_amode = 2.0
 742        specdens_bc_amode = 2.0
 743        specdens_dust_amode = 2.0
 744        specdens_seasalt_amode = 2.0
 745        specmw_so4_amode = 1.0
 746        specmw_nh4_amode = 1.0
 747        specmw_no3_amode = 1.0
 748        specmw_pom_amode = 1.0
 749        specmw_soa_amode = 1.0
 750        specmw_bc_amode = 1.0
 751        specmw_dust_amode = 1.0
 752        specmw_seasalt_amode = 1.0
 753        do m = 1, ntot_aspectype
 754           if      (specname_amode(m).eq.'sulfate   ') then
 755              specdens_so4_amode = specdens_amode(m)
 756              specmw_so4_amode = specmw_amode(m)
 757           else if (specname_amode(m).eq.'ammonium  ') then
 758              specdens_nh4_amode = specdens_amode(m)
 759              specmw_nh4_amode = specmw_amode(m)
 760           else if (specname_amode(m).eq.'nitrate   ') then
 761              specdens_no3_amode = specdens_amode(m)
 762              specmw_no3_amode = specmw_amode(m)
 763           else if (specname_amode(m).eq.'p-organic ') then
 764              specdens_pom_amode = specdens_amode(m)
 765              specmw_pom_amode = specmw_amode(m)
 766           else if (specname_amode(m).eq.'s-organic ') then
 767              specdens_soa_amode = specdens_amode(m)
 768              specmw_soa_amode = specmw_amode(m)
 769           else if (specname_amode(m).eq.'black-c   ') then
 770              specdens_bc_amode = specdens_amode(m)
 771              specmw_bc_amode = specmw_amode(m)
 772           else if (specname_amode(m).eq.'dust      ') then
 773              specdens_dust_amode = specdens_amode(m)
 774              specmw_dust_amode = specmw_amode(m)
 775           else if (specname_amode(m).eq.'seasalt   ') then
 776              specdens_seasalt_amode = specdens_amode(m)
 777              specmw_seasalt_amode = specmw_amode(m)
 778           end if
 779        enddo
 780
 781        !   masterproc writes out the pointers
 782        if ( .not. ( masterproc ) ) return
 783 #ifndef WRF_PORT
 784        write(iulog,9230)
 785 #endif
 786        write(iulog,*) 'modeptr_accum    =', modeptr_accum
 787        write(iulog,*) 'modeptr_aitken   =', modeptr_aitken
 788        write(iulog,*) 'modeptr_ufine    =', modeptr_ufine
 789        write(iulog,*) 'modeptr_coarse   =', modeptr_coarse
 790        write(iulog,*) 'modeptr_pcarbon  =', modeptr_pcarbon
 791        write(iulog,*) 'modeptr_fineseas =', modeptr_fineseas
 792        write(iulog,*) 'modeptr_finedust =', modeptr_finedust
 793        write(iulog,*) 'modeptr_coarseas =', modeptr_coarseas
 794        write(iulog,*) 'modeptr_coardust =', modeptr_coardust
 795
 796        dumname = 'none'
 797 #ifndef WRF_PORT
 798        write(iulog,9240)
 799 #endif
 800        write(iulog,9000) 'sulfate    '
 801        do m = 1, ntot_amode
 802           call initaermodes_setspecptrs_write2( m,                    &
 803                lptr_so4_a_amode(m), lptr_so4_cw_amode(m),  'so4' )
 804        end do
 805
 806        write(iulog,9000) 'msa        '
 807        do m = 1, ntot_amode
 808           call initaermodes_setspecptrs_write2( m,                    &
 809                lptr_msa_a_amode(m), lptr_msa_cw_amode(m),  'msa' )
 810        end do
 811
 812        write(iulog,9000) 'ammonium   '
 813        do m = 1, ntot_amode
 814           call initaermodes_setspecptrs_write2( m,                    &
 815                lptr_nh4_a_amode(m), lptr_nh4_cw_amode(m),  'nh4' )
 816        end do
 817
 818        write(iulog,9000) 'nitrate    '
 819        do m = 1, ntot_amode
 820           call initaermodes_setspecptrs_write2( m,                    &
 821                lptr_no3_a_amode(m), lptr_no3_cw_amode(m),  'no3' )
 822        end do
 823
 824        write(iulog,9000) 'p-organic  '
 825        do m = 1, ntot_amode
 826           call initaermodes_setspecptrs_write2( m,                    &
 827                lptr_pom_a_amode(m), lptr_pom_cw_amode(m),  'pom' )
 828        end do
 829
 830        write(iulog,9000) 's-organic  '
 831        do m = 1, ntot_amode
 832           call initaermodes_setspecptrs_write2( m,                    &
 833                lptr_soa_a_amode(m), lptr_soa_cw_amode(m),  'soa' )
 834        end do
 835
 836        write(iulog,9000) 'black-c    '
 837        do m = 1, ntot_amode
 838           call initaermodes_setspecptrs_write2( m,                    &
 839                lptr_bc_a_amode(m), lptr_bc_cw_amode(m),  'bc' )
 840        end do
 841
 842        write(iulog,9000) 'seasalt   '
 843        do m = 1, ntot_amode
 844           call initaermodes_setspecptrs_write2( m,                    &
 845                lptr_nacl_a_amode(m), lptr_nacl_cw_amode(m),  'nacl' )
 846        end do
 847
 848        write(iulog,9000) 'dust       '
 849        do m = 1, ntot_amode
 850           call initaermodes_setspecptrs_write2( m,                    &
 851                lptr_dust_a_amode(m), lptr_dust_cw_amode(m),  'dust' )
 852        end do
 853
 854 9000   format( a )
 855 9230   format(                                                         &
 856             / 'mode-pointer output from subr initaermodes_setspecptrs' )
 857 9240   format(                                                         &
 858             / 'species-pointer output from subr initaermodes_setspecptrs' / &
 859             'mode', 12x, 'id  name_a  ', 12x, 'id  name_cw' )
 860
 861        return
 862      end subroutine initaermodes_setspecptrs
 863
 864
 865      !==============================================================
 866      subroutine initaermodes_setspecptrs_write2(                     &
 867           m, laptr, lcptr, txtdum )
 868        !
 869        !   does some output for initaermodes_setspecptrs
 870 #ifndef WRF_PORT
 871        use constituents, only: pcnst, cnst_name
 872 #else
 873        use module_cam_support,    only: pcnst => pcnst_runtime
 874        use constituents, only: cnst_name
 875 #endif
 876
 877        implicit none
 878
 879        !   subr arguments
 880        integer m, laptr, lcptr
 881        character*(*) txtdum
 882
 883        !   local variables
 884        character*8 dumnamea, dumnamec
 885
 886        dumnamea = 'none'
 887        dumnamec = 'none'
 888        if (laptr .gt. 0) dumnamea = cnst_name(laptr)
 889        if (lcptr .gt. 0) dumnamec = cnst_name(lcptr)
 890        write(iulog,9241) m, laptr, dumnamea, lcptr, dumnamec, txtdum
 891
 892 9241   format( i4, 2( 2x, i12, 2x, a ),                                &
 893             4x, 'lptr_', a, '_a/cw_amode' )
 894
 895        return
 896      end subroutine initaermodes_setspecptrs_write2
 897
 898
 899      !==============================================================
 900      subroutine initaermodes_set_cnstnamecw
 901        !
 902        !   sets the cnst_name_cw
 903        !
 904 #ifndef WRF_PORT
 905        use constituents, only: pcnst, cnst_name
 906 #else
 907        use module_cam_support,    only: pcnst => pcnst_runtime
 908        use constituents, only: cnst_name
 909 #endif
 910        implicit none
 911
 912        !   subr arguments (none)
 913
 914        !   local variables
 915        integer j, l, la, lc, ll, m
 916
 917        !   set cnst_name_cw
 918        cnst_name_cw = ' '
 919        do m = 1, ntot_amode
 920           do ll = 0, nspec_amode(m)
 921              if (ll == 0) then
 922                 la = numptr_amode(m)
 923                 lc = numptrcw_amode(m)
 924              else
 925                 la = lmassptr_amode(ll,m)
 926                 lc = lmassptrcw_amode(ll,m)
 927              end if
 928              if ((la < 1) .or. (la > pcnst) .or.   &
 929                   (lc < 1) .or. (lc > pcnst)) then
 930                 write(*,'(/2a/a,5(1x,i10))')   &
 931                      '*** initaermodes_set_cnstnamecw error',   &
 932                      ' -- bad la or lc',   &
 933                      '    m, ll, la, lc, pcnst =', m, ll, la, lc, pcnst
 934                 call endrun( '*** initaermodes_set_cnstnamecw error' )
 935              end if
 936              do j = 2, len( cnst_name(la) ) - 1
 937                 if (cnst_name(la)(j:j+1) == '_a') then
 938                    cnst_name_cw(lc) = cnst_name(la)
 939                    cnst_name_cw(lc)(j:j+1) = '_c'
 940                    exit
 941                 else if (cnst_name(la)(j:j+1) == '_A') then
 942                    cnst_name_cw(lc) = cnst_name(la)
 943                    cnst_name_cw(lc)(j:j+1) = '_C'
 944                    exit
 945                 end if
 946              end do
 947              if (cnst_name_cw(lc) == ' ') then
 948                 write(*,'(/2a/a,3(1x,i10),2x,a)')   &
 949                      '*** initaermodes_set_cnstnamecw error',   &
 950                      ' -- bad cnst_name(la)',   &
 951                      '    m, ll, la, cnst_name(la) =',   &
 952                      m, ll, la, cnst_name(la)
 953                 call endrun( '*** initaermodes_set_cnstnamecw error' )
 954              end if
 955           end do   ! ll = 0, nspec_amode(m)
 956        end do   ! m = 1, ntot_amode
 957
 958        if ( masterproc ) then
 959           write(*,'(/a)') 'l, cnst_name(l), cnst_name_cw(l)'
 960           do l = 1, pcnst
 961              write(*,'(i4,2(2x,a))') l, cnst_name(l), cnst_name_cw(l)
 962           end do
 963        end if
 964
 965        return
 966      end subroutine initaermodes_set_cnstnamecw
 967
 968 #ifndef WRF_PORT
 969      !==============================================================
 970      subroutine modal_aero_initialize_q( name, q )
 971        !
 972        ! this routine is for initial testing of the modal aerosol cam3
 973        !
 974        ! it initializes several gas and aerosol species to
 975        !    "low background" values, so that very short (e.g., 1 day)
 976        !    test runs are working with non-zero values
 977        !
 978        use constituents, only: pcnst, cnst_name
 979        use pmgrid,      only: plat, plon, plev
 980
 981        implicit none
 982
 983        !--------------------------------------------------------------
 984        ! ... arguments
 985        !--------------------------------------------------------------
 986        character(len=*), intent(in) :: name                   !  constituent name
 987        real(r8), intent(inout) :: q(plon,plev,plat)           !  mass mixing ratio
 988
 989        !--------------------------------------------------------------
 990        ! ... local variables
 991        !--------------------------------------------------------------
 992        integer k, l
 993        real(r8) duma, dumb, dumz
 994
 995
 996        !
 997        ! to deactivate this routine, just return here
 998        !
 999        !     return
1000
1001
1002        if ( masterproc ) then
1003           write( *, '(2a)' )   &
1004                '*** modal_aero_initialize_q - name = ', name
1005           if (name == 'H2O2'   ) write( *, '(2a)' ) '    doing ', name
1006           if (name == 'SO2'    ) write( *, '(2a)' ) '    doing ', name
1007           if (name == 'H2SO4'  ) write( *, '(2a)' ) '    doing ', name
1008           if (name == 'DMS'    ) write( *, '(2a)' ) '    doing ', name
1009           if (name == 'NH3'    ) write( *, '(2a)' ) '    doing ', name
1010           if (name == 'so4_a1' ) write( *, '(2a)' ) '    doing ', name
1011           if (name == 'so4_a2' ) write( *, '(2a)' ) '    doing ', name
1012           if (name == 'pom_a3' ) write( *, '(2a)' ) '    doing ', name
1013           if (name == 'ncl_a4' ) write( *, '(2a)' ) '    doing ', name
1014           if (name == 'dst_a5' ) write( *, '(2a)' ) '    doing ', name
1015           if (name == 'ncl_a6' ) write( *, '(2a)' ) '    doing ', name
1016           if (name == 'dst_a7' ) write( *, '(2a)' ) '    doing ', name
1017        end if
1018
1019        do k = 1, plev
1020
1021           ! init gases
1022           dumz = (k+1.0e-5)/(plev+1.0e-5)
1023           dumb = dumz*1.0e-9/28.966
1024           if (name == 'H2O2'   ) q(:,k,:) = dumb*34.0*1.0
1025           if (name == 'SO2'    ) q(:,k,:) = dumb*64.0*0.1
1026           if (name == 'H2SO4'  ) q(:,k,:) = dumb*98.0*0.001
1027           if (name == 'DMS'    ) q(:,k,:) = dumb*62.0*0.01
1028           if (name == 'NH3'    ) q(:,k,:) = dumb*17.0*0.1
1029
1030           ! init first mass species of each aerosol mode
1031           duma = dumz*1.0e-10
1032           if (name == 'so4_a1' ) q(:,k,:) = duma*1.0
1033           if (name == 'so4_a2' ) q(:,k,:) = duma*0.002
1034           if (name == 'pom_a3' ) q(:,k,:) = duma*0.3
1035           if (name == 'ncl_a4' ) q(:,k,:) = duma*0.4
1036           if (name == 'dst_a5' ) q(:,k,:) = duma*0.5
1037           if (name == 'ncl_a6' ) q(:,k,:) = duma*0.6
1038           if (name == 'dst_a7' ) q(:,k,:) = duma*0.7
1039
1040           ! init aerosol number
1041           !
1042           ! at k=plev, duma = 1e-10 kgaero/kgair = 0.1 ugaero/kgair
1043           !            dumb = duma/(2000 kgaero/m3aero)
1044           duma = dumz*1.0e-10
1045           dumb = duma/2.0e3
1046           ! following produces number 1000X too small, and Dp 10X too big
1047           !        dumb = dumb*1.0e-3
1048           ! following produces number 1000X too big, and Dp 10X too small
1049           !        dumb = dumb*1.0e3
1050           if (name == 'num_a1' ) q(:,k,:) = dumb*1.0  *3.0e20
1051           if (name == 'num_a2' ) q(:,k,:) = dumb*0.002*4.0e22
1052           if (name == 'num_a3' ) q(:,k,:) = dumb*0.3  *5.7e21
1053           if (name == 'num_a4' ) q(:,k,:) = dumb*0.4  *2.7e19
1054           if (name == 'num_a5' ) q(:,k,:) = dumb*0.5  *4.0e20
1055           if (name == 'num_a6' ) q(:,k,:) = dumb*0.6  *2.7e16
1056           if (name == 'num_a7' ) q(:,k,:) = dumb*0.7  *4.0e17
1057
1058           !*** modal_aero_calcsize_sub - ntot_amode    7
1059           !mode, dgn, dp*, v2n, v2nhi, v2nlo    1  1.100E-07  1.847E-07  3.031E+20  4.736E+18  2.635E+21
1060           !mode, dgn, dp*, v2n, v2nhi, v2nlo    2  2.600E-08  3.621E-08  4.021E+22  5.027E+21  1.073E+24
1061           !mode, dgn, dp*, v2n, v2nhi, v2nlo    3  5.000E-08  6.964E-08  5.654E+21  7.068E+20  7.068E+23
1062           !mode, dgn, dp*, v2n, v2nhi, v2nlo    4  2.000E-07  4.112E-07  2.748E+19  2.198E+17  1.758E+21
1063           !mode, dgn, dp*, v2n, v2nhi, v2nlo    5  1.000E-07  1.679E-07  4.035E+20  3.228E+18  3.228E+21
1064           !mode, dgn, dp*, v2n, v2nhi, v2nlo    6  2.000E-06  4.112E-06  2.748E+16  3.434E+15  2.198E+17
1065           !mode, dgn, dp*, v2n, v2nhi, v2nlo    7  1.000E-06  1.679E-06  4.035E+17  5.043E+16  3.228E+18
1066
1067        end do   ! k
1068
1069        if ( masterproc ) then
1070           write( *, '(7x,a,1p,10e10.2)' )   &
1071                name, (q(1,k,1), k=plev,1,-5)
1072        end if
1073
1074        if (plev > 0) return
1075
1076
1077        if ( masterproc ) then
1078           write( *, '(/a,i5)' )   &
1079                '*** modal_aero_initialize_q - ntot_amode', ntot_amode
1080           do k = 1, ntot_amode
1081              write( *, '(/a)' ) 'mode, dgn, v2n',   &
1082                   k, dgnum_amode(k), voltonumb_amode(k)
1083           end do
1084        end if
1085
1086        return
1087      end subroutine modal_aero_initialize_q
1088 #endif
1089 #ifdef WRF_PORT
1090 !--------------------------------------------------------------------------------------------------------
1091      subroutine decouple_mam_mp(CAM_MP_MAM_cpled)
1092 !
1093 !    Purpose: This subroutine is added so that CAMMGMP scheme can be decoupled from the CAM MAM package
1094 !             If the user choose to decouple CAM MAM package and CAMMGMP scheme then the aerosol variables
1095 !             for the CAMMGMP scheme are initialized considering prescribed aerosols (ONLY for CAMMGMP)
1096 !
1097 !    *NOTE* The values for the aerosols variables should exactly match with value for prescribed aerosols in
1098 !           phys/module_cam_mp_modal_aero_initialize_data_phys.F
1099 !
1100 !    Called by module_cam_mam_init.F
1101 !
1102 !--------------------------------------------------------------------------------------------------------
1103        implicit none
1104        logical, intent(in):: CAM_MP_MAM_cpled
1105        integer, parameter :: init_val=-999888777
1106        integer  :: n
1107        real(r8) :: pi, tmpsg_mp(ntot_amode)
1108
1109        modeptr_accum_mp         = modeptr_accum
1110        modeptr_coarse_mp        = modeptr_coarse
1111        modeptr_coardust_mp      = modeptr_coardust !BSINGH - declared for MAM7 complaince
1112        modeptr_aitken_mp        = modeptr_aitken
1113
1114        numptrcw_amode_mp(:)     = numptrcw_amode(:)
1115        nspec_amode_mp(:)        = nspec_amode(:)
1116        numptr_amode_mp(:)       = numptr_amode(:)
1117
1118        cnst_name_cw_mp(:)       = cnst_name_cw(:)
1119        sigmag_amode_mp(:)       = sigmag_amode(:)
1120        dgnum_amode_mp(:)        = dgnum_amode(:)
1121
1122        voltonumbhi_amode_mp(:)  = voltonumbhi_amode(:)
1123        voltonumblo_amode_mp (:) = voltonumblo_amode(:)
1124
1125        lptr_dust_a_amode_mp(:)  = lptr_dust_a_amode(:)
1126        lptr_nacl_a_amode_mp(:)  = lptr_nacl_a_amode(:)
1127        specdens_amode_mp(:)     = specdens_amode(:)
1128        alnsg_amode_mp(:)        = alnsg_amode(:)
1129        specmw_amode_mp(:)       = specmw_amode(:)
1130        spechygro_mp(:)          = spechygro(:)
1131
1132        lmassptrcw_amode_mp(:,:) = lmassptrcw_amode(:,:)
1133        lmassptr_amode_mp(:,:)   = lmassptr_amode(:,:)
1134        lspectype_amode_mp(:,:)  = lspectype_amode(:,:)
1135
1136        if(.NOT.CAM_MP_MAM_cpled) then
1137
1138           pi = 4.*atan(1._r8)
1139
1140           !
1141           ! initialize needed variables in module modal_aero_data
1142           !
1143
1144           modeptr_accum_mp  = 1
1145           modeptr_aitken_mp = 2
1146           modeptr_coarse_mp = 3
1147
1148           ! setting portions of these arrays that should not be used
1149           ! to init_val should cause a seg-fault if they get use
1150           nspec_amode_mp(:) = init_val
1151           lspectype_amode_mp(:,:) = init_val
1152           lmassptr_amode_mp(:,:) = init_val
1153           numptr_amode_mp(:) = init_val
1154           lptr_dust_a_amode_mp(:) = init_val
1155           lptr_nacl_a_amode_mp(:) = init_val
1156
1157           n = modeptr_accum_mp
1158           nspec_amode_mp(n) = 1
1159           lspectype_amode_mp(1,n) = 1  ! sulfate
1160           lmassptr_amode_mp(1,n) = 6   ! species 6 in state%q
1161           numptr_amode_mp(n) = 7   ! species 7 in state%q
1162
1163           n = modeptr_aitken_mp
1164           nspec_amode_mp(n) = 1
1165           lspectype_amode_mp(1,n) = 1  ! sulfate
1166           lmassptr_amode_mp(1,n) = 8   ! species 8 in state%q
1167           numptr_amode_mp(n) = 9   ! species 9 in state%q
1168
1169           n = modeptr_coarse_mp
1170           nspec_amode_mp(n) = 2
1171           lspectype_amode_mp(1,n) = 2  ! dust
1172           lspectype_amode_mp(2,n) = 3  ! seasalt
1173           lmassptr_amode_mp(1,n) = 10  ! species 10 in state%q
1174           lmassptr_amode_mp(2,n) = 11  ! species 11 in state%q
1175           numptr_amode_mp(n) = 12  ! species 12 in state%q
1176           lptr_dust_a_amode_mp(n) = lmassptr_amode_mp(1,n)
1177           lptr_nacl_a_amode_mp(n) = lmassptr_amode_mp(2,n)
1178
1179           lmassptrcw_amode_mp = lmassptr_amode_mp
1180           numptrcw_amode_mp = numptr_amode_mp
1181
1182           msectional_mp = 0
1183           alnsg_amode_mp(:) = log( sigmag_amode_mp(:) )
1184           tmpsg_mp = exp( 4.5 * (alnsg_amode_mp(:)**2) )
1185
1186           voltonumb_amode_mp(  :) = 1.0/( (pi/6.0) * (dgnum_amode_mp(  :)**3) * tmpsg_mp )
1187           voltonumblo_amode_mp(:) = 1.0/( (pi/6.0) * (dgnumlo_amode_mp(:)**3) * tmpsg_mp )
1188           voltonumbhi_amode_mp(:) = 1.0/( (pi/6.0) * (dgnumhi_amode_mp(:)**3) * tmpsg_mp )
1189
1190           specdens_amode_mp(:) = 1.0e3   ! match precribe_aerosol_mixactivate, but units change
1191           specmw_amode_mp(:) = 132.0     ! match precribe_aerosol_mixactivate
1192           spechygro_mp(:) = 0.5          ! match precribe_aerosol_mixactivate
1193        endif
1194
1195
1196      end subroutine decouple_mam_mp
1197 #endif
1198
1199
1200      !==============================================================
1201    end module modal_aero_initialize_data
1202