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