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