LCOV - code coverage report
Current view: top level - physics/carma/models/trop_strat_soa1 - carma_model_mod.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 457 1738 26.3 %
Date: 2025-03-14 01:33:33 Functions: 13 32 40.6 %

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

Generated by: LCOV version 1.14