LCOV - code coverage report
Current view: top level - physics/carma/models/trop_strat_soa5 - carma_model_mod.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 578 1906 30.3 %
Date: 2025-03-14 01:30:37 Functions: 12 32 37.5 %

          Line data    Source code
       1             : !! This CARMA model is for dust aerosols and is based upon Su & Toon, JGR, 2009;
       2             : !! Su & Toon, ACP 2011.
       3             : !!
       4             : !! These dust are not currently radiatively active and do not replace the dust
       5             : !! in CAM; however, this is something that could be done in the future.
       6             : !!
       7             : !! This module defines several constants needed by CARMA, extends a couple of CARMA
       8             : !! interface methods:
       9             : !!
      10             : !!   - CARMA_DefineModel()
      11             : !!   - CARMA_EmitParticle()
      12             : !!
      13             : !! and adds some local functions used to do sea salt emission:
      14             : !!
      15             : !!   - CARMA_SurfaceWind()
      16             : !!   - WeibullWind()
      17             : !!
      18             : !! @version April-2020
      19             : !! @author  Simone Tilmes, Lin Su, Pengfei Yu, Chuck Bardeen
      20             : !!  changes to pervious version: rename PURSULF to PRSULF to be easier read in in CAM
      21             : !!  Simone Tilmes Aug5 2023: add Ilaria's diagnostic changes
      22             : 
      23             : module carma_model_mod
      24             : 
      25             :   use carma_precision_mod
      26             :   use carma_enums_mod
      27             :   use carma_constants_mod
      28             :   use carma_types_mod
      29             :   use carmaelement_mod
      30             :   use carmagas_mod
      31             :   use carmagroup_mod
      32             :   use carmasolute_mod
      33             :   use carmastate_mod
      34             :   use carma_mod
      35             :   use carma_flags_mod
      36             :   use carma_model_flags_mod
      37             : 
      38             :   use spmd_utils,     only: masterproc
      39             :   use shr_kind_mod,   only: r8 => shr_kind_r8
      40             :   use cam_abortutils, only: endrun
      41             :   use physics_types,  only: physics_state, physics_ptend
      42             :   use ppgrid,         only: pcols, pver
      43             :   use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_field, pbuf_get_index
      44             :   use time_manager,   only: is_first_step
      45             :   use cam_logfile,    only: iulog
      46             : 
      47             :   implicit none
      48             : 
      49             :   private
      50             : 
      51             :   ! Declare the public methods.
      52             :   public CARMAMODEL_CalculateCloudborneDiagnostics
      53             :   public CARMAMODEL_CreateOpticsFile
      54             :   public CARMAMODEL_DefineModel
      55             :   public CARMAMODEL_Detrain
      56             :   public CARMAMODEL_DiagnoseBins
      57             :   public CARMAMODEL_DiagnoseBulk
      58             :   public CARMAMODEL_EmitParticle
      59             :   public CARMAMODEL_InitializeModel
      60             :   public CARMAMODEL_InitializeParticle
      61             :   public CARMAMODEL_OutputBudgetDiagnostics
      62             :   public CARMAMODEL_OutputCloudborneDiagnostics
      63             :   public CARMAMODEL_OutputDiagnostics
      64             :   public CARMAMODEL_WetDeposition
      65             : 
      66             :   ! Declare public constants
      67             :   integer, public, parameter      :: NGROUP   = 2               !! Number of particle groups
      68             :   integer, public, parameter      :: NELEM    = 11              !! Number of particle elements
      69             :   integer, public, parameter      :: NBIN     = 20              !! Number of particle bins
      70             :   integer, public, parameter      :: NSOLUTE  = 0               !! Number of particle solutes
      71             :   integer, public, parameter      :: NGAS     = 2               !! Number of gases
      72             : 
      73             :   ! NOTE: This is for now, when Pengfei has only defined sulfates at one weight percent. In the future,
      74             :   ! we may want to expand this to match NMIE_WTP and/or NMIE_RH
      75             :   integer, public, parameter      :: NREFIDX  = 1               !! Number of refractive indices per element
      76             : 
      77             :   ! These need to be defined, but are only used when the particles are radiatively active.
      78             :   integer, public, parameter :: NMIE_RH  = 10              !! Number of relative humidities for mie calculations
      79             :   real(kind=f), public, parameter :: mie_rh(NMIE_RH) = (/ 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.8_f, 0.85_f, &
      80             :                                                           0.9_f, 0.92_f, 0.93_f, 0.95_f /)
      81             :   integer, public, parameter :: NMIE_WTP = 13              !! Number of weight percents for mie calculations
      82             :   real(kind=f), public , parameter :: mie_wtp(NMIE_WTP) = (/ 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.8_f, 0.83_f, &
      83             :                                                             0.86_f, 0.9_f, 0.92_f, 0.94_f, 0.96_f, 0.98_f, 1._f/)
      84             : 
      85             :   ! Defines whether the groups should undergo deep convection in phase 1 or phase 2.
      86             :   ! Water vapor and cloud particles are convected in phase 1, while all other constituents
      87             :   ! are done in phase 2.
      88             :   logical, public                 :: is_convtran1(NGROUP) = .false.  !! Should the group be transported in the first phase?
      89             : 
      90             :   ! Define any particle compositions that are used. Each composition type
      91             :   ! should have a unique number.
      92             :   integer, public, parameter      :: I_H2SO4          = 1       !! H2SO4 coposition
      93             :   integer, public, parameter      :: I_OC             = 2       !! OC composition
      94             :   integer, public, parameter      :: I_SOA1           = 3       !! SOA composition
      95             :   integer, public, parameter      :: I_SOA2           = 4       !! SOA composition
      96             :   integer, public, parameter      :: I_SOA3           = 5       !! SOA composition
      97             :   integer, public, parameter      :: I_SOA4           = 6       !! SOA composition
      98             :   integer, public, parameter      :: I_SOA5           = 7       !! SOA composition
      99             :   integer, public, parameter      :: I_BC             = 8       !! BC composition
     100             :   integer, public, parameter      :: I_DUST           = 9       !! dust composition
     101             :   integer, public, parameter      :: I_SALT           = 10       !! sea salt composition
     102             : 
     103             :   integer, public, parameter      :: I_GRP_PRSUL     = 1        !! sulfate aerosol
     104             :   integer, public, parameter      :: I_GRP_MXAER     = 2        !! mixed aerosol
     105             : 
     106             :   integer, public, parameter      :: I_ELEM_PRSUL     = 1       !! sulfate aerosol;  nameing needs to only have 2 charaters  before the element name to work with
     107             :                                                                 !! partsof the code reading different elements
     108             :   integer, public, parameter      :: I_ELEM_MXAER     = 2       !! aerosol
     109             :   integer, public, parameter      :: I_ELEM_MXOC      = 3       !! organics aerosol
     110             :   integer, public, parameter      :: I_ELEM_MXSOA1    = 4       !! secondary organic aerosol
     111             :   integer, public, parameter      :: I_ELEM_MXSOA2    = 5       !! secondary organic aerosol
     112             :   integer, public, parameter      :: I_ELEM_MXSOA3    = 6       !! secondary organic aerosol
     113             :   integer, public, parameter      :: I_ELEM_MXSOA4    = 7       !! secondary organic aerosol
     114             :   integer, public, parameter      :: I_ELEM_MXSOA5    = 8       !! secondary organic aerosol
     115             :   integer, public, parameter      :: I_ELEM_MXBC      = 9       !! black carbon
     116             :   integer, public, parameter      :: I_ELEM_MXDUST    = 10      !! dust aerosol
     117             :   integer, public, parameter      :: I_ELEM_MXSALT    = 11      !! sea salt aerosol
     118             : 
     119             :   integer, public, parameter      :: I_GAS_H2O        = 1       !! water vapor
     120             :   integer, public, parameter      :: I_GAS_H2SO4      = 2       !! sulphuric acid
     121             : 
     122             :   real(kind=f), public, parameter         :: Kappa_OC = 0.5_f      !! hygroscopicity of OC
     123             :   real(kind=f), public, parameter         :: Kappa_SOA = 0.5_f     !! hygroscopicity of SOA
     124             :   real(kind=f), public, parameter         :: Kappa_BC = 0.1_f
     125             :   real(kind=f), public, parameter         :: Kappa_DUST = 0.2_f
     126             :   real(kind=f), public, parameter         :: Kappa_SALT = 1.0_f
     127             :   real(kind=f), public, parameter         :: Kappa_SULF = 0.5_f
     128             : 
     129             :   real(kind=f), public, parameter         :: RHO_obc  = 1.35_f          !! dry density of smoke aerosol
     130             :   real(kind=f), public, parameter         :: RHO_DUST = 2.65_f          !! dry density of dust particles (g/cm^3) -Lin Su
     131             :   real(kind=f), public, parameter         :: RHO_SALT = 2.65_f          !! dry density of sea salt particles (g/cm)
     132             :   real(kind=f), public, parameter         :: RHO_SULFATE  = 1.923_f     !! dry density of sulfate particles (g/cm3)
     133             : 
     134             :  ! see CARMA_SmokeEmissionRead
     135             : ! real(kind=f), allocatable, dimension(:,:)     ::   Chla                                       ! Chlorophy11 data (mg/m3)
     136             :   real(r8), allocatable, dimension(:,:,:)       ::   BCnew                              ! #/cm2/s
     137             :   real(r8), allocatable, dimension(:,:,:)       ::   OCnew
     138             : 
     139             : 
     140             :   ! for sea salt flux calculation
     141             :   real(r8), parameter             :: uth_salt = 4._r8                !! threshold wind velocity
     142             : 
     143             : 
     144             :   ! for dust calculation
     145             :   real(kind=f), parameter         :: rClay = 1e-4_f         !! silt/clay particle radius boundary (cm)
     146             : 
     147             :   integer                         :: nClay                  !! Number of clay bins (r < 1 um)
     148             :   integer                         :: nSilt                  !! Number of silt bins
     149             :   real(kind=f)                    :: clay_mf(NBIN)=-huge(1._f) !! clay mass fraction (fraction)
     150             :   real(kind=f), allocatable, dimension(:,:) :: soil_factor  !! Soil Erosion Factor (fraction)
     151             :   real(kind=f), public, parameter :: WTMOL_H2SO4    = 98.078479_f    !! molecular weight of sulphuric acid
     152             : 
     153             : ! NOTE: The WeibullK distribution is not currently supported, since the coefficients are not
     154             : ! generated. This can be added later.
     155             : !  real(r8), allocatable, dimension(:,:) :: Weibull_k            ! Weibull K(nlat,nlon
     156             :   real(kind=f), public, parameter     :: rmin_PRSUL     = 3.43e-8_f  ! minimum radius (cm)
     157             :   real(kind=f), public, parameter     :: vmrat_PRSUL    = 3.67_f     ! volume ratio
     158             :   real(kind=f), public, parameter     :: rmin_MXAER     = 5e-6_f     ! minimum radius (cm)
     159             :   real(kind=f), public, parameter     :: vmrat_MXAER    = 2.2588_f    !2.4610_f        ! volume ratio
     160             : 
     161             : ! Physics buffer index for sulfate surface area density
     162             :   integer      :: ipbuf4soa1(NBIN) = -1
     163             :   integer      :: ipbuf4soa2(NBIN) = -1
     164             :   integer      :: ipbuf4soa3(NBIN) = -1
     165             :   integer      :: ipbuf4soa4(NBIN) = -1
     166             :   integer      :: ipbuf4soa5(NBIN) = -1
     167             :   integer      :: ipbuf4soacm1(NBIN) = -1
     168             :   integer      :: ipbuf4soacm2(NBIN) = -1
     169             :   integer      :: ipbuf4soacm3(NBIN) = -1
     170             :   integer      :: ipbuf4soacm4(NBIN) = -1
     171             :   integer      :: ipbuf4soacm5(NBIN) = -1
     172             :   integer      :: ipbuf4soapt1(NBIN) = -1
     173             :   integer      :: ipbuf4soapt2(NBIN) = -1
     174             :   integer      :: ipbuf4soapt3(NBIN) = -1
     175             :   integer      :: ipbuf4soapt4(NBIN) = -1
     176             :   integer      :: ipbuf4soapt5(NBIN) = -1
     177             :   integer      :: ipbuf4jno2 = -1
     178             :   real(kind=f) :: aeronet_fraction(NBIN)  !! fraction of BC dV/dlnr in each bin (100%)
     179             :   real(kind=f) :: so4inj_dist(NBIN)       !! SO4 injection distribution across bins using a log normal distr. using r=0.95 and sigma =1.5
     180             :   real(kind=f) :: so4inj_dist1(NBIN)      !! SO4 injection distribution across bins using a log normal distr. using r=0.95 and sigma =1.5
     181             : 
     182             :   integer :: bc_srfemis_ndx=-1, oc_srfemis_ndx=-1
     183             :   integer :: so4_elevemis_ndx=-1
     184             :   integer :: carma_dustmap(NBIN)        !! mapping of the CARMA dust bins to the surface dust bins.
     185             : 
     186             :   ! define refractive indices dependon composition and wavelength
     187             :   !
     188             :   ! NOTE: It would be better to read this out of files, but this is how Pengfei set it up, so we
     189             :   ! will use this for now.
     190             :   !
     191             :   ! NOTE: Rather than using the values from Pengfei for the sulfate, use the values from MAM. They
     192             :   ! have more precision and differ in the imaginary part below 2 um where Pengfei's are truncated at 0.
     193             :   ! The MAM values are consistent with OPAC and truncate at 1e-8.
     194             :   !real(kind=f), public :: shellreal(NWAVE)    = (/1.890_f,1.913_f,1.932_f,1.568_f,1.678_f,1.758_f,1.855_f,1.597_f,1.147_f,1.261_f,&
     195             :   !                1.424_f,1.352_f,1.379_f,1.385_f,1.385_f,1.367_f,&
     196             :   !            1.367_f,1.315_f,1.358_f,1.380_f,1.393_f,1.405_f,1.412_f,1.422_f,1.428_f,1.430_f,&
     197             :   !            1.422_f,1.468_f,1.484_f,1.164_f/)
     198             :   !
     199             :   !real(kind=f), public :: shellimag(NWAVE)    = (/0.220_f,0.152_f,0.085_f,0.223_f,0.195_f,0.441_f,0.696_f,0.695_f,0.459_f,0.161_f,&
     200             :   !                0.172_f,0.144_f,0.120_f,0.122_f,0.126_f,0.158_f,&
     201             :   !            0.158_f,0.057_f,0.003_f,0.001_f,0.001_f,0.000_f,0.000_f,0.000_f,0.000_f,0.000_f,&
     202             :   !            0.000_f,0.000_f,0.000_f,0.551_f/)
     203             : 
     204             :   real(kind=f), public, parameter :: shellreal(NWAVE)    = (/ 1.89_f, 1.912857_f, 1.932063_f, 1.586032_f, &
     205             :                1.677979_f, 1.757825_f, 1.855336_f, 1.596767_f, 1.146559_f, 1.261314_f, 1.424219_f, &
     206             :                1.351645_f, 1.378697_f, 1.385_f, 1.385_f, 1.366909_f, 1.366909_f, 1.314577_f, &
     207             :                1.357978_f, 1.380309_f, 1.392645_f, 1.404506_f, 1.412181_f, 1.421632_f, &
     208             :                1.427968_f, 1.430335_f, 1.441641_f, 1.467642_f, 1.484_f, 1.164128_f /)
     209             : 
     210             :   real(kind=f), public, parameter :: shellimag(NWAVE)    = (/ 0.22_f, 0.15185711_f, 0.08457167_f, 0.22250789_f, 0.19499999_f, &
     211             :               0.44068847_f, 0.69594361_f, 0.69466153_f, 0.45876573_f, 0.16060575_f, &
     212             :               0.1715766_f , 0.14352135_f, 0.12025213_f, 0.12222873_f, 0.12581848_f, 0.15793008_f, &
     213             :               1.57930076e-01_f, 5.66869128e-02_f, 2.88634387e-03_f, 1.49071286e-03_f, &
     214             :               5.30385233e-04_f, 1.02977119e-04_f, 1.61967358e-05_f, 1.75122678e-06_f, &
     215             :               2.21435655e-08_f, 9.99999994e-09_f, 9.99999994e-09_f, 9.99999994e-09_f, &
     216             :               9.99999994e-09_f, 5.51133746e-01_f /)
     217             : 
     218             :   real(kind=f), public, parameter :: corerealdst(NWAVE)  = &
     219             :              (/2.340_f,2.904_f,1.748_f,1.508_f,1.911_f,1.822_f,2.917_f,1.557_f,1.242_f,1.447_f,&
     220             :                1.432_f,1.473_f,1.495_f,1.500_f,1.500_f,1.510_f,&
     221             :                1.510_f,1.520_f,1.523_f,1.529_f,1.530_f,1.530_f,1.530_f,1.530_f,1.530_f,1.530_f,&
     222             :                1.530_f,1.530_f,1.530_f,1.180_f/)
     223             : 
     224             :   real(kind=f), public, parameter :: corerealbc (NWAVE)  = &
     225             :             (/2.690_f,2.501_f,2.398_f,2.332_f,2.287_f,2.234_f,2.198_f,2.166_f,2.114_f,2.054_f,&
     226             :               2.028_f,1.977_f,1.948_f,1.933_f,1.921_f,1.877_f,&
     227             :               1.877_f,1.832_f,1.813_f,1.802_f,1.791_f,1.768_f,1.761_f,1.760_f,1.750_f,1.750_f,&
     228             :               1.750_f,1.741_f,1.620_f,2.124_f/)
     229             : 
     230             :   real(kind=f), public, parameter :: coreimagdst(NWAVE)  = &
     231             :              (/0.700_f,0.857_f,0.462_f,0.263_f,0.319_f,0.260_f,0.650_f,0.373_f,0.093_f,0.105_f,&
     232             :                0.061_f,0.025_f,0.011_f,0.008_f,0.007_f,0.018_f,&
     233             :                0.018_f,0.028_f,0.012_f,0.008_f,0.007_f,0.006_f,0.005_f,0.004_f,0.004_f,0.006_f,&
     234             :                0.014_f,0.024_f,0.030_f,0.101_f/)
     235             : 
     236             :   real(kind=f), public, parameter :: coreimagbc(NWAVE)   = &
     237             :             (/1.000_f,0.884_f,0.825_f,0.791_f,0.764_f,0.734_f,0.714_f,0.696_f,0.668_f,0.644_f,&
     238             :               0.624_f,0.604_f,0.593_f,0.586_f,0.580_f,0.556_f,&
     239             :               0.556_f,0.527_f,0.503_f,0.492_f,0.481_f,0.458_f,0.451_f,0.440_f,0.430_f,0.443_f,&
     240             :               0.461_f,0.470_f,0.450_f,0.674_f/)
     241             : 
     242             :   real(kind=f), public, parameter :: waterreal(NWAVE)    = &
     243             :    (/ 1.532_f, 1.523857_f, 1.420063_f, 1.274308_f, &
     244             :       1.161387_f, 1.142222_f, 1.232189_f, 1.266436_f, 1.295687_f, 1.320659_f, 1.341516_f, &
     245             :       1.315192_f, 1.330235_f, 1.339058_f, 1.350425_f, 1.408042_f, 1.408042_f, 1.324462_f, &
     246             :       1.276726_f, 1.301847_f, 1.312051_f, 1.321301_f, 1.322836_f, 1.326836_f, 1.330968_f, &
     247             :       1.33367_f, 1.339547_f, 1.348521_f, 1.362_f, 1.290783_f /)
     248             : 
     249             :   real(kind=f), public, parameter :: waterimag(NWAVE)    = &
     250             :    (/ 0.336_f, 0.36000001_f, 0.42623809_f, 0.40341724_f, &
     251             :       0.32062717_f, 0.11484398_f, 0.04710282_f, 0.03901278_f, 0.03373134_f, 0.03437707_f, &
     252             :       0.09216518_f, 0.0121094_f, 0.01314786_f, 0.01013119_f, 0.00486624_f, 0.0142042_f, &
     253             :       1.42042044e-02_f, 1.57659209e-01_f, 1.51634401e-03_f, 1.15906247e-03_f, &
     254             :       2.35527521e-04_f, 1.71196912e-04_f, 2.43626002e-05_f, 3.12758360e-06_f, &
     255             :       3.74323598e-08_f, 1.63841034e-09_f, 2.49434956e-09_f, 1.52413800e-08_f, &
     256             :       3.35000010e-08_f, 3.43825518e-02_f /)
     257             : 
     258             :   real(r8), parameter :: onethird = 1._r8/3._r8
     259             : 
     260             : contains
     261             : 
     262             :   !! Defines all the CARMA components (groups, elements, solutes and gases) and process
     263             :   !! (coagulation, growth, nucleation) that will be part of the microphysical model.
     264             :   !!
     265             :   !!  @version May-2009
     266             :   !!  @author  Chuck Bardeen
     267        1536 :   subroutine CARMAMODEL_DefineModel(carma, rc)
     268             : 
     269             :     use physics_buffer, only: pbuf_add_field, dtype_r8
     270             : 
     271             :     type(carma_type), intent(inout)    :: carma     !! the carma object
     272             :     integer, intent(out)               :: rc        !! return code, negative indicates failure
     273             : 
     274             : 
     275             :     ! Local variables
     276             :     integer                            :: LUNOPRT              ! logical unit number for output
     277             :     character(len=2)                   :: outputname,outputbin
     278             :     logical                            :: do_print             ! do print output?
     279             :     complex(kind=f)                    :: refidx(NWAVE, NREFIDX) ! refractice indices
     280             : 
     281             :     integer                            :: igroup,ibin
     282             :     character(len=8)                   :: sname                ! short (CAM) name
     283             : 
     284             :     ! Default return code.
     285        1536 :     rc = RC_OK
     286             : 
     287             :     ! Report model specific namelist configuration parameters.
     288        1536 :     if (masterproc) then
     289           2 :       call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT)
     290           2 :       if (rc < 0) call endrun("CARMA_DefineModel: CARMA_Get failed.")
     291             : 
     292           2 :       if (do_print) write(LUNOPRT,*) ''
     293           2 :       if (do_print) write(LUNOPRT,*) 'CARMA ', trim(carma_model), ' specific settings :'
     294           2 :       if (do_print) write(LUNOPRT,*) '  carma_soilerosion_file = ', carma_soilerosion_file
     295           2 :       if (do_print) write(LUNOPRT,*) '  carma_seasalt_emis = ', trim(carma_seasalt_emis)
     296           2 :       if (do_print) write(LUNOPRT,*) '  carma_dustemisfactor = ', carma_dustemisfactor
     297             :     end if
     298             : 
     299             :     ! Define the Groups
     300             :     !
     301             :     ! NOTE: For CAM, the optional do_wetdep and do_drydep flags should be
     302             :     ! defined. If wetdep is defined, then the optional solubility factor
     303             :     ! should also be defined.
     304             : 
     305             :     !call CARMAGROUP_Create(carma, I_GRP_PURSUL, "sulfate", rmin_PRSUL, vmrat_PRSUL, I_SPHERE, 1._f, .false., &
     306             :     !                       rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.true., do_drydep=.true., solfac=0.3_f, &
     307             :     !                       scavcoef=0.1_f, is_sulfate=.true., shortname="PRSULF", icoreshell=0, &
     308             :     !                       refidx = refidx, refidxS = refidx, refidxC = refidx, do_mie=.true.,imiertn=I_MIERTN_TOON1981)
     309             :     !if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.')
     310             : 
     311             :     call CARMAGROUP_Create(carma, I_GRP_PRSUL, "sulfate", rmin_PRSUL, vmrat_PRSUL, I_SPHERE, 1._f, .false., &
     312             :                            rc, irhswell=I_WTPCT_H2SO4, do_wetdep=.false., do_drydep=.true., solfac=0.3_f, &
     313             :                            scavcoef=0.1_f, is_sulfate=.true., shortname="PRSUL", do_mie=.true., &
     314        1536 :                            imiertn=I_MIERTN_TOON1981, iopticstype = I_OPTICS_SULFATE)
     315        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.')
     316             : 
     317             : 
     318             :     !call CARMAGROUP_Create(carma, I_GRP_MIXAER, "mixed aerosol", rmin_MIXAER, vmrat_MIXAER, I_SPHERE, 1._f, .false., &
     319             :     !                       rc, do_wetdep=.true., do_drydep=.true., solfac=0.2_f, &
     320             :     !                       scavcoef=0.1_f, shortname="CRMIX", refidx=refidx, &
     321             :     !                       refidxS=refidxS, refidxC=refidxC, do_mie=.true., &
     322             :     !                       irhswell=I_MIX, irhswcomp=I_SWG_URBAN, icoreshell=1,imiertn=I_MIERTN_TOON1981)
     323             :     !if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.')
     324             : 
     325             :     call CARMAGROUP_Create(carma, I_GRP_MXAER, "mixed aerosol", rmin_MXAER, vmrat_MXAER, I_SPHERE, 1._f, .false., &
     326             :                            rc, do_wetdep=.false., do_drydep=.true., solfac=0.2_f, &
     327             :                            scavcoef=0.1_f, shortname="MXAER", irhswell=I_PETTERS, do_mie=.true., imiertn=I_MIERTN_TOON1981, &
     328             :                            iopticstype = I_OPTICS_MIXED_YU_H2O, &
     329        1536 :                            neutral_volfrc=-1._f)
     330        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddGroup failed.')
     331             : 
     332             : 
     333             :     ! Define the Elements
     334             :     !
     335             :     ! NOTE: For CAM, the optional shortname needs to be provided for the group. These names
     336             :     ! should be 6 characters or less and without spaces.
     337        1536 :     refidx(:,1) = CMPLX(shellreal(:), shellimag(:), kind=f)
     338             :     call CARMAELEMENT_Create(carma, I_ELEM_PRSUL, I_GRP_PRSUL, "Sulfate", &
     339        1536 :                              RHO_SULFATE, I_VOLATILE, I_H2SO4, rc, shortname="PRSULF", refidx=refidx)
     340        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     341             : 
     342             :     call CARMAELEMENT_Create(carma, I_ELEM_MXAER,  I_GRP_MXAER, "Sulfate in mixed sulfate", &
     343        1536 :                              RHO_SULFATE, I_VOLATILE, I_H2SO4, rc,  kappa=Kappa_SULF, shortname="MXSULF", refidx=refidx)
     344        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     345             : 
     346             :     call CARMAELEMENT_Create(carma, I_ELEM_MXOC,   I_GRP_MXAER, "organic carbon", &
     347        1536 :                              RHO_obc, I_COREMASS, I_OC, rc, kappa=Kappa_OC, shortname="MXOC")
     348        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     349             : 
     350             :     call CARMAELEMENT_Create(carma, I_ELEM_MXSOA1,   I_GRP_MXAER, "secondary organic aerosol1", &
     351        1536 :                              RHO_obc, I_COREMASS, I_SOA1, rc, kappa=Kappa_SOA, shortname="MXSOA1")
     352        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     353             : 
     354             :     call CARMAELEMENT_Create(carma, I_ELEM_MXSOA2,   I_GRP_MXAER, "secondary organic aerosol2", &
     355        1536 :                              RHO_obc, I_COREMASS, I_SOA2, rc, kappa=Kappa_SOA, shortname="MXSOA2")
     356        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     357             : 
     358             :     call CARMAELEMENT_Create(carma, I_ELEM_MXSOA3,   I_GRP_MXAER, "secondary organic aerosol3", &
     359        1536 :                              RHO_obc, I_COREMASS, I_SOA3, rc, kappa=Kappa_SOA, shortname="MXSOA3")
     360        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     361             : 
     362             :     call CARMAELEMENT_Create(carma, I_ELEM_MXSOA4,   I_GRP_MXAER, "secondary organic aerosol4", &
     363        1536 :                              RHO_obc, I_COREMASS, I_SOA4, rc, kappa=Kappa_SOA, shortname="MXSOA4")
     364        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     365             : 
     366             :     call CARMAELEMENT_Create(carma, I_ELEM_MXSOA5,   I_GRP_MXAER, "secondary organic aerosol5", &
     367        1536 :                              RHO_obc, I_COREMASS, I_SOA5, rc, kappa=Kappa_SOA, shortname="MXSOA5")
     368        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     369             : 
     370        1536 :     refidx(:,1) = CMPLX(corerealbc(:), coreimagbc(:), kind=f)
     371             :     call CARMAELEMENT_Create(carma, I_ELEM_MXBC,   I_GRP_MXAER, "black carbon", &
     372        1536 :                              RHO_obc, I_COREMASS, I_BC, rc, kappa=Kappa_BC, shortname="MXBC", refidx=refidx)
     373        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     374             : 
     375        1536 :     refidx(:,1) = CMPLX(corerealdst(:), coreimagdst(:), kind=f)
     376             :     call CARMAELEMENT_Create(carma, I_ELEM_MXDUST, I_GRP_MXAER, "dust", &
     377        1536 :                              RHO_DUST, I_COREMASS, I_DUST, rc,  kappa=Kappa_DUST, shortname="MXDUST", refidx=refidx)
     378        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     379             : 
     380             :     call CARMAELEMENT_Create(carma, I_ELEM_MXSALT, I_GRP_MXAER, "SALT in mixed sulfate", &
     381        1536 :                              RHO_SALT, I_COREMASS, I_SALT, rc, kappa=Kappa_SALT, shortname="MXSALT")
     382        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddElement failed.')
     383             : 
     384             : 
     385             :     ! Define the Solutes
     386             : 
     387             : 
     388             : 
     389             :     ! Define the Gases
     390        1536 :     refidx(:,1) = CMPLX(waterreal(:), waterimag(:), kind=f)
     391             :     call CARMAGAS_Create(carma, I_GAS_H2O, "Water Vapor", WTMOL_H2O, I_VAPRTN_H2O_MURPHY2005, I_GCOMP_H2O, &
     392        1536 :                          rc, shortname = "Q", ds_threshold=-0.2_f, refidx=refidx)
     393        1536 :     if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.')
     394             : 
     395             :     call CARMAGAS_Create(carma, I_GAS_H2SO4, "Sulfuric Acid", WTMOL_H2SO4, I_VAPRTN_H2SO4_AYERS1980, &
     396        1536 :                           I_GCOMP_H2SO4, rc, shortname = "H2SO4")
     397        1536 :     if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMAGAS_Create failed.')
     398             : 
     399             : 
     400             :     ! Define the Processes
     401             : 
     402        1536 :     call CARMA_AddGrowth(carma, I_ELEM_PRSUL, I_GAS_H2SO4, rc)
     403        1536 :     if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.')
     404             : 
     405        1536 :     call CARMA_AddGrowth(carma, I_ELEM_MXAER, I_GAS_H2SO4, rc)
     406        1536 :     if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddGrowth failed.')
     407             : 
     408        1536 :     call CARMA_AddNucleation(carma, I_ELEM_PRSUL, I_ELEM_PRSUL, I_HOMNUC, 0._f, rc, igas=I_GAS_H2SO4)
     409        1536 :     if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddNucleation failed.')
     410             : 
     411        1536 :     call CARMA_AddCoagulation(carma, I_GRP_PRSUL, I_GRP_PRSUL, I_GRP_PRSUL, I_COLLEC_FUCHS, rc)
     412        1536 :     if (rc < RC_OK) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.')
     413             : 
     414        1536 :     call CARMA_AddCoagulation(carma, I_GRP_PRSUL, I_GRP_MXAER, I_GRP_MXAER, I_COLLEC_DATA, rc)
     415        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.')
     416             : 
     417        1536 :     call CARMA_AddCoagulation(carma, I_GRP_MXAER, I_GRP_MXAER, I_GRP_MXAER, I_COLLEC_DATA, rc)
     418        1536 :     if (rc < 0) call endrun('CARMA_DefineModel::CARMA_AddCoagulation failed.')
     419             : 
     420             :     !----------------- add pbuf ------------------
     421        4608 :     do igroup = 1, NGROUP
     422             : 
     423        3072 :       call CARMAGROUP_Get(carma, igroup, rc, shortname=sname)
     424        3072 :       if (rc < 0) call endrun('carma_register::CARMAGROUP_Get failed.')
     425             :       !write(*,*) "igroup",igroup,"sname",sname
     426             : 
     427             :       ! sulfate mass and number density for each bin
     428             :       ! e.g. CRSULF01 first element mass mixing ratio; NBMXAER01 #/kg
     429       66048 :       do ibin=1,NBIN
     430       61440 :          write (outputbin, "(I2.2)") ibin
     431       64512 :          if (igroup==I_GRP_MXAER) then
     432       30720 :            call pbuf_add_field("DQDT_MXSOA1"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa1(ibin))
     433       30720 :            call pbuf_add_field("DQDT_MXSOA2"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa2(ibin))
     434       30720 :            call pbuf_add_field("DQDT_MXSOA3"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa3(ibin))
     435       30720 :            call pbuf_add_field("DQDT_MXSOA4"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa4(ibin))
     436       30720 :            call pbuf_add_field("DQDT_MXSOA5"//outputbin,'global',dtype_r8,(/pcols,pver/), ipbuf4soa5(ibin))
     437       30720 :            call pbuf_add_field("MXSOA1"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm1(ibin))
     438       30720 :            call pbuf_add_field("MXSOA2"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm2(ibin))
     439       30720 :            call pbuf_add_field("MXSOA3"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm3(ibin))
     440       30720 :            call pbuf_add_field("MXSOA4"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm4(ibin))
     441       30720 :            call pbuf_add_field("MXSOA5"//outputbin//"CM",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soacm5(ibin))
     442       30720 :            call pbuf_add_field("MXSOA1"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt1(ibin))
     443       30720 :            call pbuf_add_field("MXSOA2"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt2(ibin))
     444       30720 :            call pbuf_add_field("MXSOA3"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt3(ibin))
     445       30720 :            call pbuf_add_field("MXSOA4"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt4(ibin))
     446       30720 :            call pbuf_add_field("MXSOA5"//outputbin//"PT",'physpkg',dtype_r8,(/pcols,pver/), ipbuf4soapt5(ibin))
     447             :          end if
     448             :       end do
     449             :    end do
     450             : 
     451             :     ! no2 photolysis rate constant (/sec)
     452        1536 :     call pbuf_add_field('JNO2', 'global', dtype_r8, (/pcols,pver/), ipbuf4jno2)
     453             : 
     454             :     !---------------------------------------------
     455             : 
     456        1536 :     return
     457        1536 :   end subroutine CARMAMODEL_DefineModel
     458             : 
     459             : 
     460             :   !! Defines all the CARMA components (groups, elements, solutes and gases) and process
     461             :   !! (coagulation, growth, nucleation) that will be part of the microphysical model.
     462             :   !!
     463             :   !!  @version May-2009
     464             :   !!  @author  Chuck Bardeen
     465             :   !!
     466             :   !!  @see CARMASTATE_SetDetrain
     467           0 :   subroutine CARMAMODEL_Detrain(carma, cstate, cam_in, dlf, state, icol, dt, rc, rliq, prec_str, snow_str, &
     468             :      tnd_qsnow, tnd_nsnow)
     469        1536 :     use camsrfexch, only: cam_in_t
     470             : 
     471             :     type(carma_type), intent(in)         :: carma            !! the carma object
     472             :     type(carmastate_type), intent(inout) :: cstate           !! the carma state object
     473             :     type(cam_in_t),  intent(in)          :: cam_in           !! surface input
     474             :     real(r8), intent(in)                 :: dlf(pcols, pver) !! Detraining cld H20 from convection (kg/kg/s)
     475             :     type(physics_state), intent(in)      :: state            !! physics state variables
     476             :     integer, intent(in)                  :: icol             !! column index
     477             :     real(r8), intent(in)                 :: dt               !! time step (s)
     478             :     integer, intent(out)                 :: rc               !! return code, negative indicates failure
     479             :     real(r8), intent(inout), optional    :: rliq(pcols)      !! vertical integral of liquid not yet in q(ixcldliq)
     480             :     real(r8), intent(inout), optional    :: prec_str(pcols)  !! [Total] sfc flux of precip from stratiform (m/s)
     481             :     real(r8), intent(inout), optional    :: snow_str(pcols)  !! [Total] sfc flux of snow from stratiform (m/s)
     482             :     real(r8), intent(out), optional      :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s)
     483             :     real(r8), intent(out), optional      :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s)
     484             : 
     485             :     ! Default return code.
     486           0 :     rc = RC_OK
     487             : 
     488           0 :     return
     489           0 :   end subroutine CARMAMODEL_Detrain
     490             : 
     491             : 
     492             :   !! For diagnostic groups, sets up up the CARMA bins based upon the CAM state.
     493             :   !!
     494             :   !!  @version July-2009
     495             :   !!  @author  Chuck Bardeen
     496     1050624 :   subroutine CARMAMODEL_DiagnoseBins(carma, cstate, state, pbuf, icol, dt, rc, rliq, prec_str, snow_str)
     497             : 
     498             :     type(carma_type), intent(in)          :: carma        !! the carma object
     499             :     type(carmastate_type), intent(inout)  :: cstate       !! the carma state object
     500             :     type(physics_state), intent(in)       :: state        !! physics state variables
     501             :     type(physics_buffer_desc), pointer    :: pbuf(:)      !! physics buffer
     502             :     integer, intent(in)                   :: icol         !! column index
     503             :     real(r8), intent(in)                  :: dt           !! time step
     504             :     integer, intent(out)                  :: rc           !! return code, negative indicates failure
     505             :     real(r8), intent(in), optional        :: rliq(pcols)      !! vertical integral of liquid not yet in q(ixcldliq)
     506             :     real(r8), intent(inout), optional     :: prec_str(pcols)  !! [Total] sfc flux of precip from stratiform (m/s)
     507             :     real(r8), intent(inout), optional     :: snow_str(pcols)  !! [Total] sfc flux of snow from stratiform (m/s)
     508             : 
     509             :     ! local variables
     510     1050624 :     real(r8), pointer, dimension(:,:)    :: dqdt_soa              !! soa tendency due to gas-aerosol exchange  kg/kg/s
     511     1050624 :     real(r8), pointer, dimension(:,:)    :: jno2_rate             !! jno2 tendency due to gas-aerosol exchange  kg/kg/s
     512     1050624 :     real(r8), pointer, dimension(:,:)    :: soacm1                 !! aerosol tendency due to gas-aerosol exchange  kg/kg/s
     513     1050624 :     real(r8), pointer, dimension(:,:)    :: soacm2                 !! aerosol tendency due to gas-aerosol exchange  kg/kg/s
     514     1050624 :     real(r8), pointer, dimension(:,:)    :: soacm3                 !! aerosol tendency due to gas-aerosol exchange  kg/kg/s
     515     1050624 :     real(r8), pointer, dimension(:,:)    :: soacm4                 !! aerosol tendency due to gas-aerosol exchange  kg/kg/s
     516     1050624 :     real(r8), pointer, dimension(:,:)    :: soacm5                 !! aerosol tendency due to gas-aerosol exchange  kg/kg/s
     517     1050624 :     real(r8), pointer, dimension(:,:)    :: soapt1                 !! aerosol tendency due to no2 photolysis  kg/kg/s
     518     1050624 :     real(r8), pointer, dimension(:,:)    :: soapt2                 !! aerosol tendency due to no2 photolysis  kg/kg/s
     519     1050624 :     real(r8), pointer, dimension(:,:)    :: soapt3                 !! aerosol tendency due to no2 photolysis  kg/kg/s
     520     1050624 :     real(r8), pointer, dimension(:,:)    :: soapt4                 !! aerosol tendency due to no2 photolysis  kg/kg/s
     521     1050624 :     real(r8), pointer, dimension(:,:)    :: soapt5                 !! aerosol tendency due to no2 photolysis  kg/kg/s
     522             :     real(r8)                             :: mmr_core(cstate%f_NZ)!! mass mixing ratio of the core (kg/kg)
     523     2101248 :     real(r8)                             :: mmr_soa(cstate%f_NZ)  !! mass mixing ratio of soa element (kg/kg)
     524     2101248 :     real(r8)                             :: mmr(cstate%f_NZ)      !! mass mixing ratio per bin (kg/kg)
     525             :     real(r8)                             :: delta_soa(cstate%f_NZ)     !! mass mixing ratio differences from soa gas-aerosol-exchange
     526             :     integer                              :: icorelem(NELEM), ncore,ienconc,icore, ielem, ielem_soa, igroup, ibin, icomposition, n, err
     527             : 
     528             :     ! Default return code.
     529     1050624 :     rc = RC_OK
     530             : 
     531             :     ! get no2 photolysis rates if they exist
     532     1050624 :     call pbuf_get_field(pbuf, ipbuf4jno2, jno2_rate)     ! surface area density
     533             : 
     534             :     ! get SOA tendency pbuf field for the mixed group and every bin
     535             : 
     536     1050624 :     igroup = I_GRP_MXAER
     537     1050624 :     call CARMAGROUP_Get(carma, igroup, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem)
     538     1050624 :     if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_Get failed.')
     539             : 
     540    22063104 :     do ibin = 1, NBIN
     541             : 
     542             :       ! Iterate over the core elements, looking for the SOA elements. Once found,
     543             :       ! determine the new SOA taking into account both the addition of condensed
     544             :       ! SOA and the loss of photolyzed SOA.
     545   211175424 :       do ielem = 1, ncore
     546             : 
     547   189112320 :         call CARMASTATE_GetBin(cstate, icorelem(ielem), ibin, mmr(:), rc)
     548   189112320 :         if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMASTATE_GetBin failed.')
     549             : 
     550   189112320 :         call CARMAELEMENT_GET(carma, icorelem(ielem), rc, icomposition=icomposition)
     551   189112320 :         if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAELEMENT_Get failed.')
     552             : 
     553             :         ! Only need to make adjustments for the SOA.
     554   210124800 :         if (icomposition == I_SOA1) then
     555    21012480 :           call pbuf_get_field(pbuf, ipbuf4soa1(ibin), dqdt_soa)     ! surface area density
     556             : 
     557             :           ! Add that soa tendency from chemistry to the aerosol.
     558             :           !
     559             :           !   NOTE: dqdt is in kg/kg/s
     560   693411840 :           mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt
     561             : 
     562             :           ! Save the chemistry tendency so it can by output in the diagnostics.
     563    21012480 :           call pbuf_get_field(pbuf, ipbuf4soacm1(ibin), soacm1)
     564  1386823680 :           soacm1(icol,:) = dqdt_soa(icol,:)
     565             : 
     566             :           ! Save the NO2 photolysis tendency so it can by output in the diagnostics.
     567             :           !
     568             :           ! NOTE: Simone, what is the 0.0004_r8??
     569    21012480 :           call pbuf_get_field(pbuf, ipbuf4soapt1(ibin), soapt1)
     570  1386823680 :           soapt1(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:)
     571             : 
     572             :           ! Now adjust the SOA for the loss by the photolysis rate provided by the
     573             :           ! chemistry.
     574   693411840 :           mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt1(icol,:) * dt)
     575             : 
     576             :           ! Save out these new value for SOA.
     577             :           call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc)
     578    21012480 :           if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.')
     579             : 
     580             :         end if  !mxsoa1
     581             : 
     582   210124800 :         if (icomposition == I_SOA2) then
     583    21012480 :           call pbuf_get_field(pbuf, ipbuf4soa2(ibin), dqdt_soa)     ! surface area density
     584             : 
     585             :           ! Add that soa tendency from chemistry to the aerosol.
     586             :           !
     587             :           !   NOTE: dqdt is in kg/kg/s
     588   693411840 :           mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt
     589             : 
     590             :           ! Save the chemistry tendency so it can by output in the diagnostics.
     591    21012480 :           call pbuf_get_field(pbuf, ipbuf4soacm2(ibin), soacm2)
     592  1386823680 :           soacm2(icol,:) = dqdt_soa(icol,:)
     593             : 
     594             :           ! Save the NO2 photolysis tendency so it can by output in the diagnostics.
     595             :           !
     596             :           ! NOTE: Simone, what is the 0.0004_r8??
     597    21012480 :           call pbuf_get_field(pbuf, ipbuf4soapt2(ibin), soapt2)
     598  1386823680 :           soapt2(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:)
     599             : 
     600             :           ! Now adjust the SOA for the loss by the photolysis rate provided by the
     601             :           ! chemistry.
     602   693411840 :           mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt2(icol,:) * dt)
     603             : 
     604             :           ! Save out these new value for SOA.
     605             :           call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc)
     606    21012480 :           if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.')
     607             : 
     608             :         end if  !mxsoa2
     609             : 
     610   210124800 :         if (icomposition == I_SOA3) then
     611    21012480 :           call pbuf_get_field(pbuf, ipbuf4soa3(ibin), dqdt_soa)     ! surface area density
     612             : 
     613             :           ! Add that soa tendency from chemistry to the aerosol.
     614             :           !
     615             :           !   NOTE: dqdt is in kg/kg/s
     616   693411840 :           mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt
     617             : 
     618             :           ! Save the chemistry tendency so it can by output in the diagnostics.
     619    21012480 :           call pbuf_get_field(pbuf, ipbuf4soacm3(ibin), soacm3)
     620  1386823680 :           soacm3(icol,:) = dqdt_soa(icol,:)
     621             : 
     622             :           ! Save the NO2 photolysis tendency so it can by output in the diagnostics.
     623             :           !
     624             :           ! NOTE: Simone, what is the 0.0004_r8??
     625    21012480 :           call pbuf_get_field(pbuf, ipbuf4soapt3(ibin), soapt3)
     626  1386823680 :           soapt3(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:)
     627             : 
     628             :           ! Now adjust the SOA for the loss by the photolysis rate provided by the
     629             :           ! chemistry.
     630   693411840 :           mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt3(icol,:) * dt)
     631             : 
     632             :           ! Save out these new value for SOA.
     633             :           call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc)
     634    21012480 :           if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.')
     635             : 
     636             :         end if  !mxsoa3
     637             : 
     638   210124800 :         if (icomposition == I_SOA4) then
     639    21012480 :           call pbuf_get_field(pbuf, ipbuf4soa4(ibin), dqdt_soa)     ! surface area density
     640             : 
     641             :           ! Add that soa tendency from chemistry to the aerosol.
     642             :           !
     643             :           !   NOTE: dqdt is in kg/kg/s
     644   693411840 :           mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt
     645             : 
     646             :           ! Save the chemistry tendency so it can by output in the diagnostics.
     647    21012480 :           call pbuf_get_field(pbuf, ipbuf4soacm4(ibin), soacm4)
     648  1386823680 :           soacm4(icol,:) = dqdt_soa(icol,:)
     649             : 
     650             :           ! Save the NO2 photolysis tendency so it can by output in the diagnostics.
     651             :           !
     652             :           ! NOTE: Simone, what is the 0.0004_r8??
     653    21012480 :           call pbuf_get_field(pbuf, ipbuf4soapt4(ibin), soapt4)
     654  1386823680 :           soapt4(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:)
     655             : 
     656             :           ! Now adjust the SOA for the loss by the photolysis rate provided by the
     657             :           ! chemistry.
     658   693411840 :           mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt4(icol,:) * dt)
     659             : 
     660             :           ! Save out these new value for SOA.
     661             :           call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc)
     662    21012480 :           if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.')
     663             : 
     664             :         end if  !mxsoa4
     665             : 
     666   609361920 :         if (icomposition == I_SOA5) then
     667    21012480 :           call pbuf_get_field(pbuf, ipbuf4soa5(ibin), dqdt_soa)     ! surface area density
     668             : 
     669             :           ! Add that soa tendency from chemistry to the aerosol.
     670             :           !
     671             :           !   NOTE: dqdt is in kg/kg/s
     672   693411840 :           mmr_soa(:) = mmr(:) + dqdt_soa(icol,:) * dt
     673             : 
     674             :           ! Save the chemistry tendency so it can by output in the diagnostics.
     675    21012480 :           call pbuf_get_field(pbuf, ipbuf4soacm5(ibin), soacm5)
     676  1386823680 :           soacm5(icol,:) = dqdt_soa(icol,:)
     677             : 
     678             :           ! Save the NO2 photolysis tendency so it can by output in the diagnostics.
     679             :           !
     680             :           ! NOTE: Simone, what is the 0.0004_r8??
     681    21012480 :           call pbuf_get_field(pbuf, ipbuf4soapt5(ibin), soapt5)
     682  1386823680 :           soapt5(icol,:) = - 0.0004_r8 * jno2_rate(icol,:) * mmr_soa(:)
     683             : 
     684             :           ! Now adjust the SOA for the loss by the photolysis rate provided by the
     685             :           ! chemistry.
     686   693411840 :           mmr_soa(:) = max(0.0_r8, mmr_soa(:) + soapt5(icol,:) * dt)
     687             : 
     688             :           ! Save out these new value for SOA.
     689             :           call CARMASTATE_SetBin(cstate, icorelem(ielem), ibin, mmr_soa, rc)
     690    21012480 :           if (rc /= RC_OK) call endrun('CARMA_DiagnoseBins::CARMAGROUP_SetBin failed.')
     691             : 
     692             :         end if  !mxsoa5
     693             :        end do  !ielem
     694             :     end do  !ibin
     695             : 
     696     1050624 :   end subroutine CARMAMODEL_DiagnoseBins
     697             : 
     698             : 
     699             :   !! For diagnostic groups, determines the tendencies on the CAM state from the CARMA bins.
     700             :   !!
     701             :   !!  @version July-2009
     702             :   !!  @author  Chuck Bardeen
     703     1050624 :   subroutine CARMAMODEL_DiagnoseBulk(carma, cstate, cam_out, state, pbuf, ptend, icol, dt, rc, rliq, prec_str, snow_str, &
     704             :     prec_sed, snow_sed, tnd_qsnow, tnd_nsnow, re_ice)
     705             :     use camsrfexch, only: cam_out_t
     706             : 
     707             :     type(carma_type), intent(in)         :: carma     !! the carma object
     708             :     type(carmastate_type), intent(inout) :: cstate    !! the carma state object
     709             :     type(cam_out_t),      intent(inout)  :: cam_out   !! cam output to surface models
     710             :     type(physics_state), intent(in)      :: state     !! physics state variables
     711             :     type(physics_buffer_desc), pointer   :: pbuf(:)   !! physics buffer
     712             :     type(physics_ptend), intent(inout)   :: ptend     !! constituent tendencies
     713             :     integer, intent(in)                  :: icol      !! column index
     714             :     real(r8), intent(in)                 :: dt        !! time step
     715             :     integer, intent(out)                 :: rc        !! return code, negative indicates failure
     716             :     real(r8), intent(inout), optional    :: rliq(pcols)      !! vertical integral of liquid not yet in q(ixcldliq)
     717             :     real(r8), intent(inout), optional    :: prec_str(pcols)  !! [Total] sfc flux of precip from stratiform (m/s)
     718             :     real(r8), intent(inout), optional    :: snow_str(pcols)  !! [Total] sfc flux of snow from stratiform (m/s)
     719             :     real(r8), intent(inout), optional    :: prec_sed(pcols)       !! total precip from cloud sedimentation (m/s)
     720             :     real(r8), intent(inout), optional    :: snow_sed(pcols)       !! snow from cloud ice sedimentation (m/s)
     721             :     real(r8), intent(inout), optional    :: tnd_qsnow(pcols,pver) !! snow mass tendency (kg/kg/s)
     722             :     real(r8), intent(inout), optional    :: tnd_nsnow(pcols,pver) !! snow number tendency (#/kg/s)
     723             :     real(r8), intent(out), optional      :: re_ice(pcols,pver)    !! ice effective radius (m)
     724             : 
     725             :    ! Local variables
     726             :     real(r8)                             :: numberDensity(cstate%f_NZ)
     727             :     real(r8)                             :: totad(cstate%f_NZ)
     728             :     real(r8)                             :: ad(cstate%f_NZ)       !! aerosol wet surface area density (cm2/cm3)
     729             :     real(r8)                             :: totreff(cstate%f_NZ)  !! total volume density, used to calculate total effective radius (cm) for history output
     730             :     real(r8)                             :: reff(cstate%f_NZ)     !! wet effective radius (m)
     731             :     real(r8)                             :: mmr(cstate%f_NZ)      !! mass mixing ratio per bin (kg/kg)
     732             :     real(r8)                             :: coremmr(cstate%f_NZ)  !! mmr of all the core
     733             :     real(r8)                             :: mmr_gas(cstate%f_NZ)  !! gas mass mixing ratio (kg/kg)
     734             :     real(r8)                             :: numnkg(cstate%f_NZ)   !! total number density (#/kg)
     735             :     real(r8)                             :: r_wet(cstate%f_NZ)    !! Sulfate aerosol bin wet radius (cm)
     736             :     real(r8)                             :: elem1mr(cstate%f_NZ)  !! First element mass mixing ratio (kg/kg)
     737             :     real(r8)                             :: binnkg(cstate%f_NZ)   !! number density per bin (#/kg)
     738             :     real(r8)                             :: kappa(cstate%f_NZ)    !! hygroscopicity parameter (Petters & Kreidenweis, ACP, 2007)
     739             :     real(r8)                             :: rhoa_wet(cstate%f_NZ) !! wet air density (kg/m3)
     740             :     real(r8)                             :: wtpct(cstate%f_NZ)    !! sulfate weight percent
     741             :     real(r8)                             :: rmass(NBIN)           !! dry mass
     742             :     real(r8)                             :: rhop_dry(cstate%f_NZ) !! dry particle density [g/cm3]
     743             : 
     744             :     integer                              :: ibin, igroup, igas, icomposition
     745             :     integer                              :: icorelem(NELEM), ncore,ienconc,icore
     746             :     character(len=8)                     :: sname                 !! short (CAM) name
     747             : 
     748             :     real(r8), pointer, dimension(:,:)    :: sadsulf_ptr           !! Total surface area density pointer (cm2/cm3)
     749             :     real(r8), pointer, dimension(:,:)    :: reffaer_ptr           !! Total effective radius pointer (cm) for history output
     750             :     real(r8), pointer, dimension(:,:)    :: wtp_ptr               !! weight percent pointer
     751             :     real(r8), pointer, dimension(:,:)    :: sad_ptr               !! Surface area density pointer
     752             :     real(r8), pointer, dimension(:,:)    :: reff_ptr              !! Effective radius pointer
     753             :     real(r8), pointer, dimension(:,:)    :: numnkg_ptr            !! Each group number density pointer
     754             :     real(r8), pointer, dimension(:,:)    :: binnkg_ptr            !! Each bin number density pointer
     755             :     real(r8), pointer, dimension(:,:)    :: elem1mr_ptr           !! First element mmr pointer
     756             :     real(r8), pointer, dimension(:,:)    :: kappa_ptr             !! kappa pointer
     757             :     real(r8), pointer, dimension(:,:)    :: wetr_ptr              !! wet radius pointer
     758             :     real(r8), pointer, dimension(:,:)    :: dryr_ptr              !! dry radius
     759             : 
     760             :     ! Default return code.
     761     1050624 :     rc = RC_OK
     762             : 
     763     1050624 :     return
     764     1050624 :   end subroutine CARMAMODEL_DiagnoseBulk
     765             : 
     766             : 
     767             :   !! Calculates the emissions for CARMA aerosol particles. By default, there is no
     768             :   !! emission, but this routine can be overridden for models that wish to have
     769             :   !! an aerosol emission.
     770             :   !!
     771             :   !! @author  Lin Su, Pengfei Yu, Chuck Bardeen
     772             :   !! @version Dec-2010
     773    16051200 :   subroutine CARMAMODEL_EmitParticle(carma, ielem, ibin, icnst, dt, state, cam_in, tendency, surfaceFlux, pbuf, rc)
     774     1050624 :     use ppgrid,        only: pcols, pver
     775             :     use physics_types, only: physics_state
     776             :     use phys_grid,     only: get_lon_all_p, get_lat_all_p
     777             :     use time_manager,  only: get_curr_date, get_perp_date, is_perpetual
     778             :     use camsrfexch,    only: cam_in_t
     779             :     use cam_history,   only: outfld
     780             : 
     781             :     type(carma_type), intent(in)       :: carma                 !! the carma object
     782             :     integer, intent(in)                :: ielem                 !! element index
     783             :     integer, intent(in)                :: ibin                  !! bin index
     784             :     integer, intent(in)                :: icnst                 !! consituent index
     785             :     real(r8), intent(in)               :: dt                    !! time step (s)
     786             :     type(physics_state), intent(in)    :: state                 !! physics state
     787             :     type(cam_in_t), intent(in)         :: cam_in                !! surface inputs
     788             :     real(r8), intent(out)              :: tendency(pcols, pver) !! constituent tendency (kg/kg/s)
     789             :     real(r8), intent(out)              :: surfaceFlux(pcols)    !! constituent surface flux (kg/m^2/s)
     790             :     type(physics_buffer_desc), pointer :: pbuf(:)               !! physics buffer
     791             :     integer, intent(out)               :: rc                    !! return code, negative indicates failure
     792             : 
     793             :     integer      :: ilat(pcols)             ! latitude index
     794             :     integer      :: ilon(pcols)             ! longitude index
     795             :     real(r8)     :: clat(pcols)             ! latitude
     796             :     integer      :: lchnk                   ! chunk identifier
     797             :     integer      :: ncol                    ! number of columns in chunk
     798             :     integer      :: icol                    ! column index
     799             :     integer      :: p                       ! plev index
     800             :     integer      :: yr                      ! year
     801             :     integer      :: mon                     ! month
     802             :     integer      :: day                     ! day of month
     803             :     integer      :: ncsec                   ! time of day (seconds)
     804             :     real(r8)     :: smoke(pcols)            ! smoke emission flux (molecues/cm2/s)
     805             :     real(r8)     :: rhoa(pcols,pver)        ! density of air  g/cm3
     806             :     real(r8)     :: so4_inj(pcols,pver)     ! so4 emission flux (molecues/cm3/s)
     807             :     real(r8)     :: so4_tendency_factor(pcols,pver)     ! Convertion factor from molec/cm3/s to kg/kg/s
     808             :     integer      :: igroup                  ! the index of the carma aerosol group
     809             :     character(len=32) :: shortname          ! the shortname of the group
     810             : 
     811             : 
     812             : 
     813             :     ! -------- local variables added for dust and sea-salt model ------------
     814             :     real(r8)            :: ch                                 ! dimensional factor & tuning number,
     815             :     real(r8)            :: rmass(NBIN)                        ! bin mass (g)
     816             :     real(r8)            :: r                                  ! bin center (cm)
     817             :     real(r8)            :: rdust                              ! dust bin center (cm)
     818             :     real(r8)            :: dustFlux                           ! dust flux (kg/m2/s)
     819             :     real(r8)            :: rsalt                              ! salt bin center (cm)
     820             :     real(r8)            :: drsalt                             ! salt bin width (cm)
     821             :     real(r8)            :: rhop(NBIN)                         ! element density (g/cm3)
     822             :     real(r8)            :: vrfact
     823             :     real(r8)            :: uth                                ! threshold wind velocity (m/s)
     824             :     real(r8)            :: uv10                               ! 10 m wind speed (m/s)
     825             :     real(r8)            :: cd10                               ! 10-m drag coefficient ()
     826             :     real(r8)            :: wwd                                ! raw wind speed (m/s)
     827             :     real(r8)            :: sp                                 ! mass fraction for soil factor
     828             :     integer             :: idustbin                           ! ibin to use for dust production, smallest silt bin for clay
     829             : 
     830             : ! ------------ local variables added for organics model ----------------------
     831             :     real(r8)     :: dr
     832             :     real(r8)     :: aeronet(NBIN)                       ! AERONET DATA, Sep.20, 2002, Jaru Reserve, Brazil (refer to MATICHUK et al., 2008)
     833             :     real(r8)     :: saltFlux(pcols)                     ! sea salt flux to calculate marine POA
     834             :     integer      :: LUNOPRT                             ! logical unit number for output
     835             :     logical      :: do_print                            ! do print output?
     836             : 
     837             :     real(r8),parameter :: OMtoOCratio = 1.8_r8           ! Need better names and doc
     838             :     real(r8),parameter :: SmoketoSufaceFlux = 1.9934e-22_r8 ! SmoketoSufaceFlux = BC molecular weight
     839             :                                                             ! (12 g/mol)/avocadro constant (6e-23 #/mol) *10
     840    16051200 :     real(r8), pointer :: BCemis_ptr(:), OCemis_ptr(:)
     841    16051200 :     real(r8), pointer :: SO4elevemis_ptr(:,:)
     842             : 
     843             :     ! Default return code.
     844    16051200 :     rc = RC_OK
     845   272870400 :     smoke(:) = -huge(1._r8)
     846  8747904000 :     so4_inj(:,:) = -huge(1._r8)
     847    16051200 :     ch = carma_dustemisfactor
     848             : 
     849             :     ! Determine the day of year.
     850    16051200 :     if ( is_perpetual() ) then
     851           0 :       call get_perp_date(yr, mon, day, ncsec)
     852             :     else
     853    16051200 :       call get_curr_date(yr, mon, day, ncsec)
     854             :     end if
     855             : 
     856             :     ! Determine the latitude and longitude of each column.
     857    16051200 :     lchnk = state%lchnk
     858    16051200 :     ncol = state%ncol
     859             : 
     860             :     ! Add any surface flux here.
     861   247188480 :     surfaceFlux(:ncol) = 0.0_r8
     862             : 
     863             :     ! For emissions into the atmosphere, put the emission here.
     864             :     !
     865             :     ! NOTE: Do not set tendency to be the surface flux. Surface source is put in to
     866             :     ! the bottom layer by vertical diffusion. See vertical_solver module, line 355.
     867  7926082560 :     tendency(:ncol, :pver) = 0.0_r8
     868             : 
     869             :      ! Add Emission (surfaceFlux) here.
     870             : 
     871             :     !!*******************************************************************************************************
     872             : 
     873             :     !! add an element, first element is total number with emission from both OC and BC;
     874             :     !! second element is BC mass
     875             :     !! by Pengfei Yu
     876             :     !! Feb.22 2012
     877             :     !!*******************************************************************************************************
     878             : 
     879             : 
     880    16051200 :     call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname)
     881    16051200 :     if (RC < RC_ERROR) return
     882             : 
     883    16051200 :     call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, rmass=rmass)
     884    16051200 :     if (RC < RC_ERROR) return
     885             : 
     886             :      !!*******************************************************************************************************
     887             : 
     888             :     !if (masterproc) then
     889             :     !  call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT)
     890             :     !
     891             :     ! if (do_print) then
     892             :     !   write(carma%f_LUNOPRT,*) 'AERONET', aeronet
     893             :     !   write(carma%f_LUNOPRT,*) 'dr', dr
     894             :     !   write(carma%f_LUNOPRT,*) 'r', r
     895             :     ! end if
     896             :     !end if
     897             : 
     898             :     !!*******************************************************************************************************
     899             : 
     900    16051200 :     if(carma_BCOCemissions == 'Specified')then
     901    16051200 :       call pbuf_get_field(pbuf, bc_srfemis_ndx, BCemis_ptr)
     902    16051200 :       call pbuf_get_field(pbuf, oc_srfemis_ndx, OCemis_ptr)
     903             :     end if
     904    16051200 :     if(carma_SO4elevemis== 'Specified')then
     905           0 :       call pbuf_get_field(pbuf, so4_elevemis_ndx, SO4elevemis_ptr)
     906             :     end if
     907             : 
     908             :     ! Organic carbon emssions
     909    16051200 :     if (ielem == I_ELEM_MXOC) then
     910     1459200 :        if (carma_BCOCemissions == 'Yu2015') then
     911           0 :           call get_lat_all_p(lchnk, ncol, ilat)
     912           0 :           call get_lon_all_p(lchnk, ncol, ilon)
     913           0 :           do icol = 1,ncol
     914           0 :              smoke(icol) = OCnew(ilat(icol), ilon(icol), mon)*OMtoOCratio
     915             :           end do
     916     1459200 :        elseif(carma_BCOCemissions == 'Specified')then
     917    22471680 :           smoke(:ncol) = OCemis_ptr(:ncol)
     918             :        end if
     919             : 
     920             : !  st  scip Fsub PBAFlux etcfor now
     921    22471680 :        surfaceFlux(:ncol) = surfaceFlux(:ncol) + smoke(:ncol)*aeronet_fraction(ibin)*SmoketoSufaceFlux
     922             :     end if
     923             : 
     924             :     ! Black carbon emissions
     925    16051200 :     if (ielem == I_ELEM_MXBC) then
     926     1459200 :        if (carma_BCOCemissions == 'Yu2015') then
     927           0 :           do icol = 1,ncol
     928           0 :              smoke(icol) = BCnew(ilat(icol), ilon(icol), mon)
     929             :           end do
     930     1459200 :        elseif(carma_BCOCemissions == 'Specified') then
     931    22471680 :           smoke(:ncol) = BCemis_ptr(:ncol)
     932             :        end if
     933             : 
     934    22471680 :        surfaceFlux(:ncol) = surfaceFlux(:ncol) + smoke(:ncol)*aeronet_fraction(ibin)*SmoketoSufaceFlux
     935             :     end if
     936             : 
     937    16051200 :     if(carma_SO4elevemis == 'Specified') then
     938             :        ! Sulfate emissions
     939           0 :        if (ielem == I_ELEM_PRSUL)  then
     940             :           ! convert from #/kg to kg/kg  = 1.e-3 *  mw/avog (6e-23)    !kg/kg
     941             :           ! convert from #/cm3/s to kg/kg/s = 1.e3 * density of air * mw / avog
     942             :           !AVG: molec/mol R_AIR: units?
     943             :           !rhoa
     944             :           !number Density
     945             :           !rhoa(:ncol,:) = 10._r8 * state%pmid(:ncol,:) / (R_AIR * state%t(:ncol,:))
     946             :           !pmid is in Pa (Pa->dynes (factor of 10.), T (K), -> g/cm3
     947             : 
     948             :           !so4_tendency_factor(:ncol,:) = rhoa(:ncol,:) * WTMOL_H2SO4 / AVG  !molec/cm3/s to kg/kg
     949             : 
     950           0 :           so4_inj(:ncol,:) = SO4elevemis_ptr(:ncol,:)
     951             : 
     952             : 
     953             :           ! set so4_inj larger 0. because of potential negative missing values
     954           0 :           do icol = 1,ncol
     955           0 :              do p = 1,pver
     956           0 :                 rhoa(icol,p) = 10._r8 * state%pmid(icol,p) / (R_AIR * state%t(icol,p))
     957             :                 !pmid is in Pa (Pa->dynes (factor of 10.), T (K), -> g/cm3
     958             :                 !emis = molec/cm3/s
     959             :                 !rhoa = g/cm3
     960             :                 !mw = g/mol
     961             :                 !avg =  molec/mol
     962             :                 !so4_tendency_factor(icol,p) = rhoa(icol,p) * WTMOL_H2SO4 / AVG  !molec/cm3/s to kg/kg
     963           0 :                 so4_tendency_factor(icol,p) =  WTMOL_H2SO4 / AVG / rhoa(icol,p)  !molec/cm3/s to kg/kg
     964           0 :                 so4_inj(icol,p) = max(0._r8,so4_inj(icol,p))
     965           0 :                 if (so4_inj(icol,p).gt.0._r8) then
     966           0 :                    tendency(icol,p) = so4_inj(icol,p)*so4inj_dist(ibin)*so4_tendency_factor(icol,p)
     967             :                 end if
     968             :              end do
     969             :           end do
     970             :        end if
     971             :     end if
     972             : 
     973             :     ! Dust emissions
     974    16051200 :     if (ielem == I_ELEM_MXDUST) then
     975             : 
     976             :       ! The radius should be determined by the dust density not the group
     977             :       ! density
     978     1459200 :       call CARMAELEMENT_Get(carma, I_ELEM_MXDUST, rc, rho=rhop)
     979     1459200 :       if (RC < RC_ERROR) return
     980             : 
     981             :       ! Calculate the radius assuming that all the mass will be emitted as this
     982             :       ! element.
     983     1459200 :       rdust = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin)) ** (1._r8 / 3._r8)
     984             : 
     985             :       ! Is this clay or silt?
     986             :       !
     987             :       ! NOTE: It is assumed that 90% of the mass will be silt and 10% will
     988             :       ! be clay.
     989             :       !
     990             :       ! NOTE: For clay bins, use the smallest silt bin to calculate the
     991             :       ! mass and then scale that into each clay bin based upon interpolation of
     992             :       ! Tegen and Lacis [1996].
     993     1459200 :       if (rdust >= rClay) then
     994      583680 :         sp         = 0.9_r8 / nSilt
     995      583680 :         idustbin   = ibin
     996             :       else
     997      875520 :         sp         = 0.1_r8 / nClay
     998      875520 :         idustbin   = nClay + 1
     999             :       end if
    1000             : 
    1001             :       ! Process each column.
    1002    22471680 :       do icol = 1,ncol
    1003             : 
    1004    21012480 :         call CARMAMODEL_SurfaceWind(carma, icol, I_ELEM_MXDUST, igroup, idustbin, cam_in, uv10, wwd, uth, rc)
    1005             : 
    1006             :         ! Is the wind above the threshold for dust production?
    1007    21012480 :         if (sqrt(wwd) > uth) then
    1008           0 :           dustFlux = ch * soil_factor(icol, lchnk) * sp * &
    1009     3762518 :                               wwd * (sqrt(wwd) - uth)
    1010             :         else
    1011             :           dustFlux = 0._r8
    1012             :         endif
    1013             : 
    1014             :         ! Scale the clay bins based upon the smallest silt bin.
    1015    21012480 :         dustFlux = clay_mf(ibin) * dustFlux
    1016             : 
    1017             :         ! Add the dust flux to the accumulated emissions (important for I_ELEM_MXAER)
    1018    22471680 :         surfaceFlux(icol) = surfaceFlux(icol) + dustFlux
    1019             :       end do
    1020             : 
    1021             :       ! For debug purposes, output the soil erosion factor.
    1022     1459200 :       call outfld('CRSLERFC', soil_factor(:ncol, lchnk), ncol, lchnk)
    1023             :     end if
    1024             : 
    1025             : 
    1026             :     ! Sea salt emissions
    1027    16051200 :     if (ielem == I_ELEM_MXSALT) then
    1028             : 
    1029             :       ! The radius should be determined by the dust density not the group
    1030             :       ! density
    1031     1459200 :       call CARMAELEMENT_Get(carma, I_ELEM_MXSALT, rc, rho=rhop)
    1032     1459200 :       if (RC < RC_ERROR) return
    1033             : 
    1034             :       ! Calculate the radius assuming that all the mass will be emitted as sea
    1035             :       ! salt.
    1036     1459200 :       vrfact = ((3._r8/2._r8 / PI / (vmrat_MXAER + 1._r8))**(1._r8 / 3._r8)) * ((vmrat_MXAER**(1._r8 / 3._r8)) - 1._r8)
    1037     1459200 :       rsalt = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin))**(1._r8 / 3._r8)
    1038     1459200 :       drsalt = vrfact * ((rmass(ibin)/rhop(ibin))**(1._r8 / 3._r8))
    1039             : 
    1040             :       ! get sea spray aerosol flux first (for ibin; SaltFlux(:ncol) unit:kg/m2/s)
    1041             :       call CARMAMODEL_SaltFlux(carma, ibin, state, rsalt, drsalt, rmass(ibin), cam_in, saltFlux, rc)
    1042             : 
    1043             : !st  not used currently  but done by Pengfei
    1044             :        !! introduce marine POA emission, use ChlorophyII-dependent mass contribution of OC
    1045             :        !! see Gantt et al., 2009
    1046             :        !! for sub-micron, I use sea salt flux instead of sub-micron marine particles
    1047             :        !! needed to verify later
    1048             :        !! Added by Pengfei Yu
    1049             :        !! Oct.6.2012
    1050             :        ! get [Chl-a] data
    1051             :   !!   do icol = 1, ncol
    1052             :   !!       if (Chla(ilat(icol), ilon(icol)) .lt. 0._r8) then
    1053             :   !!          Fsub(icol) = 0._r8
    1054             :   !!       else
    1055             :   !!          Fsub(icol) = Chla(ilat(icol), ilon(icol)) * 0.63_r8 + 0.1_r8
    1056             :   !!       endif
    1057             :   !!       Fsub(icol) = min(Fsub(icol), 1._r8)
    1058             :   !!   enddo
    1059             :   !!   surfaceFlux(:ncol) = SaltFlux(:ncol)
    1060             :   !!   ! sea salt (NaCl) flux should exclude marine organics and marine sulfate
    1061             :   !!   if (carma%f_group(igroup)%f_r(ibin) .le. 0.5e-4_r8) then
    1062             :   !!       !surfaceFlux(:ncol) = SaltFlux(:ncol)*(1._r8-0.0983_r8) - SaltFlux(:ncol) * Fsub(:ncol)
    1063             :   !!        surfaceFlux(:ncol) = (SaltFlux(:ncol) - SaltFlux(:ncol)*Fsub(:ncol))/1.0983_r8
    1064             :   !!   else
    1065             :   !!       !surfaceFlux(:ncol) = SaltFlux(:ncol)*(1._r8-0.0983_r8) - SaltFlux(:ncol) * (Fsub(:ncol)*0.03_r8)
    1066             :   !!        surfaceFlux(:ncol) = (SaltFlux(:ncol) - SaltFlux(:ncol)*Fsub(:ncol)*0.03_r8)/1.0983_r8
    1067             :   !!   endif
    1068    22471680 :       surfaceFlux(:ncol) = surfaceFlux(:ncol) + saltFlux(:ncol)
    1069             :     end if
    1070             : 
    1071             :     return
    1072    32102400 :   end subroutine CARMAMODEL_EmitParticle
    1073             : 
    1074             : 
    1075             :   !! Allows the model to perform its own initialization in addition to what is done
    1076             :   !! by default in CARMA_init.
    1077             :   !!
    1078             :   !! @author  Chuck Bardeen
    1079             :   !! @version May-2009
    1080        1536 :   subroutine CARMAMODEL_InitializeModel(carma, lq_carma, pbuf2d, rc)
    1081    16051200 :     use cam_history,  only: addfld,  horiz_only, add_default
    1082             :     use constituents, only: pcnst
    1083             : 
    1084             :     type(carma_type), intent(in)       :: carma                 !! the carma object
    1085             :     logical, intent(inout)             :: lq_carma(pcnst)       !! flags to indicate whether the constituent
    1086             :                                                                 !! could have a CARMA tendency
    1087             :     type(physics_buffer_desc), pointer :: pbuf2d(:,:)
    1088             :     integer, intent(out)               :: rc                    !! return code, negative indicates failure
    1089             : 
    1090             :     ! -------- local variables ----------
    1091             :     integer            :: ibin                                ! CARMA bin index
    1092             :     real(r8)           :: r(NBIN), dr(NBIN), rdust(NBIN),robc(NBIN),drobc(NBIN),rm(NBIN),rhop(NBIN)       ! bin center (cm)
    1093             :     integer            :: count_Silt                          ! count number for Silt
    1094             :     integer            :: igroup                              ! the index of the carma aerosol group
    1095             :     integer            :: ielem                               ! the index of the carma aerosol element
    1096             :     character(len=32)  :: shortname                           ! the shortname of the element
    1097             :     integer            :: LUNOPRT                             ! logical unit number for output
    1098             :     logical            :: do_print                            ! do print output?
    1099             : 
    1100             :     integer :: i, idata,isizebin,ibin_local
    1101             :     integer,parameter :: aeronet_dim1 = 22
    1102             :     integer,parameter :: aeronet_dim2 = 4
    1103             :     real(r8),dimension(aeronet_dim1,aeronet_dim2) :: sizedist_aeronet
    1104             :     real(r8),dimension(aeronet_dim1) :: sizedist_avg
    1105             :     real(r8),dimension(NBIN) :: sizedist_carmabin
    1106             :     real(r8) :: rmass(NBIN) !! dry mass
    1107             :     real(r8) :: vrfact
    1108             :     real(r8) :: rgeo
    1109             :     real(r8) :: siglog, siglogsq, sq2pi
    1110             :     character(len=16)    :: binname      !! names bins
    1111             : 
    1112             :     real(r8),parameter :: size_aeronet(aeronet_dim1) = (/0.050000_r8,0.065604_r8,0.086077_r8,0.112939_r8,0.148184_r8, &
    1113             :          0.194429_r8,0.255105_r8,0.334716_r8,0.439173_r8,0.576227_r8,0.756052_r8,0.991996_r8,1.301571_r8,1.707757_r8, &
    1114             :          2.240702_r8,2.939966_r8,3.857452_r8,5.061260_r8,6.640745_r8,8.713145_r8,11.432287_r8,15.000000_r8/)*1.e-4_r8 !um to cm
    1115             : 
    1116             :     ! Default return code.
    1117        1536 :     rc = RC_OK
    1118             : 
    1119             :     ! Determine how many clay and how many silt bins there are, based
    1120             :     ! upon the bin definitions and rClay.
    1121             :     !
    1122             :     ! TBD: This should use the radii rather than being hard coded.
    1123             :     ! nClay = 8
    1124             :     ! nSilt = NBIN - nClay
    1125       18432 :     do ielem = 1, NELEM
    1126             : 
    1127             :        ! To get particle radius, need to derive from rmass and density of dust.
    1128       16896 :        call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname, rho=rhop)
    1129       16896 :        if (RC < RC_ERROR) return
    1130             : 
    1131       16896 :        call CARMAGROUP_GET(carma, igroup, rc, rmass=rmass)
    1132       16896 :        if (RC < RC_ERROR) return
    1133             : 
    1134       35328 :        if (shortname .eq. "MXDUST") then
    1135             : 
    1136        1536 :           count_Silt = 0
    1137       32256 :           do ibin = 1, NBIN
    1138             : 
    1139             :              ! Calculate the radius assuming that all the mass will be emitted as this
    1140             :              ! element.
    1141       30720 :              rdust(ibin) = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin))**(1._r8 / 3._r8)
    1142             : 
    1143       32256 :              if (rdust(ibin) >= rclay) then
    1144       12288 :                 count_Silt = count_Silt + 1
    1145             :              else
    1146             :              end if
    1147             :           end do
    1148        1536 :           nSilt = count_Silt
    1149        1536 :           nClay = NBIN - nSilt
    1150             :        end if
    1151             :     end do
    1152             : 
    1153             :     ! Read in the soil factors.
    1154        1536 :     call CARMAMODEL_ReadSoilErosionFactor(rc)
    1155        1536 :     if (RC < RC_ERROR) return
    1156             : 
    1157             :     ! To determine Clay Mass Fraction
    1158       18432 :     do ielem = 1, NELEM
    1159             :        ! To get particle radius
    1160       16896 :        call CARMAELEMENT_GET(carma, ielem, rc, igroup=igroup, shortname=shortname)
    1161       16896 :        if (RC < RC_ERROR) return
    1162             : 
    1163       35328 :        if (shortname .eq. "MXDUST") then
    1164        1536 :           call CARMAMODEL_ClayMassFraction(carma, igroup, rdust, rc)
    1165             :        end if
    1166             :     end do
    1167             : 
    1168        1536 :     if (masterproc) then
    1169           2 :       call CARMA_Get(carma, rc, do_print=do_print, LUNOPRT=LUNOPRT)
    1170           2 :       if (rc < 0) call endrun("CARMA_InitializeModel: CARMA_Get failed.")
    1171             : 
    1172           2 :       if (do_print) then
    1173           2 :         write(carma%f_LUNOPRT,*) 'Initializing CARMA dust model ...'
    1174           2 :         write(carma%f_LUNOPRT,*) 'nClay = ', nClay, ' nSilt = ', nSilt
    1175           2 :         write(carma%f_LUNOPRT,*) 'clay_mf = ', clay_mf
    1176           2 :         write(carma%f_LUNOPRT,*) 'soil_factor = ', soil_factor
    1177             : 
    1178           2 :         write(carma%f_LUNOPRT,*) 'CARMA dust initialization complete'
    1179             :       end if
    1180             :     end if
    1181             : 
    1182        1536 :     call addfld('CRSLERFC', horiz_only, 'A', 'fraction', 'CARMA soil erosion factor')
    1183             : 
    1184        1536 :     if (carma_BCOCemissions == 'Yu2015')then
    1185             :        ! Added by Pengfei Yu to read smoke emission data
    1186           0 :        call CARMAMODEL_BCOCread(rc)
    1187             :     end if
    1188        1536 :     if(carma_BCOCemissions == 'Specified')then
    1189        1536 :        bc_srfemis_ndx = pbuf_get_index("BC_srfemis")
    1190        1536 :        oc_srfemis_ndx = pbuf_get_index("OC_srfemis")
    1191             :     end if
    1192             : 
    1193             :     ! prescribed sulfate emissions for stratospheric aerosol injections
    1194        1536 :     if(carma_SO4elevemis == 'Specified')then
    1195           0 :        so4_elevemis_ndx = pbuf_get_index("SO4_elevemis")
    1196             :     end if
    1197             : 
    1198        1536 :     if (is_first_step()) then
    1199             : 
    1200             :        ! Initialize physics buffer fields
    1201        2304 :        do igroup = 1, NGROUP
    1202       33024 :           do ibin = 1, NBIN
    1203       32256 :              if (igroup==I_GRP_MXAER) then
    1204       15360 :                 call pbuf_set_field(pbuf2d, ipbuf4soa1(ibin), 0.0_r8 )
    1205       15360 :                 call pbuf_set_field(pbuf2d, ipbuf4soa2(ibin), 0.0_r8 )
    1206       15360 :                 call pbuf_set_field(pbuf2d, ipbuf4soa3(ibin), 0.0_r8 )
    1207       15360 :                 call pbuf_set_field(pbuf2d, ipbuf4soa4(ibin), 0.0_r8 )
    1208       15360 :                 call pbuf_set_field(pbuf2d, ipbuf4soa5(ibin), 0.0_r8 )
    1209             :              end if
    1210             :           end do
    1211             :        end do
    1212             : 
    1213         768 :        call pbuf_set_field(pbuf2d, ipbuf4jno2, 0.0_r8 )
    1214             :     endif
    1215             : 
    1216             :     sizedist_aeronet(:aeronet_dim1,1) = (/0.000585_r8,0.006080_r8,0.025113_r8,0.052255_r8,0.079131_r8,0.081938_r8, &
    1217             :          0.035791_r8,0.010982_r8,0.005904_r8,0.007106_r8,0.011088_r8,0.012340_r8,0.010812_r8,0.010423_r8, &
    1218       35328 :          0.011892_r8,0.016529_r8,0.023967_r8,0.026854_r8,0.017901_r8,0.007226_r8,0.002161_r8,0.000544_r8/)
    1219             :     sizedist_aeronet(:aeronet_dim1,2) = (/0.000541_r8,0.006524_r8,0.026103_r8,0.050825_r8,0.077730_r8,0.080545_r8, &
    1220             :          0.035400_r8,0.011143_r8,0.005753_r8,0.006095_r8,0.008730_r8,0.010794_r8,0.011517_r8,0.012051_r8, &
    1221       35328 :          0.012362_r8,0.014710_r8,0.019738_r8,0.022156_r8,0.014892_r8,0.005976_r8,0.001891_r8,0.000573_r8/)
    1222             :     sizedist_aeronet(:aeronet_dim1,3) = (/0.000747_r8,0.009291_r8,0.043556_r8,0.099216_r8,0.142377_r8,0.108606_r8, &
    1223             :          0.043723_r8,0.016385_r8,0.008318_r8,0.005597_r8,0.004431_r8,0.004131_r8,0.004980_r8,0.007484_r8, &
    1224       35328 :          0.011795_r8,0.017235_r8,0.022404_r8,0.025216_r8,0.022521_r8,0.013752_r8,0.005051_r8,0.001057_r8/)
    1225             :     sizedist_aeronet(:aeronet_dim1,4) = (/0.000979_r8,0.007724_r8,0.034451_r8,0.090410_r8,0.135893_r8,0.103115_r8, &
    1226             :          0.046047_r8,0.018989_r8,0.009149_r8,0.005034_r8,0.003199_r8,0.002680_r8,0.003249_r8,0.005105_r8, &
    1227       35328 :          0.008370_r8,0.012542_r8,0.016973_r8,0.021107_r8,0.022077_r8,0.015639_r8,0.006001_r8,0.001115_r8/)
    1228             : 
    1229        1536 :     sizedist_avg(:) = 0._r8
    1230        7680 :     do idata = 1,aeronet_dim2
    1231      142848 :        sizedist_avg(:) = sizedist_avg(:) + sizedist_aeronet(:,idata)
    1232             :     end do
    1233       35328 :     sizedist_avg(:) = sizedist_avg(:)*0.25_r8
    1234             : 
    1235        4608 :     do igroup = 1,NGROUP
    1236        3072 :       call CARMAGROUP_GET(carma, igroup, rc, shortname=shortname, rmass=rmass)
    1237             : 
    1238             : 
    1239        4608 :       if (shortname .eq. "MXAER") then
    1240             : 
    1241             :         !interpolate into carma bin
    1242        1536 :         sizedist_carmabin = 0._r8
    1243             : 
    1244       32256 :         do ibin_local = 1, NBIN
    1245             :           ! Calculate the radius assuming that all the mass will be emitted as this
    1246             :           ! element.
    1247       30720 :           vrfact = ((3._r8/2._r8 / PI / (vmrat_MXAER + 1._r8))**(1._r8 / 3._r8)) * ((vmrat_MXAER**(1._r8 / 3._r8)) - 1._r8)
    1248       30720 :           robc(ibin_local) = (3._r8 * rmass(ibin_local) / 4._r8 / PI / rho_obc)**(1._r8 / 3._r8)
    1249       30720 :           drobc(ibin_local) = vrfact * ((rmass(ibin_local)/rho_obc) **(1._r8 / 3._r8))
    1250             : 
    1251       30720 :           if(robc(ibin_local) .lt. size_aeronet(1)) then
    1252           0 :             sizedist_carmabin(ibin_local) = sizedist_avg(1)
    1253             :           end if
    1254       30720 :           if(robc(ibin_local) .ge. size_aeronet(aeronet_dim1)) then
    1255           0 :             sizedist_carmabin(ibin_local) = sizedist_avg(aeronet_dim1)
    1256             :           end if
    1257      677376 :           do isizebin= 1,aeronet_dim1-1
    1258      675840 :             if( robc(ibin_local) .ge. size_aeronet(isizebin) .and.  robc(ibin_local) .lt. size_aeronet(isizebin+1))then
    1259             :               sizedist_carmabin(ibin_local) = sizedist_avg(isizebin)*(size_aeronet(isizebin+1)-robc(ibin_local))/&
    1260             :                   (size_aeronet(isizebin+1)-size_aeronet(isizebin))&
    1261             :                   +sizedist_avg(isizebin+1)*(robc(ibin_local)-size_aeronet(isizebin))&
    1262       30720 :                   /(size_aeronet(isizebin+1)-size_aeronet(isizebin))
    1263             :             end if
    1264             :           end do
    1265             :         end do
    1266             : 
    1267        1536 :         rm(:) = 0._r8
    1268       32256 :         do ibin_local = 1, NBIN
    1269       32256 :           rm(ibin_local) = sizedist_carmabin(ibin_local)*drobc(ibin_local)/robc(ibin_local)*RHO_obc*1.e-15_r8         ! kg
    1270             :         enddo
    1271             : 
    1272       32256 :         do ibin_local = 1, NBIN
    1273      646656 :           aeronet_fraction(ibin_local) = rm(ibin_local)/sum(rm(:))
    1274             :         end do
    1275             : 
    1276             :       end if
    1277             :     end do
    1278             : 
    1279             :     ! Produce lognormal size distribtuion for sulfate emissions (SO4 geoengienering experiments)
    1280             : 
    1281             :     ! Define specific for SO4 injection, e.g.,mean dry radius: 0.095, sigma = 1.5
    1282        1536 :     so4inj_dist(:) = 0.0_r8
    1283        1536 :     so4inj_dist1(:) = 0.0_r8
    1284        1536 :     rgeo=0.095e-4_f                    ! mean radius for aerosol injections in cm
    1285        1536 :     siglog=log(1.5_r8)    ! assumed log normal distribtuion around mean radius for aerosol injections
    1286        1536 :     siglogsq=siglog**2_f
    1287        1536 :     sq2pi = sqrt(2._r8*pi)
    1288             :     !aer_Vrat =  vmrat_PRSUL
    1289             : 
    1290        1536 :     call CARMAGROUP_GET(carma, I_GRP_PRSUL, rc, r=r, dr=dr, shortname=shortname, rmass=rmass)
    1291             : 
    1292             :     !interpolate into carma bin
    1293             : 
    1294       32256 :     do ibin_local = 1, NBIN
    1295             :        ! Size Distribution-Parameter: log-normal distribution applied using Seinfeld and Pandis (2016)
    1296       30720 :        so4inj_dist1(ibin_local)=dr(ibin_local)/(r(ibin_local)*sq2pi*siglog)*exp(-(((log(r(ibin_local)/rgeo))**2._r8)/(2._r8*siglogsq)))
    1297       30720 :        so4inj_dist(ibin_local)=dr(ibin_local)/(r(ibin_local)*sq2pi*siglog)*exp(-(((log(r(ibin_local)/rgeo))**2._r8)/(2._r8*siglogsq)))
    1298       32256 :        so4inj_dist1(ibin_local) = so4inj_dist1(ibin_local) *rmass(ibin_local)
    1299             :     end do
    1300       62976 :     so4inj_dist(:) = so4inj_dist(:) / sum(so4inj_dist)
    1301       62976 :     so4inj_dist1(:) = so4inj_dist1(:) / sum(so4inj_dist1)
    1302             : 
    1303             :     ! Provide diagnostics on the SOA tendencies that affect MXAER.
    1304       32256 :     do ibin = 1, NBIN
    1305       30720 :        write(binname, '(A, I2.2)') "MXSOA1", ibin
    1306       61440 :        call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA1 gas condensation tendency')
    1307       61440 :        call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA1 photolysis tendency')
    1308       30720 :        write(binname, '(A, I2.2)') "MXSOA2", ibin
    1309       61440 :        call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA2 gas condensation tendency')
    1310       61440 :        call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA2 photolysis tendency')
    1311       30720 :        write(binname, '(A, I2.2)') "MXSOA3", ibin
    1312       61440 :        call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA3 gas condensation tendency')
    1313       61440 :        call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA3 photolysis tendency')
    1314       30720 :        write(binname, '(A, I2.2)') "MXSOA4", ibin
    1315       61440 :        call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA4 gas condensation tendency')
    1316       61440 :        call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA4 photolysis tendency')
    1317       30720 :        write(binname, '(A, I2.2)') "MXSOA5", ibin
    1318       61440 :        call addfld(trim(binname)//"CM", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA5 gas condensation tendency')
    1319       62976 :        call addfld(trim(binname)//"PT", (/ 'lev' /), 'A', 'kg/kg/s', 'MXAER SOA5 photolysis tendency')
    1320             :     end do
    1321             : 
    1322             :     ! Provide diagnostics for SO4 tendencies from other physics packages
    1323             :     !
    1324             :     ! NOTE: This can be useful for determining an SO4 budget and for debugging
    1325             :     ! SO4 conservation.
    1326        1536 :     if (carma_do_budget_diags) then
    1327             : 
    1328           0 :       call addfld("SO4PRBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 pure burden')
    1329           0 :       if (carma_diags_file > 0) call add_default("SO4PRBD", carma_diags_file, ' ')
    1330           0 :       call addfld("SO4MXBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 mix burden')
    1331           0 :       if (carma_diags_file > 0) call add_default("SO4MXBD", carma_diags_file, ' ')
    1332           0 :       call addfld("SO4PRCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SO4 pure burden')
    1333           0 :       if (carma_diags_file > 0) call add_default("SO4PRCLDBD", carma_diags_file, ' ')
    1334           0 :       call addfld("SO4MXCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SO4 mix burden')
    1335             : 
    1336           0 :       if (carma_diags_file > 0) call add_default("SO4MXCLDBD", carma_diags_file, ' ')
    1337           0 :       call addfld("SO4PRSF", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 pure surface flux')
    1338           0 :       if (carma_diags_file > 0) call add_default("SO4PRSF", carma_diags_file, ' ')
    1339           0 :       call addfld("SO4MXSF", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SO4 mix surface flux')
    1340           0 :       if (carma_diags_file > 0) call add_default("SO4MXSF", carma_diags_file, ' ')
    1341             : 
    1342           0 :       call addfld("H2SO4BD", horiz_only, 'A', 'kg/m2', 'CARMA, H2SO4 burden')
    1343           0 :       if (carma_diags_file > 0) call add_default("H2SO4BD", carma_diags_file, ' ')
    1344           0 :       call addfld("SO2BD", horiz_only, 'A', 'kg/m2', 'CARMA, SO2 burden')
    1345           0 :       if (carma_diags_file > 0) call add_default("SO2BD", carma_diags_file, ' ')
    1346             : 
    1347           0 :       call addfld("MXBCBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial BC mix burden')
    1348           0 :       if (carma_diags_file > 0) call add_default("MXBCBD", carma_diags_file, ' ')
    1349           0 :       call addfld("MXDUSTBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial Dust mix burden')
    1350           0 :       if (carma_diags_file > 0) call add_default("MXDUSTBD", carma_diags_file, ' ')
    1351           0 :       call addfld("MXOCBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial OC mix burden')
    1352           0 :       if (carma_diags_file > 0) call add_default("MXOCBD", carma_diags_file, ' ')
    1353           0 :       call addfld("MXSALTBD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial Sea Salt mix burden')
    1354           0 :       if (carma_diags_file > 0) call add_default("MXSALTBD", carma_diags_file, ' ')
    1355           0 :       call addfld("MXSOA1BD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA1 mix burden')
    1356           0 :       if (carma_diags_file > 0) call add_default("MXSOA1BD", carma_diags_file, ' ')
    1357           0 :       call addfld("MXSOA2BD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA2 mix burden')
    1358           0 :       if (carma_diags_file > 0) call add_default("MXSOA2BD", carma_diags_file, ' ')
    1359           0 :       call addfld("MXSOA3BD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA3 mix burden')
    1360           0 :       if (carma_diags_file > 0) call add_default("MXSOA3BD", carma_diags_file, ' ')
    1361           0 :       call addfld("MXSOA4BD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA4 mix burden')
    1362           0 :       if (carma_diags_file > 0) call add_default("MXSOA4BD", carma_diags_file, ' ')
    1363           0 :       call addfld("MXSOA5BD", horiz_only, 'A', 'kg/m2', 'CARMA, Interstitial SOA5 mix burden')
    1364           0 :       if (carma_diags_file > 0) call add_default("MXSOA5BD", carma_diags_file, ' ')
    1365             : 
    1366           0 :       call addfld("MXBCCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne BC mix burden')
    1367           0 :       if (carma_diags_file > 0) call add_default("MXBCCLDBD", carma_diags_file, ' ')
    1368           0 :       call addfld("MXDUSTCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne Dust mix burden')
    1369           0 :       if (carma_diags_file > 0) call add_default("MXDUSTCLDBD", carma_diags_file, ' ')
    1370           0 :       call addfld("MXOCCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne OC mix burden')
    1371           0 :       if (carma_diags_file > 0) call add_default("MXOCCLDBD", carma_diags_file, ' ')
    1372           0 :       call addfld("MXSALTCLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne Sea Salt mix burden')
    1373           0 :       if (carma_diags_file > 0) call add_default("MXSALTCLDBD", carma_diags_file, ' ')
    1374           0 :       call addfld("MXSOA1CLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA1 mix burden')
    1375           0 :       if (carma_diags_file > 0) call add_default("MXSOA1CLDBD", carma_diags_file, ' ')
    1376           0 :       call addfld("MXSOA2CLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA2 mix burden')
    1377           0 :       if (carma_diags_file > 0) call add_default("MXSOA2CLDBD", carma_diags_file, ' ')
    1378           0 :       call addfld("MXSOA3CLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA3 mix burden')
    1379           0 :       if (carma_diags_file > 0) call add_default("MXSOA3CLDBD", carma_diags_file, ' ')
    1380           0 :       call addfld("MXSOA4CLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA4 mix burden')
    1381           0 :       if (carma_diags_file > 0) call add_default("MXSOA4CLDBD", carma_diags_file, ' ')
    1382           0 :       call addfld("MXSOA5CLDBD", horiz_only, 'A', 'kg/m2', 'CARMA, Cloudborne SOA5 mix burden')
    1383           0 :       if (carma_diags_file > 0) call add_default("MXSOA5CLDBD", carma_diags_file, ' ')
    1384             :     end if
    1385             : 
    1386        1536 :     if (carma_do_package_diags) then
    1387             : 
    1388             :       ! Iterate of the packages that have be instrumented. These should match the calls
    1389             :       ! in physpkg.f90.
    1390           0 :       do i = 1, carma_ndiagpkgs
    1391           0 :         call addfld("SO4PRBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', SO4 pure burden')
    1392           0 :         if (carma_diags_file > 0) call add_default("SO4PRBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1393           0 :         call addfld("SO4MXBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', SO4 mixed burden')
    1394           0 :         if (carma_diags_file > 0) call add_default("SO4MXBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1395             : 
    1396           0 :         call addfld("SO4PRSF_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Surface Flux, SO4 pure tendency')
    1397           0 :         if (carma_diags_file > 0) call add_default("SO4PRSF_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1398           0 :         call addfld("SO4MXSF_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Surface Flux, SO4 mix tendency')
    1399           0 :         if (carma_diags_file > 0) call add_default("SO4MXSF_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1400             : 
    1401           0 :         call addfld("SO4PRTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', SO4 pure tendency')
    1402           0 :         if (carma_diags_file > 0) call add_default("SO4PRTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1403           0 :         call addfld("SO4MXTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', SO4 mixed tendency')
    1404           0 :         if (carma_diags_file > 0) call add_default("SO4MXTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1405             : 
    1406           0 :         call addfld("SO4PRCLDBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', Cloudborne SO4 pure burden')
    1407           0 :         if (carma_diags_file > 0) call add_default("SO4PRCLDBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1408           0 :         call addfld("SO4MXCLDBD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', Cloudborne SO4 mixed burden')
    1409           0 :         if (carma_diags_file > 0) call add_default("SO4MXCLDBD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1410             : 
    1411           0 :         call addfld("SO4PRCLDTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Cloudborne SO4 pure tendency')
    1412           0 :         if (carma_diags_file > 0) call add_default("SO4PRCLDTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1413           0 :         call addfld("SO4MXCLDTC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', Cloudborne SO4 mixed tendency')
    1414           0 :         if (carma_diags_file > 0) call add_default("SO4MXCLDTC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1415             : 
    1416           0 :         call addfld("H2SO4TC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', H2SO4 total tendency')
    1417           0 :         if (carma_diags_file > 0) call add_default("H2SO4TC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1418           0 :         call addfld("H2SO4BD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', H2SO4 burden')
    1419           0 :         if (carma_diags_file > 0) call add_default("H2SO4BD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1420           0 :         call addfld("SO2TC_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2/s', trim(carma_diags_packages(i))//', SO2 total tendency')
    1421           0 :         if (carma_diags_file > 0) call add_default("SO2TC_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1422           0 :         call addfld("SO2BD_"//trim(carma_diags_packages(i)), horiz_only, 'A', 'kg/m2', trim(carma_diags_packages(i))//', SO2 burden')
    1423           0 :         if (carma_diags_file > 0) call add_default("SO2BD_"//trim(carma_diags_packages(i)), carma_diags_file, ' ')
    1424             :       end do
    1425             :     end if
    1426             : 
    1427             :    ! Provide diagnostics for Mass mixing ration summed over the bins
    1428        3072 :     call addfld("SO4PRMR", (/ 'lev' /), 'A', 'kg/kg', 'SO4 pure mass mixing ratio')
    1429        3072 :     call addfld("MXSO4MR", (/ 'lev' /), 'A', 'kg/kg', 'SO4 mixed mass mixing ratio')
    1430        3072 :     call addfld("MXBCMR", (/ 'lev' /), 'A', 'kg/kg', 'BC mixed mass mixing ratio')
    1431        3072 :     call addfld("MXDUSTMR", (/ 'lev' /), 'A', 'kg/kg', 'DUST mixed mass mixing ratio')
    1432        3072 :     call addfld("MXOCMR", (/ 'lev' /), 'A', 'kg/kg', 'OC mixed mass mixing ratio')
    1433        3072 :     call addfld("MXSALTMR", (/ 'lev' /), 'A', 'kg/kg', 'SALT mixed mass mixing ratio')
    1434        3072 :     call addfld("MXSOAMR", (/ 'lev' /), 'A', 'kg/kg', 'SOA mixed mass mixing ratio')
    1435             : 
    1436        1536 :     return
    1437        1536 :   end subroutine CARMAMODEL_InitializeModel
    1438             : 
    1439             : 
    1440             :   !! Sets the initial condition for CARMA aerosol particles. By default, there are no
    1441             :   !! particles, but this routine can be overridden for models that wish to have an
    1442             :   !! initial value.
    1443             :   !!
    1444             :   !! NOTE: If CARMA constituents appear in the initial condition file, then those
    1445             :   !! values will override anything set here.
    1446             :   !!
    1447             :   !! @author  Chuck Bardeen
    1448             :   !! @version May-2009
    1449           0 :   subroutine CARMAMODEL_InitializeParticle(carma, ielem, ibin, latvals, lonvals, mask, q, rc)
    1450             : 
    1451             :     type(carma_type), intent(in)  :: carma      !! the carma object
    1452             :     integer,          intent(in)  :: ielem      !! element index
    1453             :     integer,          intent(in)  :: ibin       !! bin index
    1454             :     real(r8),         intent(in)  :: latvals(:) !! lat in degrees (ncol)
    1455             :     real(r8),         intent(in)  :: lonvals(:) !! lon in degrees (ncol)
    1456             :     logical,          intent(in)  :: mask(:)    !! Only initialize where .true.
    1457             :     real(r8),         intent(inout) :: q(:,:)     !! mass mixing ratio (gcol, lev)
    1458             :     integer,          intent(out) :: rc         !! return code, negative indicates failure
    1459             : 
    1460             :     ! Default return code.
    1461           0 :     rc = RC_OK
    1462             : 
    1463             :     ! Add initial condition here.
    1464             :     !
    1465             :     ! NOTE: Initialized to 0. by the caller, so nothing needs to be done.
    1466             : 
    1467           0 :     return
    1468        1536 :   end subroutine CARMAMODEL_InitializeParticle
    1469             : 
    1470             : 
    1471             :   !! This routine is an extension of CARMA_CreateOpticsFile() that allows for
    1472             :   !! model specific tables to be created in addition to the model independent
    1473             :   !! methods that are in carma_intr.F90.
    1474             :   !!
    1475             :   !! The opticsType that is specified for the group determines how the optical
    1476             :   !! properties will be generated for that group. Each group can use a different
    1477             :   !! optics method if needed. Refractive indices need for these calculation are
    1478             :   !! are specified in the group's elements rather than at the group level. This
    1479             :   !! allows various mixing approaches to be used to determine the refractive index
    1480             :   !! for the particle as a whole. If the refractive index for water is needed,
    1481             :   !! it is specific the the CARMAGAS object for H2O.
    1482             :   !!
    1483             :   !! The I_OPTICS_MIXED_YU2105  and I_OPTICS_SULFATE_YU2015 optics methods are
    1484             :   !! designed to trop_strat models as define in the Yu et al. (2015) paper. The
    1485             :   !! I_OPTICS_MIXED_YU_H2O includes volume mixing of the water into the shell.
    1486           0 :   subroutine CARMAMODEL_CreateOpticsFile(carma, igroup, opticsType, rc)
    1487             : 
    1488             :     implicit none
    1489             : 
    1490             :     type(carma_type), intent(inout)     :: carma         !! the carma object
    1491             :     integer, intent(in)                 :: igroup        !! group identifier
    1492             :     integer, intent(in)                 :: opticsType    !! optics type (see I_OPTICS_... in carma_enums.F90)
    1493             :     integer, intent(out)                :: rc            !! return code, negative indicates failure
    1494             : 
    1495             :     ! Local variables
    1496             :     logical                             :: do_mie
    1497             :     integer                             :: cnsttype               ! constituent type
    1498             : 
    1499             :     ! Assume success.
    1500           0 :     rc = 0
    1501             : 
    1502             :     ! What type of calculation is needed for this group?
    1503             :     !
    1504             :     ! NOTE: Some of these calculations generate optical properties as single mass
    1505             :     ! coefficients, while others are lookup tables designed around multiple
    1506             :     ! dimensions.
    1507           0 :     select case (opticsType)
    1508             : 
    1509             :       ! This is for the mixed aerosol group as implemented by Yu et al. (2015),
    1510             :       ! and is specific to the aerosol defintion in that model. There are multiple
    1511             :       ! elements, some grouped in the core and others in the shell. The refractive
    1512             :       ! index for the shell is assumed to be only sulfates, and the refractive
    1513             :       ! index of the core is a mix of dust and black carbon. Core/shell optics
    1514             :       ! are used to determine the optical properties.
    1515             :       case(I_OPTICS_MIXED_YU2015)
    1516           0 :         call CARMAMODEL_CreateOpticsFile_MixedYu(carma, igroup, rc)
    1517           0 :         if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_MixedYu failed.')
    1518             : 
    1519             :       ! This is for the pure sulfate group as implemented by Yu et al. (2015).
    1520             :       ! The particle may swell, but the refractive index is fixed regardless
    1521             :       ! of the weight percent of H21SO4 in the particle.
    1522             :       case(I_OPTICS_SULFATE_YU2015)
    1523           0 :         call CARMAMODEL_CreateOpticsFile_SulfateYu(carma, igroup, rc)
    1524           0 :         if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_SulfateYu failed.')
    1525             : 
    1526             :       ! This is similar to I_OPTICS_MIXED_YU2015, except that the shell is a volume
    1527             :       ! mixture of water and H2SO4 rather than just being H2SO4.
    1528             :       case(I_OPTICS_MIXED_YU_H2O)
    1529           0 :         call CARMAMODEL_CreateOpticsFile_MixedYuH2o(carma, igroup, rc)
    1530           0 :         if (rc < 0) call endrun('carma_CreateOpticsFile::CreateOpticsFile_MixedYuH2o failed.')
    1531             : 
    1532             :       case default
    1533           0 :         call endrun('carma_CreateOpticsFile:: Unknown optics type.')
    1534             :     end select
    1535             : 
    1536           0 :     return
    1537             :   end subroutine CARMAMODEL_CreateOpticsFile
    1538             : 
    1539             : 
    1540             :   !! This routine creates files containing optical properties for the mixed group
    1541             :   !! following Yu et al. (2015). These optical properties are used by the RRTMG radiation
    1542             :   !! code to include the impact of CARMA particles in the radiative transfer
    1543             :   !! calculation.
    1544           0 :   subroutine CARMAMODEL_CreateOpticsFile_MixedYu(carma, igroup, rc)
    1545             :     use radconstants, only : nswbands, nlwbands
    1546             :     use wrap_nf
    1547             :     use wetr, only         : getwetr
    1548             : 
    1549             :     implicit none
    1550             : 
    1551             :     type(carma_type), intent(inout)     :: carma         !! the carma object
    1552             :     integer, intent(in)                 :: igroup        !! group index
    1553             :     integer, intent(out)                :: rc            !! return code, negative indicates failure
    1554             : 
    1555             :     !! Core-shell mixing method for mie and radiation calculations for the Yu et al. (2015)
    1556             :     !! style table. The CAM optics code will interpolate based upon the current core/shell
    1557             :     !! mass ratio from a table built using the specified core/shell.
    1558             :     integer, parameter                  :: ncoreshellratio  = 9               !! Number of core/shell ratio for mie calculations
    1559             :     integer, parameter                  :: ndstbcratio = 8
    1560             :     integer, parameter                  :: nkap = 9
    1561             : 
    1562             :     real(kind=f), parameter :: coreshellratio(ncoreshellratio) = (/ 0.001_f, 0.00237_f, 0.00562_f, 0.01333_f, &
    1563             :                                                                     0.03162_f, 0.07499_f, 0.17782_f, 0.42169_f, 1.0_f /)
    1564             :     real(kind=f), parameter :: dstbcratio(ndstbcratio) = (/ 0.01_f, 0.025_f, 0.063_f, 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.9_f/)
    1565             :     real(kind=f), parameter :: kap(nkap) = (/ 0.1_f, 0.2_f, 0.3_f, 0.4_f, 0.5_f, 0.7_f, 0.9_f, 1.1_f, 1.2_f/)
    1566             : 
    1567             :     ! Local variables
    1568             :     integer                             :: ibin, iwave, irh, icsr, idb, ikap, icore, ncore
    1569             :     integer                             :: icorelem(NELEM)
    1570             :     integer                             :: irhswell
    1571             :     integer                             :: imiertn
    1572             :     integer                             :: ienconc
    1573             :     real(kind=f)                        :: rho(NBIN), rhopwet
    1574             :     real(kind=f)                        :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN)
    1575             :     real(kind=f)                        :: wave(NWAVE)
    1576             :     complex(kind=f)                     :: refidx(NWAVE, NREFIDX)
    1577             :     complex(kind=f)                     :: refidxS(NWAVE, NREFIDX)
    1578             :     complex(kind=f)                     :: refidxB(NWAVE, NREFIDX)
    1579             :     complex(kind=f)                     :: refidxD(NWAVE, NREFIDX)
    1580             :     complex(kind=f)                     :: refidxC
    1581             :     !real(kind=f) :: coreimagidx
    1582             :     character(len=CARMA_NAME_LEN)       :: name
    1583             :     character(len=CARMA_SHORT_NAME_LEN) :: shortname
    1584             :     logical                             :: do_mie
    1585             :     integer                             :: fid
    1586             :     integer                             :: rhdim, lwdim, swdim, csrdim, dstbcrdim, kapdim
    1587             :     integer                             :: rhvar, lwvar, swvar, csr_var, dstbcr_var, kap_var
    1588             :     integer                             :: abs_lw_coreshell_var, qabs_lw_coreshell_var
    1589             :     integer                             :: ext_sw_coreshell_var, ssa_sw_coreshell_var
    1590             :     integer                             :: asm_sw_coreshell_var, qext_sw_coreshell_var
    1591             :     integer                             :: rwetvar
    1592             :     integer                             :: omdim, andim, namedim
    1593             :     integer                             :: omvar, anvar, namevar
    1594             :     integer                             :: dimids(5)
    1595             :     integer                             :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar
    1596             :     real(kind=f)                        :: abs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap)
    1597             :     real(kind=f)                        :: qabs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap)
    1598             :     real(kind=f)                        :: ext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap)
    1599             :     real(kind=f)                        :: qext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap)
    1600             :     real(kind=f)                        :: ssa_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap)
    1601             :     real(kind=f)                        :: asm_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap)
    1602             :     real(kind=f)                        :: rwetbin(NMIE_RH)
    1603             :     character(len=8)                    :: c_name                   ! constituent name
    1604             :     character(len=32)                   :: aer_name                 ! long enough for both aername and name
    1605             :     character(len=255)                  :: filepath
    1606             :     real(kind=f)                        :: rwet
    1607             :     real(kind=f)                        :: rcore                ! CORE radius used in MIE calculation
    1608             :     real(kind=f)                        :: Qext
    1609             :     real(kind=f)                        :: Qsca
    1610             :     real(kind=f)                        :: asym
    1611             :     integer                             :: start_text(2), count_text(2)
    1612             :     integer                             :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var
    1613             :     integer                             :: ncsr, ndbr
    1614             :     integer                             :: cnsttype               ! constituent type
    1615             :     integer                             :: maxbin                 ! last prognostic bin
    1616             :     integer                             :: LUNOPRT              ! logical unit number for output
    1617             :     logical                             :: do_print             ! do print output?
    1618             :     integer                             :: ret
    1619             : 
    1620             :     character(len=32) :: elementname
    1621             : 
    1622             :     ! Assume success.
    1623           0 :     rc = 0
    1624             : 
    1625             :     ! Get the wavelength structure.
    1626           0 :     call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT)
    1627           0 :     if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.')
    1628             : 
    1629             :     ! Get the necessary group properties.
    1630             :     call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, &
    1631             :                         rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, imiertn=imiertn, &
    1632           0 :                         ienconc=ienconc, ncore=ncore, icorelem=icorelem, cnsttype=cnsttype, maxbin=maxbin)
    1633           0 :     if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.')
    1634             : 
    1635             :     ! The concentration element has the sulfate refractive index.
    1636           0 :     call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidxS)
    1637           0 :     if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.')
    1638             : 
    1639             :     ! Need to find the dust and black carbon refractive indicies for the core.
    1640           0 :     do icore = 1, ncore
    1641           0 :       call CARMAELEMENT_Get(carma, icorelem(icore), rc, shortname=elementname, refidx=refidx)
    1642           0 :       if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.')
    1643             : 
    1644           0 :       if (trim(elementname) == 'MXBC') then
    1645           0 :         refidxB = refidx
    1646           0 :       else if (trim(elementname) == 'MXDUST') then
    1647           0 :         refidxD = refidx
    1648             :       end if
    1649             :     end do
    1650             : 
    1651             : 
    1652             :     ! A file needs to be created for each bin.
    1653           0 :     do ibin = 1, NBIN
    1654             : 
    1655             :       ! Bins past maxbin are treated as diagnostic even if the group
    1656             :       ! is prognostic and thus are not advected in the paerent model.
    1657           0 :       if (ibin <= maxbin) then
    1658             : 
    1659           0 :         write(c_name, '(A, I2.2)') trim(shortname), ibin
    1660             : 
    1661             :         ! Construct the path to the file. Each model will have its own subdirectory
    1662             :         ! where the optical property files are stored.
    1663           0 :         filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc'
    1664             : 
    1665           0 :         if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath)
    1666             : 
    1667             :         ! Create the file.
    1668           0 :         call wrap_create(filepath, NF90_CLOBBER, fid)
    1669             : 
    1670           0 :         ncsr = ncoreshellratio
    1671           0 :         ndbr = ndstbcratio
    1672             : 
    1673             :         ! Define the dimensions: rh, lwbands, swbands
    1674           0 :         call wrap_def_dim(fid, 'rh_idx',  NMIE_RH,  rhdim)
    1675           0 :         call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim)
    1676           0 :         call wrap_def_dim(fid, 'sw_band', nswbands, swdim)
    1677             : 
    1678           0 :         call wrap_def_dim(fid, 'coreshellratio', ncsr, csrdim)
    1679           0 :         call wrap_def_dim(fid, 'dstbcratio', ndbr, dstbcrdim)
    1680           0 :         call wrap_def_dim(fid, 'kap', nkap, kapdim)
    1681             : 
    1682           0 :         dimids(1) = rhdim
    1683           0 :         call wrap_def_var(fid, 'rh',  NF90_DOUBLE, 1, dimids(1), rhvar)
    1684           0 :         call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar)
    1685             : 
    1686           0 :         dimids(1) = lwdim
    1687           0 :         call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar)
    1688             : 
    1689           0 :         dimids(1) = swdim
    1690           0 :         call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar)
    1691             : 
    1692           0 :         dimids(1) = csrdim
    1693           0 :         call wrap_def_var(fid, 'coreshellratio', NF90_DOUBLE, 1, dimids(1), csr_var)
    1694           0 :         dimids(1) = dstbcrdim
    1695           0 :         call wrap_def_var(fid, 'dstbcratio', NF90_DOUBLE, 1, dimids(1), dstbcr_var)
    1696           0 :         dimids(1) = kapdim
    1697           0 :         call wrap_def_var(fid, 'kap', NF90_DOUBLE, 1, dimids(1), kap_var)
    1698             : 
    1699             : 
    1700           0 :         call wrap_put_att_text(fid, rhvar, 'units', 'fraction')
    1701           0 :         call wrap_put_att_text(fid, rwetvar, 'units', 'cm')
    1702           0 :         call wrap_put_att_text(fid, lwvar, 'units', 'm')
    1703           0 :         call wrap_put_att_text(fid, swvar, 'units', 'm')
    1704             : 
    1705           0 :         call wrap_put_att_text(fid, csr_var,'units', 'fraction')
    1706           0 :         call wrap_put_att_text(fid, dstbcr_var,'units', 'fraction')
    1707           0 :         call wrap_put_att_text(fid, kap_var,'units', 'unitless')
    1708           0 :         call wrap_put_att_text(fid, csr_var,'long_name', 'coreshell ratio')
    1709           0 :         call wrap_put_att_text(fid, dstbcr_var,'long_name', 'dust-bc ratio')
    1710           0 :         call wrap_put_att_text(fid, kap_var,'long_name', 'kappa value')
    1711             : 
    1712           0 :         call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity')
    1713           0 :         call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius')
    1714           0 :         call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands')
    1715           0 :         call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands')
    1716             : 
    1717             :         ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) LW optics properties: abs_lw_coreshell, qabs_lw_coreshell
    1718           0 :         dimids(1) = rhdim
    1719           0 :         dimids(2) = lwdim
    1720           0 :         dimids(3) = csrdim
    1721           0 :         dimids(4) = dstbcrdim
    1722           0 :         dimids(5) = kapdim
    1723           0 :         call wrap_def_var(fid, 'abs_lw_coreshell', NF90_DOUBLE, 5, dimids(1:5), abs_lw_coreshell_var)
    1724           0 :         call wrap_def_var(fid, 'qabs_lw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qabs_lw_coreshell_var)
    1725             : 
    1726           0 :         call wrap_put_att_text(fid, abs_lw_coreshell_var, 'units', 'meter^2 kilogram^-1')
    1727           0 :         call wrap_put_att_text(fid, qabs_lw_coreshell_var,'units', '-')
    1728             : 
    1729             :         ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) SW optics properties:
    1730             :         !  ext_sw_coreshell, qext_sw_coreshell, ssa_sw_coreshell, asm_sw_coreshell
    1731           0 :         dimids(1) = rhdim
    1732           0 :         dimids(2) = swdim
    1733           0 :         dimids(3) = csrdim
    1734           0 :         dimids(4) = dstbcrdim
    1735           0 :         dimids(5) = kapdim
    1736           0 :         call wrap_def_var(fid, 'ext_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ext_sw_coreshell_var)
    1737           0 :         call wrap_def_var(fid, 'qext_sw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qext_sw_coreshell_var)
    1738           0 :         call wrap_def_var(fid, 'ssa_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ssa_sw_coreshell_var)
    1739           0 :         call wrap_def_var(fid, 'asm_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), asm_sw_coreshell_var)
    1740             : 
    1741           0 :         call wrap_put_att_text(fid, ssa_sw_coreshell_var, 'units', 'fraction')
    1742           0 :         call wrap_put_att_text(fid, ext_sw_coreshell_var, 'units', 'meter^2 kilogram^-1')
    1743           0 :         call wrap_put_att_text(fid, qext_sw_coreshell_var,'units', '-')
    1744           0 :         call wrap_put_att_text(fid, asm_sw_coreshell_var, 'units', '-')
    1745             : 
    1746             :         ! Define the variables for the refractive indicies.
    1747           0 :         dimids(1) = swdim
    1748           0 :         call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var)
    1749           0 :         call wrap_def_var(fid, 'refindex_im_aer_sw',   NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var)
    1750             : 
    1751           0 :         dimids(1) = lwdim
    1752           0 :         call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var)
    1753           0 :         call wrap_def_var(fid, 'refindex_im_aer_lw',   NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var)
    1754             : 
    1755           0 :         call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-')
    1756           0 :         call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-')
    1757           0 :         call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-')
    1758           0 :         call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-')
    1759             : 
    1760           0 :         call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave')
    1761           0 :         call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave')
    1762           0 :         call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave')
    1763           0 :         call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave')
    1764             : 
    1765             :         ! Define fields that define the aerosol properties.
    1766           0 :         call wrap_def_dim(fid, 'opticsmethod_len',  32, omdim)
    1767           0 :         dimids(1) = omdim
    1768           0 :         call wrap_def_var(fid, 'opticsmethod',  NF90_CHAR, 1, dimids(1), omvar)
    1769             : 
    1770           0 :         call wrap_def_dim(fid, 'namelength',  20, andim)
    1771           0 :         dimids(1) = andim
    1772           0 :         call wrap_def_var(fid, 'aername',  NF90_CHAR, 1, dimids(1), anvar)
    1773             : 
    1774           0 :         call wrap_def_dim(fid, 'name_len',  32, namedim)
    1775           0 :         dimids(1) = namedim
    1776           0 :         call wrap_def_var(fid, 'name',  NF90_CHAR, 1, dimids, namevar)
    1777             : 
    1778           0 :         call wrap_def_var(fid, 'density',            NF90_DOUBLE, 0, dimids(1), denvar)
    1779           0 :         call wrap_def_var(fid, 'sigma_logr',         NF90_DOUBLE, 0, dimids(1), slogvar)
    1780           0 :         call wrap_def_var(fid, 'dryrad',             NF90_DOUBLE, 0, dimids(1), dryrvar)
    1781           0 :         call wrap_def_var(fid, 'radmin_aer',         NF90_DOUBLE, 0, dimids(1), rminvar)
    1782           0 :         call wrap_def_var(fid, 'radmax_aer',         NF90_DOUBLE, 0, dimids(1), rmaxvar)
    1783           0 :         call wrap_def_var(fid, 'hygroscopicity',     NF90_DOUBLE, 0, dimids(1), hygrovar)
    1784           0 :         call wrap_def_var(fid, 'num_to_mass_ratio',  NF90_DOUBLE, 0, dimids(1), ntmvar)
    1785             : 
    1786           0 :         call wrap_put_att_text(fid, denvar,   'units', 'kg m^-3')
    1787           0 :         call wrap_put_att_text(fid, slogvar,  'units', '-')
    1788           0 :         call wrap_put_att_text(fid, dryrvar,  'units', 'm')
    1789           0 :         call wrap_put_att_text(fid, rminvar,  'units', 'm')
    1790           0 :         call wrap_put_att_text(fid, rmaxvar,  'units', 'm')
    1791           0 :         call wrap_put_att_text(fid, hygrovar, 'units', '-')
    1792           0 :         call wrap_put_att_text(fid, ntmvar,   'units', 'kg^-1')
    1793             : 
    1794           0 :         call wrap_put_att_text(fid, denvar,   'long_name', 'aerosol material density')
    1795           0 :         call wrap_put_att_text(fid, slogvar,  'long_name', 'geometric standard deviation of aerosol')
    1796           0 :         call wrap_put_att_text(fid, dryrvar,  'long_name', 'dry number mode radius of aerosol')
    1797           0 :         call wrap_put_att_text(fid, rminvar,  'long_name', 'minimum dry radius of aerosol for bin')
    1798           0 :         call wrap_put_att_text(fid, rmaxvar,  'long_name', 'maximum dry radius of aerosol for bin')
    1799           0 :         call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol')
    1800           0 :         call wrap_put_att_text(fid, ntmvar,   'long_name', 'ratio of number to mass of aerosol')
    1801             : 
    1802             :         ! End the defintion phase of the netcdf file.
    1803           0 :         call wrap_enddef(fid)
    1804             : 
    1805             :         ! Write out the dimensions.
    1806           0 :         call wrap_put_var_realx(fid, rhvar, mie_rh(:NMIE_RH))
    1807           0 :         call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f)
    1808           0 :         call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f)
    1809             : 
    1810           0 :         call wrap_put_var_realx(fid, csr_var,coreshellratio(:ncsr))
    1811           0 :         call wrap_put_var_realx(fid, dstbcr_var,dstbcratio(:ndstbcratio))
    1812           0 :         call wrap_put_var_realx(fid, kap_var,kap(:nkap))
    1813             : 
    1814             :         ! Write out the refractive indicies.
    1815           0 :         call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidxS(nlwbands+1:, 1)))
    1816           0 :         call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidxS(nlwbands+1:, 1)))
    1817           0 :         call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidxS(:nlwbands, 1)))
    1818           0 :         call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidxS(:nlwbands, 1)))
    1819             : 
    1820             :         ! Pad the names out with spaces.
    1821           0 :         aer_name = '                                '
    1822           0 :         aer_name(1:len(trim(c_name))) = c_name
    1823             : 
    1824           0 :         start_text(1) = 1
    1825           0 :         count_text(1) = 32
    1826           0 :         call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /))
    1827           0 :         count_text(1) = 20
    1828           0 :         call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /))
    1829             : 
    1830           0 :         count_text(1) = len('hygroscopic_coreshell           ')
    1831           0 :         call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_coreshell           ' /))
    1832             : 
    1833           0 :         call wrap_put_var_realx(fid, denvar,   (/ rho(ibin) * 1e-3_f / 1e-6_f /))
    1834           0 :         call wrap_put_var_realx(fid, slogvar,  (/ 0._f /))
    1835           0 :         call wrap_put_var_realx(fid, dryrvar,  (/ r(ibin) * 1e-2_f /))
    1836           0 :         call wrap_put_var_realx(fid, rminvar,  (/ rlow(ibin) * 1e-2_f /))
    1837           0 :         call wrap_put_var_realx(fid, rmaxvar,  (/ rup(ibin) * 1e-2_f /))
    1838           0 :         call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /))
    1839           0 :         call wrap_put_var_realx(fid, ntmvar,   (/ 1._f / rmass(ibin) / 1e-3_f /))
    1840             : 
    1841             :         ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated
    1842             :         ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell
    1843             :         ! Modified by Pengfei Yu
    1844             :         ! April.1, 2012
    1845             : 
    1846             :         !--------------------------- for 5-D core-shell optical properties ----------------------------
    1847             : 
    1848             :         ! Iterate over a range of relative humidities, since the particle may swell
    1849             :         ! with relative humidity which will change its optical properties.
    1850           0 :         do irh = 1, NMIE_RH
    1851             : 
    1852           0 :           do ikap = 1, nkap
    1853             : 
    1854             :             ! Determine the wet radius.
    1855           0 :             call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc, kappa=kap(ikap), temp=270._f)
    1856           0 :             rwetbin(irh) = rwet
    1857             : 
    1858             :             ! Calculate at each wavelength.
    1859           0 :             do iwave = 1, NWAVE
    1860             : 
    1861             :               ! For now just assume BC/OC constant 15%
    1862             :               ! rcore = r(ibin)*(0.15**onethird)
    1863             :               ! Using Mie code, consider core/shell ratio
    1864           0 :               do icsr = 1, ncsr
    1865           0 :                 if (ncsr > 1) then
    1866           0 :                   rcore = r(ibin)*(coreshellratio(icsr)**onethird)
    1867             :                 else
    1868           0 :                   rcore = 0.0_f
    1869             :                 endif
    1870             : 
    1871             :                 ! Using Mie code, assume the particle is CORE-SHELL
    1872             :                 ! By: Pengfei Yu
    1873             :                 ! Mar.22, 2012
    1874             : 
    1875             :                 !write(*,*) 'before call mie-3D, icsr = ', icsr, ' ;iwave = ', iwave, ' ;irh = ', irh
    1876             :                 !write(*,*) 'ibin = ', ibin, ' ;rcore = ', rcore, ' ;csratio = ', coreshellratio(icsr)
    1877             : 
    1878           0 :                 do idb = 1, ndbr
    1879             : 
    1880             :                   ! NOTE: This is not the best way to combine the dust and BC refractive indices
    1881             :                   ! for the core. Volume mixing should be used for both the real and imaginary
    1882             :                   ! parts, not just the imaginary.
    1883             : !                  coreimagidx = dstbcratio(idb) * aimag(refidxB(iwave,1)) + (1._f - dstbcratio(idb)) * aimag(refidxD(iwave,1))
    1884             : !                  refidxC = cmplx((real(refidxD(iwave,1)) + real(refidxB(iwave,1))) / 2._f, coreimagidx)
    1885           0 :                   refidxC = dstbcratio(idb) * refidxB(iwave,1) + (1._f - dstbcratio(idb)) * refidxD(iwave,1)
    1886             : 
    1887             :                   call mie(carma, &
    1888             :                            imiertn, &
    1889             :                            rwet, &
    1890             :                            wave(iwave), &
    1891             :                            0._f, &
    1892             :                            3.0_f, &
    1893             :                            0.0_f, &
    1894             :                            1.0_f, &
    1895             :                            refidxS(iwave, 1), &
    1896             :                            rcore, &
    1897             :                            refidxC, &
    1898             :                            Qext, &
    1899             :                            Qsca, &
    1900             :                            asym, &
    1901           0 :                            rc)
    1902           0 :                   if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.')
    1903             : 
    1904             :                   ! Calculate  the shortwave and longwave properties?
    1905             :                   !
    1906             :                   ! NOTE: miess is in cgs units, but the optics file needs to be in mks
    1907             :                   ! units, so perform the necessary conversions.
    1908           0 :                   if (iwave <= nlwbands) then
    1909             : 
    1910             :                     ! Longwave just needs absorption: abs_lw.
    1911           0 :                     qabs_lw_coreshell(irh, iwave, icsr, idb, ikap) = (Qext - Qsca) ! absorption per particle
    1912             :                     abs_lw_coreshell (irh, iwave, icsr, idb, ikap) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 &
    1913           0 :                                                                       / (rmass(ibin) * 1e-3_f)
    1914             :                   else
    1915             : 
    1916             :                     ! Shortwave needs extinction, single scattering albedo and asymmetry factor:
    1917             :                     ! ext_sw, qext_sw, ssa_sw and asm_sw.
    1918           0 :                     qext_sw_coreshell(irh, iwave - nlwbands, icsr, idb, ikap) = Qext ! extinction per particle
    1919             :                     ext_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qext * PI * (rwet * 1e-2_f)**2 &
    1920           0 :                                                                                 / (rmass(ibin) * 1e-3_f)
    1921           0 :                     ssa_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qsca / Qext
    1922           0 :                     asm_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = asym
    1923             :                   end if
    1924             :                 end do   ! idb
    1925             :               end do       ! icsr
    1926             :             end do   ! iwave
    1927             :           end do      ! ikap
    1928             :         end do     ! irh
    1929             : 
    1930           0 :         call wrap_put_var_realx(fid, rwetvar, rwetbin(:))
    1931             : 
    1932             :         ! Write out the longwave fields.
    1933           0 :         ret = nf90_put_var(fid, abs_lw_coreshell_var, abs_lw_coreshell (:, :, :, :, :))
    1934           0 :         if (ret /= NF90_NOERR) then
    1935           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', abs_lw_coreshell_var
    1936           0 :            call handle_error(ret)
    1937             :         end if
    1938             : 
    1939           0 :         ret = nf90_put_var(fid, qabs_lw_coreshell_var,  qabs_lw_coreshell(:, :, :, :, :))
    1940           0 :         if (ret /= NF90_NOERR) then
    1941           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qabs_lw_coreshell_var
    1942           0 :            call handle_error(ret)
    1943             :         end if
    1944             : 
    1945             :         ! Write out the shortwave fields.
    1946           0 :         ret = nf90_put_var(fid, ext_sw_coreshell_var,   ext_sw_coreshell (:, :, :, :, :))
    1947           0 :         if (ret /= NF90_NOERR) then
    1948           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ext_sw_coreshell_var
    1949           0 :            call handle_error(ret)
    1950             :         end if
    1951             : 
    1952           0 :         ret = nf90_put_var(fid, qext_sw_coreshell_var,  qext_sw_coreshell(:, :, :, :, :))
    1953           0 :         if (ret /= NF90_NOERR) then
    1954           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qext_sw_coreshell_var
    1955           0 :            call handle_error(ret)
    1956             :         end if
    1957             : 
    1958           0 :         ret = nf90_put_var(fid, ssa_sw_coreshell_var,   ssa_sw_coreshell (:, :, :, :, :))
    1959           0 :         if (ret /= NF90_NOERR) then
    1960           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ssa_sw_coreshell_var
    1961           0 :            call handle_error(ret)
    1962             :         end if
    1963             : 
    1964           0 :         ret = nf90_put_var(fid, asm_sw_coreshell_var,   asm_sw_coreshell (:, :, :, :, :))
    1965           0 :         if (ret /= NF90_NOERR) then
    1966           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', asm_sw_coreshell_var
    1967           0 :            call handle_error(ret)
    1968             :         end if
    1969             : 
    1970             :         ! Close the file.
    1971           0 :         call wrap_close(fid)
    1972             :       end if
    1973             :     end do
    1974             : 
    1975           0 :     return
    1976             :   end subroutine CARMAMODEL_CreateOpticsFile_MixedYu
    1977             : 
    1978             :   !! This routine creates files containing optical properties for the mixed group
    1979             :   !! following Yu et al. (2015), except that it includes water vapor in the shell.
    1980             :   !! The difference between the wet and dry radius is assumed to be water valor and
    1981             :   !! the shell is a volume mix of the H2SO4 and the water. These optical properties
    1982             :   !! are used by the RRTMG radiation code to include the impact of CARMA particles
    1983             :   !! in the radiative transfer calculation.
    1984             :   !!
    1985             :   !! NOTE: The table structure is the same as for MixedYu, so no changes need to be
    1986             :   !! made on the CAM side to use these optics.
    1987           0 :   subroutine CARMAMODEL_CreateOpticsFile_MixedYuH2o(carma, igroup, rc)
    1988             :     use radconstants, only : nswbands, nlwbands
    1989             :     use wrap_nf
    1990             :     use wetr, only         : getwetr
    1991             : 
    1992             :     implicit none
    1993             : 
    1994             :     type(carma_type), intent(inout)     :: carma         !! the carma object
    1995             :     integer, intent(in)                 :: igroup        !! group index
    1996             :     integer, intent(out)                :: rc            !! return code, negative indicates failure
    1997             : 
    1998             :     !! Core-shell mixing method for mie and radiation calculations for the Yu et al. (2015)
    1999             :     !! style table. The CAM optics code will interpolate based upon the current core/shell
    2000             :     !! mass ratio from a table built using the specified core/shell.
    2001             :     integer, parameter                  :: ncoreshellratio  = 9               !! Number of core/shell ratio for mie calculations
    2002             :     integer, parameter                  :: ndstbcratio = 8
    2003             :     integer, parameter                  :: nkap = 9
    2004             : 
    2005             :     real(kind=f)                        :: coreshellratio(ncoreshellratio) = (/ 0.001_f, 0.00237_f, 0.00562_f, 0.01333_f, 0.03162_f, 0.07499_f, 0.17782_f, 0.42169_f, 1.0_f /)
    2006             :     real(kind=f)                                    :: dstbcratio(ndstbcratio) = (/ 0.01_f, 0.025_f, 0.063_f, 0.1_f, 0.3_f, 0.5_f, 0.7_f, 0.9_f/)
    2007             :     real(kind=f)                                    :: kap(nkap) = (/ 0.1_f, 0.2_f, 0.3_f, 0.4_f, 0.5_f, 0.7_f, 0.9_f, 1.1_f, 1.2_f/)
    2008             : 
    2009             :     ! Local variables
    2010             :     integer                             :: ibin, iwave, irh, icsr, idb, ikap, icore, ncore
    2011             :     integer                             :: icorelem(NELEM)
    2012             :     integer                             :: irhswell
    2013             :     integer                             :: imiertn
    2014             :     integer                             :: ienconc
    2015             :     real(kind=f)                        :: rho(NBIN), rhopwet
    2016             :     real(kind=f)                        :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN)
    2017             :     real(kind=f)                        :: wave(NWAVE)
    2018             :     complex(kind=f)                     :: refidx(NWAVE, NREFIDX)
    2019             :     complex(kind=f)                     :: refidxS(NWAVE, NREFIDX)
    2020             :     complex(kind=f)                     :: refidxB(NWAVE, NREFIDX)
    2021             :     complex(kind=f)                     :: refidxD(NWAVE, NREFIDX)
    2022             :     complex(kind=f)                     :: refidxW(NWAVE)
    2023             :     complex(kind=f)                     :: refidxC
    2024             :     complex(kind=f)                     :: refidxSH
    2025             :     !real(kind=f) :: coreimagidx
    2026             :     character(len=CARMA_NAME_LEN)       :: name
    2027             :     character(len=CARMA_SHORT_NAME_LEN) :: shortname
    2028             :     logical                             :: do_mie
    2029             :     integer                             :: fid
    2030             :     integer                             :: rhdim, lwdim, swdim, csrdim, dstbcrdim, kapdim
    2031             :     integer                             :: rhvar, lwvar, swvar, csr_var, dstbcr_var, kap_var
    2032             :     integer                             :: abs_lw_coreshell_var, qabs_lw_coreshell_var
    2033             :     integer                             :: ext_sw_coreshell_var, ssa_sw_coreshell_var, asm_sw_coreshell_var, qext_sw_coreshell_var
    2034             :     integer                             :: rwetvar
    2035             :     integer                             :: omdim, andim, namedim
    2036             :     integer                             :: omvar, anvar, namevar
    2037             :     integer                             :: dimids(5)
    2038             :     integer                             :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar
    2039             :     real(kind=f)                        :: abs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap)
    2040             :     real(kind=f)                        :: qabs_lw_coreshell(NMIE_RH, nlwbands, ncoreshellratio, ndstbcratio, nkap)
    2041             :     real(kind=f)                        :: ext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap)
    2042             :     real(kind=f)                        :: qext_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap)
    2043             :     real(kind=f)                        :: ssa_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap)
    2044             :     real(kind=f)                        :: asm_sw_coreshell(NMIE_RH, nswbands, ncoreshellratio, ndstbcratio, nkap)
    2045             :     real(kind=f)                        :: rwetbin(NMIE_RH)
    2046             :     character(len=8)                    :: c_name                   ! constituent name
    2047             :     character(len=32)                   :: aer_name                 ! long enough for both aername and name
    2048             :     character(len=255)                  :: filepath
    2049             :     real(kind=f)                        :: rwet
    2050             :     real(kind=f)                        :: rcore                ! CORE radius used in MIE calculation
    2051             :     real(kind=f)                        :: Qext
    2052             :     real(kind=f)                        :: Qsca
    2053             :     real(kind=f)                        :: asym
    2054             :     integer                             :: start_text(2), count_text(2)
    2055             :     integer                             :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var
    2056             :     integer                             :: ncsr, ndbr
    2057             :     integer                             :: cnsttype               ! constituent type
    2058             :     integer                             :: maxbin                 ! last prognostic bin
    2059             :     integer                             :: LUNOPRT              ! logical unit number for output
    2060             :     logical                             :: do_print             ! do print output?
    2061             :     integer                             :: ret
    2062             :     real(kind=f)                        :: volwater
    2063             :     real(kind=f)                        :: volsulfate
    2064             :     real(kind=f)                        :: volshell
    2065             :     integer                             :: igash2o
    2066             : 
    2067             :     character(len=32) :: elementname
    2068             : 
    2069             :     ! Assume success.
    2070           0 :     rc = 0
    2071             : 
    2072             :     ! Get the wavelength structure.
    2073           0 :     call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT, igash2o=igash2o)
    2074           0 :     if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.')
    2075             : 
    2076             :     ! Get the necessary group properties.
    2077             :     call CARMAGROUP_Get(carma, igroup, rc, do_mie=do_mie, name=name, shortname=shortname, r=r, &
    2078             :                         rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, imiertn=imiertn, &
    2079           0 :                         ienconc=ienconc, ncore=ncore, icorelem=icorelem, cnsttype=cnsttype, maxbin=maxbin)
    2080           0 :     if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.')
    2081             : 
    2082             :     ! The concentration element has the sulfate refractive index.
    2083           0 :     call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidxS)
    2084           0 :     if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.')
    2085             : 
    2086             :     ! Need to find the dust and black carbon refractive indicies for the core.
    2087           0 :     do icore = 1, ncore
    2088           0 :       call CARMAELEMENT_Get(carma, icorelem(icore), rc, shortname=elementname, refidx=refidx)
    2089           0 :       if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.')
    2090             : 
    2091           0 :       if (trim(elementname) == 'MXBC') then
    2092           0 :         refidxB = refidx
    2093           0 :       else if (trim(elementname) == 'MXDUST') then
    2094           0 :         refidxD = refidx
    2095             :       end if
    2096             :     end do
    2097             : 
    2098             :     ! Get the refractive index for water.
    2099           0 :     call CARMAGAS_Get(carma, igash2o, rc, refidx=refidxW)
    2100           0 :     if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGAS_Get failed.')
    2101             : 
    2102           0 :     refidxW(:) = CMPLX(waterreal(:), waterimag(:), kind=f)
    2103             : 
    2104             :     ! A file needs to be created for each bin.
    2105           0 :     do ibin = 1, NBIN
    2106             : 
    2107             :       ! Bins past maxbin are treated as diagnostic even if the group
    2108             :       ! is prognostic and thus are not advected in the paerent model.
    2109           0 :       if (ibin <= maxbin) then
    2110             : 
    2111           0 :         write(c_name, '(A, I2.2)') trim(shortname), ibin
    2112             : 
    2113             :         ! Construct the path to the file. Each model will have its own subdirectory
    2114             :         ! where the optical property files are stored.
    2115           0 :         filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc'
    2116             : 
    2117           0 :         if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath)
    2118             : 
    2119             :         ! Create the file.
    2120           0 :         call wrap_create(filepath, NF90_CLOBBER, fid)
    2121             : 
    2122           0 :         ncsr = ncoreshellratio
    2123           0 :         ndbr = ndstbcratio
    2124             : 
    2125             :         ! Define the dimensions: rh, lwbands, swbands
    2126           0 :         call wrap_def_dim(fid, 'rh_idx',  NMIE_RH,  rhdim)
    2127           0 :         call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim)
    2128           0 :         call wrap_def_dim(fid, 'sw_band', nswbands, swdim)
    2129             : 
    2130           0 :         call wrap_def_dim(fid, 'coreshellratio', ncsr, csrdim)
    2131           0 :         call wrap_def_dim(fid, 'dstbcratio', ndbr, dstbcrdim)
    2132           0 :         call wrap_def_dim(fid, 'kap', nkap, kapdim)
    2133             : 
    2134           0 :         dimids(1) = rhdim
    2135           0 :         call wrap_def_var(fid, 'rh',  NF90_DOUBLE, 1, dimids(1), rhvar)
    2136           0 :         call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar)
    2137             : 
    2138           0 :         dimids(1) = lwdim
    2139           0 :         call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar)
    2140             : 
    2141           0 :         dimids(1) = swdim
    2142           0 :         call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar)
    2143             : 
    2144           0 :         dimids(1) = csrdim
    2145           0 :         call wrap_def_var(fid, 'coreshellratio', NF90_DOUBLE, 1, dimids(1), csr_var)
    2146           0 :         dimids(1) = dstbcrdim
    2147           0 :         call wrap_def_var(fid, 'dstbcratio', NF90_DOUBLE, 1, dimids(1), dstbcr_var)
    2148           0 :         dimids(1) = kapdim
    2149           0 :         call wrap_def_var(fid, 'kap', NF90_DOUBLE, 1, dimids(1), kap_var)
    2150             : 
    2151             : 
    2152           0 :         call wrap_put_att_text(fid, rhvar, 'units', 'fraction')
    2153           0 :         call wrap_put_att_text(fid, rwetvar, 'units', 'cm')
    2154           0 :         call wrap_put_att_text(fid, lwvar, 'units', 'm')
    2155           0 :         call wrap_put_att_text(fid, swvar, 'units', 'm')
    2156             : 
    2157           0 :         call wrap_put_att_text(fid, csr_var,'units', 'fraction')
    2158           0 :         call wrap_put_att_text(fid, dstbcr_var,'units', 'fraction')
    2159           0 :         call wrap_put_att_text(fid, kap_var,'units', 'unitless')
    2160           0 :         call wrap_put_att_text(fid, csr_var,'long_name', 'coreshell ratio')
    2161           0 :         call wrap_put_att_text(fid, dstbcr_var,'long_name', 'dust-bc ratio')
    2162           0 :         call wrap_put_att_text(fid, kap_var,'long_name', 'kappa value')
    2163             : 
    2164           0 :         call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity')
    2165           0 :         call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius')
    2166           0 :         call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands')
    2167           0 :         call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands')
    2168             : 
    2169             :         ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) LW optics properties: abs_lw_coreshell, qabs_lw_coreshell
    2170           0 :         dimids(1) = rhdim
    2171           0 :         dimids(2) = lwdim
    2172           0 :         dimids(3) = csrdim
    2173           0 :         dimids(4) = dstbcrdim
    2174           0 :         dimids(5) = kapdim
    2175           0 :         call wrap_def_var(fid, 'abs_lw_coreshell', NF90_DOUBLE, 5, dimids(1:5), abs_lw_coreshell_var)
    2176           0 :         call wrap_def_var(fid, 'qabs_lw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qabs_lw_coreshell_var)
    2177             : 
    2178           0 :         call wrap_put_att_text(fid, abs_lw_coreshell_var, 'units', 'meter^2 kilogram^-1')
    2179           0 :         call wrap_put_att_text(fid, qabs_lw_coreshell_var,'units', '-')
    2180             : 
    2181             :         ! Define 3-dimension (:nrh,:nswbands,:ncoreshellratio) SW optics properties:
    2182             :         !    ext_sw_coreshell, qext_sw_coreshell, ssa_sw_coreshell, asm_sw_coreshell
    2183           0 :         dimids(1) = rhdim
    2184           0 :         dimids(2) = swdim
    2185           0 :         dimids(3) = csrdim
    2186           0 :         dimids(4) = dstbcrdim
    2187           0 :         dimids(5) = kapdim
    2188           0 :         call wrap_def_var(fid, 'ext_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ext_sw_coreshell_var)
    2189           0 :         call wrap_def_var(fid, 'qext_sw_coreshell',NF90_DOUBLE, 5, dimids(1:5), qext_sw_coreshell_var)
    2190           0 :         call wrap_def_var(fid, 'ssa_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), ssa_sw_coreshell_var)
    2191           0 :         call wrap_def_var(fid, 'asm_sw_coreshell', NF90_DOUBLE, 5, dimids(1:5), asm_sw_coreshell_var)
    2192             : 
    2193           0 :         call wrap_put_att_text(fid, ssa_sw_coreshell_var, 'units', 'fraction')
    2194           0 :         call wrap_put_att_text(fid, ext_sw_coreshell_var, 'units', 'meter^2 kilogram^-1')
    2195           0 :         call wrap_put_att_text(fid, qext_sw_coreshell_var,'units', '-')
    2196           0 :         call wrap_put_att_text(fid, asm_sw_coreshell_var, 'units', '-')
    2197             : 
    2198             :         ! Define the variables for the refractive indicies.
    2199           0 :         dimids(1) = swdim
    2200           0 :         call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var)
    2201           0 :         call wrap_def_var(fid, 'refindex_im_aer_sw',   NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var)
    2202             : 
    2203           0 :         dimids(1) = lwdim
    2204           0 :         call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var)
    2205           0 :         call wrap_def_var(fid, 'refindex_im_aer_lw',   NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var)
    2206             : 
    2207           0 :         call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-')
    2208           0 :         call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-')
    2209           0 :         call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-')
    2210           0 :         call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-')
    2211             : 
    2212           0 :         call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave')
    2213           0 :         call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave')
    2214           0 :         call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave')
    2215           0 :         call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave')
    2216             : 
    2217             :         ! Define fields that define the aerosol properties.
    2218           0 :         call wrap_def_dim(fid, 'opticsmethod_len',  32, omdim)
    2219           0 :         dimids(1) = omdim
    2220           0 :         call wrap_def_var(fid, 'opticsmethod',  NF90_CHAR, 1, dimids(1), omvar)
    2221             : 
    2222           0 :         call wrap_def_dim(fid, 'namelength',  20, andim)
    2223           0 :         dimids(1) = andim
    2224           0 :         call wrap_def_var(fid, 'aername',  NF90_CHAR, 1, dimids(1), anvar)
    2225             : 
    2226           0 :         call wrap_def_dim(fid, 'name_len',  32, namedim)
    2227           0 :         dimids(1) = namedim
    2228           0 :         call wrap_def_var(fid, 'name',  NF90_CHAR, 1, dimids, namevar)
    2229             : 
    2230           0 :         call wrap_def_var(fid, 'density',            NF90_DOUBLE, 0, dimids(1), denvar)
    2231           0 :         call wrap_def_var(fid, 'sigma_logr',         NF90_DOUBLE, 0, dimids(1), slogvar)
    2232           0 :         call wrap_def_var(fid, 'dryrad',             NF90_DOUBLE, 0, dimids(1), dryrvar)
    2233           0 :         call wrap_def_var(fid, 'radmin_aer',         NF90_DOUBLE, 0, dimids(1), rminvar)
    2234           0 :         call wrap_def_var(fid, 'radmax_aer',         NF90_DOUBLE, 0, dimids(1), rmaxvar)
    2235           0 :         call wrap_def_var(fid, 'hygroscopicity',     NF90_DOUBLE, 0, dimids(1), hygrovar)
    2236           0 :         call wrap_def_var(fid, 'num_to_mass_ratio',  NF90_DOUBLE, 0, dimids(1), ntmvar)
    2237             : 
    2238           0 :         call wrap_put_att_text(fid, denvar,   'units', 'kg m^-3')
    2239           0 :         call wrap_put_att_text(fid, slogvar,  'units', '-')
    2240           0 :         call wrap_put_att_text(fid, dryrvar,  'units', 'm')
    2241           0 :         call wrap_put_att_text(fid, rminvar,  'units', 'm')
    2242           0 :         call wrap_put_att_text(fid, rmaxvar,  'units', 'm')
    2243           0 :         call wrap_put_att_text(fid, hygrovar, 'units', '-')
    2244           0 :         call wrap_put_att_text(fid, ntmvar,   'units', 'kg^-1')
    2245             : 
    2246           0 :         call wrap_put_att_text(fid, denvar,   'long_name', 'aerosol material density')
    2247           0 :         call wrap_put_att_text(fid, slogvar,  'long_name', 'geometric standard deviation of aerosol')
    2248           0 :         call wrap_put_att_text(fid, dryrvar,  'long_name', 'dry number mode radius of aerosol')
    2249           0 :         call wrap_put_att_text(fid, rminvar,  'long_name', 'minimum dry radius of aerosol for bin')
    2250           0 :         call wrap_put_att_text(fid, rmaxvar,  'long_name', 'maximum dry radius of aerosol for bin')
    2251           0 :         call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol')
    2252           0 :         call wrap_put_att_text(fid, ntmvar,   'long_name', 'ratio of number to mass of aerosol')
    2253             : 
    2254             :         ! End the defintion phase of the netcdf file.
    2255           0 :         call wrap_enddef(fid)
    2256             : 
    2257             :         ! Write out the dimensions.
    2258           0 :         call wrap_put_var_realx(fid, rhvar, mie_rh(:NMIE_RH))
    2259           0 :         call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f)
    2260           0 :         call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f)
    2261             : 
    2262           0 :         call wrap_put_var_realx(fid, csr_var,coreshellratio(:ncsr))
    2263           0 :         call wrap_put_var_realx(fid, dstbcr_var,dstbcratio(:ndstbcratio))
    2264           0 :         call wrap_put_var_realx(fid, kap_var,kap(:nkap))
    2265             : 
    2266             :         ! Write out the refractive indicies.
    2267           0 :         call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidxS(nlwbands+1:, 1)))
    2268           0 :         call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidxS(nlwbands+1:, 1)))
    2269           0 :         call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidxS(:nlwbands, 1)))
    2270           0 :         call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidxS(:nlwbands, 1)))
    2271             : 
    2272             :         ! Pad the names out with spaces.
    2273           0 :         aer_name = '                                '
    2274           0 :         aer_name(1:len(trim(c_name))) = c_name
    2275             : 
    2276           0 :         start_text(1) = 1
    2277           0 :         count_text(1) = 32
    2278           0 :         call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /))
    2279           0 :         count_text(1) = 20
    2280           0 :         call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /))
    2281             : 
    2282           0 :         count_text(1) = len('hygroscopic_coreshell           ')
    2283           0 :         call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_coreshell           ' /))
    2284             : 
    2285           0 :         call wrap_put_var_realx(fid, denvar,   (/ rho(ibin) * 1e-3_f / 1e-6_f /))
    2286           0 :         call wrap_put_var_realx(fid, slogvar,  (/ 0._f /))
    2287           0 :         call wrap_put_var_realx(fid, dryrvar,  (/ r(ibin) * 1e-2_f /))
    2288           0 :         call wrap_put_var_realx(fid, rminvar,  (/ rlow(ibin) * 1e-2_f /))
    2289           0 :         call wrap_put_var_realx(fid, rmaxvar,  (/ rup(ibin) * 1e-2_f /))
    2290           0 :         call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /))
    2291           0 :         call wrap_put_var_realx(fid, ntmvar,   (/ 1._f / rmass(ibin) / 1e-3_f /))
    2292             : 
    2293             :         ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated
    2294             :         ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell
    2295             :         ! Modified by Pengfei Yu
    2296             :         ! April.1, 2012
    2297             : 
    2298             :         !--------------------------- for 5-D core-shell optical properties ----------------------------
    2299             : 
    2300             :         ! Iterate over a range of relative humidities, since the particle may swell
    2301             :         ! with relative humidity which will change its optical properties.
    2302           0 :         do irh = 1, NMIE_RH
    2303             : 
    2304           0 :           do ikap = 1, nkap
    2305             : 
    2306             :             ! Determine the wet radius.
    2307           0 :             call getwetr(carma, igroup, mie_rh(irh), r(ibin), rwet, rho(ibin), rhopwet, rc, kappa=kap(ikap), temp=270._f)
    2308           0 :             rwetbin(irh) = rwet
    2309             : 
    2310             :             ! Calculate at each wavelength.
    2311           0 :             do iwave = 1, NWAVE
    2312             : 
    2313             :               ! For now just assume BC/OC constant 15%
    2314             :               ! rcore = r(ibin)*(0.15**onethird)
    2315             :               ! Using Mie code, consider core/shell ratio
    2316           0 :               do icsr = 1, ncsr
    2317           0 :                 if (ncsr > 1) then
    2318           0 :                   rcore = r(ibin)*(coreshellratio(icsr)**onethird)
    2319             :                 else
    2320           0 :                   rcore = 0.0_f
    2321             :                 endif
    2322             : 
    2323             :                 ! This is not in Yu (2015), but rather than using the refractive
    2324             :                 ! index of H2SO4 for the shell, do a volume mix of water and H2SO4
    2325             :                 ! for the refractive index of the shell.
    2326           0 :                 volwater = rwet**3._f - r(ibin)**3._f
    2327           0 :                 volsulfate = r(ibin)**3._f * (1._f - coreshellratio(icsr))
    2328           0 :                 volshell = volwater + volsulfate
    2329           0 :                 if (volshell > 0._f) then
    2330           0 :                   refidxSH = (volwater / volshell) * refidxW(iwave) + (volsulfate / volshell) * refidxS(iwave, 1)
    2331             :                 else
    2332           0 :                   refidxSH = refidxS(iwave, 1)
    2333             :                 end if
    2334             : 
    2335             :                 ! Using Mie code, assume the particle is CORE-SHELL
    2336             :                 ! By: Pengfei Yu
    2337             :                 ! Mar.22, 2012
    2338             : 
    2339             :                 !write(*,*) 'before call mie-3D, icsr = ', icsr, ' ;iwave = ', iwave, ' ;irh = ', irh
    2340             :                 !write(*,*) 'ibin = ', ibin, ' ;rcore = ', rcore, ' ;csratio = ', coreshellratio(icsr)
    2341             : 
    2342           0 :                 do idb = 1, ndbr
    2343             : 
    2344             :                   ! NOTE: This is not the best way to combine the dust and BC refractive indices
    2345             :                   ! for the core. Volume mixing should be used for both the real and imaginary
    2346             :                   ! parts, not just the imaginary.
    2347             : !                  coreimagidx = dstbcratio(idb) * aimag(refidxB(iwave,1)) + (1._f - dstbcratio(idb)) * aimag(refidxD(iwave,1))
    2348             : !                  refidxC = cmplx((real(refidxD(iwave,1)) + real(refidxB(iwave,1))) / 2._f, coreimagidx)
    2349           0 :                   refidxC = dstbcratio(idb) * refidxB(iwave,1) + (1._f - dstbcratio(idb)) * refidxD(iwave,1)
    2350             : 
    2351             :                   call mie(carma, &
    2352             :                            imiertn, &
    2353             :                            rwet, &
    2354             :                            wave(iwave), &
    2355             :                            0._f, &
    2356             :                            3.0_f, &
    2357             :                            0.0_f, &
    2358             :                            1.0_f, &
    2359             :                            refidxSH, &
    2360             :                            rcore, &
    2361             :                            refidxC, &
    2362             :                            Qext, &
    2363             :                            Qsca, &
    2364             :                            asym, &
    2365           0 :                            rc)
    2366           0 :                   if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.')
    2367             : 
    2368             :                   ! Calculate  the shortwave and longwave properties?
    2369             :                   !
    2370             :                   ! NOTE: miess is in cgs units, but the optics file needs to be in mks
    2371             :                   ! units, so perform the necessary conversions.
    2372           0 :                   if (iwave <= nlwbands) then
    2373             : 
    2374             :                     ! Longwave just needs absorption: abs_lw.
    2375           0 :                     qabs_lw_coreshell(irh, iwave, icsr, idb, ikap) = (Qext - Qsca)                            ! absorption per particle
    2376           0 :                     abs_lw_coreshell (irh, iwave, icsr, idb, ikap) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f)
    2377             :                   else
    2378             : 
    2379             :                     ! Shortwave needs extinction, single scattering albedo and asymmetry factor:
    2380             :                     ! ext_sw, qext_sw, ssa_sw and asm_sw.
    2381           0 :                     qext_sw_coreshell(irh, iwave - nlwbands, icsr, idb, ikap) = Qext                          ! extinction per particle
    2382           0 :                     ext_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f)
    2383           0 :                     ssa_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = Qsca / Qext
    2384           0 :                     asm_sw_coreshell (irh, iwave - nlwbands, icsr, idb, ikap) = asym
    2385             :                   end if
    2386             :                 end do   ! idb
    2387             :               end do       ! icsr
    2388             :             end do   ! iwave
    2389             :           end do      ! ikap
    2390             :         end do     ! irh
    2391             : 
    2392           0 :         call wrap_put_var_realx(fid, rwetvar, rwetbin(:))
    2393             : 
    2394             :         ! Write out the longwave fields.
    2395           0 :         ret = nf90_put_var(fid, abs_lw_coreshell_var, abs_lw_coreshell (:, :, :, :, :))
    2396           0 :         if (ret /= NF90_NOERR) then
    2397           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', abs_lw_coreshell_var
    2398           0 :            call handle_error(ret)
    2399             :         end if
    2400             : 
    2401           0 :         ret = nf90_put_var(fid, qabs_lw_coreshell_var,  qabs_lw_coreshell(:, :, :, :, :))
    2402           0 :         if (ret /= NF90_NOERR) then
    2403           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qabs_lw_coreshell_var
    2404           0 :            call handle_error(ret)
    2405             :         end if
    2406             : 
    2407             :         ! Write out the shortwave fields.
    2408           0 :         ret = nf90_put_var(fid, ext_sw_coreshell_var,   ext_sw_coreshell (:, :, :, :, :))
    2409           0 :         if (ret /= NF90_NOERR) then
    2410           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ext_sw_coreshell_var
    2411           0 :            call handle_error(ret)
    2412             :         end if
    2413             : 
    2414           0 :         ret = nf90_put_var(fid, qext_sw_coreshell_var,  qext_sw_coreshell(:, :, :, :, :))
    2415           0 :         if (ret /= NF90_NOERR) then
    2416           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', qext_sw_coreshell_var
    2417           0 :            call handle_error(ret)
    2418             :         end if
    2419             : 
    2420           0 :         ret = nf90_put_var(fid, ssa_sw_coreshell_var,   ssa_sw_coreshell (:, :, :, :, :))
    2421           0 :         if (ret /= NF90_NOERR) then
    2422           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', ssa_sw_coreshell_var
    2423           0 :            call handle_error(ret)
    2424             :         end if
    2425             : 
    2426           0 :         ret = nf90_put_var(fid, asm_sw_coreshell_var,   asm_sw_coreshell (:, :, :, :, :))
    2427           0 :         if (ret /= NF90_NOERR) then
    2428           0 :            write(iulog,*)'CARMA_CreateOpticsFile_MixedYu: error writing varid =', asm_sw_coreshell_var
    2429           0 :            call handle_error(ret)
    2430             :         end if
    2431             : 
    2432             :         ! Close the file.
    2433           0 :         call wrap_close(fid)
    2434             :       end if
    2435             :     end do
    2436             : 
    2437           0 :     return
    2438           0 :   end subroutine CARMAMODEL_CreateOpticsFile_MixedYuH2o
    2439             : 
    2440             : 
    2441             :   !! This routine creates files containing optical properties for the pure sulfate group
    2442             :   !! following Yu et al. (2015). These optical properties are used by the RRTMG radiation
    2443             :   !! code to include the impact of CARMA particles in the radiative transfer
    2444             :   !! calculation.
    2445           0 :   subroutine CARMAMODEL_CreateOpticsFile_SulfateYu(carma, igroup, rc)
    2446             :     use radconstants, only : nswbands, nlwbands
    2447             :     use wrap_nf
    2448             :     use wetr, only         : getwetr
    2449             : 
    2450             :     implicit none
    2451             : 
    2452             :     type(carma_type), intent(inout)     :: carma         !! the carma object
    2453             :     integer, intent(in)                 :: igroup        !! group index
    2454             :     integer, intent(out)                :: rc            !! return code, negative indicates failure
    2455             : 
    2456             :     ! Local variables
    2457             :     integer                             :: ibin, iwave, iwtp
    2458             :     integer                             :: irhswell
    2459             :     integer                             :: imiertn
    2460             :     integer                             :: ienconc
    2461             :     real(kind=f)                        :: rho(NBIN), rhopwet
    2462             :     real(kind=f)                        :: r(NBIN), rmass(NBIN), rlow(NBIN), rup(NBIN)
    2463             :     real(kind=f)                        :: wave(NWAVE)
    2464             :     complex(kind=f)                     :: refidx(NWAVE, NREFIDX)
    2465             :     character(len=CARMA_NAME_LEN)       :: name
    2466             :     character(len=CARMA_SHORT_NAME_LEN) :: shortname
    2467             :     integer                             :: fid
    2468             :     integer                             :: rhdim, lwdim, swdim, wtpdim
    2469             :     integer                             :: rhvar, lwvar, swvar, wtp_var
    2470             :     integer                             :: rwetvar
    2471             :     integer                             :: abs_lw_wtp_var, qabs_lw_wtp_var
    2472             :     integer                             :: ext_sw_wtp_var, ssa_sw_wtp_var, asm_sw_wtp_var, qext_sw_wtp_var
    2473             :     integer                             :: omdim, andim, namedim
    2474             :     integer                             :: omvar, anvar, namevar
    2475             :     integer                             :: dimids(2)
    2476             :     integer                             :: denvar, slogvar, dryrvar, rminvar, rmaxvar, hygrovar, ntmvar
    2477             :     real(kind=f)                        :: abs_lw_wtp(NMIE_WTP, nlwbands)
    2478             :     real(kind=f)                        :: qabs_lw_wtp(NMIE_WTP, nlwbands)
    2479             :     real(kind=f)                        :: ext_sw_wtp(NMIE_WTP, nswbands)
    2480             :     real(kind=f)                        :: qext_sw_wtp(NMIE_WTP, nswbands)
    2481             :     real(kind=f)                        :: ssa_sw_wtp(NMIE_WTP, nswbands)
    2482             :     real(kind=f)                        :: asm_sw_wtp(NMIE_WTP, nswbands)
    2483             :     character(len=8)                    :: c_name                   ! constituent name
    2484             :     character(len=32)                   :: aer_name                 ! long enough for both aername and name
    2485             :     character(len=255)                  :: filepath
    2486             :     real(kind=f)                        :: rwet
    2487             :     real(kind=f)                        :: Qext
    2488             :     real(kind=f)                        :: Qsca
    2489             :     real(kind=f)                        :: asym
    2490             :     integer                             :: start_text(2), count_text(2)
    2491             :     integer                             :: sw_r_refidx_var, sw_i_refidx_var, lw_r_refidx_var, lw_i_refidx_var
    2492             :     integer                             :: cnsttype               ! constituent type
    2493             :     integer                             :: maxbin                 ! last prognostic bin
    2494             :     integer                             :: LUNOPRT              ! logical unit number for output
    2495             :     logical                             :: do_print             ! do print output?
    2496             :     integer                             :: ret
    2497             : 
    2498             : 
    2499             :     ! Assume success.
    2500           0 :     rc = 0
    2501             : 
    2502             :     ! Get the wavelength structure.
    2503           0 :     call CARMA_GET(carma, rc, wave=wave, do_print=do_print, LUNOPRT=LUNOPRT)
    2504           0 :     if (rc < 0) call endrun('carma_CreateOpticsFile::CARMA_Get failed.')
    2505             : 
    2506             :     ! Get the necessary group properties.
    2507             :     call CARMAGROUP_Get(carma, igroup, rc, name=name, shortname=shortname, r=r, &
    2508             :                         rlow=rlow, rup=rup, rmass=rmass, irhswell=irhswell, &
    2509           0 :                         ienconc=ienconc, cnsttype=cnsttype, maxbin=maxbin, imiertn=imiertn)
    2510           0 :     if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAGROUP_Get failed.')
    2511             : 
    2512             :     ! Get the necessary element properties.
    2513           0 :     call CARMAELEMENT_Get(carma, ienconc, rc, rho=rho, refidx=refidx)
    2514           0 :     if (rc < 0) call endrun('carma_CreateOpticsFile::CARMAELEMENT_Get failed.')
    2515             : 
    2516             :     ! A file needs to be created for each bin.
    2517           0 :     do ibin = 1, NBIN
    2518             : 
    2519             :       ! Bins past maxbin are treated as diagnostic even if the group
    2520             :       ! is prognostic and thus are not advected in the paerent model.
    2521           0 :       if (ibin <= maxbin) then
    2522             : 
    2523           0 :         write(c_name, '(A, I2.2)') trim(shortname), ibin
    2524             : 
    2525             :         ! Construct the path to the file. Each model will have its own subdirectory
    2526             :         ! where the optical property files are stored.
    2527           0 :         filepath = trim(carma_model) // '_' // trim(c_name) // '_rrtmg.nc'
    2528             : 
    2529           0 :         if (do_print) write(LUNOPRT,*) 'Creating CARMA optics file ... ', trim(filepath)
    2530             : 
    2531             :         ! Create the file.
    2532           0 :         call wrap_create(filepath, NF90_CLOBBER, fid)
    2533             : 
    2534             :         ! Define the dimensions: rh, lwbands, swbands
    2535           0 :         call wrap_def_dim(fid, 'rh_idx',  NMIE_RH,  rhdim)
    2536           0 :         call wrap_def_dim(fid, 'lw_band', nlwbands, lwdim)
    2537           0 :         call wrap_def_dim(fid, 'sw_band', nswbands, swdim)
    2538             : 
    2539           0 :         call wrap_def_dim(fid, 'wgtpct', NMIE_WTP, wtpdim)
    2540             : 
    2541           0 :         dimids(1) = rhdim
    2542           0 :         call wrap_def_var(fid, 'rh',  NF90_DOUBLE, 1, dimids(1), rhvar)
    2543           0 :         call wrap_def_var(fid, 'rwet',NF90_DOUBLE, 1, dimids(1), rwetvar)
    2544             : 
    2545           0 :         dimids(1) = lwdim
    2546           0 :         call wrap_def_var(fid, 'lw_band', NF90_DOUBLE, 1, dimids(1), lwvar)
    2547             : 
    2548           0 :         dimids(1) = swdim
    2549           0 :         call wrap_def_var(fid, 'sw_band', NF90_DOUBLE, 1, dimids(1), swvar)
    2550             : 
    2551           0 :         dimids(1) = wtpdim
    2552           0 :         call wrap_def_var(fid, 'wgtpct', NF90_DOUBLE, 1, dimids(1), wtp_var)
    2553             : 
    2554           0 :         call wrap_put_att_text(fid, rhvar, 'units', 'fraction')
    2555           0 :         call wrap_put_att_text(fid, rwetvar, 'units', 'cm')
    2556           0 :         call wrap_put_att_text(fid, lwvar, 'units', 'm')
    2557           0 :         call wrap_put_att_text(fid, swvar, 'units', 'm')
    2558             : 
    2559           0 :         call wrap_put_att_text(fid, wtp_var,'units', 'unitless')
    2560           0 :         call wrap_put_att_text(fid, wtp_var,'long_name', 'weight percent')
    2561             : 
    2562           0 :         call wrap_put_att_text(fid, rhvar, 'long_name', 'relative humidity')
    2563           0 :         call wrap_put_att_text(fid, rwetvar, 'long_name', 'wet radius')
    2564           0 :         call wrap_put_att_text(fid, lwvar, 'long_name', 'longwave bands')
    2565           0 :         call wrap_put_att_text(fid, swvar, 'long_name', 'shortwave bands')
    2566             : 
    2567             :         ! Define the variables: abs_lw, ext_sw, ssa_sw, asm_sw
    2568             :         ! Define 2-dimension (:nrh,:nswbands) LW optics properties: abs_lw, qabs_lw
    2569           0 :         dimids(1) = wtpdim
    2570           0 :         dimids(2) = lwdim
    2571           0 :         call wrap_def_var(fid, 'abs_lw_wtp', NF90_DOUBLE, 2, dimids(1:2), abs_lw_wtp_var)
    2572           0 :         call wrap_def_var(fid, 'qabs_lw_wtp',NF90_DOUBLE, 2, dimids(1:2), qabs_lw_wtp_var)
    2573             : 
    2574           0 :         call wrap_put_att_text(fid, abs_lw_wtp_var, 'units', 'meter^2 kilogram^-1')
    2575           0 :         call wrap_put_att_text(fid, qabs_lw_wtp_var,'units', '-')
    2576             : 
    2577             :         ! Define 2-dimension (:nrh,:nswbands) optics properties: ext_sw, qext_sw, ssa_sw, asm_sw
    2578           0 :         dimids(1) = wtpdim
    2579           0 :         dimids(2) = swdim
    2580           0 :         call wrap_def_var(fid, 'ext_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), ext_sw_wtp_var)
    2581           0 :         call wrap_def_var(fid, 'qext_sw_wtp',NF90_DOUBLE, 2, dimids(1:2), qext_sw_wtp_var)
    2582           0 :         call wrap_def_var(fid, 'ssa_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), ssa_sw_wtp_var)
    2583           0 :         call wrap_def_var(fid, 'asm_sw_wtp', NF90_DOUBLE, 2, dimids(1:2), asm_sw_wtp_var)
    2584             : 
    2585           0 :         call wrap_put_att_text(fid, ssa_sw_wtp_var, 'units', 'fraction')
    2586           0 :         call wrap_put_att_text(fid, qext_sw_wtp_var,'units', '-')
    2587           0 :         call wrap_put_att_text(fid, ext_sw_wtp_var, 'units', 'meter^2 kilogram^-1')
    2588           0 :         call wrap_put_att_text(fid, asm_sw_wtp_var, 'units', '-')
    2589             : 
    2590             :         ! Define the variables for the refractive indicies.
    2591           0 :         dimids(1) = swdim
    2592           0 :         call wrap_def_var(fid, 'refindex_real_aer_sw', NF90_DOUBLE, 1, dimids(1), sw_r_refidx_var)
    2593           0 :         call wrap_def_var(fid, 'refindex_im_aer_sw',   NF90_DOUBLE, 1, dimids(1), sw_i_refidx_var)
    2594             : 
    2595           0 :         dimids(1) = lwdim
    2596           0 :         call wrap_def_var(fid, 'refindex_real_aer_lw', NF90_DOUBLE, 1, dimids(1), lw_r_refidx_var)
    2597           0 :         call wrap_def_var(fid, 'refindex_im_aer_lw',   NF90_DOUBLE, 1, dimids(1), lw_i_refidx_var)
    2598             : 
    2599           0 :         call wrap_put_att_text(fid, sw_r_refidx_var, 'units', '-')
    2600           0 :         call wrap_put_att_text(fid, sw_i_refidx_var, 'units', '-')
    2601           0 :         call wrap_put_att_text(fid, lw_r_refidx_var, 'units', '-')
    2602           0 :         call wrap_put_att_text(fid, lw_i_refidx_var, 'units', '-')
    2603             : 
    2604           0 :         call wrap_put_att_text(fid, sw_r_refidx_var, 'long_name', 'real refractive index of aerosol - shortwave')
    2605           0 :         call wrap_put_att_text(fid, sw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - shortwave')
    2606           0 :         call wrap_put_att_text(fid, lw_r_refidx_var, 'long_name', 'real refractive index of aerosol - longwave')
    2607           0 :         call wrap_put_att_text(fid, lw_i_refidx_var, 'long_name', 'imaginary refractive index of aerosol - longwave')
    2608             : 
    2609             : 
    2610             :         ! Define fields that define the aerosol properties.
    2611           0 :         call wrap_def_dim(fid, 'opticsmethod_len',  32, omdim)
    2612           0 :         dimids(1) = omdim
    2613           0 :         call wrap_def_var(fid, 'opticsmethod',  NF90_CHAR, 1, dimids(1), omvar)
    2614             : 
    2615           0 :         call wrap_def_dim(fid, 'namelength',  20, andim)
    2616           0 :         dimids(1) = andim
    2617           0 :         call wrap_def_var(fid, 'aername',  NF90_CHAR, 1, dimids(1), anvar)
    2618             : 
    2619           0 :         call wrap_def_dim(fid, 'name_len',  32, namedim)
    2620           0 :         dimids(1) = namedim
    2621           0 :         call wrap_def_var(fid, 'name',  NF90_CHAR, 1, dimids, namevar)
    2622             : 
    2623           0 :         call wrap_def_var(fid, 'density',            NF90_DOUBLE, 0, dimids(1), denvar)
    2624           0 :         call wrap_def_var(fid, 'sigma_logr',         NF90_DOUBLE, 0, dimids(1), slogvar)
    2625           0 :         call wrap_def_var(fid, 'dryrad',             NF90_DOUBLE, 0, dimids(1), dryrvar)
    2626           0 :         call wrap_def_var(fid, 'radmin_aer',         NF90_DOUBLE, 0, dimids(1), rminvar)
    2627           0 :         call wrap_def_var(fid, 'radmax_aer',         NF90_DOUBLE, 0, dimids(1), rmaxvar)
    2628           0 :         call wrap_def_var(fid, 'hygroscopicity',     NF90_DOUBLE, 0, dimids(1), hygrovar)
    2629           0 :         call wrap_def_var(fid, 'num_to_mass_ratio',  NF90_DOUBLE, 0, dimids(1), ntmvar)
    2630             : 
    2631           0 :         call wrap_put_att_text(fid, denvar,   'units', 'kg m^-3')
    2632           0 :         call wrap_put_att_text(fid, slogvar,  'units', '-')
    2633           0 :         call wrap_put_att_text(fid, dryrvar,  'units', 'm')
    2634           0 :         call wrap_put_att_text(fid, rminvar,  'units', 'm')
    2635           0 :         call wrap_put_att_text(fid, rmaxvar,  'units', 'm')
    2636           0 :         call wrap_put_att_text(fid, hygrovar, 'units', '-')
    2637           0 :         call wrap_put_att_text(fid, ntmvar,   'units', 'kg^-1')
    2638             : 
    2639           0 :         call wrap_put_att_text(fid, denvar,   'long_name', 'aerosol material density')
    2640           0 :         call wrap_put_att_text(fid, slogvar,  'long_name', 'geometric standard deviation of aerosol')
    2641           0 :         call wrap_put_att_text(fid, dryrvar,  'long_name', 'dry number mode radius of aerosol')
    2642           0 :         call wrap_put_att_text(fid, rminvar,  'long_name', 'minimum dry radius of aerosol for bin')
    2643           0 :         call wrap_put_att_text(fid, rmaxvar,  'long_name', 'maximum dry radius of aerosol for bin')
    2644           0 :         call wrap_put_att_text(fid, hygrovar, 'long_name', 'hygroscopicity of aerosol')
    2645           0 :         call wrap_put_att_text(fid, ntmvar,   'long_name', 'ratio of number to mass of aerosol')
    2646             : 
    2647             :         ! End the defintion phase of the netcdf file.
    2648           0 :         call wrap_enddef(fid)
    2649             : 
    2650             :         ! Write out the dimensions.
    2651           0 :         call wrap_put_var_realx(fid, rhvar, mie_rh(:))
    2652           0 :         call wrap_put_var_realx(fid, lwvar, wave(:nlwbands) * 1e-2_f)
    2653           0 :         call wrap_put_var_realx(fid, swvar, wave(nlwbands+1:) * 1e-2_f)
    2654             : 
    2655           0 :         call wrap_put_var_realx(fid, wtp_var, mie_wtp(:)*100._f)
    2656             : 
    2657             :         ! Write out the refractive indicies.
    2658           0 :         call wrap_put_var_realx(fid, sw_r_refidx_var, real(refidx(nlwbands+1:, 1)))
    2659           0 :         call wrap_put_var_realx(fid, sw_i_refidx_var, aimag(refidx(nlwbands+1:, 1)))
    2660           0 :         call wrap_put_var_realx(fid, lw_r_refidx_var, real(refidx(:nlwbands, 1)))
    2661           0 :         call wrap_put_var_realx(fid, lw_i_refidx_var, aimag(refidx(:nlwbands, 1)))
    2662             : 
    2663             :         ! Pad the names out with spaces.
    2664           0 :         aer_name = '                                '
    2665           0 :         aer_name(1:len(trim(c_name))) = c_name
    2666             : 
    2667           0 :         start_text(1) = 1
    2668           0 :         count_text(1) = 32
    2669           0 :         call wrap_put_vara_text(fid, namevar, start_text, count_text, (/ aer_name /))
    2670           0 :         count_text(1) = 20
    2671           0 :         call wrap_put_vara_text(fid, anvar, start_text, count_text, (/ aer_name /))
    2672             : 
    2673           0 :         count_text(1) = len('hygroscopic_wtp                 ')
    2674           0 :         call wrap_put_vara_text(fid, omvar, start_text, count_text, (/ 'hygroscopic_wtp                 ' /))
    2675             : 
    2676           0 :         call wrap_put_var_realx(fid, denvar,   (/ rho(ibin) * 1e-3_f / 1e-6_f /))
    2677           0 :         call wrap_put_var_realx(fid, slogvar,  (/ 0._f /))
    2678           0 :         call wrap_put_var_realx(fid, dryrvar,  (/ r(ibin) * 1e-2_f /))
    2679           0 :         call wrap_put_var_realx(fid, rminvar,  (/ rlow(ibin) * 1e-2_f /))
    2680           0 :         call wrap_put_var_realx(fid, rmaxvar,  (/ rup(ibin) * 1e-2_f /))
    2681           0 :         call wrap_put_var_realx(fid, hygrovar, (/ 0.6_f /))
    2682           0 :         call wrap_put_var_realx(fid, ntmvar,   (/ 1._f / rmass(ibin) / 1e-3_f /))
    2683             : 
    2684             :         ! For now, ext_sw(:nrh, :nswbands) and ext_sw_coreshell(:nrh, :nswbands, :ncoreshellratio) both are calculated
    2685             :         ! Since other aerosols in CAM may use ext_sw rather than ext_sw_coreshell
    2686             :         ! Modified by Pengfei Yu
    2687             :         ! April.1, 2012
    2688             : 
    2689             :         ! calculate qext and ext for pure sulfate dependent on weight percent
    2690             :         ! ideally qext is based on (wgt,temp,wave), however Beyer et al. (1996) Figure 5
    2691             :         ! shows sulfate density is roughly 0.006 g/cm3/k, I negelet temp dimension, assuming temp = 270 K
    2692             :         ! In code, sulfate density is precisely calculated to determine wet raidus
    2693           0 :         do iwtp = 1, NMIE_WTP
    2694             : 
    2695             :           ! NOTE: Weight percent is normal a result of the getwetr calculation. To build the
    2696             :           ! table based upon weight percent, we need to pass in the desired value and a
    2697             :           ! reference temperature. In that case, the RH is ignored.
    2698           0 :           call getwetr(carma, igroup, mie_rh(1), r(ibin), rwet, rho(ibin), rhopwet, rc, wgtpct=mie_wtp(iwtp)*100._f, temp=270._f)
    2699           0 :           if (rc < 0) call endrun('carma_CreateOpticsFile::wetr failed.')
    2700             : 
    2701             :           ! Calculate at each wavelength.
    2702           0 :           do iwave = 1, NWAVE
    2703             : 
    2704             :             ! Using Mie code, calculate the optical properties: extinction coefficient,
    2705             :             ! single scattering albedo and asymmetry factor.
    2706             :             ! Assume the particle is homogeneous (no core).
    2707             :             !
    2708             :             ! NOTE: The refractive index for sulfate changes with RH/weight percent, which
    2709             :             ! is not reflected in this code.
    2710             :             call mie(carma, &
    2711             :                      imiertn, &
    2712             :                      rwet, &
    2713           0 :                      wave(iwave), &
    2714             :                      0._f, &
    2715             :                      3.0_f, &
    2716             :                      0.0_f, &
    2717             :                      1.0_f, &
    2718             :                      refidx(iwave, 1), &
    2719             :                      0.0_f, &
    2720             :                      refidx(iwave, 1), &
    2721             :                      Qext, &
    2722             :                      Qsca, &
    2723             :                      asym, &
    2724           0 :                      rc)
    2725           0 :             if (rc < 0) call endrun('carma_CreateOpticsFile::mie failed.')
    2726             : 
    2727             :             ! Calculate  the shortwave and longwave properties?
    2728             :             !
    2729             :             ! NOTE: miess is in cgs units, but the optics file needs to be in mks
    2730             :             ! units, so perform the necessary conversions.
    2731           0 :             if (iwave <= nlwbands) then
    2732             : 
    2733             :               ! Longwave just needs absorption: abs_lw.
    2734           0 :               qabs_lw_wtp(iwtp, iwave) = (Qext - Qsca)                           ! absorption per particle
    2735           0 :               abs_lw_wtp (iwtp, iwave) = (Qext - Qsca) * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f)
    2736             :             else
    2737             : 
    2738             :               ! Shortwave needs extinction, single scattering albedo and asymmetry factor:
    2739             :               ! ext_sw, ssa_sw and asm_sw.
    2740           0 :               qext_sw_wtp(iwtp, iwave - nlwbands) = Qext                             ! extinction per particle
    2741           0 :               ext_sw_wtp (iwtp, iwave - nlwbands) = Qext * PI * (rwet * 1e-2_f)**2 / (rmass(ibin) * 1e-3_f)
    2742           0 :               ssa_sw_wtp (iwtp, iwave - nlwbands) = Qsca / Qext
    2743           0 :               asm_sw_wtp (iwtp, iwave - nlwbands) = asym
    2744             :             end if
    2745             :           end do ! iwave
    2746             :         end do  ! iwtp
    2747             : 
    2748             :         ! Write out the longwave fields.
    2749           0 :         ret = nf90_put_var(fid, abs_lw_wtp_var,  abs_lw_wtp (:, :))
    2750           0 :         if (ret /= NF90_NOERR) then
    2751           0 :            write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', fid, abs_lw_wtp_var
    2752           0 :            call handle_error(ret)
    2753             :         end if
    2754             : 
    2755           0 :         ret = nf90_put_var(fid, qabs_lw_wtp_var, qabs_lw_wtp(:, :))
    2756           0 :         if (ret /= NF90_NOERR) then
    2757           0 :            write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', qabs_lw_wtp_var
    2758           0 :            call handle_error(ret)
    2759             :         end if
    2760             : 
    2761             :         ! Write out the shortwave fields.
    2762           0 :         ret = nf90_put_var(fid, ext_sw_wtp_var, ext_sw_wtp (:, :))
    2763           0 :         if (ret /= NF90_NOERR) then
    2764           0 :            write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', ext_sw_wtp_var
    2765           0 :            call handle_error(ret)
    2766             :         end if
    2767             : 
    2768           0 :         ret = nf90_put_var(fid, qext_sw_wtp_var,qext_sw_wtp(:, :))
    2769           0 :         if (ret /= NF90_NOERR) then
    2770           0 :            write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', qext_sw_wtp_var
    2771           0 :            call handle_error(ret)
    2772             :         end if
    2773             : 
    2774           0 :         ret = nf90_put_var(fid, ssa_sw_wtp_var, ssa_sw_wtp (:, :))
    2775           0 :         if (ret /= NF90_NOERR) then
    2776           0 :            write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', ssa_sw_wtp_var
    2777           0 :            call handle_error(ret)
    2778             :         end if
    2779             : 
    2780           0 :         ret = nf90_put_var(fid, asm_sw_wtp_var, asm_sw_wtp (:, :))
    2781           0 :         if (ret /= NF90_NOERR) then
    2782           0 :            write(iulog,*)'CARMA_CreateOpticsFile_SulfateYu: error writing varid =', asm_sw_wtp_var
    2783           0 :            call handle_error(ret)
    2784             :         end if
    2785             : 
    2786             :         ! Close the file.
    2787           0 :         call wrap_close(fid)
    2788             :       end if
    2789             :     end do
    2790             : 
    2791           0 :     return
    2792             :   end subroutine CARMAMODEL_CreateOpticsFile_SulfateYu
    2793             : 
    2794             : 
    2795             :   !! Called at the end of the timestep after all the columns have been processed to
    2796             :   !! to allow additional diagnostics that have been stored in pbuf to be output.
    2797             :   !!
    2798             :   !! NOTE: This is just keeping track of the changes in the interstitial aerosol,
    2799             :   !! and does not keep track of the aerosol that flows out the top or bottom of the
    2800             :   !! model or that moves into cloudborne aerosol.
    2801             :   !!
    2802             :   !! NOTE: Output occurs a chunk at a time.
    2803             :   !!
    2804             :   !!  @version January-2023
    2805             :   !!  @author  Chuck Bardeen
    2806           0 :   subroutine CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc)
    2807             : 
    2808             :     type(carma_type), intent(in)         :: carma        !! the carma object
    2809             :     type(physics_state), intent(in)      :: state        !! Physics state variables - before pname
    2810             :     type(physics_buffer_desc), pointer, intent(in)   :: pbuf(:)      !! physics buffer
    2811             :     real(r8), intent(out)                :: aerclddiag(pcols,MAXCLDAERDIAG) !! the total cloudborne aerosols, supports up to MAXCLDAERDIAG different values
    2812             :     integer, intent(out)                 :: rc           !! return code, negative indicates failure
    2813             : 
    2814             :     integer                              :: ncols        !! number of columns in the chunk
    2815             :     integer                              :: icol         !! column index
    2816             :     integer                              :: ibin         !! bin index
    2817             :     integer                              :: ienconc      !! concentration element index
    2818             :     integer                              :: ncore        !! number of cores
    2819             :     integer                              :: icorelem(NELEM) !! core element index
    2820             :     real(r8)                             :: mair(pcols,pver)   !! Mass of air column (kg/m2)
    2821             :     real(r8)                             :: pureso4(pcols,pver) !! Burden pure sulfate (kg/m2)
    2822             :     real(r8)                             :: mixso4(pcols,pver)  !! Burden mix sulfate (kg/m2)
    2823             :     real(r8)                             :: bdbc(pcols,pver)    !! Burden BC sulfate (kg/m2)
    2824             :     real(r8)                             :: bddust(pcols,pver)  !! Burden Dust sulfate (kg/m2)
    2825             :     real(r8)                             :: bdoc(pcols,pver)    !! Burden OC sulfate (kg/m2)
    2826             :     real(r8)                             :: bdsalt(pcols,pver)  !! Burden Salt sulfate (kg/m2)
    2827             :     real(r8)                             :: bdsoa1(pcols,pver)   !! Burden SOA sulfate (kg/m2)
    2828             :     real(r8)                             :: bdsoa2(pcols,pver)   !! Burden SOA sulfate (kg/m2)
    2829             :     real(r8)                             :: bdsoa3(pcols,pver)   !! Burden SOA sulfate (kg/m2)
    2830             :     real(r8)                             :: bdsoa4(pcols,pver)   !! Burden SOA sulfate (kg/m2)
    2831             :     real(r8)                             :: bdsoa5(pcols,pver)   !! Burden SOA sulfate (kg/m2)
    2832           0 :     real(r8), pointer, dimension(:,:)    :: mmr                 !! cloudbourne aerosol mmr  (kg/kg)
    2833             :     character(len=16)                    :: shortname
    2834             :     character(len=16)                    :: binname
    2835             :     character(len=16)                    :: concname
    2836             :     integer                              :: mmr_ndx
    2837             :     integer                              :: i
    2838             : 
    2839             :     ! Default return code.
    2840           0 :     rc = RC_OK
    2841             : 
    2842           0 :     pureso4(:,:)     = 0._r8
    2843           0 :     mixso4(:,:)      = 0._r8
    2844           0 :     aerclddiag(:, :) = 0._r8
    2845           0 :     bdbc(:, :)       = 0._r8
    2846           0 :     bddust(:, :)     = 0._r8
    2847           0 :     bdoc(:, :)       = 0._r8
    2848           0 :     bdsalt(:, :)     = 0._r8
    2849           0 :     bdsoa1(:, :)      = 0._r8
    2850           0 :     bdsoa2(:, :)      = 0._r8
    2851           0 :     bdsoa3(:, :)      = 0._r8
    2852           0 :     bdsoa4(:, :)      = 0._r8
    2853           0 :     bdsoa5(:, :)      = 0._r8
    2854             : 
    2855             :     ! Get the air mass in the column
    2856             :     !
    2857             :     ! NOTE convert GRAV from cm/s2 to m/s2.
    2858           0 :     ncols = state%ncol
    2859           0 :     mair(:ncols,:) = state%pdel(:ncols,:) / (GRAV / 100._r8)
    2860             : 
    2861             :     ! For PRSUL, is just the tendency for the concentration element.
    2862           0 :     call CARMAGROUP_Get(carma, I_GRP_PRSUL, rc, ienconc=ienconc)
    2863           0 :     call CARMAELEMENT_Get(carma, ienconc, rc, shortname=shortname)
    2864             : 
    2865           0 :     do ibin = 1, nbin
    2866             : 
    2867           0 :       write(binname, '(A, I2.2)') "CLD"//trim(shortname), ibin
    2868           0 :       mmr_ndx = pbuf_get_index(binname)
    2869           0 :       call pbuf_get_field(pbuf, mmr_ndx, mmr)
    2870             : 
    2871           0 :       pureso4(:ncols,:) = pureso4(:ncols,:) + mmr(:ncols,:) * mair(:ncols,:)
    2872             :     end do
    2873             : 
    2874             :     ! For MXAER, it is the difference in mass between the concentration element
    2875             :     ! and the sum of the core masses.
    2876             :     !
    2877             :     ! NOTE: Since this is using the CAM state variables and not he CARMA state
    2878             :     ! variables the concentration element is just the mass of the sulfate.
    2879           0 :     call CARMAGROUP_Get(carma, I_GRP_MXAER, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem)
    2880           0 :     call CARMAELEMENT_Get(carma, ienconc, rc, shortname=concname)
    2881             : 
    2882           0 :     do ibin = 1, nbin
    2883             : 
    2884           0 :       write(binname, '(A, I2.2)') "CLD"//trim(concname), ibin
    2885           0 :       mmr_ndx = pbuf_get_index(binname)
    2886           0 :       call pbuf_get_field(pbuf, mmr_ndx, mmr)
    2887             : 
    2888           0 :       mixso4(:ncols,:) = mixso4(:ncols,:) + mmr(:ncols,:) * mair(:ncols,:)
    2889             : 
    2890           0 :       do i = 1, ncore
    2891           0 :         call CARMAELEMENT_Get(carma, icorelem(i), rc, shortname=shortname)
    2892             : 
    2893           0 :         write(binname, '(A, I2.2)') "CLD"//trim(shortname), ibin
    2894           0 :         mmr_ndx = pbuf_get_index(binname)
    2895           0 :         call pbuf_get_field(pbuf, mmr_ndx, mmr)
    2896             : 
    2897           0 :         if (shortname .eq. "MXBC") then
    2898           0 :           bdbc(:ncols, :) = bdbc(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:)
    2899           0 :         else if (shortname .eq. "MXDUST") then
    2900           0 :           bddust(:ncols, :) = bddust(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:)
    2901           0 :         else if (shortname .eq. "MXOC") then
    2902           0 :           bdoc(:ncols, :) = bdoc(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:)
    2903           0 :         else if (shortname .eq. "MXSALT") then
    2904           0 :           bdsalt(:ncols, :) = bdsalt(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:)
    2905           0 :         else if (shortname .eq. "MXSOA1") then
    2906           0 :           bdsoa1(:ncols, :) = bdsoa1(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:)
    2907           0 :         else if (shortname .eq. "MXSOA2") then
    2908           0 :           bdsoa2(:ncols, :) = bdsoa2(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:)
    2909           0 :         else if (shortname .eq. "MXSOA3") then
    2910           0 :           bdsoa3(:ncols, :) = bdsoa3(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:)
    2911           0 :         else if (shortname .eq. "MXSOA4") then
    2912           0 :           bdsoa4(:ncols, :) = bdsoa4(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:)
    2913           0 :         else if (shortname .eq. "MXSOA5") then
    2914           0 :           bdsoa5(:ncols, :) = bdsoa5(:ncols, :) + mmr(:ncols,:) * mair(:ncols,:)
    2915             :         end if
    2916             :       end do
    2917             :     end do
    2918             : 
    2919           0 :     do icol = 1, ncols
    2920           0 :       aerclddiag(icol, 1) = sum(pureso4(icol,:))
    2921           0 :       aerclddiag(icol, 2) = sum(mixso4(icol,:))
    2922           0 :       aerclddiag(icol, 3) = sum(bdbc(icol,:))
    2923           0 :       aerclddiag(icol, 4) = sum(bddust(icol,:))
    2924           0 :       aerclddiag(icol, 5) = sum(bdoc(icol,:))
    2925           0 :       aerclddiag(icol, 6) = sum(bdsalt(icol,:))
    2926           0 :       aerclddiag(icol, 7) = sum(bdsoa1(icol,:))
    2927           0 :       aerclddiag(icol, 8) = sum(bdsoa2(icol,:))
    2928           0 :       aerclddiag(icol, 9) = sum(bdsoa3(icol,:))
    2929           0 :       aerclddiag(icol,10) = sum(bdsoa4(icol,:))
    2930           0 :       aerclddiag(icol,11) = sum(bdsoa5(icol,:))
    2931             :     end do
    2932             : 
    2933           0 :     return
    2934           0 :   end subroutine CARMAMODEL_CalculateCloudborneDiagnostics
    2935             : 
    2936             : 
    2937             :   !! Called at the end of the timestep after all the columns have been processed to
    2938             :   !! to allow additional diagnostics that have been stored in pbuf to be output.
    2939             :   !!
    2940             :   !! NOTE: This is just keeping track of the changes in the interstitial aerosol,
    2941             :   !! and does not keep track of the aerosol that flows out the top or bottom of the
    2942             :   !! model or that moves into cloudborne aerosol.
    2943             :   !!
    2944             :   !! NOTE: Output occurs a chunk at a time.
    2945             :   !!
    2946             :   !!  @version January-2023
    2947             :   !!  @author  Chuck Bardeen
    2948           0 :   subroutine CARMAMODEL_OutputBudgetDiagnostics(carma, icnst4elem, icnst4gas, state, ptend, old_cflux, cflux, dt, pname, rc)
    2949             :     use cam_history,  only: outfld
    2950             :     use constituents, only: pcnst, cnst_get_ind
    2951             : 
    2952             :     type(carma_type), intent(in)         :: carma        !! the carma object
    2953             :     integer, intent(in)                  :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element
    2954             :     integer, intent(in)                  :: icnst4gas(NGAS)         !! constituent index for a carma gas
    2955             :     type(physics_state), intent(in)      :: state        !! Physics state variables - before pname
    2956             :     type(physics_ptend), intent(in)      :: ptend        !! indivdual parameterization tendencies
    2957             :     real(r8)                             :: old_cflux(pcols,pcnst)  !! cam_in%clfux from before the timestep_tend
    2958             :     real(r8)                             :: cflux(pcols,pcnst)  !! cam_in%clfux from after the timestep_tend
    2959             :     real(r8), intent(in)                 :: dt           !! timestep (s)
    2960             :     character(*), intent(in)             :: pname        !! short name of the physics package
    2961             :     integer, intent(out)                 :: rc           !! return code, negative indicates failure
    2962             : 
    2963             :     integer                              :: icol         !! column index
    2964             :     integer                              :: ibin         !! bin index
    2965             :     integer                              :: i
    2966             :     integer                              :: icnst        !! constituent index
    2967             :     integer                              :: ienconc      !! concentration element index
    2968             :     integer                              :: ncore        !! number of cores
    2969             :     integer                              :: icorelem(NELEM) !! core element index
    2970             :     real(r8)                             :: mair(pver)   !! Mass of air column (kg/m2)
    2971             :     real(r8)                             :: puretend(pcols) !! Tendency pure sulfate (kg/m2/s)
    2972             :     real(r8)                             :: mixtend(pcols)  !! Tendency mix sulfate (kg/m2/s)
    2973             :     real(r8)                             :: bdprso4(pcols)  !! Burden pure sulfate (kg/m2)
    2974             :     real(r8)                             :: bdmxso4(pcols)  !! Burden mixed sulfate (kg/m2)
    2975             :     real(r8)                             :: cprflux(pcols)  !! Surface Flux tendency, pure sulfate (kg/m2/s)
    2976             :     real(r8)                             :: cmxflux(pcols)  !! Surface Flux tendency, mix sulfate (kg/m2/s)
    2977             :     real(r8)                             :: gastend(pcols)  !! Tendency H2SO4 gas (kg/m2/s)
    2978             :     real(r8)                             :: so2tend(pcols)  !! Tendency SO2 gas (kg/m2/s)
    2979             :     real(r8)                             :: h2so4(pcols)   !! H2SO4 gas (kg/m2)
    2980             :     real(r8)                             :: so2(pcols)     !! SO2 gas (kg/m2)
    2981             : 
    2982             : 
    2983             :     ! Default return code.
    2984           0 :     rc = RC_OK
    2985             : 
    2986           0 :     puretend(:) = 0._r8
    2987           0 :     mixtend(:)  = 0._r8
    2988           0 :     gastend(:)  = 0._r8
    2989           0 :     so2tend(:)  = 0._r8
    2990           0 :     cprflux(:)  = 0._r8
    2991           0 :     cmxflux(:)  = 0._r8
    2992             : 
    2993           0 :     bdmxso4(:)  = 0._r8
    2994           0 :     bdprso4(:)  = 0._r8
    2995           0 :     h2so4(:) = 0._r8
    2996           0 :     so2(:) = 0._r8
    2997             : 
    2998             :     ! Add up the sulfate tendencies.
    2999           0 :     do icol = 1, state%ncol
    3000             : 
    3001             :       ! Get the air mass in the column
    3002             :       !
    3003             :       ! NOTE convert GRAV from cm/s2 to m/s2.
    3004           0 :       mair(:) = state%pdel(icol,:) / (GRAV / 100._r8)
    3005             : 
    3006           0 :       do ibin = 1, nbin
    3007             : 
    3008             :         ! For PRSUL, is just the tendency for the concentration element.
    3009           0 :         call CARMAGROUP_Get(carma, I_GRP_PRSUL, rc, ienconc=ienconc)
    3010           0 :         icnst = icnst4elem(ienconc, ibin)
    3011             : 
    3012           0 :         if (ptend%lq(icnst)) then
    3013           0 :           puretend(icol) = puretend(icol) + sum(ptend%q(icol,:,icnst) * mair(:))
    3014             :         end if
    3015           0 :         bdprso4(icol) = bdprso4(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3016             : 
    3017           0 :         cprflux = cprflux(icol) + (cflux(icol,icnst) - old_cflux(icol,icnst))
    3018             : 
    3019             :         ! For MXAER, it is the difference in mass between the concentration element
    3020             :         ! and the sum of the core masses.
    3021             :         !
    3022             :         ! NOTE: Since this is using the CAM state variables and not he CARMA state
    3023             :         ! variables the concentration element is just the mass of the sulfate.
    3024           0 :         call CARMAGROUP_Get(carma, I_GRP_MXAER, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem)
    3025           0 :         icnst = icnst4elem(ienconc, ibin)
    3026             : 
    3027           0 :         if (ptend%lq(icnst)) then
    3028           0 :           mixtend(icol) = mixtend(icol) + sum(ptend%q(icol, :, icnst) * mair(:))
    3029             :         end if
    3030             : 
    3031           0 :         bdmxso4(icol) = bdmxso4(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3032           0 :         cmxflux(icol) = cmxflux(icol) + (cflux(icol,icnst) - old_cflux(icol,icnst))
    3033             :       end do
    3034             : 
    3035             :       ! Calculate the H2SO4 change.
    3036           0 :       icnst = icnst4gas(I_GAS_H2SO4)
    3037           0 :       if (ptend%lq(icnst)) then
    3038           0 :         gastend(icol) = sum(ptend%q(icol,:,icnst) * mair(:))
    3039             :       end if
    3040             :       ! Calculate the H2SO4 burden.
    3041           0 :       h2so4(icol) = sum(state%q(icol,:,icnst) * mair(:))
    3042             : 
    3043             :       ! Also do SO2
    3044           0 :       call cnst_get_ind("SO2", icnst)
    3045           0 :       if (ptend%lq(icnst)) then
    3046           0 :         so2tend(icol) = sum(ptend%q(icol,:,icnst) * mair(:))
    3047             :       end if
    3048             :       ! Calculate the SO2 burden.
    3049           0 :       so2(icol) = sum(state%q(icol,:,icnst) * mair(:))
    3050             :     end do
    3051             : 
    3052           0 :     if (carma_do_package_diags) then
    3053             :        ! Output the total sulfate and H2SO4 tendencies for this physics package.
    3054           0 :        call outfld("SO4PRTC_"//trim(pname), puretend(:), pcols, state%lchnk)
    3055           0 :        call outfld("SO4MXTC_"//trim(pname), mixtend(:), pcols, state%lchnk)
    3056           0 :        call outfld("H2SO4TC_"//trim(pname), gastend(:), pcols, state%lchnk)
    3057           0 :        call outfld("H2SO4BD_"//trim(pname), h2so4(:), pcols, state%lchnk)
    3058           0 :        call outfld("SO2BD_"//trim(pname), so2(:), pcols, state%lchnk)
    3059           0 :        call outfld("SO2TC_"//trim(pname), so2tend(:), pcols, state%lchnk)
    3060           0 :        call outfld("SO4PRSF_"//trim(pname), cprflux(:), pcols, state%lchnk)
    3061           0 :        call outfld("SO4MXSF_"//trim(pname), cmxflux(:), pcols, state%lchnk)
    3062           0 :        call outfld("SO4PRBD_"//trim(pname), bdprso4(:), pcols, state%lchnk)
    3063           0 :        call outfld("SO4MXBD_"//trim(pname), bdmxso4(:), pcols, state%lchnk)
    3064             :     endif
    3065             : 
    3066           0 :     return
    3067           0 :   end subroutine CARMAMODEL_OutputBudgetDiagnostics
    3068             : 
    3069             : 
    3070             :   !! Called at the end of the timestep after all the columns have been processed to
    3071             :   !! to allow additional diagnostics that have been stored in pbuf to be output.
    3072             :   !!
    3073             :   !! NOTE: This is just keeping track of the changes in the interstitial aerosol,
    3074             :   !! and does not keep track of the aerosol that flows out the top or bottom of the
    3075             :   !! model or that moves into cloudborne aerosol.
    3076             :   !!
    3077             :   !! NOTE: Output occurs a chunk at a time.
    3078             :   !!
    3079             :   !!  @version January-2023
    3080             :   !!  @author  Chuck Bardeen
    3081           0 :   subroutine CARMAMODEL_OutputCloudborneDiagnostics(carma, state, pbuf, dt, pname, oldaerclddiag, rc)
    3082           0 :     use cam_history, only: outfld
    3083             : 
    3084             :     type(carma_type), intent(in)         :: carma        !! the carma object
    3085             :     type(physics_state), intent(in)      :: state        !! Physics state variables - before CARMA
    3086             :     type(physics_buffer_desc), pointer, intent(in)   :: pbuf(:)      !! physics buffer
    3087             :     real(r8), intent(in)                 :: dt           !! timestep (s)
    3088             :     character(*), intent(in)             :: pname        !! short name of the physics package
    3089             :     real(r8), intent(in )                :: oldaerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags
    3090             :     integer, intent(out)                 :: rc           !! return code, negative indicates failure
    3091             : 
    3092             :     real(r8)             :: aerclddiag(pcols,MAXCLDAERDIAG) !! the after timestep cloudborne aerosol diags
    3093             : 
    3094             :     ! Default return code.
    3095           0 :     rc = RC_OK
    3096             : 
    3097             :     ! Get the current diagnostics for the cloudborne aerosols.
    3098           0 :     call CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc)
    3099             : 
    3100             :     ! Output the total sulfate and H2SO4 tendencies for this physics package.
    3101           0 :     call outfld("SO4PRCLDTC_"//trim(pname), (aerclddiag(:,1) - oldaerclddiag(:,1)) / dt, pcols, state%lchnk)
    3102           0 :     call outfld("SO4MXCLDTC_"//trim(pname), (aerclddiag(:,2) - oldaerclddiag(:,2)) / dt, pcols, state%lchnk)
    3103             : 
    3104             :     ! To be similar to interstitial, where the burden is calculated from the
    3105             :     ! state before the tendencies are applied, report the old burden not the
    3106             :     ! current burden.
    3107             :     ! call outfld("SO4PRCLDBD_"//trim(pname), aerclddiag(:,1), pcols, state%lchnk)
    3108             :     ! call outfld("SO4MXCLDBD_"//trim(pname), aerclddiag(:,2), pcols, state%lchnk)
    3109           0 :     call outfld("SO4PRCLDBD_"//trim(pname), oldaerclddiag(:,1), pcols, state%lchnk)
    3110           0 :     call outfld("SO4MXCLDBD_"//trim(pname), oldaerclddiag(:,2), pcols, state%lchnk)
    3111             : 
    3112           0 :     return
    3113           0 :   end subroutine CARMAMODEL_OutputCloudborneDiagnostics
    3114             : 
    3115             : 
    3116             :   !! Called at the end of the timestep after all the columns have been processed to
    3117             :   !! to allow additional diagnostics that have been stored in pbuf to be output.
    3118             :   !!
    3119             :   !! NOTE: Output occurs a chunk at a time.
    3120             :   !!
    3121             :   !!  @version January-2023
    3122             :   !!  @author  Chuck Bardeen
    3123       72960 :   subroutine CARMAMODEL_OutputDiagnostics(carma, icnst4elem, state, ptend, pbuf, cam_in, rc)
    3124           0 :     use cam_history,   only: outfld
    3125             :     use constituents,  only: cnst_get_ind
    3126             :     use camsrfexch,    only: cam_in_t
    3127             : 
    3128             :     type(carma_type), intent(in)         :: carma        !! the carma object
    3129             :     integer, intent(in)                  :: icnst4elem(NELEM, NBIN) !! constituent index for a carma element
    3130             :     type(physics_state), intent(in)      :: state        !! Physics state variables - before CARMA
    3131             :     type(physics_ptend), intent(in)      :: ptend        !! indivdual parameterization tendencies
    3132             :     type(physics_buffer_desc), pointer, intent(in)   :: pbuf(:)  !! physics buffer
    3133             :     type(cam_in_t), intent(in)           :: cam_in       !! surface inputs
    3134             :     integer, intent(out)                 :: rc           !! return code, negative indicates failure
    3135             : 
    3136             :     integer                              :: icol         !! column index
    3137             :     integer                              :: ibin         !! bin index
    3138       72960 :     real(r8), pointer, dimension(:,:)    :: soacm1       !! aerosol tendency due to gas-aerosol exchange  kg/kg/s
    3139       72960 :     real(r8), pointer, dimension(:,:)    :: soacm2       !! aerosol tendency due to gas-aerosol exchange  kg/kg/s
    3140       72960 :     real(r8), pointer, dimension(:,:)    :: soacm3       !! aerosol tendency due to gas-aerosol exchange  kg/kg/s
    3141       72960 :     real(r8), pointer, dimension(:,:)    :: soacm4       !! aerosol tendency due to gas-aerosol exchange  kg/kg/s
    3142       72960 :     real(r8), pointer, dimension(:,:)    :: soacm5       !! aerosol tendency due to gas-aerosol exchange  kg/kg/s
    3143       72960 :     real(r8), pointer, dimension(:,:)    :: soapt1       !! aerosol tendency due to no2 photolysis  kg/kg/s
    3144       72960 :     real(r8), pointer, dimension(:,:)    :: soapt2       !! aerosol tendency due to no2 photolysis  kg/kg/s
    3145       72960 :     real(r8), pointer, dimension(:,:)    :: soapt3       !! aerosol tendency due to no2 photolysis  kg/kg/s
    3146       72960 :     real(r8), pointer, dimension(:,:)    :: soapt4       !! aerosol tendency due to no2 photolysis  kg/kg/s
    3147       72960 :     real(r8), pointer, dimension(:,:)    :: soapt5       !! aerosol tendency due to no2 photolysis  kg/kg/s
    3148             :     character(len=16)                    :: binname      !! names bins
    3149             :     real(r8)                             :: aerclddiag(pcols,MAXCLDAERDIAG) !! the before timestep cloudborne aerosol diags
    3150             :     integer                              :: i
    3151             :     integer                              :: icnst        !! constituent index
    3152             :     integer                              :: ienconc      !! concentration element index
    3153             :     integer                              :: ncore        !! number of cores
    3154             :     integer                              :: icorelem(NELEM) !! core element index
    3155             :     real(r8)                             :: mair(pver)   !! Mass of air column (kg/m2)
    3156             :     real(r8)                             :: pureso4(pcols) !! pure sulfate (kg/m2)
    3157             :     real(r8)                             :: mixso4(pcols)  !! mix sulfate (kg/m2)
    3158             :     real(r8)                             :: cprflux(pcols) !! Surface Flux pure sulfate (kg/m2/s)
    3159             :     real(r8)                             :: cmxflux(pcols) !! Surface Flux mix sulfate (kg/m2/s)
    3160             :     real(r8)                             :: h2so4(pcols)   !! H2SO4 gas (kg/m2)
    3161             :     real(r8)                             :: so2(pcols)     !! SO2 gas (kg/m2)
    3162             :     real(r8)                             :: bdbc(pcols)    !! Burden BC sulfate (kg/m2)
    3163             :     real(r8)                             :: bddust(pcols)  !! Burden dust (kg/m2)
    3164             :     real(r8)                             :: bdoc(pcols)    !! Burden OC sulfate (kg/m2)
    3165             :     real(r8)                             :: bdsalt(pcols)  !! Burden SALT sulfate (kg/m2)
    3166             :     real(r8)                             :: bdsoa1(pcols)   !! Burden SOA sulfate (kg/m2)
    3167             :     real(r8)                             :: bdsoa2(pcols)   !! Burden SOA sulfate (kg/m2)
    3168             :     real(r8)                             :: bdsoa3(pcols)   !! Burden SOA sulfate (kg/m2)
    3169             :     real(r8)                             :: bdsoa4(pcols)   !! Burden SOA sulfate (kg/m2)
    3170             :     real(r8)                             :: bdsoa5(pcols)   !! Burden SOA sulfate (kg/m2)
    3171             :     real(r8)                             :: pureso4mr(pcols,pver) !! Mixing ratio pure sulfate (kg/kg)
    3172             :     real(r8)                             :: mixso4mr(pcols,pver)  !! Mixing ratio mix sulfate (kg/kg)
    3173             :     real(r8)                             :: bcmr(pcols,pver)      !! Mixing ratio BC sulfate (kg/kg)
    3174             :     real(r8)                             :: dustmr(pcols,pver)    !! Mixing ratio dust (kg/kg)
    3175             :     real(r8)                             :: ocmr(pcols,pver)      !! Mixing ratio OC sulfate (kg/kg)
    3176             :     real(r8)                             :: saltmr(pcols,pver)    !! Mixing ratio SALT sulfate (kg/kg)
    3177             :     real(r8)                             :: soamr(pcols,pver)     !! Mixing ratio SOA sulfate (kg/kg)
    3178             :     character(len=16)                    :: shortname
    3179             : 
    3180             :     ! Default return code.
    3181       72960 :     rc = RC_OK
    3182             : 
    3183             :     ! Provide diagnostics on the SOA tendencies that affect MXSOA.
    3184     1532160 :     do ibin = 1, NBIN
    3185             : 
    3186     1459200 :       write(binname, '(A, I2.2)') "MXSOA1", ibin
    3187     1459200 :       call pbuf_get_field(pbuf, ipbuf4soacm1(ibin), soacm1)
    3188     1459200 :       call outfld(trim(binname)//'CM', soacm1(:, :), pcols, state%lchnk)
    3189     1459200 :       call pbuf_get_field(pbuf, ipbuf4soapt1(ibin), soapt1)
    3190     1459200 :       call outfld(trim(binname)//'PT', soapt1(:, :), pcols, state%lchnk)
    3191             : 
    3192     1459200 :       write(binname, '(A, I2.2)') "MXSOA2", ibin
    3193     1459200 :       call pbuf_get_field(pbuf, ipbuf4soacm2(ibin), soacm2)
    3194     1459200 :       call outfld(trim(binname)//'CM', soacm2(:, :), pcols, state%lchnk)
    3195     1459200 :       call pbuf_get_field(pbuf, ipbuf4soapt2(ibin), soapt2)
    3196     1459200 :       call outfld(trim(binname)//'PT', soapt2(:, :), pcols, state%lchnk)
    3197             : 
    3198     1459200 :       write(binname, '(A, I2.2)') "MXSOA3", ibin
    3199     1459200 :       call pbuf_get_field(pbuf, ipbuf4soacm3(ibin), soacm3)
    3200     1459200 :       call outfld(trim(binname)//'CM', soacm3(:, :), pcols, state%lchnk)
    3201     1459200 :       call pbuf_get_field(pbuf, ipbuf4soapt3(ibin), soapt3)
    3202     1459200 :       call outfld(trim(binname)//'PT', soapt3(:, :), pcols, state%lchnk)
    3203             : 
    3204     1459200 :       write(binname, '(A, I2.2)') "MXSOA4", ibin
    3205     1459200 :       call pbuf_get_field(pbuf, ipbuf4soacm4(ibin), soacm4)
    3206     1459200 :       call outfld(trim(binname)//'CM', soacm4(:, :), pcols, state%lchnk)
    3207     1459200 :       call pbuf_get_field(pbuf, ipbuf4soapt4(ibin), soapt4)
    3208     1459200 :       call outfld(trim(binname)//'PT', soapt4(:, :), pcols, state%lchnk)
    3209             : 
    3210     1459200 :       write(binname, '(A, I2.2)') "MXSOA5", ibin
    3211     1459200 :       call pbuf_get_field(pbuf, ipbuf4soacm5(ibin), soacm5)
    3212     1459200 :       call outfld(trim(binname)//'CM', soacm5(:, :), pcols, state%lchnk)
    3213     1459200 :       call pbuf_get_field(pbuf, ipbuf4soapt5(ibin), soapt5)
    3214    14664960 :       call outfld(trim(binname)//'PT', soapt5(:, :), pcols, state%lchnk)
    3215             :     end do
    3216             : 
    3217       72960 :     if (carma_do_budget_diags) then
    3218             :        ! Output the cloudborne SO4 burdens.
    3219           0 :        call CARMAMODEL_CalculateCloudborneDiagnostics(carma, state, pbuf, aerclddiag, rc)
    3220           0 :        call outfld("SO4PRCLDBD", aerclddiag(:,1), pcols, state%lchnk)
    3221           0 :        call outfld("SO4MXCLDBD", aerclddiag(:,2), pcols, state%lchnk)
    3222           0 :        call outfld("MXBCCLDBD", aerclddiag(:,3), pcols, state%lchnk)
    3223           0 :        call outfld("MXDUSTCLDBD", aerclddiag(:,4), pcols, state%lchnk)
    3224           0 :        call outfld("MXOCCLDBD", aerclddiag(:,5), pcols, state%lchnk)
    3225           0 :        call outfld("MXSALTCLDBD", aerclddiag(:,6), pcols, state%lchnk)
    3226           0 :        call outfld("MXSOA1CLDBD", aerclddiag(:,7), pcols, state%lchnk)
    3227           0 :        call outfld("MXSOA2CLDBD", aerclddiag(:,8), pcols, state%lchnk)
    3228           0 :        call outfld("MXSOA3CLDBD", aerclddiag(:,9), pcols, state%lchnk)
    3229           0 :        call outfld("MXSOA4CLDBD", aerclddiag(:,10), pcols, state%lchnk)
    3230           0 :        call outfld("MXSOA5CLDBD", aerclddiag(:,11), pcols, state%lchnk)
    3231             :     endif
    3232             : 
    3233             :     ! Output the interstitial SO4 burdens.
    3234       72960 :     pureso4(:) = 0._r8
    3235       72960 :     mixso4(:)  = 0._r8
    3236       72960 :     cprflux(:) = 0._r8
    3237       72960 :     cmxflux(:) = 0._r8
    3238       72960 :     h2so4(:)   = 0._r8
    3239       72960 :     so2(:)     = 0._r8
    3240       72960 :     bdbc(:)    = 0._r8
    3241       72960 :     bddust(:)  = 0._r8
    3242       72960 :     bdoc(:)    = 0._r8
    3243       72960 :     bdsalt(:)  = 0._r8
    3244       72960 :     bdsoa1(:)   = 0._r8
    3245       72960 :     bdsoa2(:)   = 0._r8
    3246       72960 :     bdsoa3(:)   = 0._r8
    3247       72960 :     bdsoa4(:)   = 0._r8
    3248       72960 :     bdsoa5(:)   = 0._r8
    3249             : 
    3250             :     ! Output the mixing ratio
    3251       72960 :     pureso4mr(:,:) = 0._r8
    3252       72960 :     mixso4mr(:,:)  = 0._r8
    3253       72960 :     bcmr(:,:)      = 0._r8
    3254       72960 :     dustmr(:,:)    = 0._r8
    3255       72960 :     ocmr(:,:)      = 0._r8
    3256       72960 :     saltmr(:,:)    = 0._r8
    3257       72960 :     soamr(:,:)     = 0._r8
    3258             : 
    3259             :     ! Add up the sulfate tendencies.
    3260     1123584 :     do icol = 1, state%ncol
    3261             : 
    3262             :       ! Get the air mass in the column
    3263             :       !
    3264             :       ! NOTE convert GRAV from cm/s2 to m/s2.
    3265    34670592 :       mair(:) = state%pdel(icol,:) / (GRAV / 100._r8)
    3266             : 
    3267    22063104 :       do ibin = 1, nbin
    3268             : 
    3269             :         ! For PRSUL, is just the tendency for the concentration element.
    3270    21012480 :         call CARMAGROUP_Get(carma, I_GRP_PRSUL, rc, ienconc=ienconc)
    3271    21012480 :         icnst = icnst4elem(ienconc, ibin)
    3272             : 
    3273   693411840 :         pureso4mr(icol,:) = pureso4mr(icol,:) + state%q(icol,:,icnst)
    3274   693411840 :         pureso4(icol) = pureso4(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3275             : 
    3276   357212160 :         cprflux = cprflux + cam_in%cflx(icol,icnst)
    3277             : 
    3278             :         ! For MXAER, it is the difference in mass between the concentration element
    3279             :         ! and the sum of the core masses.
    3280             :         !
    3281             :         ! NOTE: Since this is using the CAM state variables and not he CARMA state
    3282             :         ! variables the concentration element is just the mass of the sulfate.
    3283    21012480 :         call CARMAGROUP_Get(carma, I_GRP_MXAER, rc, ienconc=ienconc, ncore=ncore, icorelem=icorelem)
    3284    21012480 :         icnst = icnst4elem(ienconc, ibin)
    3285             : 
    3286   693411840 :         mixso4mr(icol,:) = mixso4mr(icol,:) + state%q(icol, :, icnst)
    3287   693411840 :         mixso4(icol) = mixso4(icol) + sum(state%q(icol, :, icnst) * mair(:))
    3288             : 
    3289    21012480 :         cmxflux(icol) = cmxflux(icol) + cam_in%cflx(icol,icnst)
    3290             : 
    3291   211175424 :         do i = 1, ncore
    3292   189112320 :           icnst = icnst4elem(icorelem(i), ibin)
    3293             : 
    3294             :           call CARMAELEMENT_Get(carma, icorelem(i), rc, shortname=shortname)
    3295   210124800 :           if (shortname .eq. "MXBC") then
    3296   693411840 :             bcmr(icol,:) = bcmr(icol,:) + state%q(icol,:,icnst)
    3297   693411840 :             bdbc(icol) = bdbc(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3298   168099840 :           else if (shortname .eq. "MXDUST") then
    3299   693411840 :             dustmr(icol,:) = dustmr(icol,:) + state%q(icol,:,icnst)
    3300   693411840 :             bddust(icol) = bddust(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3301   147087360 :           else if (shortname .eq. "MXOC") then
    3302   693411840 :             ocmr(icol,:) = ocmr(icol,:) + state%q(icol,:,icnst)
    3303   693411840 :             bdoc(icol) = bdoc(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3304   126074880 :           else if (shortname .eq. "MXSALT") then
    3305   693411840 :             saltmr(icol,:) = saltmr(icol,:) + state%q(icol,:,icnst)
    3306   693411840 :             bdsalt(icol) = bdsalt(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3307   105062400 :           else if (shortname .eq. "MXSOA1") then
    3308   693411840 :             soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst)
    3309   693411840 :             bdsoa1(icol) = bdsoa1(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3310    84049920 :           else if (shortname .eq. "MXSOA2") then
    3311   693411840 :             soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst)
    3312   693411840 :             bdsoa2(icol) = bdsoa2(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3313    63037440 :           else if (shortname .eq. "MXSOA3") then
    3314   693411840 :             soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst)
    3315   693411840 :             bdsoa3(icol) = bdsoa3(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3316    42024960 :           else if (shortname .eq. "MXSOA4") then
    3317   693411840 :             soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst)
    3318   693411840 :             bdsoa4(icol) = bdsoa4(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3319    21012480 :           else if (shortname .eq. "MXSOA5") then
    3320   693411840 :             soamr(icol,:) = soamr(icol,:) + state%q(icol,:,icnst)
    3321   693411840 :             bdsoa5(icol) = bdsoa5(icol) + sum(state%q(icol,:,icnst) * mair(:))
    3322             :           end if
    3323             : 
    3324             :         end do
    3325             :       end do
    3326             : 
    3327             :       ! Calculate the H2SO4 burden.
    3328     1050624 :       call cnst_get_ind("H2SO4", icnst)
    3329    34670592 :       h2so4(icol) = sum(state%q(icol,:,icnst) * mair(:))
    3330             : 
    3331             :       ! Calculate the SO2 burden.
    3332     1050624 :       call cnst_get_ind("SO2", icnst)
    3333    35794176 :       so2(icol) = sum(state%q(icol,:,icnst) * mair(:))
    3334             :     end do
    3335             : 
    3336       72960 :     if (carma_do_budget_diags) then
    3337             :        ! Output the total aerosol and gas burdens and the aerosol fluxes.
    3338           0 :        call outfld("SO4PRBD", pureso4(:), pcols, state%lchnk)
    3339           0 :        call outfld("SO4MXBD", mixso4(:), pcols, state%lchnk)
    3340           0 :        call outfld("SO4PRSF", cprflux(:), pcols, state%lchnk)
    3341           0 :        call outfld("SO4MXSF", cmxflux(:), pcols, state%lchnk)
    3342           0 :        call outfld("H2SO4BD", h2so4(:), pcols, state%lchnk)
    3343           0 :        call outfld("SO2BD", so2(:), pcols, state%lchnk)
    3344           0 :        call outfld("MXBCBD", bdbc(:), pcols, state%lchnk)
    3345           0 :        call outfld("MXDUSTBD", bddust(:), pcols, state%lchnk)
    3346           0 :        call outfld("MXOCBD", bdoc(:), pcols, state%lchnk)
    3347           0 :        call outfld("MXSALTBD", bdsalt(:), pcols, state%lchnk)
    3348           0 :        call outfld("MXSOA1BD", bdsoa1(:), pcols, state%lchnk)
    3349           0 :        call outfld("MXSOA2BD", bdsoa2(:), pcols, state%lchnk)
    3350           0 :        call outfld("MXSOA3BD", bdsoa3(:), pcols, state%lchnk)
    3351           0 :        call outfld("MXSOA4BD", bdsoa4(:), pcols, state%lchnk)
    3352           0 :        call outfld("MXSOA5BD", bdsoa5(:), pcols, state%lchnk)
    3353             :     endif
    3354             : 
    3355             :     ! Output the total aerosol mixing ratio
    3356       72960 :     call outfld("SO4PRMR", pureso4mr(:,:), pcols, state%lchnk)
    3357       72960 :     call outfld("MXSO4MR", mixso4mr(:,:), pcols, state%lchnk)
    3358       72960 :     call outfld("MXBCMR", bcmr(:,:), pcols, state%lchnk)
    3359       72960 :     call outfld("MXDUSTMR", dustmr(:,:), pcols, state%lchnk)
    3360       72960 :     call outfld("MXOCMR", ocmr(:,:), pcols, state%lchnk)
    3361       72960 :     call outfld("MXSALTMR", saltmr(:,:), pcols, state%lchnk)
    3362       72960 :     call outfld("MXSOAMR", soamr(:,:), pcols, state%lchnk)
    3363             : 
    3364       72960 :     return
    3365      145920 :   end subroutine CARMAMODEL_OutputDiagnostics
    3366             : 
    3367             : 
    3368             : 
    3369             :   !!  Called after wet deposition has been performed. Allows the specific model to add
    3370             :   !!  wet deposition of CARMA aerosols to the aerosols being communicated to the surface.
    3371             :   !!
    3372             :   !!  @version July-2011
    3373             :   !!  @author  Chuck Bardeen
    3374           0 :   subroutine CARMAMODEL_WetDeposition(carma, ielem, ibin, sflx, cam_out, state, rc)
    3375       72960 :     use camsrfexch, only: cam_out_t
    3376             : 
    3377             :     type(carma_type), intent(in)         :: carma       !! the carma object
    3378             :     integer, intent(in)                  :: ielem       !! element index
    3379             :     integer, intent(in)                  :: ibin        !! bin index
    3380             :     real(r8), intent(in)                 :: sflx(pcols) !! surface flux (kg/m2/s)
    3381             :     type(cam_out_t), intent(inout)       :: cam_out     !! cam output to surface models
    3382             :     type(physics_state), intent(in)      :: state       !! physics state variables
    3383             :     integer, intent(out)                 :: rc          !! return code, negative indicates failure
    3384             : 
    3385             :     integer    :: icol
    3386             : 
    3387             :     ! Default return code.
    3388           0 :     rc = RC_OK
    3389             : 
    3390           0 :     return
    3391           0 :   end subroutine CARMAMODEL_WetDeposition
    3392             : 
    3393             : 
    3394             :   !! Calculates the emissions for CARMA sea salt aerosol particles.
    3395             :   !!
    3396             :   !! @author  Tianyi Fan, Chuck Bardeen, Pengfei Yu
    3397             :   !! @version Dec-2010
    3398             :   !! originally calculate sea salt flux in EmitParticle, Pengfei Yu make
    3399             :   !! it a separate subroutine since multiple aerosol types need salt flux
    3400             :   !! e.g. sea salt, sea salt sulfate, marine organics
    3401     1459200 :   subroutine CARMAMODEL_SaltFlux(carma, ibin, state, r, dr, rmass, cam_in, SaltFlux, rc)
    3402           0 :     use ppgrid,        only: pcols
    3403             :     use physics_types, only: physics_state
    3404             :     use camsrfexch,    only: cam_in_t
    3405             : 
    3406             :     type(carma_type), intent(in)       :: carma                 !! the carma object
    3407             :     integer, intent(in)                :: ibin                  !! bin index
    3408             :     type(physics_state), intent(in)    :: state                 !! physics state
    3409             :     real(r8), intent(in)               :: r                     !! bin center (cm)
    3410             :     real(r8), intent(in)               :: dr                    !! bin width (cm)
    3411             :     real(r8), intent(in)               :: rmass                 !! bin mass (g)
    3412             :     type(cam_in_t), intent(in)         :: cam_in                !! surface inputs
    3413             :     real(r8), intent(out)              :: SaltFlux(pcols)       !! constituent surface flux (kg/m^2/s)
    3414             :     integer, intent(out)               :: rc                    !! return code, negative indicates failure
    3415             : 
    3416             :     integer      :: ncol                    ! number of columns in chunk
    3417             :     integer      :: icol                    ! column index
    3418             : 
    3419             : 
    3420             :     ! -------- local variables added for sea salt model ------------
    3421             :     real(r8)            :: rdrycm, rdry                       ! dry radius [cm], [um]
    3422             :     real(r8)            :: r80cm, r80                         ! wet radius at relatige humidity of 80% [cm]
    3423             :     real(r8)            :: ncflx                              ! dF/dr [#/m2/s/um]
    3424             :     real(r8)            :: Monahan, Clarke, Smith             ! dF/dr [#/m2/s/um]
    3425             :     real(r8)            :: A_para, B_para, sita_para          ! A, B, and sita parameters in Gong
    3426             :     real(r8)            :: B_mona                             ! the parameter used in Monahan
    3427             :     real(r8)            :: W_Caff                             ! Correction factor in Caffrey
    3428             :     real(r8)            :: u14, ustar_smith, cd_smith         ! 14m wind velocity, friction velocity, and drag coefficient as desired by Andreas source function
    3429             :     real(r8)            :: wcap                               ! whitecap coverage
    3430             :     real(r8)            :: fref                               ! correction factor suggested by Hoppe2005
    3431             :     real(r8), parameter :: xkar = 0.4_r8                      ! Von Karman constant
    3432             :     real(r8)            :: u10in                              ! 10 meter wind speed use in the emission rate
    3433             : 
    3434             :     ! ------------------------------------------------------------------------------------------------
    3435             :     ! -- Martensson source function. Coefficients for the parameterization of Ak(c4-c0) and Bk(d4-d0)
    3436             :     ! -------------------------------------------------------------------------------------------------
    3437             :     real(r8), parameter :: c41 = -2.576e35_r8
    3438             :     real(r8), parameter :: c42 = -2.452e33_r8
    3439             :     real(r8), parameter :: c43 =  1.085e29_r8
    3440             :     real(r8), parameter :: c31 =  5.932e28_r8
    3441             :     real(r8), parameter :: c32 =  2.404e27_r8
    3442             :     real(r8), parameter :: c33 = -9.841e23_r8
    3443             :     real(r8), parameter :: c21 = -2.867e21_r8
    3444             :     real(r8), parameter :: c22 = -8.148e20_r8
    3445             :     real(r8), parameter :: c23 =  3.132e18_r8
    3446             :     real(r8), parameter :: c11 = -3.003e13_r8
    3447             :     real(r8), parameter :: c12 =  1.183e14_r8
    3448             :     real(r8), parameter :: c13 = -4.165e12_r8
    3449             :     real(r8), parameter :: c01 = -2.881e6_r8
    3450             :     real(r8), parameter :: c02 = -6.743e6_r8
    3451             :     real(r8), parameter :: c03 =  2.181e6_r8
    3452             :     real(r8), parameter :: d41 = 7.188e37_r8
    3453             :     real(r8), parameter :: d42 = 7.368e35_r8
    3454             :     real(r8), parameter :: d43 = -2.859e31_r8
    3455             :     real(r8), parameter :: d31 =-1.616e31_r8
    3456             :     real(r8), parameter :: d32 =-7.310e29_r8
    3457             :     real(r8), parameter :: d33 = 2.601e26_r8
    3458             :     real(r8), parameter :: d21 = 6.791e23_r8
    3459             :     real(r8), parameter :: d22 = 2.528e23_r8
    3460             :     real(r8), parameter :: d23 =-8.297e20_r8
    3461             :     real(r8), parameter :: d11 = 1.829e16_r8
    3462             :     real(r8), parameter :: d12 =-3.787e16_r8
    3463             :     real(r8), parameter :: d13 = 1.105e15_r8
    3464             :     real(r8), parameter :: d01 = 7.609e8_r8
    3465             :     real(r8), parameter :: d02 = 2.279e9_r8
    3466             :     real(r8), parameter :: d03 =-5.800e8_r8
    3467             : 
    3468             :     ! ------------------------------------------------------------
    3469             :     ! ----  Clarke Source Function. Coefficients for Ai    -------
    3470             :     ! ------------------------------------------------------------
    3471             :     real(r8), parameter :: beta01 =-5.001e3_r8
    3472             :     real(r8), parameter :: beta11 = 0.808e6_r8
    3473             :     real(r8), parameter :: beta21 =-1.980e7_r8
    3474             :     real(r8), parameter :: beta31 = 2.188e8_r8
    3475             :     real(r8), parameter :: beta41 =-1.144e9_r8
    3476             :     real(r8), parameter :: beta51 = 2.290e9_r8
    3477             :     real(r8), parameter :: beta02 = 3.854e3_r8
    3478             :     real(r8), parameter :: beta12 = 1.168e4_r8
    3479             :     real(r8), parameter :: beta22 =-6.572e4_r8
    3480             :     real(r8), parameter :: beta32 = 1.003e5_r8
    3481             :     real(r8), parameter :: beta42 =-6.407e4_r8
    3482             :     real(r8), parameter :: beta52 = 1.493e4_r8
    3483             :     real(r8), parameter :: beta03 = 4.498e2_r8
    3484             :     real(r8), parameter :: beta13 = 0.839e3_r8
    3485             :     real(r8), parameter :: beta23 =-5.394e2_r8
    3486             :     real(r8), parameter :: beta33 = 1.218e2_r8
    3487             :     real(r8), parameter :: beta43 =-1.213e1_r8
    3488             :     real(r8), parameter :: beta53 = 4.514e-1_r8
    3489             : 
    3490             :     ! ---------------------------------------------
    3491             :     ! coefficient A1, A2 in Andreas's Source funcion
    3492             :     ! ---------------------------------------------
    3493             :     real(r8)            ::A1A92
    3494             :     real(r8)            ::A2A92
    3495             : 
    3496             :     ! ---------------------------------------------
    3497             :     ! coefficient in Smith's Source funcion
    3498             :     ! ---------------------------------------------
    3499             :     real(r8), parameter ::  f1 = 3.1_r8
    3500             :     real(r8), parameter ::  f2 = 3.3_r8
    3501             :     real(r8), parameter ::  r1 = 2.1_r8
    3502             :     real(r8), parameter ::  r2 = 9.2_r8
    3503             :     real(r8), parameter ::  delta = 10._r8
    3504             : 
    3505             :     ! --------------------------------------------------------------------
    3506             :     ! ---- constants in calculating the particle wet radius [Gerber, 1985]
    3507             :     ! --------------------------------------------------------------------
    3508             :     real(r8), parameter :: c1   = 0.7674_r8        ! .
    3509             :     real(r8), parameter :: c2   = 3.079_r8         ! .
    3510             :     real(r8), parameter :: c3   = 2.573e-11_r8     ! .
    3511             :     real(r8), parameter :: c4   = -1.424_r8        ! constants in calculating the particle wet radius
    3512             : 
    3513             :     ! Default return code.
    3514     1459200 :     rc = RC_OK
    3515             : 
    3516     1459200 :     ncol = state%ncol
    3517             : 
    3518             :     ! Add any surface flux here.
    3519    22471680 :     SaltFlux(:ncol) = 0.0_r8
    3520             : 
    3521             :     ! Are we configured for one of the known emission schemes?
    3522             :     if( carma_seasalt_emis .ne. "Gong"       .and. &
    3523             :         carma_seasalt_emis .ne. "Martensson" .and. &
    3524             :         carma_seasalt_emis .ne. "Clarke"     .and. &
    3525             :         carma_seasalt_emis .ne. "Andreas"    .and. &
    3526             :         carma_seasalt_emis .ne. "Caffrey"    .and. &
    3527             :         carma_seasalt_emis .ne. "CMS"        .and. &
    3528     1459200 :         carma_seasalt_emis .ne. "NONE"       .and. &
    3529             :         carma_seasalt_emis .ne. "CONST"        ) then
    3530             : 
    3531           0 :        call endrun('carma_EmitParticle:: Invalid sea salt emission scheme.')
    3532             :     end if
    3533             : 
    3534             :     !**********************************
    3535             :     ! wet sea salt radius at RH = 80%
    3536             :     !**********************************
    3537     1459200 :     r80cm   = (c1 *  (r) ** c2 / (c3 * r ** c4 - log10(0.8_r8)) + (r)**3) ** (1._r8/3._r8) ! [cm]
    3538     1459200 :     rdrycm  = r  ! [cm]
    3539     1459200 :     r80     = r80cm *1.e4_r8    ! [um]
    3540     1459200 :     rdry    = rdrycm*1.e4_r8  ! [um]
    3541             : 
    3542    23930880 :     do icol = 1,ncol
    3543             : 
    3544             :        ! Only generate sea salt over the ocean.
    3545    22471680 :        if (cam_in%ocnfrac(icol) > 0._r8) then
    3546             : 
    3547             :           !**********************************
    3548             :           !    WIND for seasalt production
    3549             :           !**********************************
    3550    14081500 :           call CARMAMODEL_SurfaceWind_salt(icol, cam_in, u10in, rc)
    3551             : 
    3552             :           ! Add any surface flux here.
    3553    14081500 :           ncflx       = 0.0_r8
    3554    14081500 :           Monahan     = 0.0_r8
    3555    14081500 :           Clarke      = 0.0_r8
    3556    14081500 :           Smith       = 0.0_r8
    3557             : 
    3558             :           !**********************************
    3559             :           !        Whitecap Coverage
    3560             :           !**********************************
    3561    14081500 :           wcap = 3.84e-6_r8 * u10in ** 3.41_r8      ! in percent, ie., 75%, wcap = 0.75
    3562             : 
    3563             :           !****************************************
    3564             :           !        Hoppel correction factor
    3565             :           !        Smith drag coefficients and etc
    3566             :           !****************************************
    3567    14081500 :           if (u10in .le. 10._r8) then
    3568             :              cd_smith = 1.14e-3_r8
    3569             :           else
    3570     4729380 :              cd_smith = (0.49_r8 + 0.065_r8 * u10in) * 1.e-3_r8
    3571             :           end if
    3572             : 
    3573             :           ! ustar_smith = cd_smith **0.5_r8 * u10in
    3574             :           !
    3575             :           ! We don't have vg yet, since that is calculated by CARMA. That will require
    3576             :           ! a different interface for the emissions, storing vg in the physics buffer,
    3577             :           ! and/or doing some duplicate calculations for vg assuming 80% RH.
    3578             :           !          fref = (delta/state%zm(icol, pver))**(vg(icol, ibin, igelem(i))/(xkar*ustar_smith))
    3579    14081500 :           fref = 1.0_r8
    3580             : 
    3581             :           !**********************************
    3582             :           !        Source Functions
    3583             :           !**********************************
    3584             :           if (carma_seasalt_emis .eq. 'NONE') then
    3585             :              ncflx = 0._r8
    3586             :           end if
    3587             : 
    3588    14081500 :           if (carma_seasalt_emis .eq. 'CONST') then
    3589           0 :              ncflx = 1.e-5_r8
    3590             :           end if
    3591             : 
    3592             :           !-------Gong source function------
    3593    14081500 :           if (carma_seasalt_emis == "Gong") then
    3594    14081500 :              sita_para = 30
    3595    14081500 :              A_para = - 4.7_r8 * (1+ sita_para * r80) ** (- 0.017_r8 * r80** (-1.44_r8))
    3596    14081500 :              B_para = (0.433_r8 - log10(r80)) / 0.433_r8
    3597    14081500 :              ncflx = 1.373_r8* u10in ** 3.41_r8 * r80 ** A_para * (1._r8 + 0.057_r8 * r80**3.45_r8) * 10._r8 ** (1.607_r8 * exp(- B_para **2))
    3598             :              !            if (do_print) write(LUNOPRT, *) "Gong: ncflx = ", ncflx, ", u10n = ", u10in
    3599             :           end if
    3600             : 
    3601             :           !------Martensson source function-----
    3602    14081500 :           if (carma_seasalt_emis == "Martensson") then
    3603           0 :              if (rdry .le. 0.0725_r8) then
    3604           0 :                 ncflx = (Ak1(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk1(rdry*1.0e-6_r8)) * wcap      ! dF/dlogr [#/s/m2]
    3605           0 :                 ncflx = ncflx / (2.30258509_r8 * rdry)                                            ! dF/dr    [#/s/m2/um]
    3606           0 :              elseif (rdry .gt. 0.0725_r8 .and. rdry .le. 0.2095_r8) then
    3607           0 :                 ncflx = (Ak2(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk2(rdry*1.0e-6_r8)) * wcap      ! dF/dlogr [#/s/m2]
    3608           0 :                 ncflx = ncflx / (2.30258509_r8 * rdry)                                            ! dF/dr    [#/s/m2/um]
    3609           0 :              elseif (rdry .gt. 0.2095_r8 .and. rdry .le. 1.4_r8) then
    3610           0 :                 ncflx = (Ak3(rdry*1.0e-6_r8)* (25._r8+273._r8) + Bk3(rdry*1.0e-6_r8)) * wcap      ! dF/dlogr [#/s/m2]
    3611           0 :                 ncflx = ncflx / (2.30258509_r8 * rdry)                                            ! dF/dr    [#/s/m2/um]
    3612             :              else
    3613             :                 ncflx = 0._r8
    3614             :              end if
    3615             :           end if
    3616             : 
    3617             :           !-------Clarke source function-------
    3618    14081500 :           if (carma_seasalt_emis == "Clarke")then
    3619           0 :              if (rdry .lt. 0.066_r8) then
    3620           0 :                 ncflx = A1(rdry) * 1.e4_r8 * wcap                              ! dF/dlogr [#/s/m2]
    3621           0 :                 ncflx = ncflx / (2.30258509_r8 * rdry)                        ! dF/dr    [#/s/m2/um]
    3622           0 :              elseif (rdry .ge. 0.066_r8 .and. rdry .lt. 0.6_r8) then
    3623           0 :                 ncflx = A2(rdry) * 1.e4_r8 * wcap                             ! dF/dlogr [#/s/m2]
    3624           0 :                 ncflx = ncflx / (2.30258509_r8 * rdry)                        ! dF/dr    [#/s/m2/um]
    3625           0 :              elseif (rdry .ge. 0.6_r8 .and. rdry .lt. 4.0_r8) then
    3626           0 :                 ncflx = A3(rdry) * 1.e4_r8 * wcap                             ! dF/dlogr [#/s/m2]
    3627           0 :                 ncflx= ncflx / (2.30258509_r8 * rdry)                         ! dF/dr    [#/s/m2/um]
    3628             :              else
    3629             :                 ncflx = 0._r8
    3630             :              end if
    3631             :           end if
    3632             : 
    3633             :           !-----------Caffrey source function------------
    3634    14081500 :           if (carma_seasalt_emis == "Caffrey") then
    3635             : 
    3636             :              !Monahan
    3637           0 :              B_mona = (0.38_r8 - log10(r80)) / 0.65_r8
    3638           0 :              Monahan = 1.373_r8 * (u10in**3.41_r8) * r80**(-3._r8) * (1._r8 + 0.057_r8 *r80**1.05_r8)  * 10._r8 ** (1.19_r8 * exp(-1._r8 * B_mona**2)) ! dF/dr
    3639             : 
    3640             :              !Smith
    3641           0 :              u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar * log(14._r8 / 10._r8))  ! 14 meter wind
    3642           0 :              A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8)
    3643           0 :              A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8)
    3644           0 :              Smith = A1A92*exp(-f1 *(log(r80/r1))**2) + A2A92*exp(-f2 * (log(r80/r2))**2)     ! dF/dr   [#/m2/s/um]
    3645             : 
    3646             :              !Caffrey based on Monahan and Smith
    3647           0 :              W_Caff = 1.136_r8 **(-1._r8 * rdry ** (-0.855_r8))*(1._r8 + 0.2_r8/rdry)
    3648           0 :              if (rdry .lt. 0.15_r8) then
    3649             :                 ncflx = Monahan
    3650             :              else
    3651           0 :                 if (u10in .le. 9._r8) then
    3652             :                    ncflx = Monahan
    3653             :                 else
    3654           0 :                    if(Monahan .ge. Smith) then
    3655             :                       ncflx = Monahan
    3656             :                    else
    3657           0 :                       ncflx = Smith
    3658             :                    end if
    3659             :                 end if
    3660             :              end if
    3661             : 
    3662           0 :              ncflx = ncflx * W_Caff
    3663             : 
    3664             :              !%%%%%%%%%%%%%%%%%%%%%%%%%
    3665             :              ! Apply Hoppel correction
    3666             :              !%%%%%%%%%%%%%%%%%%%%%%%%%
    3667           0 :              ncflx = ncflx * fref
    3668             :           end if
    3669             : 
    3670             :           !--------CMS (Clarke, Monahan, and Smith source function)-------
    3671    14081500 :           if (carma_seasalt_emis == "CMS") then
    3672             : 
    3673             :              !Clarke
    3674           0 :              if (rdry .lt. 0.066_r8) then
    3675           0 :                 Clarke = A1(rdry) * 1.e4_r8 * wcap                     ! dF/dlogr [#/s/m2]
    3676           0 :                 Clarke = Clarke / (2.30258509_r8 * rdry)               ! dF/dr    [#/s/m2/um]
    3677           0 :              elseif ((rdry .ge. 0.066_r8) .and. (rdry .lt. 0.6_r8)) then
    3678           0 :                 Clarke = A2(rdry) * 1.e4_r8 * wcap                     ! dF/dlogr [#/s/m2]
    3679           0 :                 Clarke = Clarke / (2.30258509_r8 * rdry)               ! dF/dr    [#/s/m2/um]
    3680           0 :              elseif ((rdry .ge. 0.6_r8) .and. (rdry .lt. 4.0_r8)) then
    3681           0 :                 Clarke = A3(rdry) * 1.e4_r8 * wcap                      ! dF/dlogr [#/s/m2]
    3682           0 :                 Clarke= Clarke / (2.30258509_r8 * rdry)                 ! dF/dr    [#/s/m2/um]
    3683             :              end if
    3684             : 
    3685             :              !Monahan
    3686           0 :              B_Mona = (0.38_r8 - log10(r80)) / 0.65_r8
    3687           0 :              Monahan = 1.373_r8 * u10in ** 3.41_r8 * r80 ** (-3._r8) * (1._r8 + 0.057_r8 * r80**1.05_r8) * 10._r8 ** (1.19_r8 * exp(- B_Mona **2))
    3688             : 
    3689             :              !Smith
    3690           0 :              u14 = u10in * (1._r8 + cd_smith**0.5_r8 / xkar*log(14._r8 / 10._r8))  ! 14 meter wind
    3691           0 :              A1A92 = 10._r8 ** (0.0676_r8 * u14 + 2.430_r8)
    3692           0 :              A2A92 = 10._r8 ** (0.9590_r8 * u14**0.5_r8 - 1.476_r8)
    3693           0 :              Smith = A1A92*exp(-f1 *(log(r80 / r1))**2) + A2A92*exp(-f2 * (log(r80 / r2))**2)     ! dF/dr   [#/m2/s/um]
    3694             : 
    3695             :              !%%%%%%%%%%%%%%%%%%%%%%%%%
    3696             :              !     CMS1 or CMS2
    3697             :              !%%%%%%%%%%%%%%%%%%%%%%%%%
    3698             :              !          if (rdry .lt. 0.1_r8) then   ! originally cut at 0.1 um
    3699             :              ! ***CMS1*****
    3700           0 :              if (rdry .lt. 1._r8) then    ! cut at 1.0 um
    3701             :                 ! ***CMS2*****
    3702             :                 !          if (rdry .lt. 2._r8) then    ! cut at 2.0 um
    3703             :                 ncflx = Clarke
    3704             :              else
    3705           0 :                 if (u10in .lt. 9._r8) then
    3706             :                    ncflx = Monahan
    3707             :                 else
    3708           0 :                    if (Monahan .gt. Smith) then
    3709             :                       ncflx = Monahan
    3710             :                    else
    3711           0 :                       ncflx = Smith
    3712             :                    end if
    3713             :                 end if
    3714             :              end if
    3715             : 
    3716             :              !%%%%%%%%%%%%%%%%%%%%%%%%%
    3717             :              ! Apply Hoppel correction
    3718             :              !%%%%%%%%%%%%%%%%%%%%%%%%%
    3719             :              ncflx = ncflx * fref
    3720             :           end if
    3721             : 
    3722             :           ! convert ncflx [#/m^2/s/um] to surfaceFlx [kg/m^2/s]
    3723    14081500 :           SaltFlux(icol) = ncflx * dr * rmass * 10._r8      ! *1e4[um/cm] * 1.e-3[kg/g]
    3724             : 
    3725             :           !          if (do_print) write(LUNOPRT, *) "ibin = ", ibin, ", igroup = ", igroup
    3726             :           !          if (do_print) write(LUNOPRT, *) "dr = ", dr, ", rmass = ", rmass
    3727             :           !          if (do_print) write(LUNOPRT, *) "ncflx = " , ncflx, ", SaltFlux = ", SaltFlux(icol)
    3728             : 
    3729             :           ! weighted by the ocean fraction
    3730    14081500 :           SaltFlux(icol) = SaltFlux(icol) * cam_in%ocnfrac(icol)
    3731             :        end if
    3732             :     end do
    3733             : 
    3734             :   contains
    3735             : 
    3736             :     ! Coefficient Ak in Martensson's source functions
    3737           0 :     pure real(r8) function Ak1(rpdry)
    3738             :       real(r8),intent(in) :: rpdry
    3739           0 :       Ak1 = c41*(2._r8*rpdry)**4 + c31*(2._r8*rpdry) ** 3 + c21*(2._r8*rpdry)**2 + c11*(2._r8*rpdry)+ c01
    3740     1459200 :     end function Ak1
    3741             : 
    3742           0 :     pure real(r8) function Ak2(rpdry)
    3743             :       real(r8),intent(in) :: rpdry
    3744           0 :       Ak2 = c42*(2._r8*rpdry)**4 + c32*(2._r8*rpdry) ** 3 + c22*(2._r8*rpdry)**2 + c12*(2._r8*rpdry)+ c02
    3745           0 :     end function Ak2
    3746             : 
    3747           0 :     pure real(r8) function Ak3(rpdry)
    3748             :       real(r8),intent(in) :: rpdry
    3749           0 :       Ak3 = c43*(2._r8*rpdry)**4 + c33*(2._r8*rpdry) ** 3 + c23*(2._r8*rpdry)**2 + c13*(2._r8*rpdry)+ c03
    3750           0 :     end function Ak3
    3751             : 
    3752             :     ! Coefficient Bk in Martensson's source functions
    3753           0 :     pure real(r8) function Bk1(rpdry)
    3754             :       real(r8),intent(in) :: rpdry
    3755           0 :       Bk1= d41*(2._r8*rpdry)**4 + d31*(2._r8*rpdry) ** 3 + d21*(2._r8*rpdry)**2 + d11*(2._r8*rpdry)+ d01
    3756           0 :     end function Bk1
    3757             : 
    3758           0 :     pure real(r8) function Bk2(rpdry)
    3759             :       real(r8),intent(in) :: rpdry
    3760           0 :       Bk2 = d42*(2._r8*rpdry)**4 + d32*(2._r8*rpdry) ** 3 + d22*(2._r8*rpdry)**2 + d12*(2._r8*rpdry)+ d02
    3761           0 :     end function Bk2
    3762             : 
    3763           0 :     pure real(r8) function Bk3(rpdry)
    3764             :       real(r8),intent(in) :: rpdry
    3765           0 :       Bk3 = d43*(2._r8*rpdry)**4 + d33*(2._r8*rpdry) ** 3 + d23*(2._r8*rpdry)**2 + d13*(2._r8*rpdry)+ d03
    3766           0 :     end function Bk3
    3767             : 
    3768             :     ! Coefficient Ak in Clarkes's source function
    3769           0 :     pure real(r8) function A1(rpdry)
    3770             :       real(r8),intent(in) :: rpdry
    3771             :       A1 = beta01 + beta11*(2._r8*rpdry) + beta21*(2._r8*rpdry)**2 + beta31*(2._r8*rpdry)**3 &
    3772           0 :            + beta41*(2._r8*rpdry)**4 + beta51*(2._r8*rpdry)**5
    3773           0 :     end function A1
    3774             : 
    3775           0 :     pure real(r8) function A2(rpdry)
    3776             :       real(r8),intent(in) :: rpdry
    3777             :       A2 = beta02 + beta12*(2._r8*rpdry) + beta22*(2._r8*rpdry)**2 + beta32*(2._r8*rpdry)**3 &
    3778           0 :            + beta42*(2._r8*rpdry)**4 + beta52*(2._r8*rpdry)**5
    3779           0 :     end function A2
    3780             : 
    3781           0 :     pure real(r8) function A3(rpdry)
    3782             :       real(r8),intent(in) :: rpdry
    3783             :       A3 = beta03 + beta13*(2._r8*rpdry) + beta23*(2._r8*rpdry)**2 + beta33*(2._r8*rpdry)**3 &
    3784           0 :            + beta43*(2._r8*rpdry)**4 + beta53*(2._r8*rpdry)**5
    3785           0 :     end function A3
    3786             : 
    3787             :   end subroutine CARMAMODEL_SaltFlux
    3788             : 
    3789             : 
    3790             :   !! Calculate the sea surface wind with a Weibull distribution.
    3791             :   !!
    3792             :   !! @author  Tianyi Fan
    3793             :   !! @version August-2010
    3794    14081500 :   subroutine CARMAMODEL_SurfaceWind_salt(icol, cam_in, u10in, rc)
    3795             :     use camsrfexch, only: cam_in_t
    3796             : 
    3797             :     ! in and out field
    3798             :     integer, intent(in)                 :: icol                  !! column index
    3799             :     type(cam_in_t), intent(in)          :: cam_in                !! surface inputs
    3800             :     real(r8), intent(out)               :: u10in                 !! the 10m wind speed put into the source function
    3801             :     integer, intent(out)                :: rc                    !! return code, negative indicates failure
    3802             : 
    3803             :     ! local variables
    3804             :     real(r8) :: uWB341              ! the nth mean wind with integration using Weibull Distribution(integrate from threshold wind velocity)
    3805             : 
    3806    14081500 :     rc = RC_OK
    3807             : 
    3808    14081500 :     uWB341 = 0._r8
    3809             : 
    3810             :     ! calc. the Weibull wind distribution
    3811    14081500 :     u10in = cam_in%u10(icol)
    3812             : 
    3813    14081500 :     call CARMAMODEL_WeibullWind(u10in, uth_salt, 3.41_r8, uWB341)
    3814             : 
    3815    14081500 :     u10in = uWB341 ** (1._r8 / 3.41_r8)
    3816             : 
    3817             : !    if (do_print) write(LUNOPRT, *) 'CARMA_SurfaceWind: icol ',icol, ', u10 =', cam_in%u10(icol), ', u10in =', u10in
    3818             : 
    3819    14081500 :     return
    3820    14081500 :   end subroutine CARMAMODEL_SurfaceWind_salt
    3821             : 
    3822             : 
    3823             : 
    3824             :   !!  Determines the mass fraction for the clay (submicron) bins based upon
    3825             :   !!  Tegen and Lacis [1996]. The total fraction for all clay bins should
    3826             :   !!  add up to 1.
    3827             :   !!
    3828             :   !!  NOTE: WOuld it be better to interpolate this into the bins rather than
    3829             :   !!  assigning all CARMA bins within a Tegen & Lacis bin the same value?
    3830             :   !!
    3831             :   !!  NOTE: Should any mass go to bins smaller than the smallest one used by
    3832             :   !!  Tegen and Lacis?
    3833             :   !!
    3834             :   !!  @version July-2012
    3835             :   !!  @author  Lin Su, Pengfei Yu, Chuck Bardeen
    3836        1536 :   subroutine CARMAMODEL_ClayMassFraction(carma, igroup, rdust, rc)
    3837             : 
    3838             :     type(carma_type), intent(in)         :: carma       !! the carma object
    3839             :     integer, intent(in)                  :: igroup      !! the carma group index
    3840             :     real(r8), intent(in)                 :: rdust(NBIN) !! radius assuming entire particle is dust
    3841             :     integer, intent(inout)               :: rc          !! return code, negative indicates failure
    3842             : 
    3843             :     ! Bins and mass fraction from Tegen and Lacis.
    3844             :     integer, parameter  :: NBIN_TEGEN = 4
    3845             :     real(r8)            :: tl_rmin(NBIN_TEGEN) = (/ 1.e-5_r8,  1.8e-5_r8, 3.e-5_r8, 6.e-5_r8 /)
    3846             :     real(r8)            :: tl_rmax(NBIN_TEGEN) = (/ 1.8e-5_r8, 3.e-5_r8,  6.e-5_r8, 1.e-4_r8 /)
    3847             :     real(r8)            :: tl_mf(NBIN_TEGEN)   = (/ 0.009_r8,  0.081_r8,  0.234_r8, 0.676_r8 /)
    3848             : 
    3849             :     ! Local Variables
    3850             :     integer, parameter  :: IBELOW = 1
    3851             :     integer, parameter  :: IABOVE = 6
    3852             :     integer             :: tl_count(NBIN_TEGEN+2)  ! count number in Tegen and Lacis ranges
    3853             :     integer             :: ind_up(NBIN_TEGEN+2)
    3854             :     integer             :: ind_low(NBIN_TEGEN+2)
    3855             :     integer             :: j                    ! local index number
    3856             :     integer             :: ibin                 ! carma bin index
    3857             : 
    3858             :     ! Default return code.
    3859        1536 :     rc = RC_OK
    3860             : 
    3861             :     ! Figure out how many of the CARMA bins are in each of the Tegen and Lacis
    3862             :     ! ranges.
    3863        1536 :     tl_count(:) = 0
    3864             : 
    3865       32256 :     do ibin = 1, NBIN
    3866             : 
    3867             :       ! Smaller than the range.
    3868       30720 :       if (rdust(ibin) < tl_rmin(1)) then
    3869        4608 :         tl_count(IBELOW) = tl_count(IBELOW) + 1
    3870             :       end if
    3871             : 
    3872             :       ! In the range
    3873      153600 :       do j = 1, NBIN_TEGEN
    3874      153600 :         if (rdust(ibin) < tl_rmax(j) .and. rdust(ibin) >= tl_rmin(j)) then
    3875       13824 :           tl_count(j+1) = tl_count(j+1) + 1
    3876             :         end if
    3877             :       end do
    3878             : 
    3879             :       ! Bigger than the range.
    3880       32256 :       if (rdust(ibin) >= tl_rmax(NBIN_TEGEN)) then
    3881       12288 :         tl_count(IABOVE) = tl_count(IABOVE) + 1
    3882             :       end if
    3883             :     end do
    3884             : 
    3885             :     ! Determine where the boundaries are between the TEGEN bins and
    3886             :     ! the CARMA bin structure.
    3887        1536 :     ind_up(:)   = 0
    3888        1536 :     ind_low(:)  = 0
    3889        1536 :     ind_up (IBELOW)  = tl_count(IBELOW)
    3890        1536 :     ind_low(IBELOW)  = min(1, tl_count(IBELOW))
    3891             : 
    3892        9216 :     do j = 1, 5
    3893        7680 :       ind_up (j+1) = ind_up(j) + tl_count(j+1)
    3894        9216 :       ind_low(j+1) = ind_up(j) + min(tl_count(j+1), 1)
    3895             :     end do
    3896             : 
    3897             :     ! No mass to bins smaller than the smallest size.
    3898        1536 :     clay_mf(:) = 0._r8
    3899             : 
    3900             :     ! NOTE: This won't work right if the dust bins are coarser than
    3901             :     ! the Tegen and Lacis bins. In this case mass fraction would need
    3902             :     ! to be combined from the Tegen & Lacis bins into a CARMA bin.
    3903        7680 :     do j = 1, NBIN_TEGEN
    3904        7680 :       if (tl_count(j+1) > 0) then
    3905       19968 :         clay_mf(ind_low(j+1):ind_up(j+1)) = tl_mf(j) / tl_count(j+1)
    3906             :       end if
    3907             :     end do
    3908             : 
    3909       15360 :     clay_mf(ind_low(IABOVE):) = 1._r8
    3910             : 
    3911        1536 :     return
    3912    14081500 :   end subroutine CARMAMODEL_ClayMassFraction
    3913             : 
    3914             : 
    3915             :   !! Calculate the sea surface wind with a Weibull distribution.
    3916             :   !!
    3917             :   !! NOTE: This should be combined with a similar routine in the sea salt
    3918             :   !! model, and any differences should be control by parameters into this
    3919             :   !! routine (and perhaps namelist variables).
    3920             :   !!
    3921             :   !! @author  Lin Su, Pengfei Yu, Chuck Bardeen
    3922             :   !! @version July-2012
    3923    21012480 :   subroutine CARMAMODEL_SurfaceWind(carma, icol, ielem, igroup, ibin, cam_in, uv10, wwd, uth, rc)
    3924             :     use camsrfexch, only: cam_in_t
    3925             : 
    3926             :     ! in and out field
    3927             :     type(carma_type), intent(in)        :: carma                 !! the carma object
    3928             :     integer, intent(in)                 :: icol                  !! column index
    3929             :     integer, intent(in)                 :: ielem                 !! element index
    3930             :     integer, intent(in)                 :: igroup                !! group index
    3931             :     integer, intent(in)                 :: ibin                  !! bin index
    3932             :     type(cam_in_t), intent(in)          :: cam_in                !! surface inputs
    3933             :     real(r8), intent(out)               :: uv10                  !! the 10m wind speed (m/s)
    3934             :     real(r8), intent(out)               :: wwd                   !! the 10m wind speed  with Weibull applied (m/s)
    3935             :     real(r8), intent(out)               :: uth                   !! the 10m wind threshold (m/s)
    3936             :     integer,  intent(inout)             :: rc                    !! return code, negative indicates failure
    3937             : 
    3938             :     real(r8), parameter                 :: vk = 0.4_r8           ! von Karman constant
    3939             :     real(r8)                            :: rmass(NBIN)           ! CARMA bin mass (g)
    3940             :     real(r8)                            :: r                     ! CARMA bin center (cm)
    3941             :     real(r8)                            :: rhop(NBIN)            ! CARMA partile element density (g/cm3)
    3942             :     real(r8)                            :: uthfact               !
    3943             :     real(r8), parameter                 :: rhoa = 1.25e-3_r8     ! Air density at surface
    3944             : 
    3945    21012480 :     rc = RC_OK
    3946             : 
    3947             :     ! Get the 10 meter wind speed
    3948    21012480 :     uv10 = cam_in%u10(icol)
    3949             : 
    3950             :     ! Calculate the threshold wind speed of each bin [Marticorena and Bergametti,1995]
    3951             :     ! note that in cgs units --> m/s
    3952    21012480 :     call CARMAGROUP_GET(carma, igroup, rc, rmass=rmass)
    3953    21012480 :     if (RC < RC_ERROR) return
    3954             : 
    3955             :     ! Define particle # concentration element index for current group
    3956    21012480 :     call CARMAELEMENT_Get(carma, ielem, rc, rho=rhop)
    3957    21012480 :     if (RC < RC_ERROR) return
    3958             : 
    3959             :     ! Calculate the radius assuming that all the mass will be emitted as this
    3960             :     ! element.
    3961    21012480 :     r = (3._r8 * rmass(ibin) / 4._r8 / PI / rhop(ibin))**(1._r8 / 3._r8)
    3962             : 
    3963    21012480 :     if (cam_in%soilw(icol) >= 0._r8 .AND. cam_in%soilw(icol) < 0.5_r8) then
    3964             : 
    3965             :        ! Prevent small values of soilw from driving uthfact negative, but allow
    3966             :        ! for dust emissions even when soilw is 0.
    3967     4235800 :        uthfact = 1.2_r8 + 0.2_r8*log10(max(0.001_r8, cam_in%soilw(icol)))
    3968             : 
    3969     4235800 :        if (r > 2.825e-5_r8) then  ! r(4) = 2.825e-5 cm
    3970             :            uth = uthfact * 1.e-2_r8 * 0.13_r8 * sqrt(rhop(ibin)*GRAV*r*2._r8/rhoa) &
    3971             :                        * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/(r*2._r8)**2.5_r8) &
    3972     4235800 :                        / sqrt(1.928_r8*(1331._r8*(r*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8)
    3973             :        else
    3974             :            uth = uthfact*1.e-2_r8* 0.13_r8 * sqrt(rhop(ibin)*GRAV*(.75e-4_r8)*2._r8/rhoa)   &
    3975             :                        * sqrt(1._r8 + .006_r8/rhop(ibin)/GRAV/((.75e-4_r8)*2._r8)**2.5_r8) &
    3976           0 :                        / sqrt(1.928_r8*(1331._r8*((.75e-4_r8)*2._r8)**1.56_r8 + .38_r8)**.092_r8 - 1._r8)
    3977             :        endif
    3978             :     else
    3979    16776680 :        uth = uv10
    3980             :     endif
    3981             : 
    3982             :     ! Use Weibull with Lansing's estimate for shape.
    3983    21012480 :     call CARMAMODEL_WeibullWind(uv10, uth, 2._r8, wwd)
    3984             : 
    3985             :     ! Set the threshold to the weibull wind value if sol moisture >= 0.5,
    3986             :     ! to turn off emissions.
    3987    21012480 :     if (cam_in%soilw(icol) >= 0.5_r8) then
    3988    16776680 :       uth = sqrt(wwd)
    3989             :     end if
    3990             : 
    3991             :     return
    3992    21012480 :   end subroutine CARMAMODEL_SurfaceWind
    3993             : 
    3994             : 
    3995             :   !! Read in the dust source (soil) erodibility factor from a NETCDF file. In this
    3996             :   !! processes, the data is regridded from the source size to the size needed by the
    3997             :   !! model.
    3998             :   !!
    3999             :   !! NOTE: This is currently doing 2-D interpolation, but it really should be doing
    4000             :   !! regridding.
    4001             :   !!
    4002             :   !! @author  Pengfei Yu
    4003             :   !! @version July-2012
    4004             : 
    4005             : !! st
    4006             : !! could use /components/cam/src/chemistry/aerosol/soil_erod_mod.F90 here insted of this routine?
    4007        1536 :   subroutine CARMAMODEL_ReadSoilErosionFactor(rc)
    4008    21012480 :     use ppgrid,             only: begchunk, endchunk, pcols
    4009             :     use ioFileMod,          only: getfil
    4010             :     use interpolate_data,   only: lininterp_init, lininterp, interp_type, lininterp_finish
    4011             :     use phys_grid,          only: get_rlon_all_p, get_rlat_all_p, get_ncols_p
    4012             :     use wrap_nf
    4013             : 
    4014             :     integer, intent(out)                      :: rc                    !! return code, negative indicates failure
    4015             : 
    4016             :     ! local variables
    4017             :     integer                                   :: idvar, f_nlon, f_nlat, idlat, idlon
    4018             :     integer                                   :: fid, fid_lon, fid_lat
    4019        1536 :     real(r8), allocatable, dimension(:,:)     :: ero_factor
    4020             :     character(len=256)                        :: ero_file
    4021        1536 :     real(r8), allocatable, dimension(:)       :: ero_lat               ! latitude dimension
    4022        1536 :     real(r8), allocatable, dimension(:)       :: ero_lon               ! latitude dimension
    4023             :     type (interp_type)                        :: lat_wght, lon_wght
    4024             :     real(r8)                                  :: lat(pcols)            ! latitude index
    4025             :     real(r8)                                  :: lon(pcols)            ! longitude index
    4026             :     integer                                   :: i
    4027             :     integer                                   :: lchnk                 ! chunk identifier
    4028             :     integer                                   :: ncol                  ! number of columns in chunk
    4029             : 
    4030             :     real(r8), parameter   :: zero=0_r8, twopi=2_r8*pi, degs2rads = pi/180._r8
    4031             : 
    4032        1536 :     rc = RC_OK
    4033             : 
    4034             :     ! Open the netcdf file (read only)
    4035        1536 :     call getfil(carma_soilerosion_file, ero_file, 0)
    4036        1536 :     call wrap_open(ero_file, 0, fid)
    4037             : 
    4038             :     ! Get file dimensions
    4039        1536 :     call wrap_inq_dimid(fid, 'plon', fid_lon)
    4040        1536 :     call wrap_inq_dimid(fid, 'plat', fid_lat)
    4041        1536 :     call wrap_inq_dimlen(fid, fid_lon, f_nlon)
    4042        1536 :     call wrap_inq_dimlen(fid, fid_lat, f_nlat)
    4043             : 
    4044        4608 :     allocate(ero_lat(f_nlat))
    4045        4608 :     allocate(ero_lon(f_nlon))
    4046        6144 :     allocate(ero_factor (f_nlon, f_nlat))
    4047        4608 :     allocate(soil_factor(pcols, begchunk:endchunk))
    4048             : 
    4049             :     ! Read in the tables.
    4050        1536 :     call wrap_inq_varid(fid, 'new_source', idvar)
    4051        1536 :     i = nf90_get_var (fid, idvar, ero_factor)
    4052        1536 :     if (i/=NF90_NOERR) then
    4053           0 :        write(iulog,*)'CARMA_ReadSoilErosionFactor: error reading varid =', idvar
    4054           0 :        call handle_error (i)
    4055             :     end if
    4056        1536 :     call wrap_inq_varid(fid, 'plat', idlat)
    4057        1536 :     call wrap_get_var_realx(fid, idlat,  ero_lat)
    4058        1536 :     call wrap_inq_varid(fid, 'plon', idlon)
    4059        1536 :     call wrap_get_var_realx(fid, idlon,  ero_lon)
    4060             : 
    4061      278016 :     ero_lat(:) = ero_lat(:)*degs2rads
    4062      554496 :     ero_lon(:) = ero_lon(:)*degs2rads
    4063             : 
    4064             :     ! Close the file.
    4065        1536 :     call wrap_close(fid)
    4066             : 
    4067        9216 :     do lchnk=begchunk, endchunk
    4068        7680 :        ncol = get_ncols_p(lchnk)
    4069             : 
    4070        7680 :        call get_rlat_all_p(lchnk, pcols, lat)
    4071        7680 :        call get_rlon_all_p(lchnk, pcols, lon)
    4072             : 
    4073        7680 :        call lininterp_init(ero_lon, f_nlon, lon, ncol, 2, lon_wght, zero, twopi)
    4074        7680 :        call lininterp_init(ero_lat, f_nlat, lat, ncol, 1, lat_wght)
    4075             : 
    4076        7680 :        call lininterp(ero_factor, f_nlon, f_nlat, soil_factor(1:ncol,lchnk), ncol, lon_wght, lat_wght)
    4077             : 
    4078        7680 :        call lininterp_finish(lon_wght)
    4079        9216 :        call lininterp_finish(lat_wght)
    4080             :     end do
    4081             : 
    4082        1536 :     deallocate(ero_lat)
    4083        1536 :     deallocate(ero_lon)
    4084        1536 :     deallocate(ero_factor)
    4085             : 
    4086        7680 :   end subroutine CARMAMODEL_ReadSoilErosionFactor
    4087             : 
    4088             :   !! Calculate the nth mean of u using Weibull wind distribution
    4089             :   !! considering the threshold wind velocity. This algorithm
    4090             :   !! integrates from uth to infinite (u^n P(u)du )
    4091             :   !!
    4092             :   !! @author  Tianyi Fan
    4093             :   !! @version August-2010
    4094    35093980 :    subroutine CARMAMODEL_WeibullWind(u, uth, n, uwb, wbk)
    4095        1536 :     use shr_spfn_mod, only: gamma =>  shr_spfn_gamma, igamma => shr_spfn_igamma
    4096             : 
    4097             :     real(r8), intent(in)  :: u      ! mean wind speed
    4098             :     real(r8), intent(in)  :: uth    ! threshold velocity
    4099             :     real(r8), intent(in)  :: n      ! the rank of u in the integration
    4100             :     real(r8), intent(out) :: uwb    ! the Weibull distribution
    4101             :     real(r8), intent(in), optional ::  wbk    ! the shape parameter
    4102             : 
    4103             :     ! local variable
    4104             :     real(r8)  :: k                  ! the shape parameter in Weibull distribution
    4105             :     real(r8)  :: c                  ! the scale parameter in Weibull distribution
    4106             : 
    4107    35093980 :     if (present(wbk)) then
    4108           0 :       k = wbk
    4109             :     else
    4110    35093980 :       k = 0.94_r8*u**0.5_r8        ! follow Grini and Zender, 2004JGR
    4111             :  !    k = 2.5_r8                   ! Lansing's estimate
    4112             :     end if
    4113             : 
    4114             :     ! If u is 0, then k can be 0, which makes a lot of this undefined.
    4115             :     ! Just return 0. in this case.
    4116    35093980 :     if (u < 0.35_r8) then
    4117       49520 :       uwb = 0._r8
    4118             :     else
    4119    35044460 :       c   = u * (gamma(1._r8 + 1._r8 / k))**(-1._r8)
    4120    35044460 :       uwb = c**n * igamma(n / k + 1._r8, (uth / c)**k)
    4121             :     end if
    4122             : 
    4123    35093980 :   end subroutine CARMAMODEL_WeibullWind
    4124             : 
    4125             :   !! Read BC data from three components:
    4126             :   !! 1. GAINS anthropogenic; 2. Ship Emission; 3. GFEDv3; 4. Aircraft
    4127             :   !! GAINS unit: kt/year; 2D; lon:-180-180
    4128             :   !! Ship Emission unit: kg/m2/s; 3D (month,lat,lon); lon:0-360
    4129             :   !! GFEDv3 unit: g/m2/month; 3D (month,lat,lon); lon:-180-180
    4130             :   !!
    4131             :   !! @author  Pengfei Yu
    4132             :   !! @version May-2013
    4133           0 :   subroutine CARMAMODEL_BCOCRead(rc)
    4134             :     use pmgrid,        only: plat, plon
    4135             :     use ioFileMod,     only: getfil
    4136             :     use cam_pio_utils, only: cam_pio_openfile
    4137             :     use interpolate_data,  only : lininterp_init, lininterp, interp_type, lininterp_finish
    4138             :     use pio,            only : file_desc_t, var_desc_t, &
    4139             :                                pio_inq_dimid, pio_inq_varid, &
    4140             :                                pio_get_var, pio_nowrite, pio_inq_dimlen, &
    4141             :                                pio_inq_dimlen, pio_closefile
    4142             :     use dycore,        only: dycore_is
    4143             : 
    4144             :     integer, intent(out)                      :: rc                    !! return code, negative indicates failure
    4145             : 
    4146             :     ! local variables
    4147             :     integer                                   :: f_nlon, f_nlat, f_ntime
    4148             :     integer                                   :: fid_lon, fid_lat, fid_time
    4149           0 :     real(r8), allocatable, dimension(:,:)     :: BC_f2d, BC2d, OC_f2d, OC2d
    4150           0 :     real(r8), allocatable, dimension(:,:,:)   :: BC_f3d, BC3d, OC_f3d, OC3d
    4151             : !
    4152             :     character(len=256)                        :: BC_GAINS_file
    4153             :     character(len=256)                        :: OC_GAINS_file
    4154             :     character(len=256)                        :: BC_GFEDv3_file
    4155             :     character(len=256)                        :: OC_GFEDv3_file
    4156             :     character(len=256)                        :: BC_ship_file
    4157             :     character(len=256)                        :: OC_ship_file
    4158             : !
    4159           0 :     real(r8), allocatable, dimension(:,:,:)       :: BC_anthro_GAINS
    4160           0 :     real(r8), allocatable, dimension(:,:,:)       :: OC_anthro_GAINS
    4161           0 :     real(r8), allocatable, dimension(:,:,:)       :: BC_GFEDv3
    4162           0 :     real(r8), allocatable, dimension(:,:,:)       :: OC_GFEDv3
    4163           0 :     real(r8), allocatable, dimension(:,:,:)       :: BC_ship_GAINS
    4164           0 :     real(r8), allocatable, dimension(:,:,:)       :: OC_ship_GAINS
    4165             : !
    4166           0 :     real(r8), allocatable, dimension(:)       :: BC_lat, OC_lat       ! latitude dimension
    4167           0 :     real(r8), allocatable, dimension(:)       :: BC_lon, OC_lon       ! latitude dimension
    4168             :     type (interp_type)                        :: wgt1, wgt2
    4169             :     real(r8)                                  :: lat(plat), lon(plon)
    4170             :     integer                                   :: i, itime
    4171             :     real(r8)                                                              :: rearth, gridarea
    4172             :     integer                                                                       :: nmonth
    4173             :     real(r8)                                                              :: tempor(plon,plat)
    4174           0 :     real(r8), allocatable, dimension(:,:,:)       :: tempor3d
    4175           0 :     real(r8), allocatable, dimension(:,:)         :: tempor2d
    4176           0 :     real(r8), allocatable, dimension(:)           :: tempor1d
    4177             :     integer                                                                       :: mid_idx
    4178           0 :     real(r8), allocatable, dimension(:,:)         :: BC_dom_f2d, OC_dom_f2d
    4179           0 :     real(r8), allocatable, dimension(:,:,:)       :: BC_dom_f3d, OC_dom_f3d
    4180           0 :     real(r8), allocatable, dimension(:,:,:)       :: BC_awb_f3d, OC_awb_f3d
    4181           0 :     real(r8), allocatable, dimension(:,:)         :: BC2d_dom, OC2d_dom
    4182           0 :     real(r8), allocatable, dimension(:)           :: facH, facL
    4183             :     integer                                                                       :: ind_15N, ind_45N, ierr
    4184             :     type(file_desc_t) :: fid
    4185             :     type(var_desc_t) :: idvar, idlat, idlon, idvar_dom, idvar_awb
    4186             : 
    4187             :     real(r8) :: nlats
    4188             : 
    4189           0 :     rc = RC_OK
    4190             : 
    4191           0 :     if(dycore_is('UNSTRUCTURED') ) then
    4192           0 :        call endrun('CARMAMODEL_BCOCRead: Yu2015 emissions not implemented for unstructured grids' )
    4193             :     end if
    4194             : 
    4195             :     ! get model lat and lon
    4196             :     nlats = plat-1 ! gnu compiler workaround
    4197           0 :     do i = 1, plat
    4198           0 :        lat(i) = 180._r8/(nlats)*(i-1)-90._r8
    4199             :     end do
    4200           0 :     do i = 1, plon
    4201           0 :        lon(i) = 360._r8/plon*(i-1)
    4202             :     end do
    4203             : 
    4204             : !
    4205           0 :     nmonth = 12
    4206             : 
    4207           0 :     if(carma_BCOCemissions == 'Yu2015')then
    4208             :        ! allocate BCnew and OCnew, unit is #/cm2/s
    4209           0 :        allocate(BCnew(plat, plon, nmonth))
    4210           0 :        allocate(OCnew(plat, plon, nmonth))
    4211           0 :        BCnew = -huge(1._r8)
    4212           0 :        OCnew = -huge(1._r8)
    4213             :     endif
    4214             : 
    4215             : ! monthly fraction of domestic emission
    4216           0 :     allocate(facH(nmonth))
    4217           0 :     allocate(facL(nmonth))
    4218             :     facH = (/0.18_r8,0.14_r8,0.13_r8,0.08_r8,0.04_r8,0.02_r8,0.01_r8,&
    4219           0 :                 0.02_r8,0.03_r8,0.07_r8,0.11_r8,0.17_r8/)
    4220             :     facL = (/0.17_r8,0.14_r8,0.11_r8,0.06_r8,0.04_r8,0.04_r8,0.04_r8,&
    4221           0 :                 0.04_r8,0.04_r8,0.06_r8,0.10_r8,0.15_r8/)
    4222             : 
    4223             : ! find index for 15N and 45N
    4224           0 :     do i = 1, plat
    4225           0 :        if (lat(i) .gt. 15._r8) then
    4226             :           ind_15N = i
    4227             :           exit
    4228             :        endif
    4229             :     end do
    4230             : !
    4231           0 :     do i = 1, plat
    4232           0 :        if (lat(i) .gt. 45._r8) then
    4233             :           ind_45N = i
    4234             :           exit
    4235             :        endif
    4236             :     end do
    4237             : 
    4238             :     ! Part 1a: BC anthropogenic from GAINS
    4239             :     ! -------------------------------------------------
    4240             :     ! Open the netcdf file (read only)
    4241           0 :     call getfil(BC_GAINS_filename, BC_GAINS_file, 0)
    4242           0 :     call cam_pio_openfile( fid, BC_GAINS_file, PIO_NOWRITE)
    4243             : 
    4244             :     ! Get file dimensions
    4245           0 :     ierr = pio_inq_dimid(fid, 'time', fid_time)
    4246           0 :     ierr = pio_inq_dimid(fid, 'lon', fid_lon)
    4247           0 :     ierr = pio_inq_dimid(fid, 'lat', fid_lat)
    4248           0 :     ierr = pio_inq_dimlen(fid, fid_time,f_ntime)
    4249           0 :     ierr = pio_inq_dimlen(fid, fid_lon, f_nlon)
    4250           0 :     ierr = pio_inq_dimlen(fid, fid_lat, f_nlat)
    4251             : 
    4252           0 :     allocate(BC_lat(f_nlat))
    4253           0 :     allocate(BC_lon(f_nlon))
    4254           0 :     allocate(BC_f3d(f_nlon, f_nlat, f_ntime))
    4255           0 :     allocate(BC_f2d(f_nlon, f_nlat))
    4256           0 :     allocate(BC_dom_f2d(f_nlon, f_nlat))
    4257           0 :     allocate(BC_dom_f3d(f_nlon, f_nlat, f_ntime))
    4258           0 :     allocate(BC_awb_f3d(f_nlon, f_nlat, f_ntime))
    4259           0 :     allocate(BC2d (plon, plat))
    4260           0 :     allocate(BC2d_dom (plon, plat))
    4261           0 :     allocate(BC_anthro_GAINS(nmonth, plat, plon))
    4262             : 
    4263             :     ! Read in the tables.
    4264           0 :     ierr = pio_inq_varid(fid, 'emis_all', idvar)
    4265           0 :     ierr = pio_get_var(fid, idvar, BC_f3d )
    4266           0 :     ierr = pio_inq_varid(fid, 'emis_dom', idvar_dom)
    4267           0 :     ierr = pio_get_var(fid, idvar, BC_dom_f3d )
    4268           0 :     ierr = pio_inq_varid(fid, 'emis_awb', idvar_awb)
    4269           0 :     ierr = pio_get_var(fid, idvar, BC_awb_f3d )
    4270           0 :     ierr = pio_inq_varid(fid, 'lat', idlat)
    4271           0 :     ierr = pio_get_var(fid, idlat, BC_lat )
    4272           0 :     ierr = pio_inq_varid(fid, 'lon ', idlon)
    4273           0 :     ierr = pio_get_var(fid, idlon, BC_lon )
    4274             : 
    4275             :     ! Close the file.
    4276           0 :     call pio_closefile(fid)
    4277             :     ! get emission excluding domestic and agriculture waste buring
    4278           0 :     BC_f2d = BC_f3d(:,:,1) - BC_dom_f3d(:,:,1) - BC_awb_f3d(:,:,1)
    4279           0 :     BC_dom_f2d = BC_dom_f3d(:,:,1)
    4280             : 
    4281             :     ! make sure file longitude range from 0-360
    4282           0 :     if (BC_lon(1) < -160._r8) then
    4283           0 :        allocate(tempor2d(f_nlon, f_nlat))
    4284           0 :        allocate(tempor1d(f_nlon))
    4285           0 :        mid_idx = floor(f_nlon/2._r8)
    4286             :        ! emission excluding dom
    4287           0 :        tempor2d(1:mid_idx,:f_nlat) = BC_f2d(mid_idx+1:f_nlon,:f_nlat)
    4288           0 :        tempor1d(1:mid_idx) = BC_lon(mid_idx+1:f_nlon)
    4289           0 :        tempor2d(mid_idx+1:f_nlon,:f_nlat) = BC_f2d(1:mid_idx,:f_nlat)
    4290           0 :        tempor1d(mid_idx+1:f_nlon) = BC_lon(1:mid_idx)+360._r8
    4291           0 :        BC_f2d = tempor2d
    4292             :        ! dom emission
    4293           0 :        tempor2d(1:mid_idx,:f_nlat) = BC_dom_f2d(mid_idx+1:f_nlon,:f_nlat)
    4294           0 :        tempor2d(mid_idx+1:f_nlon,:f_nlat) = BC_dom_f2d(1:mid_idx,:f_nlat)
    4295           0 :        BC_dom_f2d = tempor2d
    4296             :        !
    4297           0 :        BC_lon = tempor1d
    4298           0 :        deallocate(tempor2d)
    4299           0 :        deallocate(tempor1d)
    4300             :     else
    4301           0 :        BC_lon = BC_lon
    4302             :     endif
    4303             : 
    4304             :     ! Convert kt/year ----> #/cm2/s
    4305           0 :     rearth = 6.371e6_r8 ! m
    4306           0 :     do i = 1, f_nlat
    4307             :        gridarea = 2.0_r8*3.14159_r8*rearth/f_nlat * &
    4308           0 :                           2.0_r8*3.14159_r8*rearth/f_nlon*cos(BC_lat(i)/180._r8*3.14159_r8)
    4309             :        !
    4310           0 :        BC_f2d(:f_nlon,i) = BC_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ &       ! g/s
    4311           0 :                                         12._r8*6.02e23_r8/gridarea*1.e-4_r8                     ! #/cm2/s
    4312             :        !
    4313           0 :        BC_dom_f2d(:f_nlon,i) = BC_dom_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ &       ! g/s
    4314           0 :                                         12._r8*6.02e23_r8/gridarea*1.e-4_r8                     ! #/cm2/s
    4315             :     end do
    4316             : 
    4317           0 :     call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1)
    4318           0 :     call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2)
    4319           0 :     call lininterp(BC_f2d, f_nlon, f_nlat, BC2d, plon, plat, wgt2, wgt1)
    4320           0 :     call lininterp_finish(wgt1)
    4321           0 :     call lininterp_finish(wgt2)
    4322             : 
    4323           0 :     call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1)
    4324           0 :     call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2)
    4325           0 :     call lininterp(BC_dom_f2d, f_nlon, f_nlat, BC2d_dom, plon, plat, wgt2, wgt1)
    4326           0 :     call lininterp_finish(wgt1)
    4327           0 :     call lininterp_finish(wgt2)
    4328             : 
    4329             :     ! To implement Monthly data for dom emssion
    4330             :     ! methods from Stohl et al., 2013
    4331             :     ! facH works for high latitudes: 45-90N
    4332             :     ! facL works for low latitudes: 15-45N
    4333             :     ! below 15N, no seasonal variation
    4334             :     !
    4335           0 :     do itime = 1, nmonth
    4336             :        ! 45N-90N
    4337           0 :        BC2d(:plon, ind_45N:plat) = BC2d(:plon, ind_45N:plat) + &
    4338           0 :                                    BC2d_dom(:plon, ind_45N:plat)*facH(itime)*12._r8
    4339             :        ! 15N-45N
    4340           0 :        BC2d(:plon, ind_15N:ind_45N-1) = BC2d(:plon, ind_15N:ind_45N-1) + &
    4341           0 :                                         BC2d_dom(:plon, ind_15N:ind_45N-1)*facL(itime)*12._r8
    4342             :        ! 90S-15N
    4343           0 :        BC2d(:plon, 1:ind_15N-1) = BC2d(:plon, 1:ind_15N-1) + &
    4344           0 :                                   BC2d_dom(:plon, 1:ind_15N-1)
    4345             : 
    4346           0 :        BC_anthro_GAINS(itime, :plat, :plon) = transpose(BC2d(:plon, :plat))
    4347             :     end do
    4348             : 
    4349           0 :     deallocate(BC_lat)
    4350           0 :     deallocate(BC_lon)
    4351           0 :     deallocate(BC_f2d)
    4352           0 :     deallocate(BC_f3d)
    4353           0 :     deallocate(BC_dom_f2d)
    4354           0 :     deallocate(BC_dom_f3d)
    4355           0 :     deallocate(BC_awb_f3d)
    4356           0 :     deallocate(BC2d)
    4357           0 :     deallocate(BC2d_dom)
    4358             : 
    4359             :     ! Part 1b: OC anthropogenic from GAINS
    4360             :     ! -------------------------------------------------
    4361             :     ! Open the netcdf file (read only)
    4362           0 :     call getfil(OC_GAINS_filename, OC_GAINS_file, 0)
    4363           0 :     call cam_pio_openfile(fid, trim(OC_GAINS_file), PIO_NOWRITE)
    4364             : 
    4365             :     ! Get file dimensions
    4366           0 :     ierr = pio_inq_dimid(fid, 'time', fid_time)
    4367           0 :     ierr = pio_inq_dimid(fid, 'lon', fid_lon)
    4368           0 :     ierr = pio_inq_dimid(fid, 'lat', fid_lat)
    4369           0 :     ierr = pio_inq_dimlen(fid, fid_time,f_ntime)
    4370           0 :     ierr = pio_inq_dimlen(fid, fid_lon, f_nlon)
    4371           0 :     ierr = pio_inq_dimlen(fid, fid_lat, f_nlat)
    4372             : 
    4373           0 :     allocate(OC_lat(f_nlat))
    4374           0 :     allocate(OC_lon(f_nlon))
    4375           0 :     allocate(OC_f2d(f_nlon, f_nlat))
    4376           0 :     allocate(OC_f3d(f_nlon, f_nlat, f_ntime))
    4377           0 :     allocate(OC_dom_f2d(f_nlon, f_nlat))
    4378           0 :     allocate(OC_dom_f3d(f_nlon, f_nlat, f_ntime))
    4379           0 :     allocate(OC_awb_f3d(f_nlon, f_nlat, f_ntime))
    4380           0 :     allocate(OC2d (plon, plat))
    4381           0 :     allocate(OC2d_dom (plon, plat))
    4382           0 :     allocate(OC_anthro_GAINS(nmonth, plat, plon))
    4383             : 
    4384             :     ! Read in the tables.
    4385           0 :     ierr = pio_inq_varid(fid, 'emis_all', idvar)
    4386           0 :     ierr = pio_get_var(fid, idvar, OC_f3d )
    4387           0 :     ierr = pio_inq_varid(fid, 'emis_dom', idvar_dom)
    4388           0 :     ierr = pio_get_var(fid, idvar, OC_dom_f3d )
    4389           0 :     ierr = pio_inq_varid(fid, 'emis_awb', idvar_awb)
    4390           0 :     ierr = pio_get_var(fid, idvar, OC_awb_f3d )
    4391           0 :     ierr = pio_inq_varid(fid, 'lat', idlat)
    4392           0 :     ierr = pio_get_var(fid, idlat, OC_lat )
    4393           0 :     ierr = pio_inq_varid(fid, 'lon ', idlon)
    4394           0 :     ierr = pio_get_var(fid, idlon, OC_lon )
    4395             : 
    4396             :     ! Close the file.
    4397           0 :     call pio_closefile(fid)
    4398             : 
    4399             :     ! get emission excluding domestic and agriculture waste burning
    4400           0 :     OC_f2d(:,:) = OC_f3d(:,:,1) - OC_dom_f3d(:,:,1) - OC_awb_f3d(:,:,1)
    4401           0 :     OC_dom_f2d = OC_dom_f3d(:,:,1)
    4402             : 
    4403             :     ! make sure file longitude range from -180-180 to 0-360
    4404           0 :     if (OC_lon(1) < -160._r8) then
    4405           0 :        allocate(tempor2d(f_nlon, f_nlat))
    4406           0 :        allocate(tempor1d(f_nlon))
    4407           0 :        mid_idx = floor(f_nlon/2._r8)
    4408             :        ! emission excluding dom
    4409           0 :        tempor2d(1:mid_idx,:f_nlat) = OC_f2d(mid_idx+1:f_nlon,:f_nlat)
    4410           0 :        tempor1d(1:mid_idx) = OC_lon(mid_idx+1:f_nlon)
    4411           0 :        tempor2d(mid_idx+1:f_nlon,:f_nlat) = OC_f2d(1:mid_idx,:f_nlat)
    4412           0 :        tempor1d(mid_idx+1:f_nlon) = OC_lon(1:mid_idx)+360._r8
    4413           0 :        OC_f2d = tempor2d
    4414             :        ! dom emission
    4415           0 :        tempor2d(1:mid_idx,:f_nlat) = OC_dom_f2d(mid_idx+1:f_nlon,:f_nlat)
    4416           0 :        tempor2d(mid_idx+1:f_nlon,:f_nlat) = OC_dom_f2d(1:mid_idx,:f_nlat)
    4417           0 :        OC_dom_f2d = tempor2d
    4418             :        !
    4419           0 :        OC_lon = tempor1d
    4420           0 :        deallocate(tempor2d)
    4421           0 :        deallocate(tempor1d)
    4422             :     else
    4423           0 :        OC_lon = OC_lon
    4424             :     endif
    4425             : 
    4426             :     ! Convert kt/year ----> #/cm2/s
    4427           0 :     rearth = 6.371e6_r8 ! m
    4428           0 :     do i = 1, f_nlat
    4429             :        gridarea = 2.0_r8*3.14159_r8*rearth/f_nlat * &
    4430           0 :                   2.0_r8*3.14159_r8*rearth/f_nlon*cos(OC_lat(i)/180._r8*3.14159_r8)
    4431             :        !
    4432           0 :        OC_f2d(:f_nlon,i) = OC_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ &       ! g/s
    4433           0 :                            12._r8*6.02e23_r8/gridarea*1.e-4_r8                     ! #/cm2/s
    4434             :        !
    4435           0 :        OC_dom_f2d(:f_nlon,i) = OC_dom_f2d(:f_nlon,i)/365._r8/86400._r8*1.e9_r8/ &       ! g/s
    4436           0 :                                12._r8*6.02e23_r8/gridarea*1.e-4_r8                     ! #/cm2/s
    4437             :     end do
    4438             : 
    4439           0 :     call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1)
    4440           0 :     call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2)
    4441           0 :     call lininterp(OC_f2d, f_nlon, f_nlat, OC2d, plon, plat, wgt2, wgt1)
    4442           0 :     call lininterp_finish(wgt1)
    4443           0 :     call lininterp_finish(wgt2)
    4444             : 
    4445           0 :     call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1)
    4446           0 :     call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2)
    4447           0 :     call lininterp(OC_dom_f2d, f_nlon, f_nlat, OC2d_dom, plon, plat, wgt2, wgt1)
    4448           0 :     call lininterp_finish(wgt1)
    4449           0 :     call lininterp_finish(wgt2)
    4450             : 
    4451             :     ! To implement Monthly data for dom emssion
    4452             :     ! methods from Stohl et al., 2013
    4453             :     ! facH works for high latitudes: 45-90N
    4454             :     ! facL works for low latitudes: 15-45N
    4455             :     ! below 15N, no seasonal variation
    4456             :     !
    4457           0 :     do itime = 1, nmonth
    4458             :        ! 45N-90N
    4459           0 :        OC2d(:plon, ind_45N:plat) = OC2d(:plon, ind_45N:plat) + &
    4460           0 :                                    OC2d_dom(:plon, ind_45N:plat)*facH(itime)*12._r8
    4461             :        ! 15N-45N
    4462           0 :        OC2d(:plon, ind_15N:ind_45N-1) = OC2d(:plon, ind_15N:ind_45N-1) + &
    4463           0 :                                         OC2d_dom(:plon, ind_15N:ind_45N-1)*facL(itime)*12._r8
    4464             :        ! 90S-15N
    4465           0 :        OC2d(:plon, 1:ind_15N-1) = OC2d(:plon, 1:ind_15N-1) + &
    4466           0 :                                   OC2d_dom(:plon, 1:ind_15N-1)
    4467             : 
    4468           0 :        OC_anthro_GAINS(itime, :plat, :plon) = transpose(OC2d(:plon, :plat))
    4469             :     end do
    4470             : 
    4471           0 :     deallocate(OC_lat)
    4472           0 :     deallocate(OC_lon)
    4473           0 :     deallocate(OC_f2d)
    4474           0 :     deallocate(OC_f3d)
    4475           0 :     deallocate(OC_dom_f2d)
    4476           0 :     deallocate(OC_dom_f3d)
    4477           0 :     deallocate(OC_awb_f3d)
    4478           0 :     deallocate(OC2d)
    4479           0 :     deallocate(OC2d_dom)
    4480             : 
    4481             :     ! Part 2a: BC ship
    4482             :     ! -------------------------------------------------
    4483             :     ! Open the netcdf file (read only)
    4484           0 :     call getfil(BC_ship_filename, BC_ship_file, 0)
    4485           0 :     call cam_pio_openfile(fid, trim(BC_ship_file), PIO_NOWRITE)
    4486             :     !call wrap_open(BC_ship_file, 0, fid)
    4487             : 
    4488             :     ! Get file dimensions
    4489           0 :     ierr = pio_inq_dimid(fid, 'lon', fid_lon)
    4490           0 :     ierr = pio_inq_dimid(fid, 'lat', fid_lat)
    4491           0 :     ierr = pio_inq_dimlen(fid, fid_lon, f_nlon)
    4492           0 :     ierr = pio_inq_dimlen(fid, fid_lat, f_nlat)
    4493             : 
    4494           0 :     allocate(BC_lat(f_nlat))
    4495           0 :     allocate(BC_lon(f_nlon))
    4496           0 :     allocate(BC_f3d(f_nlon, f_nlat, nmonth))
    4497           0 :     allocate(BC3d (plon, plat, nmonth))
    4498           0 :     allocate(BC_ship_GAINS(nmonth, plat, plon))
    4499             : 
    4500             :    ! Read in the tables.
    4501           0 :     ierr = pio_inq_varid(fid, 'emiss_shp', idvar)
    4502           0 :     ierr = pio_get_var(fid, idvar, BC_f3d )
    4503           0 :     ierr = pio_inq_varid(fid, 'lat', idlat)
    4504           0 :     ierr = pio_get_var(fid, idlat, BC_lat )
    4505           0 :     ierr = pio_inq_varid(fid, 'lon ', idlon)
    4506           0 :     ierr = pio_get_var(fid, idlon, BC_lon )
    4507             : 
    4508             :     ! Close the file.
    4509           0 :     call pio_closefile(fid)
    4510             : 
    4511             :     ! make sure file longitude range from -180-180 to 0-360
    4512           0 :     if (BC_lon(1) < -160._r8) then
    4513           0 :        allocate(tempor3d(f_nlon, f_nlat, nmonth))
    4514           0 :        allocate(tempor1d(f_nlon))
    4515           0 :        mid_idx = floor(f_nlon/2._r8)
    4516           0 :        tempor3d(1:mid_idx,:f_nlat,:nmonth) = BC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth)
    4517           0 :        tempor1d(1:mid_idx) = BC_lon(mid_idx+1:f_nlon)
    4518           0 :        tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = BC_f3d(1:mid_idx,:f_nlat,:nmonth)
    4519           0 :        tempor1d(mid_idx+1:f_nlon) = BC_lon(1:mid_idx)+360._r8
    4520           0 :        BC_f3d = tempor3d
    4521           0 :        BC_lon = tempor1d
    4522           0 :        deallocate(tempor3d)
    4523           0 :        deallocate(tempor1d)
    4524             :     else
    4525           0 :        BC_lon = BC_lon
    4526             :     endif
    4527             : 
    4528             :     ! convert unit from kg/m2/s to #/cm2/s
    4529           0 :     BC_f3d = BC_f3d*1.e3_r8/1.e4_r8/12._r8*6.02e23_r8
    4530             : 
    4531           0 :     call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1)
    4532           0 :     call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2)
    4533           0 :     do itime = 1, nmonth
    4534           0 :        call lininterp(BC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1)
    4535           0 :        BC3d(:,:,itime) = tempor(:,:)
    4536             :     end do
    4537           0 :     call lininterp_finish(wgt1)
    4538           0 :     call lininterp_finish(wgt2)
    4539             : 
    4540           0 :     do itime = 1, nmonth
    4541           0 :        BC_ship_GAINS(itime, :plat, :plon) = transpose(BC3d(:plon, :plat, itime))
    4542             :     end do
    4543             : 
    4544           0 :     deallocate(BC_lat)
    4545           0 :     deallocate(BC_lon)
    4546           0 :     deallocate(BC_f3d)
    4547           0 :     deallocate(BC3d)
    4548             : 
    4549             :     ! Part 2b: OC Ship
    4550             :     ! -------------------------------------------------
    4551             :     ! Open the netcdf file (read only)
    4552           0 :     call getfil(OC_ship_filename, OC_ship_file, 0)
    4553           0 :     call cam_pio_openfile(fid, trim(OC_ship_file), PIO_NOWRITE)
    4554             : 
    4555             :     ! Get file dimensions
    4556           0 :     ierr = pio_inq_dimid(fid, 'lon', fid_lon)
    4557           0 :     ierr = pio_inq_dimid(fid, 'lat', fid_lat)
    4558           0 :     ierr = pio_inq_dimlen(fid, fid_lon, f_nlon)
    4559           0 :     ierr = pio_inq_dimlen(fid, fid_lat, f_nlat)
    4560             : 
    4561           0 :     allocate(OC_lat(f_nlat))
    4562           0 :     allocate(OC_lon(f_nlon))
    4563           0 :     allocate(OC_f3d(f_nlon, f_nlat, nmonth))
    4564           0 :     allocate(OC3d (plon, plat, nmonth))
    4565           0 :     allocate(OC_ship_GAINS(nmonth, plat, plon))
    4566             : 
    4567             :     ! Read in the tables.
    4568           0 :     ierr = pio_inq_varid(fid, 'emiss_shp', idvar)
    4569           0 :     ierr = pio_get_var(fid, idvar, OC_f3d )
    4570           0 :     ierr = pio_inq_varid(fid, 'lat', idlat)
    4571           0 :     ierr = pio_get_var(fid, idlat, OC_lat )
    4572           0 :     ierr = pio_inq_varid(fid, 'lon ', idlon)
    4573           0 :     ierr = pio_get_var(fid, idlon, OC_lon )
    4574             : 
    4575             :     ! Close the file.
    4576           0 :     call pio_closefile(fid)
    4577             : 
    4578             :     ! make sure file longitude range from -180-180 to 0-360
    4579           0 :     if (OC_lon(1) < -160._r8) then
    4580           0 :        allocate(tempor3d(f_nlon, f_nlat, nmonth))
    4581           0 :        allocate(tempor1d(f_nlon))
    4582           0 :        mid_idx = floor(f_nlon/2._r8)
    4583           0 :        tempor3d(1:mid_idx,:f_nlat,:nmonth) = OC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth)
    4584           0 :        tempor1d(1:mid_idx) = OC_lon(mid_idx+1:f_nlon)
    4585           0 :        tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = OC_f3d(1:mid_idx,:f_nlat,:nmonth)
    4586           0 :        tempor1d(mid_idx+1:f_nlon) = OC_lon(1:mid_idx)+360._r8
    4587           0 :        OC_f3d = tempor3d
    4588           0 :        OC_lon = tempor1d
    4589           0 :        deallocate(tempor3d)
    4590           0 :        deallocate(tempor1d)
    4591             :     else
    4592           0 :        OC_lon = OC_lon
    4593             :     endif
    4594             : 
    4595             :     ! convert unit from kg/m2/s to #/cm2/s
    4596           0 :     OC_f3d = OC_f3d*1.e3_r8/1.e4_r8/12._r8*6.02e23_r8
    4597             : 
    4598           0 :     call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1)
    4599           0 :     call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2)
    4600           0 :     do itime = 1, nmonth
    4601           0 :        call lininterp(OC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1)
    4602           0 :        OC3d(:,:,itime) = tempor(:,:)
    4603             :     end do
    4604           0 :     call lininterp_finish(wgt1)
    4605           0 :     call lininterp_finish(wgt2)
    4606             : 
    4607           0 :     do itime = 1, nmonth
    4608           0 :        OC_ship_GAINS(itime, :plat, :plon) = transpose(OC3d(:plon, :plat, itime))
    4609             :     end do
    4610             : 
    4611           0 :     deallocate(OC_lat)
    4612           0 :     deallocate(OC_lon)
    4613           0 :     deallocate(OC_f3d)
    4614           0 :     deallocate(OC3d)
    4615             : 
    4616             :     ! Part 3a: BC GFEDv3
    4617             :     ! -------------------------------------------------
    4618             :     ! Open the netcdf file (read only)
    4619           0 :     call getfil(BC_GFEDv3_filename, BC_GFEDv3_file, 0)
    4620           0 :     call cam_pio_openfile(fid, trim(BC_GFEDv3_file), PIO_NOWRITE)
    4621             : 
    4622             :     ! Get file dimensions
    4623           0 :     ierr = pio_inq_dimid(fid, 'lon', fid_lon)
    4624           0 :     ierr = pio_inq_dimid(fid, 'lat', fid_lat)
    4625           0 :     ierr = pio_inq_dimlen(fid, fid_lon, f_nlon)
    4626           0 :     ierr = pio_inq_dimlen(fid, fid_lat, f_nlat)
    4627             : 
    4628           0 :     allocate(BC_lat(f_nlat))
    4629           0 :     allocate(BC_lon(f_nlon))
    4630           0 :     allocate(BC_f3d(f_nlon, f_nlat, nmonth))
    4631           0 :     allocate(tempor3d(f_nlon, f_nlat, nmonth))
    4632           0 :     allocate(BC3d (plon, plat, nmonth))
    4633           0 :     allocate(BC_GFEDv3(nmonth, plat, plon))
    4634             : 
    4635             :     ! Read in the tables.
    4636           0 :     BC_f3d = 0._r8
    4637           0 :     ierr = pio_inq_varid(fid, 'emis', idvar)
    4638           0 :     ierr = pio_get_var(fid, idvar, tempor3d )
    4639             :     !call wrap_inq_varid(fid, 'emis', idvar)
    4640             :     !call wrap_get_var_realx(fid, idvar,  tempor3d)
    4641           0 :     BC_f3d = BC_f3d + tempor3d
    4642             :     ! excluding non-real values
    4643           0 :     where (BC_f3d(:,:,:) .ge. 1.e10_r8)
    4644             :         BC_f3d(:,:,:) = 1.e-30_r8
    4645             :     end where
    4646             : 
    4647           0 :     ierr = pio_inq_varid(fid, 'lat', idlat)
    4648           0 :     ierr = pio_get_var(fid, idlat, BC_lat )
    4649           0 :     ierr = pio_inq_varid(fid, 'lon ', idlon)
    4650           0 :     ierr = pio_get_var(fid, idlon, BC_lon )
    4651             : 
    4652             :     ! Close the file.
    4653           0 :     call pio_closefile(fid)
    4654             : 
    4655             :     ! make sure file longitude range from -180-180 to 0-360
    4656           0 :     if (BC_lon(1) < -160._r8) then
    4657           0 :        allocate(tempor1d(f_nlon))
    4658           0 :        mid_idx = floor(f_nlon/2._r8)
    4659           0 :        tempor3d(1:mid_idx,:f_nlat,:nmonth) = BC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth)
    4660           0 :        tempor1d(1:mid_idx) = BC_lon(mid_idx+1:f_nlon)
    4661           0 :        tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = BC_f3d(1:mid_idx,:f_nlat,:nmonth)
    4662           0 :        tempor1d(mid_idx+1:f_nlon) = BC_lon(1:mid_idx)+360._r8
    4663           0 :        BC_f3d = tempor3d
    4664           0 :        BC_lon = tempor1d
    4665           0 :        deallocate(tempor1d)
    4666             :     else
    4667           0 :        BC_lon = BC_lon
    4668             :     endif
    4669             : 
    4670             :     ! convert unit from g/m2/month to #/cm2/s
    4671           0 :     BC_f3d = BC_f3d/1.e4_r8/30._r8/86400._r8/12._r8*6.02e23_r8
    4672             : 
    4673           0 :     call lininterp_init(BC_lat, f_nlat, lat, plat, 1, wgt1)
    4674           0 :     call lininterp_init(BC_lon, f_nlon, lon, plon, 1, wgt2)
    4675           0 :     do itime = 1, nmonth
    4676           0 :        call lininterp(BC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1)
    4677           0 :        BC3d(:,:,itime) = tempor(:,:)
    4678             :     end do
    4679           0 :     call lininterp_finish(wgt1)
    4680           0 :     call lininterp_finish(wgt2)
    4681             : 
    4682           0 :     do itime = 1, nmonth
    4683           0 :        BC_GFEDv3(itime, :plat, :plon) = transpose(BC3d(:plon, :plat, itime))
    4684             :     end do
    4685             : 
    4686           0 :     deallocate(BC_lat)
    4687           0 :     deallocate(BC_lon)
    4688           0 :     deallocate(BC_f3d)
    4689           0 :     deallocate(BC3d)
    4690           0 :     deallocate(tempor3d)
    4691             : 
    4692             :     ! Part 3b: OC GFEDv3
    4693             :     ! -------------------------------------------------
    4694             :     ! Open the netcdf file (read only)
    4695           0 :     call getfil(OC_GFEDv3_filename, OC_GFEDv3_file, 0)
    4696           0 :     call cam_pio_openfile(fid, trim(OC_GFEDv3_file), PIO_NOWRITE)
    4697             : 
    4698             :     ! Get file dimensions
    4699           0 :     ierr = pio_inq_dimid(fid, 'lon', fid_lon)
    4700           0 :     ierr = pio_inq_dimid(fid, 'lat', fid_lat)
    4701           0 :     ierr = pio_inq_dimlen(fid, fid_lon, f_nlon)
    4702           0 :     ierr = pio_inq_dimlen(fid, fid_lat, f_nlat)
    4703             : 
    4704             :     ! write(carma%f_LUNOPRT,*) ''
    4705             :     ! write(carma%f_LUNOPRT,*) 'f_lon = ', f_nlon
    4706             :     ! write(carma%f_LUNOPRT,*) 'f_lat = ', f_nlat
    4707             :     ! write(carma%f_LUNOPRT,*) ''
    4708             : 
    4709           0 :     allocate(OC_lat(f_nlat))
    4710           0 :     allocate(OC_lon(f_nlon))
    4711           0 :     allocate(OC_f3d(f_nlon, f_nlat, nmonth))
    4712           0 :     allocate(tempor3d(f_nlon, f_nlat, nmonth))
    4713           0 :     allocate(OC3d (plon, plat, nmonth))
    4714           0 :     allocate(OC_GFEDv3(nmonth, plat, plon))
    4715             : 
    4716             :     ! Read in the tables.
    4717           0 :      OC_f3d = 0._r8
    4718           0 :     ierr = pio_inq_varid(fid, 'emis', idvar)
    4719           0 :     ierr = pio_get_var(fid, idvar, tempor3d )
    4720             :     !call wrap_inq_varid(fid, 'emis', idvar)
    4721             :     !call wrap_get_var_realx(fid, idvar,  tempor3d)
    4722           0 :     OC_f3d = OC_f3d + tempor3d
    4723             :     ! excluding non-real values
    4724           0 :     where (OC_f3d(:,:,:) .ge. 1.e10_r8)
    4725             :         OC_f3d(:,:,:) = 1.e-30_r8
    4726             :     end where
    4727             : 
    4728           0 :     ierr = pio_inq_varid(fid, 'lat', idlat)
    4729           0 :     ierr = pio_get_var(fid, idlat, OC_lat )
    4730           0 :     ierr = pio_inq_varid(fid, 'lon ', idlon)
    4731           0 :     ierr = pio_get_var(fid, idlon, OC_lon )
    4732             : 
    4733             :     ! Close the file.
    4734           0 :     call pio_closefile(fid)
    4735             : 
    4736             :     ! make sure file longitude range from -180-180 to 0-360
    4737           0 :     if (OC_lon(1) < -160._r8) then
    4738           0 :        allocate(tempor1d(f_nlon))
    4739           0 :        mid_idx = floor(f_nlon/2._r8)
    4740           0 :        tempor3d(1:mid_idx,:f_nlat,:nmonth) = OC_f3d(mid_idx+1:f_nlon,:f_nlat,:nmonth)
    4741           0 :        tempor1d(1:mid_idx) = OC_lon(mid_idx+1:f_nlon)
    4742           0 :        tempor3d(mid_idx+1:f_nlon,:f_nlat,:nmonth) = OC_f3d(1:mid_idx,:f_nlat,:nmonth)
    4743           0 :        tempor1d(mid_idx+1:f_nlon) = OC_lon(1:mid_idx)+360._r8
    4744           0 :        OC_f3d = tempor3d
    4745           0 :        OC_lon = tempor1d
    4746           0 :        deallocate(tempor1d)
    4747             :     else
    4748           0 :        OC_lon = OC_lon
    4749             :     endif
    4750           0 :     call lininterp_init(OC_lat, f_nlat, lat, plat, 1, wgt1)
    4751           0 :     call lininterp_init(OC_lon, f_nlon, lon, plon, 1, wgt2)
    4752           0 :     do itime = 1, nmonth
    4753           0 :        call lininterp(OC_f3d(:,:,itime), f_nlon, f_nlat, tempor(:,:), plon, plat, wgt2, wgt1)
    4754           0 :        OC3d(:,:,itime) = tempor(:,:)
    4755             :     end do
    4756           0 :     call lininterp_finish(wgt1)
    4757           0 :     call lininterp_finish(wgt2)
    4758             : 
    4759           0 :     do itime = 1, nmonth
    4760           0 :        OC_GFEDv3(itime, :plat, :plon) = transpose(OC3d(:plon, :plat, itime))
    4761             :     end do
    4762             : 
    4763           0 :     deallocate(OC_lat)
    4764           0 :     deallocate(OC_lon)
    4765           0 :     deallocate(OC_f3d)
    4766           0 :     deallocate(OC3d)
    4767           0 :     deallocate(tempor3d)
    4768             : 
    4769             : ! Sum
    4770           0 :     do itime = 1, nmonth
    4771           0 :        BCnew(:plat, :plon, itime) = BC_anthro_GAINS(itime, :plat, :plon) +  &
    4772           0 :              BC_ship_GAINS(itime, :plat, :plon) +  BC_GFEDv3(itime, :plat, :plon)
    4773             : !
    4774           0 :        OCnew(:plat, :plon, itime) = OC_anthro_GAINS(itime, :plat, :plon) +  &
    4775           0 :              OC_ship_GAINS(itime, :plat, :plon) +  OC_GFEDv3(itime, :plat, :plon)
    4776             :     end do
    4777             : !
    4778           0 :     deallocate(BC_anthro_GAINS)
    4779           0 :     deallocate(OC_anthro_GAINS)
    4780           0 :     deallocate(BC_ship_GAINS)
    4781           0 :     deallocate(OC_ship_GAINS)
    4782           0 :     deallocate(BC_GFEDv3)
    4783           0 :     deallocate(OC_GFEDv3)
    4784           0 :     deallocate(facH)
    4785           0 :     deallocate(facL)
    4786             : !
    4787           0 :     return
    4788           0 :   end subroutine CARMAMODEL_BCOCRead
    4789             : 
    4790             : end module carma_model_mod

Generated by: LCOV version 1.14