Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hcox_seasalt_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCOX\_SeaSalt\_Mod contains routines to calculate
9 : ! sea salt aerosol emissions, following the implementation in GEOS-Chem.
10 : ! Emission number densities of the fine and coarse mode sea salt aerosols
11 : ! are written into diagnostic containers `SEASALT\_DENS\_FINE` and
12 : ! `SEASALT\_DENS\_COARSE`, respectively.
13 : !\\
14 : !\\
15 : ! This is a HEMCO extension module that uses many of the HEMCO core
16 : ! utilities.
17 : !\\
18 : !\\
19 : ! !INTERFACE:
20 : !
21 : MODULE HCOX_SeaSalt_Mod
22 : !
23 : ! !USES:
24 : !
25 : USE HCO_Error_Mod
26 : USE HCO_Diagn_Mod
27 : USE HCO_State_Mod, ONLY : HCO_State
28 : USE HCOX_State_Mod, ONLY : Ext_State
29 :
30 : IMPLICIT NONE
31 : PRIVATE
32 : !
33 : ! !PUBLIC MEMBER FUNCTIONS:
34 : !
35 : PUBLIC :: HCOX_SeaSalt_Init
36 : PUBLIC :: HCOX_SeaSalt_Run
37 : PUBLIC :: HCOX_SeaSalt_Final
38 : !
39 : ! !REVISION HISTORY:
40 : ! 15 Dec 2013 - C. Keller - Now a HEMCO extension module
41 : ! See https://github.com/geoschem/hemco for complete history
42 : !EOP
43 : !------------------------------------------------------------------------------
44 : !
45 : ! !PRIVATE TYPES:
46 : !
47 : TYPE :: MyInst
48 : ! Tracer IDs
49 : INTEGER :: Instance
50 : INTEGER :: ExtNr
51 :
52 : ! Tracer IDs
53 : INTEGER :: ExtNrSS ! Extension number for seasalt
54 : INTEGER :: IDTSALA ! Fine aerosol model species ID
55 : INTEGER :: IDTSALC ! Coarse aerosol model species ID
56 : INTEGER :: IDTMOPO ! marine organic aerosol - phobic
57 : INTEGER :: IDTMOPI ! marine organic aerosol - philic
58 : INTEGER :: IDTBrSALA ! Br- in accum. sea salt aerosol
59 : INTEGER :: IDTBrSALC ! Br- in coarse sea salt aerosol
60 : LOGICAL :: CalcBrSalt ! Calculate Br- content?
61 : LOGICAL :: EmitSnowSS ! Calculate sea salt emission blowing snow
62 : LOGICAL :: ColdSST ! Flag to correct SSA emissions over cold waters
63 : INTEGER :: IDTSALACL ! Fine aerosol Chloride species ID
64 : INTEGER :: IDTSALCCL ! Coarse aerosol Chloride species ID
65 : INTEGER :: IDTSALAAL ! Fine SSA Alkalinity species ID
66 : INTEGER :: IDTSALCAL ! Coarse SSA Alkalinity species ID
67 :
68 : ! Scale factors
69 : REAL*8 :: BrContent ! Ratio of Br- to dry SSA (mass)
70 : REAL*8 :: WindScale ! Wind adjustment factor
71 : REAL*8 :: NSLNT_FYI ! North Hemisphere snow salinity on first year ice (FYI) (psu)
72 : REAL*8 :: NSLNT_MYI ! North Hemisphere snow salinity on multiyear ice (MYI) (psu)
73 : REAL*8 :: SSLNT_FYI ! South Hemisphere snow salinity on FYI (psu)
74 : REAL*8 :: SSLNT_MYI ! South Hemisphere snow salinity on MYI (psu)
75 : REAL*8 :: NAGE ! North Hemisphere snow age (days)
76 : REAL*8 :: SAGE ! South Hemisphere snow age (days)
77 : REAL*8 :: NumP ! number of particle per snowflake
78 :
79 : ! Module variables
80 : INTEGER :: NSALT ! # of seasalt tracers
81 : INTEGER, POINTER :: NR(:) ! Size bin information
82 : REAL*8, POINTER :: SRRC (:,:)
83 : REAL*8, POINTER :: SRRC_N(:,:)
84 : REAL*8, POINTER :: RREDGE(:,:)
85 : REAL*8, POINTER :: RRMID (:,:)
86 : REAL*8, POINTER :: SS_DEN(:) ! densities
87 : REAL*8, POINTER :: F_DI_N_FYI(:,:) ! add for blowing snow for NH
88 : REAL*8, POINTER :: F_DI_N_MYI(:,:) ! add for blowing snow for NH
89 : REAL*8, POINTER :: F_DI_S_FYI(:,:) ! add for blowing snow for SH
90 : REAL*8, POINTER :: F_DI_S_MYI(:,:) ! add for blowing snow for SH
91 : REAL*8, POINTER :: F_DN_N_FYI(:,:) ! add for blowing snow for NH
92 : REAL*8, POINTER :: F_DN_N_MYI(:,:) ! add for blowing snow for NH
93 : REAL*8, POINTER :: F_DN_S_FYI(:,:) ! add for blowing snow for SH
94 : REAL*8, POINTER :: F_DN_S_MYI(:,:) ! add for blowing snow for SH
95 :
96 :
97 : ! Number densities
98 : REAL(sp), POINTER :: NDENS_SALA(:,:) => NULL()
99 : REAL(sp), POINTER :: NDENS_SALC(:,:) => NULL()
100 : REAL(sp), POINTER :: NDENS_MOPO(:,:) => NULL()
101 : REAL(sp), POINTER :: NDENS_MOPI(:,:) => NULL()
102 : REAL(sp), POINTER :: MULTIICE(:,:) => NULL() ! add for blowing snow
103 :
104 : ! MODIS Chlorophyll-A
105 : REAL(hp), POINTER :: CHLR(:,:) => NULL()
106 :
107 : TYPE(MyInst), POINTER :: NextInst => NULL()
108 : END TYPE MyInst
109 :
110 : ! Pointer to instances
111 : TYPE(MyInst), POINTER :: AllInst => NULL()
112 : !
113 : ! !DEFINED PARAMETERS:
114 : !
115 : INTEGER, PARAMETER :: NR_MAX = 200 ! max. # of bins per mode
116 :
117 : ! Increment of radius for Emission integration (um)
118 : REAL*8, PARAMETER :: DR = 5.d-2
119 : REAL*8, PARAMETER :: BETHA = 2.d0
120 :
121 : CONTAINS
122 : !EOC
123 : !-------------------------------------------------------------------------------
124 : ! Harmonized Emissions Component (HEMCO) !
125 : !------------------------------------------------------------------------------
126 : !BOP
127 : !
128 : ! !IROUTINE: HCOX_SeaSalt_Run
129 : !
130 : ! !DESCRIPTION: Subroutine HcoX\_SeaSalt\_Run is the driver run routine to
131 : ! calculate SeaSalt emissions in HEMCO.
132 : !\\
133 : !\\
134 : ! !INTERFACE:
135 : !
136 0 : SUBROUTINE HCOX_SeaSalt_Run( ExtState, HcoState, RC )
137 : !
138 : ! !USES:
139 : !
140 : USE HCO_Calc_Mod, ONLY : HCO_EvalFld
141 : USE HCO_FluxArr_Mod, ONLY : HCO_EmisAdd
142 : !
143 : ! !INPUT PARAMETERS:
144 : !
145 : TYPE(HCO_State), POINTER :: HcoState ! Output obj
146 : TYPE(Ext_State), POINTER :: ExtState ! Module options
147 : !
148 : ! !INPUT/OUTPUT PARAMETERS:
149 : !
150 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
151 : !
152 : ! !REMARKS:
153 : ! References:
154 : ! ============================================================================
155 : ! (1 ) Chin, M., P. Ginoux, S. Kinne, B. Holben, B. Duncan, R. Martin,
156 : ! J. Logan, A. Higurashi, and T. Nakajima, "Tropospheric aerosol
157 : ! optical thickness from the GOCART model and comparisons with
158 : ! satellite and sunphotometers measurements", J. Atmos Sci., 2001.
159 : ! (2 ) Gong, S., L. Barrie, and J.-P. Blanchet, "Modeling sea-salt
160 : ! aerosols in the atmosphere. 1. Model development", J. Geophys. Res.,
161 : ! v. 102, 3805-3818, 1997.
162 : ! (3 ) Gong, S. L., "A parameterization of sea-salt aerosol source function
163 : ! for sub- and super-micron particles", Global Biogeochem. Cy., 17(4),
164 : ! 1097, doi:10.1029/2003GB002079, 2003.
165 : ! (4 ) Jaegle, L., P.K. Quinn, T.S. Bates, B. Alexander, J.-T. Lin, "Global
166 : ! distribution of sea salt aerosols: New constraints from in situ and
167 : ! remote sensing observations", Atmos. Chem. Phys., 11, 3137-3157,
168 : ! doi:10.5194/acp-11-3137-2011.
169 : ! (5 ) Huang, J., Jaeglé, L., "Wintertime enhancements of sea salt aerosol in
170 : ! polar regions consistent with a sea ice source from blowing snow."
171 : ! Atmos. Chem. Phys. 17, 3699–3712. https://doi.org/10.5194/acp-17-3699-2017, 2017.
172 : ! (6 ) Huang, J., Jaeglé, L., Chen, Q., Alexander, B., Sherwen, T.,
173 : ! Evans, M. J., Theys, N., and Choi, S. "Evaluating the impact of
174 : ! blowing snow sea salt aerosol on springtime BrO and O3 in the Arctic,
175 : ! Atmos. Chem. Phys. Discuss., https://doi.org/10.5194/acp-2019-1094, 2020.
176 : ! (7 ) Tschudi, M., W. N. Meier, J. S. Stewart, C. Fowler, and J. Maslanik.
177 : ! "EASE-Grid Sea Ice Age, Version 4." NASA National Snow and Ice Data Center
178 : ! Distributed Active Archive Center. doi: https://doi.org/10.5067/UTAV7490FEPB., 2019.
179 : !
180 : ! !REVISION HISTORY:
181 : ! See https://github.com/geoschem/hemco for complete history
182 : !EOP
183 : !------------------------------------------------------------------------------
184 : !BOC
185 : !
186 : ! !LOCAL VARIABLES:
187 : !
188 : TYPE(MyInst), POINTER :: Inst
189 : INTEGER :: I, J, N, R
190 : REAL*8 :: SALT, SALT_N, CHLR
191 : REAL*8 :: A_M2
192 : REAL*8 :: W10M
193 : REAL :: FLUX
194 0 : REAL(hp), TARGET :: FLUXSALA (HcoState%NX,HcoState%NY)
195 0 : REAL(hp), TARGET :: FLUXSALC (HcoState%NX,HcoState%NY)
196 0 : REAL(hp), TARGET :: FLUXBrSalA(HcoState%NX,HcoState%NY)
197 0 : REAL(hp), TARGET :: FLUXBrSalC(HcoState%NX,HcoState%NY)
198 0 : REAL(hp), TARGET :: FLUXMOPO (HcoState%NX,HcoState%NY)
199 0 : REAL(hp), TARGET :: FLUXMOPI (HcoState%NX,HcoState%NY)
200 0 : REAL(hp), TARGET :: FLUXSALACL(HcoState%NX,HcoState%NY)
201 0 : REAL(hp), TARGET :: FLUXSALCCL(HcoState%NX,HcoState%NY)
202 0 : REAL(hp), TARGET :: FLUXSALAAL(HcoState%NX,HcoState%NY)
203 0 : REAL(hp), TARGET :: FLUXSALCAL(HcoState%NX,HcoState%NY)
204 :
205 : ! New variables (jaegle 5/11/11)
206 : REAL*8 :: SST, SCALE
207 : ! jpp, 3/2/10
208 : REAL*8 :: SALT_NR
209 : ! B. Gantt, M. Johnson (7,9/15)
210 : REAL*8 :: OMSS1, OMSS2
211 :
212 : ! New variables for blowing snow (huang, 04/09/20)
213 : REAL*8 :: SNOWSALT
214 : REAL*8 :: FROPEN, FRFIRST
215 : REAL*8 :: FRICTVEL, WVMR, TEMP
216 : REAL*8 :: PRESS, P_ICE, RH_ICE
217 : REAL*8 :: D, FK, FD
218 : REAL*8 :: PSI, QSPRIME, UT, APRIM
219 : REAL*8 :: QS, QSNOWICE_FYI, QSNOWICE_MYI,QBSALT, QB0
220 : REAL*8 :: SLNT, SLNT_FYI, SLNT_MYI
221 : REAL*8 :: AGE, ISFROST
222 :
223 : ! New parameters for blowiung snow (huang, 04/09/20)
224 : REAL*8, PARAMETER :: LS = 2839d3 ! Latent heat of sublimation @ T=-30C (J/kg).
225 : ! Varies very little with Temperature
226 : REAL*8, PARAMETER :: RV = 461.5d0 !J kg-1 K-1
227 : REAL*8, PARAMETER :: RHONACL = 2160.0d0 !kg/m3
228 : REAL*8, PARAMETER :: RHOICE = 900.0d0 !kg/m3
229 : REAL*8, PARAMETER :: K = 2.16d-2 !J m-1 s-1 K-1
230 : REAL*8, PARAMETER :: A0 = 3.78407d-1
231 : REAL*8, PARAMETER :: A1 = -8.64089d-2
232 : REAL*8, PARAMETER :: A2 = -1.60570d-2
233 : REAL*8, PARAMETER :: A3 = 7.25516d-4
234 : REAL*8, PARAMETER :: A4 = -1.25650d-1
235 : REAL*8, PARAMETER :: A5 = 2.48430d-2
236 : REAL*8, PARAMETER :: A6 = -9.56871d-4
237 : REAL*8, PARAMETER :: A7 = 1.24600d-2
238 : REAL*8, PARAMETER :: A8 = 1.56862d-3
239 : REAL*8, PARAMETER :: A9 = -2.93002d-4
240 : REAL*8, PARAMETER :: A_SALT = 2.0d0 !from Mann et al. 2000
241 : REAL*8, PARAMETER :: B_SALT = 37.5d0 !in um
242 : REAL*8, PARAMETER :: DDSNOW = 2.0d0 !in um for snow particle interval
243 : LOGICAL, SAVE :: FIRST = .TRUE.
244 : LOGICAL, SAVE :: FIRSTSAL = .TRUE.
245 : CHARACTER(LEN=31) :: FLDNME
246 : INTEGER :: NDAYS!, cYYYY, cMM, cDD
247 0 : REAL(hp), TARGET :: MULTI(HcoState%NX,HcoState%NY)
248 0 : REAL(hp), TARGET :: SNOWSALA (HcoState%NX,HcoState%NY)
249 0 : REAL(hp), TARGET :: SNOWSALC (HcoState%NX,HcoState%NY)
250 :
251 : ! Error handling
252 : LOGICAL :: ERR
253 : CHARACTER(LEN=255) :: MSG, LOC
254 :
255 : !=================================================================
256 : ! HCOX_SeaSalt_Run begins here!
257 : !=================================================================
258 0 : LOC = 'HCOX_SeaSalt_Run (HCOX_SEASALT_MOD.F90)'
259 :
260 : ! Return if extension disabled
261 0 : IF ( ExtState%SeaSalt <= 0 ) RETURN
262 :
263 : ! Enter
264 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
265 0 : IF ( RC /= HCO_SUCCESS ) THEN
266 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
267 0 : RETURN
268 : ENDIF
269 :
270 : ! Exit status
271 0 : ERR = .FALSE.
272 :
273 : ! Get instance
274 0 : Inst => NULL()
275 0 : CALL InstGet ( ExtState%SeaSalt, Inst, RC )
276 0 : IF ( RC /= HCO_SUCCESS ) THEN
277 0 : WRITE(MSG,*) 'Cannot find SeaSalt instance Nr. ', ExtState%SeaSalt
278 0 : CALL HCO_ERROR(MSG,RC)
279 0 : RETURN
280 : ENDIF
281 :
282 : ! Init values
283 0 : FLUXSALA = 0.0_hp
284 0 : FLUXSALC = 0.0_hp
285 0 : FLUXBrSalA = 0.0_hp
286 0 : FLUXBrSalC = 0.0_hp
287 0 : FLUXMOPO = 0.0_hp
288 0 : FLUXMOPI = 0.0_hp
289 0 : FLUXSALACL = 0.0_hp
290 0 : FLUXSALCCL = 0.0_hp
291 0 : FLUXSALAAL = 0.0_hp
292 0 : FLUXSALCAL = 0.0_hp
293 0 : SNOWSALA = 0.0_hp
294 0 : SNOWSALC = 0.0_hp
295 :
296 : ! If the marine POA option is on, get the HEMCO pointer to MODIS CHLR
297 0 : IF ( HcoState%MarinePOA ) THEN
298 0 : CALL HCO_EvalFld ( HcoState, 'MODIS_CHLR', Inst%CHLR, RC )
299 0 : IF ( RC /= HCO_SUCCESS ) THEN
300 0 : WRITE(MSG,*) 'Cannot find MODIS CHLR data for marine POA'
301 0 : CALL HCO_ERROR(MSG, RC)
302 0 : RETURN
303 : ENDIF
304 : ENDIF
305 :
306 0 : IF ( Inst%EmitSnowSS ) THEN
307 : ! Read in distribution of multi-year sea ice from
308 : ! remotely sensed observations of sea ice motion and sea
309 : ! ice extent for the Arctic (Tschudi et al., 2019). For the
310 : ! Antarctic, the multi year sea ice extent is based on the minimum
311 : ! MERRA-2 sea ice extent of the previous summer.
312 0 : CALL HCO_EvalFld ( HcoState, 'MULTISEAICE', MULTI, RC )
313 0 : IF ( RC /= HCO_SUCCESS ) THEN
314 0 : WRITE(MSG,*) 'Cannot find MULTISEAICE data for blowing snow'
315 0 : CALL HCO_ERROR(MSG, RC)
316 0 : RETURN
317 : ENDIF
318 : ENDIF
319 :
320 : !=================================================================
321 : ! Emission is integrated over a given size range for each bin
322 : !=================================================================
323 : !$OMP PARALLEL DO &
324 : !$OMP DEFAULT( SHARED ) &
325 : !$OMP PRIVATE( I, J, A_M2, W10M, SST, SCALE, N ) &
326 : !$OMP PRIVATE( SALT, SALT_N, R, SALT_NR, RC ) &
327 : !$OMP PRIVATE( OMSS1, OMSS2, CHLR ) &
328 : !$OMP PRIVATE( FROPEN, SNOWSALT, AGE ) &
329 : !$OMP PRIVATE( FRICTVEL, WVMR, TEMP, PRESS, P_ICE, RH_ICE ) &
330 : !$OMP PRIVATE( D, FK, FD, PSI, QSPRIME, APRIM, UT, FRFIRST ) &
331 : !$OMP PRIVATE( SLNT, SLNT_FYI, SLNT_MYI ) &
332 : !$OMP PRIVATE( QBSALT, QB0, QS, QSNOWICE_FYI, QSNOWICE_MYI ) &
333 : !$OMP SCHEDULE( DYNAMIC )
334 :
335 : ! Loop over surface boxes
336 0 : DO J = 1, HcoState%NY
337 0 : DO I = 1, HcoState%NX
338 :
339 : ! Grid box surface area on simulation grid [m2]
340 0 : A_M2 = HcoState%Grid%AREA_M2%Val( I, J )
341 :
342 : ! Advance to next grid box if it's not over water or sea ice
343 0 : IF ( ExtState%FROCEAN%Arr%Val(I,J) <= 0d0 .and. &
344 : ExtState%FRSEAICE%Arr%Val(I,J) <= 0d0 ) CYCLE
345 :
346 : ! Wind speed at 10 m altitude [m/s]
347 0 : W10M = SQRT( ExtState%U10M%Arr%Val(I,J)**2 &
348 0 : + ExtState%V10M%Arr%Val(I,J)**2 )
349 :
350 : ! Sea surface temperature in Celcius (jaegle 5/11/11)
351 0 : SST = ExtState%TSKIN%Arr%Val(I,J) - 273.15d0
352 :
353 : ! Limit SST to 0-30C range
354 0 : SST = MAX( SST , 0d0 ) ! limit to 0C
355 0 : SST = MIN( SST , 30d0 ) ! limit to 30C
356 :
357 : ! Empirical SST scaling factor (jaegle 5/11/11)
358 : SCALE = 0.329d0 + 0.0904d0*SST - &
359 0 : 0.00717d0*SST**2d0 + 0.000207d0*SST**3d0
360 :
361 : ! Limit the SST scaling factor to 0.25 over cold SST (below 5C)
362 0 : IF ( Inst%ColdSST .and. SST<= 5.0d0 ) SCALE = 0.25d0
363 :
364 : ! Reset to using original Gong (2003) emissions (jaegle 6/30/11)
365 : !SCALE = 1.0d0
366 :
367 : ! Apply to only the open ocean fraction of the gridbox (Huang 06/12/20)
368 0 : FROPEN = ExtState%FROCEAN%Arr%Val(I,J)-ExtState%FRSEAICE%Arr%Val(I,J)
369 0 : IF ( FROPEN < 0d0 ) FROPEN = 0d0
370 :
371 : ! Eventually apply wind scaling factor.
372 0 : SCALE = SCALE * Inst%WindScale * FROPEN
373 :
374 : !----------------------------------------------------------------
375 : ! huang, 04/09/20: Add blowing snow emissions over sea ice
376 : !----------------------------------------------------------------
377 0 : IF ( Inst%EmitSnowSS ) THEN
378 0 : IF ( ExtState%FRSEAICE%Arr%Val(I,J) > 0d0 )THEN
379 : ! Friction velocity [m/s]
380 0 : FRICTVEL = ExtState%USTAR%Arr%Val(I,J)
381 : ! Convert specific humidity [g H2O/kg air] to water vapor mixing ratio [v/v]
382 : ! QV2m is in kg H2O/kg air
383 0 : WVMR = ExtState%QV2M%Arr%Val(I,J) * 28.973d0 / 18.0d0
384 : ! Temperature at 2M in grid box (I,J) [K]
385 0 : TEMP = ExtState%T2M%Arr%Val(I,J)
386 : ! Surface pressure at grid box (I,J). Convert from [Pa] to [hPa]
387 0 : PRESS = HcoState%Grid%PSFC%Val( I, J ) /100d0
388 : ! Calculate saturation vapor pressure over ice [in Pa] at temperature
389 : ! TS [K]
390 0 : P_ICE = 10d0**(-2663.5d0/TEMP+12.537d0)
391 : ! Calculate relative humidity with respect to ice [%]
392 0 : RH_ICE = PRESS * WVMR / (P_ICE*0.01d0) *100.0d0
393 : ! Limit RH to 100%
394 0 : IF (RH_ICE > 100d0) RH_ICE =100.0d0
395 : ! Coefficient of Diffusion of water vapor in air [m2/s]
396 : ! Parameterization of Massman, W.J. "A review of teh molecular diffusivities of
397 : ! H2O, CO2, CH4... in air, O2 and N2 near STP" Atmos. Env., 32, 6, 1111-1127, 1998.
398 0 : D = 2.178d-5*(1000d0/PRESS)*(TEMP/273.15d0)**1.81
399 : ! Heat conductivity and vapor diffusion terms [m s/kg]
400 : ! Rogers and Yau "A short course in cloud physics", 1989, Eqn 9.4, with
401 : ! RV = 461.5 [J/kg/K] Individual gas constant for water vapor
402 : ! LS = 2839.0*1d3 [J/kg ] Latent heat of sublimation @ T=-30C
403 : ! K = 2.16d-2 [J/(m s K)] Coeff of thermal conductivity of Air [Table 7.1 Rogers and Yau]
404 0 : FK = ( LS / (RV * TEMP ) -1d0 ) * LS / (K * TEMP)
405 0 : FD = ( RV * TEMP ) / (D * P_ICE)
406 : ! Variable PSI [m2/s] Equation 11 from Dery and Yau (2001)
407 : ! RHOICE = 900 kg/m3 Density of ice
408 0 : PSI = (RH_ICE/100.d0 - 1d0)/(2d0 * RHOICE * (FK + FD))
409 : ! Convert PSI from m2/s to units of -1x10d-12 m2/s
410 0 : PSI = PSI * (-1.0d12)
411 : ! Qs prime [mm/day snow water equivalent] Equation 11 Dery and Yau (2001)
412 : QSPRIME = A0 + A1*PSI + A2*PSI**2d0 + A3*PSI**3d0 &
413 : + A4* W10M + A5*PSI*W10M &
414 : + A6*W10M*PSI**2d0 + A7*W10M**2d0 &
415 0 : + A8*PSI*W10M**2d0 + A9*W10M**3d0
416 0 : IF ( QSPRIME < 0.0d0 ) QSPRIME = 0.0d0
417 : !APRIM
418 0 : IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) AGE = Inst%SAGE*24.0d0
419 0 : IF ( HcoState%Grid%YEDGE%Val(I,J) .ge. 0 ) AGE = Inst%NAGE*24.0d0
420 : APRIM = (1.038d0+0.03758d0*AGE-0.00014349d0*AGE**2d0 &
421 0 : + (1.911315d-7*AGE**3d0) )**(-1d0)
422 : ! Threshold wind speed [m/s]
423 0 : UT = 6.975d0 + 0.0033d0 * (TEMP - 273.15d0 + 27.27d0 )**2.0d0
424 : !IF (W10M > UT) THEN
425 : ! add RH<100 too
426 :
427 0 : IF (W10M > UT .and. RH_ICE<100d0) THEN
428 0 : QBSALT = 0.385d0*(1.0d0-Ut/W10M)**2.59d0/FRICTVEL
429 0 : QB0 = 0.385d0*(1d0-6.975d0/W10M)**2.59d0/FRICTVEL
430 : ! Snow sublimation rate [kg/m2/s] Equation 1 in Yang et al. (2008)
431 : ! The constant 1.1574d-5 converts mm/day column integrated sublimation rate to kg m-2 s-1
432 0 : QS = 1.1574d-5*APRIM*QSPRIME*QBSALT/QB0
433 : ELSE
434 : QS = 0d0
435 : ENDIF
436 : !set up the snow salinity
437 0 : IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) SLNT_FYI = Inst%SSLNT_FYI
438 0 : IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) SLNT_MYI = Inst%SSLNT_MYI
439 0 : IF ( HcoState%Grid%YEDGE%Val(I,J) .ge. 0 ) SLNT_FYI = Inst%NSLNT_FYI
440 0 : IF ( HcoState%Grid%YEDGE%Val(I,J) .ge. 0 ) SLNT_MYI = Inst%NSLNT_MYI
441 : ! Sea ice fraction that is first year
442 0 : FRFIRST = ExtState%FRSEAICE%Arr%Val(I,J) - MULTI(I,J)
443 0 : IF ( FRFIRST < 0d0 ) FRFIRST = 0d0
444 : ! Apply FYI salinity to FYI seaice fraction and MYI salinity to MYI fraction
445 : !SLNT = SLNT_FYI * FRFIRST + SLNT_MYI * MULTI(I,J)
446 : ! Assume MYI salinity is 50% of FYI
447 : !SLNT = SLNT * FRFIRST + SLNT * 0.5 * MULTI(I,J)
448 : ! Convert snow sublimation rate to sea salt production rate [kg/m2/s]
449 : ! Calculate it separately for FYI and MYI, scaled by their respective sea ice fraction
450 0 : QSNOWICE_FYI = QS * SLNT_FYI * FRFIRST / 1000d0
451 0 : QSNOWICE_MYI = QS * SLNT_MYI * MULTI(I,J) / 1000d0
452 : ELSE
453 : QSNOWICE_FYI = 0.0d0
454 : QSNOWICE_MYI = 0.0d0
455 : ENDIF
456 : ENDIF
457 : ! End of added blowing snow section
458 : !-----------------------------------------------------------------
459 :
460 : ! Do for accumulation and coarse mode, and Marine POA if enabled
461 0 : DO N = 1,Inst%NSALT
462 :
463 : ! Reset values for SALT, SALT_N, and SNOWSALT
464 0 : SALT = 0d0
465 0 : SALT_N = 0d0
466 0 : SNOWSALT = 0d0
467 :
468 : ! update seasalt from blowing snow - huang 1/4/18
469 0 : IF (( Inst%EmitSnowSS ) .and. ( N .LT.3 )) THEN
470 0 : IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) THEN
471 : ! Southern Hemisphere
472 : SALT = SALT + HcoState%TS_EMIS * A_M2 &
473 0 : * ( QSNOWICE_FYI * SUM( Inst%F_DI_S_FYI(:,N) ) + &
474 0 : QSNOWICE_MYI * SUM( Inst%F_DI_S_MYI(:,N) ) ) * DDSNOW
475 :
476 : SNOWSALT = SNOWSALT + HcoState%TS_EMIS * A_M2 &
477 : * ( QSNOWICE_FYI * SUM( Inst%F_DI_S_FYI(:,N) ) + &
478 0 : QSNOWICE_MYI * SUM( Inst%F_DI_S_MYI(:,N) ) ) * DDSNOW
479 :
480 : SALT_N = SALT_N + HcoState%TS_EMIS * A_M2 &
481 0 : * ( QSNOWICE_FYI * SUM( Inst%F_DN_S_FYI(:,N) ) + &
482 0 : QSNOWICE_MYI * SUM( Inst%F_DN_S_MYI(:,N) ) ) * DDSNOW
483 : ELSE
484 : ! Northern Hemisphere
485 : SALT = SALT + HcoState%TS_EMIS * A_M2 &
486 0 : * ( QSNOWICE_FYI * SUM( Inst%F_DI_N_FYI(:,N) ) + &
487 0 : QSNOWICE_MYI * SUM( Inst%F_DI_N_MYI(:,N) ) ) * DDSNOW
488 :
489 : SNOWSALT = SNOWSALT + HcoState%TS_EMIS * A_M2 &
490 : * ( QSNOWICE_FYI * SUM( Inst%F_DI_N_FYI(:,N) ) + &
491 0 : QSNOWICE_MYI * SUM( Inst%F_DI_N_MYI(:,N) ) ) * DDSNOW
492 :
493 : SALT_N = SALT_N + HcoState%TS_EMIS * A_M2 &
494 0 : * ( QSNOWICE_FYI * SUM( Inst%F_DN_N_FYI(:,N) ) + &
495 0 : QSNOWICE_MYI * SUM( Inst%F_DN_N_MYI(:,N) ) ) * DDSNOW
496 : ENDIF
497 : ! ewl: comment out for blowing snow since calcbr2 retired
498 : ! ! add bromine blowing snow
499 : ! IF ( Inst%CalcBr2 ) THEN
500 : ! IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) THEN
501 : ! SSA_Br2 = SSA_Br2 + HcoState%TS_EMIS * A_M2 &
502 : ! * (QSNOWICE_FYI * SUM( Inst%F_DI_S_FYI(:,N) ) + &
503 : ! QSNOWICE_MYI * SUM( Inst%F_DI_S_MYI(:,N) ) ) * DDSNOW &
504 : ! * 0.00223d0 * 0.7d0 / 2.0d0
505 : ! ELSE
506 : ! SSA_Br2 = SSA_Br2 + HcoState%TS_EMIS * A_M2 &
507 : ! * (QSNOWICE_FYI * SUM( Inst%F_DI_N_FYI(:,N) ) + &
508 : ! QSNOWICE_MYI * SUM( Inst%F_DI_N_MYI(:,N) ) ) * DDSNOW &
509 : ! * 0.00223d0 * 0.7d0 / 2.0d0
510 : ! ENDIF
511 : ! ENDIF
512 : ENDIF
513 :
514 : ! Loop over size bins
515 0 : DO R = 1, Inst%NR(N)
516 :
517 : ! Coarse and accumulation modes
518 0 : IF ( N .LT. 3 ) THEN
519 :
520 : ! Update SeaSalt source into SALT [kg]
521 : SALT = SALT + &
522 0 : ( SCALE * Inst%SRRC(R,N) * A_M2 * W10M**3.41d0 )
523 :
524 : ! Update SeaSalt source into SALT_N [#]
525 : ! (bec, bmy, 4/13/05)
526 : SALT_N = SALT_N + &
527 0 : ( SCALE * Inst%SRRC_N(R,N) * A_M2 * W10M**3.41d0 )
528 :
529 : ENDIF
530 :
531 : ! Marine organic aerosols (M. Johnson, B. Gantt)
532 0 : IF ( N .EQ. 3 ) THEN
533 :
534 : ! Get MODIS Chlorophyll-a
535 0 : CHLR = Inst%CHLR(I,J)
536 :
537 : ! Calculate organic mass fraction of SSA
538 : OMSS1 = 1.0 / ( 1.0 + EXP( -2.63 * 3.0 * CHLR &
539 0 : + 0.18 * 3.0 * W10M ) )
540 :
541 : OMSS2 = ( OMSS1 ) / (1.0 + 0.03 &
542 0 : * EXP( 6.81 * ( Inst%RRMID(R,N) * 2.0 ) ) ) &
543 0 : + 0.03 * ( OMSS1 )
544 :
545 : ! Update seasalt source into SALT [kg]
546 0 : SALT = SALT + 6.0 * ( ( Inst%SRRC(R,N) * SCALE * A_M2 &
547 : * W10M**3.41d0 * OMSS2 ) &
548 : * ( 1.0 / ( 2.2 / ( 1.0 - OMSS2 &
549 0 : * (1.0 - 2200.0 / 1000.0 ) ) ) ) )
550 :
551 0 : SALT_N = SALT_N + 6.0 * ( Inst%SRRC_N(R,N) * SCALE * A_M2 &
552 0 : * W10M**3.41d0 * OMSS2 )
553 :
554 : ENDIF
555 :
556 : ENDDO !R
557 :
558 : ! ----------------------------------------------------------------
559 : ! Pass sea salt emissions do emission array [kg/m2/s]
560 : ! ----------------------------------------------------------------
561 : ! kg --> kg/m2/s
562 0 : IF ( N == 1 ) THEN
563 0 : FLUXSALA(I,J) = SALT / A_M2 / HcoState%TS_EMIS
564 0 : SNOWSALA(I,J) = SNOWSALT / A_M2 / HcoState%TS_EMIS
565 0 : ELSEIF ( N == 2 ) THEN
566 0 : FLUXSALC(I,J) = SALT / A_M2 / HcoState%TS_EMIS
567 0 : SNOWSALC(I,J) = SNOWSALT / A_M2 / HcoState%TS_EMIS
568 0 : ELSEIF ( N == 3 ) THEN
569 0 : FLUXMOPO(I,J) = SALT / A_M2 / HcoState%TS_EMIS
570 0 : ELSEIF ( N == 4 ) THEN
571 0 : FLUXMOPI(I,J) = SALT / A_M2 / HcoState%TS_EMIS
572 : ENDIF
573 :
574 : ! ----------------------------------------------------------------
575 : ! Write out number density for diagnostics [#]
576 : ! ----------------------------------------------------------------
577 0 : IF ( N == 1 ) THEN
578 0 : Inst%NDENS_SALA(I,J) = SALT_N
579 0 : ELSEIF ( N == 2 ) THEN
580 0 : Inst%NDENS_SALC(I,J) = SALT_N
581 0 : ELSEIF ( N == 3 ) THEN
582 0 : Inst%NDENS_MOPO(I,J) = SALT_N
583 0 : ELSEIF ( N == 4 ) THEN
584 0 : Inst%NDENS_MOPI(I,J) = SALT_N
585 : ENDIF
586 :
587 : ENDDO !N
588 :
589 : ENDDO !I
590 : ENDDO !J
591 : !$OMP END PARALLEL DO
592 :
593 : ! Check exit status
594 : IF ( ERR ) THEN
595 : RC = HCO_FAIL
596 : RETURN
597 : ENDIF
598 :
599 : !=================================================================
600 : ! PASS TO HEMCO STATE AND UPDATE DIAGNOSTICS
601 : !=================================================================
602 :
603 : ! SALA
604 0 : IF ( Inst%IDTSALA > 0 ) THEN
605 :
606 : ! Add flux to emission array
607 : CALL HCO_EmisAdd( HcoState, FLUXSALA, Inst%IDTSALA, &
608 0 : RC, ExtNr=Inst%ExtNrSS )
609 0 : IF ( RC /= HCO_SUCCESS ) THEN
610 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALA', RC )
611 0 : RETURN
612 : ENDIF
613 : ENDIF
614 :
615 : ! SALC
616 0 : IF ( Inst%IDTSALC > 0 ) THEN
617 :
618 : ! Add flux to emission array
619 : CALL HCO_EmisAdd( HcoState, FLUXSALC, Inst%IDTSALC, &
620 0 : RC, ExtNr=Inst%ExtNrSS )
621 0 : IF ( RC /= HCO_SUCCESS ) THEN
622 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALC', RC )
623 0 : RETURN
624 : ENDIF
625 :
626 : ENDIF
627 :
628 : ! SALA Chloride, xnw 10/13/17
629 0 : IF ( Inst%IDTSALACL > 0 ) THEN
630 0 : FLUXSALACL = ( FLUXSALA + SNOWSALA ) * 0.5504d0
631 : ! Add flux to emission array
632 : CALL HCO_EmisAdd( HcoState, FLUXSALACL, Inst%IDTSALACL, &
633 0 : RC, ExtNr=Inst%ExtNrSS )
634 0 : IF ( RC /= HCO_SUCCESS ) THEN
635 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALACL', RC)
636 0 : RETURN
637 : ENDIF
638 : ENDIF
639 :
640 : ! SALC Chloride, xnw 11/17/17
641 0 : IF ( Inst%IDTSALCCL > 0 ) THEN
642 0 : FLUXSALCCL = ( FLUXSALC + SNOWSALC ) * 0.5504d0
643 : ! Add flux to emission array
644 : CALL HCO_EmisAdd( HcoState, FLUXSALCCL, Inst%IDTSALCCL, &
645 0 : RC, ExtNr=Inst%ExtNrSS )
646 0 : IF ( RC /= HCO_SUCCESS ) THEN
647 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALCCL', RC)
648 0 : RETURN
649 : ENDIF
650 : ENDIF
651 :
652 : ! SALA Alkalinity, xnw 11/30/17
653 0 : IF ( Inst%IDTSALAAL > 0 ) THEN
654 0 : FLUXSALAAL = FLUXSALA
655 : ! Add flux to emission array
656 : CALL HCO_EmisAdd( HcoState, FLUXSALAAL, Inst%IDTSALAAL, &
657 0 : RC, ExtNr=Inst%ExtNrSS )
658 0 : IF ( RC /= HCO_SUCCESS ) THEN
659 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALAAL', RC)
660 0 : RETURN
661 : ENDIF
662 : ENDIF
663 :
664 : ! SALC Alkalinity, xnw 11/30/17
665 0 : IF ( Inst%IDTSALCAL > 0 ) THEN
666 0 : FLUXSALCAL = FLUXSALC
667 : ! Add flux to emission array
668 : CALL HCO_EmisAdd( HcoState, FLUXSALCAL, Inst%IDTSALCAL, &
669 0 : RC, ExtNr=Inst%ExtNrSS )
670 0 : IF ( RC /= HCO_SUCCESS ) THEN
671 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALCAL', RC)
672 0 : RETURN
673 : ENDIF
674 : ENDIF
675 :
676 : ! Bromine incorporated into sea salt
677 0 : IF ( Inst%CalcBrSalt ) THEN
678 :
679 : ! Scale BrSalX emissions to SalX.
680 : ! Also add blowing snow Br emissions assuming a factor of 5 enrichment
681 : ! factor relative to seawater
682 0 : FluxBrSalA = Inst%BrContent * (FluxSalA + SNOWSALA * 5.0d0)
683 0 : FluxBrSalC = Inst%BrContent * (FluxSalC + SNOWSALC * 5.0d0)
684 :
685 : ! Add flux to emission array
686 : CALL HCO_EmisAdd( HcoState, FLUXBrSalA, Inst%IDTBrSalA, &
687 0 : RC, ExtNr=Inst%ExtNrSS )
688 0 : IF ( RC /= HCO_SUCCESS ) THEN
689 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXBrSalA', RC )
690 0 : RETURN
691 : ENDIF
692 :
693 : ! Add flux to emission array
694 : CALL HCO_EmisAdd( HcoState, FLUXBrSalC, Inst%IDTBrSalC, &
695 0 : RC, ExtNr=Inst%ExtNrSS )
696 0 : IF ( RC /= HCO_SUCCESS ) THEN
697 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXBrSalC', RC )
698 0 : RETURN
699 : ENDIF
700 :
701 : ENDIF
702 :
703 : ! MOPO
704 0 : IF ( Inst%IDTMOPO > 0 ) THEN
705 :
706 : ! Add flux to emission array
707 : CALL HCO_EmisAdd( HcoState, FLUXMOPO, Inst%IDTMOPO, &
708 0 : RC, ExtNr=Inst%ExtNrSS )
709 0 : IF ( RC /= HCO_SUCCESS ) THEN
710 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXMOPO', RC )
711 0 : RETURN
712 : ENDIF
713 :
714 : ENDIF
715 :
716 : ! MOPI
717 0 : IF ( Inst%IDTMOPI > 0 ) THEN
718 :
719 : ! Add flux to emission array
720 : CALL HCO_EmisAdd( HcoState, FLUXMOPI, Inst%IDTMOPI, &
721 0 : RC, ExtNr=Inst%ExtNrSS )
722 0 : IF ( RC /= HCO_SUCCESS ) THEN
723 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXMOPI', RC )
724 0 : RETURN
725 : ENDIF
726 :
727 : ENDIF
728 :
729 : ! Cleanup
730 0 : Inst => NULL()
731 :
732 : ! Leave w/ success
733 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
734 :
735 : END SUBROUTINE HCOX_SeaSalt_Run
736 : !EOC
737 : !------------------------------------------------------------------------------
738 : ! Harmonized Emissions Component (HEMCO) !
739 : !------------------------------------------------------------------------------
740 : !BOP
741 : !
742 : ! !IROUTINE: HCOX_SeaSalt_Init
743 : !
744 : ! !DESCRIPTION: Subroutine HcoX\_SeaSalt\_Init initializes all
745 : ! extension variables.
746 : !\\
747 : !\\
748 : ! !INTERFACE:
749 : !
750 0 : SUBROUTINE HCOX_SeaSalt_Init( HcoState, ExtName, ExtState, RC )
751 : !
752 : ! !USES:
753 : !
754 : USE HCO_State_Mod, ONLY : HCO_GetHcoID
755 : USE HCO_STATE_MOD, ONLY : HCO_GetExtHcoID
756 : USE HCO_ExtList_Mod, ONLY : GetExtNr
757 : USE HCO_ExtList_Mod, ONLY : GetExtOpt
758 : !
759 : ! !INPUT PARAMETERS:
760 : !
761 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
762 : CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name
763 : TYPE(Ext_State), POINTER :: ExtState ! Options object
764 : !
765 : ! !INPUT/OUTPUT PARAMETERS:
766 : !
767 : INTEGER, INTENT(INOUT) :: RC ! Return status
768 : !
769 : ! !REVISION HISTORY:
770 : ! 15 Dec 2013 - C. Keller - Initial version
771 : ! See https://github.com/geoschem/hemco for complete history
772 : !EOP
773 : !------------------------------------------------------------------------------
774 : !BOC
775 : !
776 : ! !LOCAL VARIABLES:
777 : !
778 : INTEGER :: ExtNrSS
779 : INTEGER :: N, R, AS
780 : REAL*8 :: A, B, R0, R1
781 : REAL*8 :: CONST_N
782 : CHARACTER(LEN=255) :: MSG, LOC
783 : INTEGER :: nSpcSS, minLen
784 : REAL*8 :: SALA_REDGE_um(2), SALC_REDGE_um(2)
785 : REAL(dp) :: tmpScale
786 : LOGICAL :: FOUND
787 0 : INTEGER, ALLOCATABLE :: HcoIDsSS(:)
788 0 : CHARACTER(LEN=31), ALLOCATABLE :: SpcNamesSS(:)
789 : TYPE(MyInst), POINTER :: Inst
790 :
791 : ! Local variables for blowing snow
792 : INTEGER :: ND, IH !IH for different hemisphere
793 : REAL*8 :: D_SNOW, D_DRY
794 : REAL*8, PARAMETER :: A_SALT = 2.0d0 !from Mann et al. 2000
795 : REAL*8, PARAMETER :: B_SALT = 37.5d0 !in um
796 : REAL*8, PARAMETER :: DDSNOW = 2.0d0 !in um for snow particle interval
797 : REAL*8, PARAMETER :: RHONACL = 2160.0d0 !kg/m3
798 : REAL*8, PARAMETER :: RHOICE = 900.0d0 !kg/m3
799 :
800 : !=================================================================
801 : ! HCOX_SeaSalt_Init begins here!
802 : !=================================================================
803 0 : LOC = 'HCOX_SeaSalt_Init (HCOX_SEASALT_MOD.F90)'
804 :
805 : ! Extension number for seasalt
806 0 : ExtNrSS = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
807 0 : IF ( ExtNrSS <= 0 ) RETURN
808 :
809 : ! Enter
810 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
811 0 : IF ( RC /= HCO_SUCCESS ) THEN
812 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
813 0 : RETURN
814 : ENDIF
815 :
816 : ! Create Instance
817 0 : Inst => NULL()
818 0 : CALL InstCreate ( ExtNrSS, ExtState%SeaSalt, Inst, RC )
819 0 : IF ( RC /= HCO_SUCCESS ) THEN
820 0 : CALL HCO_ERROR ( 'Cannot create SeaSalt instance', RC )
821 0 : RETURN
822 : ENDIF
823 : ! Also fill ExtNrSS - this is the same as the parent ExtNr
824 0 : Inst%ExtNrSS = ExtNrSS
825 :
826 : ! ----------------------------------------------------------------------
827 : ! Get species IDs and settings
828 : ! ----------------------------------------------------------------------
829 :
830 : ! Read settings specified in configuration file
831 : ! Note: the specified strings have to match those in
832 : ! the config. file!
833 : Call GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Model sea salt Br-', &
834 0 : OptValBool=Inst%CalcBrSalt, RC=RC )
835 0 : IF ( Inst%CalcBrSalt ) THEN
836 0 : minLen = 4
837 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'Br- mass ratio', &
838 0 : OptValDp=Inst%BrContent, RC=RC )
839 0 : IF ( RC /= HCO_SUCCESS ) THEN
840 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
841 0 : RETURN
842 : ENDIF
843 : ELSE
844 0 : minLen = 2
845 0 : Inst%IDTBrSALA = -1
846 0 : Inst%IDTBrSALC = -1
847 0 : Inst%BrContent = 0.0d0
848 : ENDIF
849 :
850 : ! Get HEMCO species IDs
851 : CALL HCO_GetExtHcoID( HcoState, Inst%ExtNrSS, HcoIDsSS, &
852 0 : SpcNamesSS, nSpcSS, RC )
853 0 : IF ( RC /= HCO_SUCCESS ) THEN
854 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
855 0 : RETURN
856 : ENDIF
857 0 : IF ( nSpcSS < minLen ) THEN
858 0 : MSG = 'Not enough sea salt emission species set'
859 0 : CALL HCO_ERROR(MSG, RC )
860 0 : RETURN
861 : ENDIF
862 0 : Inst%IDTSALA = HcoIDsSS(1)
863 0 : Inst%IDTSALC = HcoIDsSS(2)
864 0 : Inst%IDTSALACL = HcoIDsSS(3)
865 0 : Inst%IDTSALCCL = HcoIDsSS(4)
866 0 : Inst%IDTSALAAL = HcoIDsSS(5)
867 0 : Inst%IDTSALCAL = HcoIDsSS(6)
868 0 : IF ( Inst%CalcBrSalt ) Inst%IDTBrSALA = HcoIDsSS(7)
869 0 : IF ( Inst%CalcBrSalt ) Inst%IDTBrSALC = HcoIDsSS(8)
870 0 : IF ( HcoState%MarinePOA ) THEN
871 0 : Inst%IDTMOPO = HcoIDsSS(9)
872 0 : Inst%IDTMOPI = HcoIDsSS(10)
873 : ENDIF
874 :
875 : ! Get aerosol radius'
876 0 : SALA_REDGE_um(:) = 0.0d0
877 0 : SALC_REDGE_um(:) = 0.0d0
878 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALA lower radius', &
879 0 : OptValDp=SALA_REDGE_um(1), RC=RC )
880 0 : IF ( RC /= HCO_SUCCESS ) THEN
881 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
882 0 : RETURN
883 : ENDIF
884 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALA upper radius', &
885 0 : OptValDp=SALA_REDGE_um(2), RC=RC )
886 0 : IF ( RC /= HCO_SUCCESS ) THEN
887 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
888 0 : RETURN
889 : ENDIF
890 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALC lower radius', &
891 0 : OptValDp=SALC_REDGE_um(1), RC=RC )
892 0 : IF ( RC /= HCO_SUCCESS ) THEN
893 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
894 0 : RETURN
895 : ENDIF
896 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALC upper radius', &
897 0 : OptValDp=SALC_REDGE_um(2), RC=RC )
898 0 : IF ( RC /= HCO_SUCCESS ) THEN
899 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
900 0 : RETURN
901 : ENDIF
902 :
903 : ! fix scaling factor over cold water SST (<5 degC)
904 : CALL GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Reduce SS cold water', &
905 0 : OptValBool=Inst%ColdSST, RC=RC )
906 0 : IF ( RC /= HCO_SUCCESS ) THEN
907 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
908 0 : RETURN
909 : ENDIF
910 :
911 : ! Add a SSA source from blowing snow (by J. Huang)
912 : CALL GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Blowing Snow SS', &
913 0 : OptValBool=Inst%EmitSnowSS, RC=RC )
914 0 : IF ( RC /= HCO_SUCCESS ) THEN
915 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
916 0 : RETURN
917 : ENDIF
918 :
919 : ! Whether or not differentiate snow salinity on FYI and MYI (by J. Huang)
920 : !CALL GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Diff salinity on ice', &
921 : ! OptValBool=Inst%FYIsnow, RC=RC )
922 : !IF ( RC /= HCO_SUCCESS ) RETURN
923 :
924 : ! Add snow salinity (NH and SH), snow age and number of particles
925 : ! per snowflake as external factor from configuration file
926 0 : IF ( Inst%EmitSnowSS ) THEN
927 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'NH FYI snow salinity', &
928 0 : OptValDp=Inst%NSLNT_FYI, RC=RC )
929 0 : IF ( RC /= HCO_SUCCESS ) THEN
930 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
931 0 : RETURN
932 : ENDIF
933 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'NH MYI snow salinity', &
934 0 : OptValDp=Inst%NSLNT_MYI, RC=RC )
935 0 : IF ( RC /= HCO_SUCCESS ) THEN
936 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
937 0 : RETURN
938 : ENDIF
939 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SH FYI snow salinity', &
940 0 : OptValDp=Inst%SSLNT_FYI, RC=RC )
941 0 : IF ( RC /= HCO_SUCCESS ) THEN
942 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
943 0 : RETURN
944 : ENDIF
945 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SH MYI snow salinity', &
946 0 : OptValDp=Inst%SSLNT_MYI, RC=RC )
947 0 : IF ( RC /= HCO_SUCCESS ) THEN
948 0 : CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
949 0 : RETURN
950 : ENDIF
951 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'NH snow age', &
952 0 : OptValDp=Inst%NAGE, RC=RC )
953 0 : IF ( RC /= HCO_SUCCESS ) THEN
954 0 : CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC )
955 0 : RETURN
956 : ENDIF
957 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SH snow age', &
958 0 : OptValDp=Inst%SAGE, RC=RC )
959 0 : IF ( RC /= HCO_SUCCESS ) THEN
960 0 : CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC )
961 0 : RETURN
962 : ENDIF
963 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'N per snowflake', &
964 0 : OptValDp=Inst%NumP, RC=RC )
965 0 : IF ( RC /= HCO_SUCCESS ) THEN
966 0 : CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC )
967 0 : RETURN
968 : ENDIF
969 : ELSE
970 0 : Inst%NSLNT_FYI = 0.1d0 ! default value 0.1 psu for NH FYI snow
971 0 : Inst%NSLNT_MYI = 0.05d0 ! default value 0.05 psu for NH MYI snow
972 0 : Inst%SSLNT_FYI = 0.03d0 ! default value 0.03 psu for SH FYI snow
973 0 : Inst%SSLNT_FYI = 0.015d0 ! default value 0.015 psu for SH MYI snow
974 0 : Inst%NAGE = 3.0d0 ! default value 3 days snow age in NH
975 0 : Inst%SAGE = 1.5d0 ! default value 1.5 days snow age in SH
976 0 : Inst%NumP = 5.0d0 ! default value of 5 particles per snowflake
977 : ENDIF
978 :
979 : ! Final BrSalt flag
980 0 : Inst%CalcBrSalt = ( Inst%CalcBrSalt .and. Inst%IDTBrSALA > 0 .and. Inst%IDTBrSALC > 0 )
981 :
982 : ! The source function calculated with GEOS-4 2x2.5 wind speeds
983 : ! is too high compared to GEOS-5 at the same resolution. The 10m
984 : ! winds in GEOS-4 are too rapid. To correct this, apply a global
985 : ! scaling factor of 0.72 (jaegle 5/11/11)
986 : ! Now check first if this factor is specified in configuration file
987 : CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'Wind scale factor', &
988 0 : OptValDp=tmpScale, FOUND=FOUND, RC=RC )
989 0 : IF ( RC /= HCO_SUCCESS ) THEN
990 0 : CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC )
991 0 : RETURN
992 : ENDIF
993 0 : IF ( .NOT. FOUND ) THEN
994 0 : tmpScale = 1.0d0
995 : ENDIF
996 0 : Inst%WindScale = tmpScale
997 :
998 : ! Verbose mode
999 0 : IF ( HcoState%amIRoot ) THEN
1000 :
1001 : ! Write the name of the extension regardless of the verbose setting
1002 0 : msg = 'Using HEMCO extension: SeaSalt (sea salt aerosol emissions)'
1003 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
1004 0 : CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator
1005 : ELSE
1006 0 : CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator
1007 : ENDIF
1008 :
1009 : ! Write all other messages as debug printout only
1010 0 : IF ( HcoState%MarinePOA ) THEN
1011 0 : MSG = 'Use marine organic aerosols option'
1012 0 : CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' )
1013 : ENDIF
1014 :
1015 0 : WRITE(MSG,*) 'Accumulation aerosol: ', TRIM(SpcNamesSS(1)), &
1016 0 : ':', Inst%IDTSALA
1017 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1018 0 : WRITE(MSG,*) ' - size range : ', SALA_REDGE_um
1019 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1020 0 : WRITE(MSG,*) 'Coarse aerosol : ', TRIM(SpcNamesSS(2)), &
1021 0 : ':', Inst%IDTSALC
1022 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1023 0 : WRITE(MSG,*) ' - size range : ', SALA_REDGE_um
1024 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1025 0 : WRITE(MSG,*) ' - wind scale factor: ', Inst%WindScale
1026 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1027 :
1028 0 : IF ( Inst%EmitSnowSS ) THEN
1029 0 : WRITE(MSG,*) ' - Arctic Snow Salinity on FYI (psu): ', Inst%NSLNT_FYI
1030 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1031 0 : WRITE(MSG,*) ' - Arctic Snow Salinity on MYI (psu): ', Inst%NSLNT_MYI
1032 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1033 0 : WRITE(MSG,*) ' - Antarctic Snow Salinity on FYI (psu): ', Inst%SSLNT_FYI
1034 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1035 0 : WRITE(MSG,*) ' - Antarctic Snow Salinity on FYI (psu): ', Inst%SSLNT_MYI
1036 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1037 0 : WRITE(MSG,*) ' - Arctic Snow age (days): ', Inst%NAGE
1038 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1039 0 : WRITE(MSG,*) ' - Antarctic Snow age(days): ', Inst%SAGE
1040 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1041 0 : WRITE(MSG,*) ' - Number of particle per snowflake: ', Inst%NumP
1042 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1043 : ENDIF
1044 :
1045 0 : WRITE(MSG,*) 'Accumulation Chloride: ', TRIM(SpcNamesSS(3)), &
1046 0 : ':', Inst%IDTSALACL
1047 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1048 0 : WRITE(MSG,*) 'Coarse Chloride: ', TRIM(SpcNamesSS(4)), &
1049 0 : ':', Inst%IDTSALCCL
1050 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1051 0 : WRITE(MSG,*) 'Accumulation Alkalinity: ', TRIM(SpcNamesSS(5)), &
1052 0 : ':', Inst%IDTSALAAL
1053 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1054 0 : WRITE(MSG,*) 'Coarse Alkalinity: ', TRIM(SpcNamesSS(6)), &
1055 0 : ':', Inst%IDTSALCAL
1056 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1057 :
1058 0 : IF ( Inst%CalcBrSalt ) THEN
1059 0 : WRITE(MSG,*) 'BrSALA: ', TRIM(SpcNamesSS(7)), Inst%IDTBrSALA
1060 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1061 0 : WRITE(MSG,*) 'BrSALC: ', TRIM(SpcNamesSS(8)), Inst%IDTBrSALC
1062 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1063 0 : WRITE(MSG,*) 'Br- mass content: ', Inst%BrContent
1064 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1065 : ENDIF
1066 :
1067 0 : IF ( HcoState%MarinePOA ) THEN
1068 0 : WRITE(MSG,*) 'Hydrophobic marine organic aerosol: ', &
1069 0 : TRIM(SpcNamesSS(9)), ':', Inst%IDTMOPO
1070 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1071 :
1072 0 : WRITE(MSG,*) 'Hydrophilic marine organic aerosol: ', &
1073 0 : TRIM(SpcNamesSS(10)), ':', Inst%IDTMOPI
1074 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1075 : ENDIF
1076 : ENDIF
1077 :
1078 : ! ----------------------------------------------------------------------
1079 : ! Allocate module and subroutine arrays
1080 : ! ----------------------------------------------------------------------
1081 :
1082 : ! Number of tracers dependent on MarinePOA (ewl, 7/9/15)
1083 0 : IF ( HcoState%MarinePOA ) THEN
1084 0 : Inst%NSALT = 4
1085 : ELSE
1086 0 : Inst%NSALT = 2
1087 : ENDIF
1088 :
1089 0 : ALLOCATE ( Inst%NR ( Inst%NSALT ), STAT=AS )
1090 0 : IF ( AS/=0 ) THEN
1091 0 : CALL HCO_ERROR( 'Cannot allocate NR', RC )
1092 0 : RETURN
1093 : ENDIF
1094 0 : Inst%NR = 0
1095 :
1096 0 : ALLOCATE ( Inst%SS_DEN ( Inst%NSALT ), STAT=AS )
1097 : IF ( AS/=0 ) THEN
1098 0 : CALL HCO_ERROR( 'Cannot allocate SS_DEN', RC )
1099 0 : RETURN
1100 : ENDIF
1101 0 : Inst%SS_DEN = 2200.d0
1102 :
1103 0 : ALLOCATE ( Inst%SRRC ( NR_MAX, Inst%NSALT ), STAT=AS )
1104 : IF ( AS/=0 ) THEN
1105 0 : CALL HCO_ERROR( 'Cannot allocate SRRC', RC )
1106 0 : RETURN
1107 : ENDIF
1108 0 : Inst%SRRC = 0d0
1109 0 : ALLOCATE ( Inst%SRRC_N ( NR_MAX, Inst%NSALT ), STAT=AS )
1110 : IF ( AS/=0 ) THEN
1111 0 : CALL HCO_ERROR( 'Cannot allocate SRRC_N', RC )
1112 0 : RETURN
1113 : ENDIF
1114 0 : Inst%SRRC_N = 0d0
1115 0 : ALLOCATE ( Inst%RREDGE ( 0:NR_MAX, Inst%NSALT ), STAT=AS )
1116 : IF ( AS/=0 ) THEN
1117 0 : CALL HCO_ERROR( 'Cannot allocate RREDGE', RC )
1118 0 : RETURN
1119 : ENDIF
1120 0 : Inst%RREDGE = 0d0
1121 0 : ALLOCATE ( Inst%RRMID ( NR_MAX, Inst%NSALT ), STAT=AS )
1122 : IF ( AS/=0 ) THEN
1123 0 : CALL HCO_ERROR( 'Cannot allocate RRMID', RC )
1124 0 : RETURN
1125 : ENDIF
1126 0 : Inst%RRMID = 0d0
1127 :
1128 0 : ALLOCATE ( Inst%NDENS_SALA( HcoState%NX, HcoState%NY), STAT=AS )
1129 : IF ( AS/=0 ) THEN
1130 0 : CALL HCO_ERROR( 'Cannot allocate NDENS_SALA', RC )
1131 0 : RETURN
1132 : ENDIF
1133 0 : Inst%NDENS_SALA = 0.0_sp
1134 :
1135 0 : ALLOCATE ( Inst%NDENS_SALC( HcoState%NX, HcoState%NY), STAT=AS )
1136 : IF ( AS/=0 ) THEN
1137 0 : CALL HCO_ERROR( 'Cannot allocate NDENS_SALC', RC )
1138 0 : RETURN
1139 : ENDIF
1140 0 : Inst%NDENS_SALC = 0.0_sp
1141 :
1142 : ! Allocate for blowing snow simulation
1143 0 : IF ( Inst%EmitSnowSS ) THEN
1144 0 : ALLOCATE ( Inst%F_DI_N_FYI( NR_MAX, Inst%NSALT ), STAT=AS )
1145 : IF ( AS/=0 ) THEN
1146 0 : CALL HCO_ERROR( 'Cannot allocate F_DI_N_FYI', RC )
1147 0 : RETURN
1148 : ENDIF
1149 0 : Inst%F_DI_N_FYI = 0.0_sp
1150 :
1151 0 : ALLOCATE ( Inst%F_DI_N_MYI( NR_MAX, Inst%NSALT ), STAT=AS )
1152 : IF ( AS/=0 ) THEN
1153 0 : CALL HCO_ERROR( 'Cannot allocate F_DI_N_MYI', RC )
1154 0 : RETURN
1155 : ENDIF
1156 0 : Inst%F_DI_N_MYI = 0.0_sp
1157 :
1158 0 : ALLOCATE ( Inst%F_DN_N_FYI( NR_MAX, Inst%NSALT ), STAT=AS )
1159 : IF ( AS/=0 ) THEN
1160 0 : CALL HCO_ERROR( 'Cannot allocate F_DN_N_FYI', RC )
1161 0 : RETURN
1162 : ENDIF
1163 0 : Inst%F_DN_N_FYI = 0.0_sp
1164 :
1165 0 : ALLOCATE ( Inst%F_DN_N_MYI( NR_MAX, Inst%NSALT ), STAT=AS )
1166 : IF ( AS/=0 ) THEN
1167 0 : CALL HCO_ERROR( 'Cannot allocate F_DN_N_MYI', RC )
1168 0 : RETURN
1169 : ENDIF
1170 0 : Inst%F_DN_N_MYI = 0.0_sp
1171 :
1172 0 : ALLOCATE ( Inst%F_DI_S_FYI( NR_MAX, Inst%NSALT ), STAT=AS )
1173 : IF ( AS/=0 ) THEN
1174 0 : CALL HCO_ERROR( 'Cannot allocate F_DI_S_FYI', RC )
1175 0 : RETURN
1176 : ENDIF
1177 0 : Inst%F_DI_S_FYI = 0.0_sp
1178 :
1179 0 : ALLOCATE ( Inst%F_DI_S_MYI( NR_MAX, Inst%NSALT ), STAT=AS )
1180 : IF ( AS/=0 ) THEN
1181 0 : CALL HCO_ERROR( 'Cannot allocate F_DI_S_MYI', RC )
1182 0 : RETURN
1183 : ENDIF
1184 0 : Inst%F_DI_S_MYI = 0.0_sp
1185 :
1186 0 : ALLOCATE ( Inst%F_DN_S_FYI( NR_MAX, Inst%NSALT ), STAT=AS )
1187 : IF ( AS/=0 ) THEN
1188 0 : CALL HCO_ERROR( 'Cannot allocate F_DN_S_FYI', RC )
1189 0 : RETURN
1190 : ENDIF
1191 0 : Inst%F_DN_S_FYI = 0.0_sp
1192 :
1193 0 : ALLOCATE ( Inst%F_DN_S_MYI( NR_MAX, Inst%NSALT ), STAT=AS )
1194 : IF ( AS/=0 ) THEN
1195 0 : CALL HCO_ERROR( 'Cannot allocate F_DN_S_MYI', RC )
1196 0 : RETURN
1197 : ENDIF
1198 0 : Inst%F_DN_S_MYI = 0.0_sp
1199 : ENDIF
1200 :
1201 0 : IF ( HcoState%MarinePOA ) THEN
1202 :
1203 : ! Allocate density of phobic marine organic aerosols
1204 0 : ALLOCATE ( Inst%NDENS_MOPO( HcoState%NX, HcoState%NY), STAT=AS )
1205 : IF ( AS/=0 ) THEN
1206 0 : CALL HCO_ERROR( 'Cannot allocate NDENS_MOPO', RC )
1207 0 : RETURN
1208 : ENDIF
1209 0 : Inst%NDENS_MOPO = 0.0_sp
1210 :
1211 : ! Allocate density of philic marine organic aerosols
1212 0 : ALLOCATE ( Inst%NDENS_MOPI( HcoState%NX, HcoState%NY), STAT=AS )
1213 : IF ( AS/=0 ) THEN
1214 0 : CALL HCO_ERROR( 'Cannot allocate NDENS_MOPI', RC )
1215 0 : RETURN
1216 : ENDIF
1217 0 : Inst%NDENS_MOPI = 0.0_sp
1218 :
1219 0 : ALLOCATE ( Inst%CHLR( HcoState%NX, HcoState%NY), STAT=AS )
1220 : IF ( AS/=0 ) THEN
1221 0 : CALL HCO_ERROR( 'Cannot allocate CHLR', RC )
1222 0 : RETURN
1223 : ENDIF
1224 0 : Inst%CHLR = 0.0_hp
1225 :
1226 : ENDIF
1227 :
1228 : !=================================================================
1229 : ! Define edges and midpoints of each incremental radius bin
1230 : !=================================================================
1231 :
1232 : ! Constant [volume * time * other stuff??]
1233 : !CONST = 4d0/3d0 * PI * DR * DTEMIS * 1.d-18 * 1.373d0
1234 :
1235 : !CONST_N = DTEMIS * DR * 1.373d0
1236 : ! Constant for converting from [#/m2/s/um] to [#/m2]
1237 0 : CONST_N = HcoState%TS_EMIS * (DR * BETHA)
1238 :
1239 : ! Do for accumulation, fine mode, and marine organics (if enabled)
1240 0 : DO N = 1,Inst%NSALT
1241 :
1242 : ! Lower and upper limit of size bin N [um]
1243 : ! Note that these are dry size bins. In order to
1244 : ! get wet (RH=80%) sizes, we need to multiply by
1245 : ! BETHA.
1246 :
1247 : ! Accumulation mode
1248 0 : IF ( N==1 ) THEN
1249 0 : R0 = SALA_REDGE_um(1)
1250 0 : R1 = SALA_REDGE_um(2)
1251 :
1252 : ! Coarse mode
1253 0 : ELSEIF ( N==2 ) THEN
1254 0 : R0 = SALC_REDGE_um(1)
1255 0 : R1 = SALC_REDGE_um(2)
1256 :
1257 : ! Marine phobic (mj, bg, 7/9/15)
1258 0 : ELSEIF ( N==3 ) THEN
1259 0 : R0 = SALA_REDGE_um(1)
1260 0 : R1 = SALA_REDGE_um(2)
1261 :
1262 : ! Marine philic (mj, bg, 7/9/15)
1263 0 : ELSEIF ( N==4 ) THEN
1264 0 : R0 = SALC_REDGE_um(1)
1265 0 : R1 = SALC_REDGE_um(2)
1266 : ENDIF
1267 :
1268 : ! Number of radius size bins
1269 0 : Inst%NR(N) = INT( ( ( R1 - R0 ) / DR ) + 0.5d0 )
1270 :
1271 : ! Error check
1272 0 : IF ( Inst%NR(N) > NR_MAX ) THEN
1273 0 : MSG = 'Too many bins'
1274 0 : CALL HCO_ERROR(MSG, RC )
1275 0 : RETURN
1276 : ENDIF
1277 :
1278 : ! Lower edge of 0th bin
1279 0 : Inst%RREDGE(0,N) = R0
1280 :
1281 : ! Loop over the # of radius bins
1282 0 : DO R = 1, Inst%NR(N)
1283 :
1284 : ! Midpoint of IRth bin
1285 0 : Inst%RRMID(R,N) = Inst%RREDGE(R-1,N) + ( DR / 2d0 )
1286 :
1287 : ! Upper edge of IRth bin
1288 0 : Inst%RREDGE(R,N) = Inst%RREDGE(R-1,N) + DR
1289 :
1290 : ! Sea salt base source [#/m2]. Note that the Gong formulation
1291 : ! is for r80 (radius at 80% RH), so we need to multiply RRMID
1292 : ! by the scaling factor BETHA=2.
1293 0 : A = 4.7*(1.+30.*(BETHA*Inst%RRMID(R,N))) &
1294 0 : **(-0.017*(BETHA*Inst%RRMID(R,N))**(-1.44))
1295 0 : B = (0.433d0-LOG10(BETHA*Inst%RRMID(R,N))) / 0.433d0
1296 0 : Inst%SRRC_N(R,N) = CONST_N * 1.373 &
1297 : * (1.d0/(BETHA*Inst%RRMID(R,N))**(A)) &
1298 : * (1.d0+0.057d0*(BETHA*Inst%RRMID(R,N))**3.45d0) &
1299 0 : * 10d0**(1.607d0*EXP(-(B**2)))
1300 :
1301 : ! Sea salt base source [kg/m2]: multiply the number of particles
1302 : ! by the dry volume multiplied by the dry density of sea-salt.
1303 0 : Inst%SRRC(R,N) = Inst%SRRC_N(R,N) * 4d0/3d0 * HcoState%Phys%PI * 1.d-18 &
1304 0 : * Inst%SS_DEN( N ) * (Inst%RRMID(R,N))**3
1305 :
1306 : !-----------------------------------------------------------
1307 : ! IMPORTANT NOTE!
1308 : !
1309 : ! In mathematics, "LOG" means "log10".
1310 : ! In Fortran, "LOG" means "ln" (and LOG10 is "log10").
1311 : !
1312 : ! The following equations require log to the base 10, so
1313 : ! we need to use the Fortran function LOG10 instead of LOG.
1314 : ! (jaegle, bmy, 11/23/09)
1315 : !-----------------------------------------------------------
1316 :
1317 : ! ! Old Monahan et al. (1986) formulation
1318 : ! ! Sea salt base source [kg/m2]
1319 : ! CONST_N = DTEMIS * (DR * BETHA)
1320 : ! SRRC(R,N) = CONST * SS_DEN( N )
1321 : ! & * ( 1.d0 + 0.057d0*( BETHA * RRMID(R,N) )**1.05d0 )
1322 : ! & * 10d0**( 1.19d0*
1323 : ! & EXP(-((0.38d0-LOG10(BETHA*RRMID(R,N)))/0.65d0)**2))
1324 : ! & / BETHA**2
1325 :
1326 : ! ! Sea salt base source [#/m2] (bec, bmy, 4/13/05)
1327 : ! SRRC_N(R,N) = CONST_N * (1.d0/RRMID(R,N)**3)
1328 : ! & * (1.d0+0.057d0*(BETHA*RRMID(R,N))**1.05d0)
1329 : ! & * 10d0**(1.19d0*EXP(-((0.38d0-LOG10(BETHA*RRMID(R,N)))
1330 : ! & /0.65d0)**2))/ BETHA**2
1331 :
1332 : !### Debug
1333 : !### WRITE( 6, 100 ) R,RREDGE(R-1,N),RRMID(R,N),RREDGE(R,N),SRRC(R,N)
1334 : !### 100 FORMAT( 'IR, R0, RRMID, R1: ', i3, 3f11.4,2x,es13.6 )
1335 : ENDDO !R
1336 :
1337 : !size bins for blowing snow - Huang 6/12/20
1338 0 : IF ( Inst%EmitSnowSS .and. N .LT. 3 ) THEN
1339 : !-------------- Define size distribution ---------------------
1340 : ! for southern hemisphere FYI
1341 : D_SNOW = 1.0d0
1342 0 : DO ND = 1, NR_MAX
1343 : D_DRY = ( Inst%NSLNT_FYI * RHOICE / (1000.d0 &
1344 0 : * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
1345 :
1346 0 : IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
1347 :
1348 : !----------------------------------------------------------
1349 : ! NOTES:
1350 : ! For size distribution
1351 : ! define the two-parameter gamma probability density funtion here
1352 : ! Yang et al 2008 eq (6)
1353 : !----------------------------------------------------------
1354 : ! Midpoint of IRth bin
1355 0 : Inst%F_DI_N_FYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
1356 : * D_SNOW**( A_SALT - 1.d0 ) &
1357 0 : / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
1358 : ELSE
1359 0 : Inst%F_DI_N_FYI(ND, N) = 0d0
1360 : ENDIF
1361 0 : Inst%F_DN_N_FYI(ND, N) = Inst%F_DI_N_FYI(ND,N) / (4d0/3d0 * HcoState%Phys%PI &
1362 0 : * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
1363 :
1364 0 : D_SNOW = D_SNOW + DDSNOW
1365 : ENDDO
1366 :
1367 : ! for southern hemisphere MYI
1368 : D_SNOW = 1.0d0
1369 0 : DO ND = 1, NR_MAX
1370 : D_DRY = ( Inst%NSLNT_MYI * RHOICE / (1000.d0 &
1371 0 : * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
1372 :
1373 0 : IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
1374 : ! Midpoint of IRth bin
1375 0 : Inst%F_DI_N_MYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
1376 : * D_SNOW**( A_SALT - 1.d0 ) &
1377 0 : / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
1378 : ELSE
1379 0 : Inst%F_DI_N_MYI(ND, N) = 0d0
1380 : ENDIF
1381 0 : Inst%F_DN_N_MYI(ND, N) = Inst%F_DI_N_MYI(ND,N) / (4d0/3d0 * HcoState%Phys%PI &
1382 0 : * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
1383 :
1384 0 : D_SNOW = D_SNOW + DDSNOW
1385 : ENDDO
1386 :
1387 : ! for southern hemisphere FYI
1388 : D_SNOW = 1.0d0
1389 0 : DO ND = 1, NR_MAX
1390 : D_DRY = ( Inst%SSLNT_FYI * RHOICE / (1000.d0 &
1391 0 : * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
1392 :
1393 0 : IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
1394 : ! Midpoint of IRth bin
1395 0 : Inst%F_DI_S_FYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
1396 : * D_SNOW**( A_SALT - 1.d0 ) &
1397 0 : / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
1398 : ELSE
1399 0 : Inst%F_DI_S_FYI(ND, N) = 0d0
1400 : ENDIF
1401 0 : Inst%F_DN_S_FYI(ND, N) = Inst%F_DI_S_FYI(ND,N)/ (4d0/3d0 * HcoState%Phys%PI &
1402 0 : * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
1403 0 : D_SNOW = D_SNOW + DDSNOW
1404 : ENDDO
1405 :
1406 : ! for southern hemisphere MYI
1407 : D_SNOW = 1.0d0
1408 0 : DO ND = 1, NR_MAX
1409 : D_DRY = ( Inst%SSLNT_MYI * RHOICE / (1000.d0 &
1410 0 : * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
1411 :
1412 0 : IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
1413 : ! Midpoint of IRth bin
1414 0 : Inst%F_DI_S_MYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
1415 : * D_SNOW**( A_SALT - 1.d0 ) &
1416 0 : / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
1417 : ELSE
1418 0 : Inst%F_DI_S_MYI(ND, N) = 0d0
1419 : ENDIF
1420 0 : Inst%F_DN_S_MYI(ND, N) = Inst%F_DI_S_MYI(ND,N)/ (4d0/3d0 * HcoState%Phys%PI &
1421 0 : * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
1422 0 : D_SNOW = D_SNOW + DDSNOW
1423 : ENDDO
1424 :
1425 : ENDIF
1426 :
1427 : ENDDO !N
1428 :
1429 : !=======================================================================
1430 : ! Create diagnostics. The number densities of both modes are always
1431 : ! written into a diagnostics so that they can be used by other routines
1432 : ! and from outside of HEMCO. These diagnostics just hold a pointer
1433 : ! to the respective density arrays filled by the run method of this
1434 : ! module.
1435 : !=======================================================================
1436 : CALL Diagn_Create ( HcoState = HcoState, &
1437 : cName = 'SEASALT_DENS_FINE', &
1438 : ExtNr = Inst%ExtNrSS, &
1439 : Cat = -1, &
1440 : Hier = -1, &
1441 : HcoID = Inst%IDTSALA, &
1442 : SpaceDim = 2, &
1443 : OutUnit = 'number_dens', &
1444 : AutoFill = 0, &
1445 : Trgt2D = Inst%NDENS_SALA, &
1446 : COL = HcoState%Diagn%HcoDiagnIDManual, &
1447 0 : RC = RC )
1448 0 : IF ( RC /= HCO_SUCCESS ) THEN
1449 0 : CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC )
1450 0 : RETURN
1451 : ENDIF
1452 :
1453 : CALL Diagn_Create ( HcoState = HcoState, &
1454 : cName = 'SEASALT_DENS_COARSE', &
1455 : ExtNr = Inst%ExtNrSS, &
1456 : Cat = -1, &
1457 : Hier = -1, &
1458 : HcoID = Inst%IDTSALC, &
1459 : SpaceDim = 2, &
1460 : OutUnit = 'number_dens', &
1461 : AutoFill = 0, &
1462 : Trgt2D = Inst%NDENS_SALC, &
1463 : COL = HcoState%Diagn%HcoDiagnIDManual, &
1464 0 : RC = RC )
1465 0 : IF ( RC /= HCO_SUCCESS ) THEN
1466 0 : CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC )
1467 0 : RETURN
1468 : ENDIF
1469 :
1470 : ! Create marine density diagnostics only if marine POA enabled
1471 0 : IF ( HcoState%MarinePOA ) THEN
1472 :
1473 : CALL Diagn_Create ( HcoState = HcoState, &
1474 : cName = 'SEASALT_DENS_PHOBIC', &
1475 : ExtNr = Inst%ExtNrSS, &
1476 : Cat = -1, &
1477 : Hier = -1, &
1478 : HcoID = Inst%IDTMOPO, &
1479 : SpaceDim = 2, &
1480 : OutUnit = 'number_dens', &
1481 : AutoFill = 0, &
1482 : Trgt2D = Inst%NDENS_MOPO, &
1483 : COL = HcoState%Diagn%HcoDiagnIDManual, &
1484 0 : RC = RC )
1485 0 : IF ( RC /= HCO_SUCCESS ) THEN
1486 0 : CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC )
1487 0 : RETURN
1488 : ENDIF
1489 :
1490 : CALL Diagn_Create ( HcoState = HcoState, &
1491 : cName = 'SEASALT_DENS_PHILIC', &
1492 : ExtNr = Inst%ExtNrSS, &
1493 : Cat = -1, &
1494 : Hier = -1, &
1495 : HcoID = Inst%IDTMOPI, &
1496 : SpaceDim = 2, &
1497 : OutUnit = 'number_dens', &
1498 : AutoFill = 0, &
1499 : Trgt2D = Inst%NDENS_MOPI, &
1500 : COL = HcoState%Diagn%HcoDiagnIDManual, &
1501 0 : RC = RC )
1502 0 : IF ( RC /= HCO_SUCCESS ) THEN
1503 0 : CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC )
1504 0 : RETURN
1505 : ENDIF
1506 :
1507 : ENDIF
1508 :
1509 : !=======================================================================
1510 : ! Activate this module and the fields of ExtState that it uses
1511 : !=======================================================================
1512 :
1513 : ! Activate met fields used by this module
1514 0 : ExtState%TSKIN%DoUse = .TRUE.
1515 0 : ExtState%U10M%DoUse = .TRUE.
1516 0 : ExtState%V10M%DoUse = .TRUE.
1517 0 : ExtState%FROCEAN%DoUse = .TRUE.
1518 0 : ExtState%FRSEAICE%DoUse = .TRUE.
1519 :
1520 : ! for blowing snow
1521 0 : IF ( Inst%EmitSnowSS ) THEN
1522 0 : ExtState%USTAR%DoUse = .TRUE.
1523 0 : ExtState%T2M%DoUse = .TRUE.
1524 0 : ExtState%QV2M%DoUse = .TRUE.
1525 : ENDIF
1526 :
1527 : ! Return w/ success
1528 0 : IF ( ALLOCATED(HcoIDsSS ) ) DEALLOCATE(HcoIDsSS )
1529 0 : IF ( ALLOCATED(SpcNamesSS ) ) DEALLOCATE(SpcNamesSS )
1530 :
1531 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
1532 :
1533 0 : END SUBROUTINE HCOX_SeaSalt_Init
1534 : !EOC
1535 : !------------------------------------------------------------------------------
1536 : ! Harmonized Emissions Component (HEMCO) !
1537 : !------------------------------------------------------------------------------
1538 : !BOP
1539 : !
1540 : ! !IROUTINE: HCOX_SeaSalt_Final
1541 : !
1542 : ! !DESCRIPTION: Subroutine HcoX\_SeaSalt\_Final deallocates
1543 : ! all module arrays.
1544 : !\\
1545 : !\\
1546 : ! !INTERFACE:
1547 : !
1548 0 : SUBROUTINE HCOX_SeaSalt_Final ( ExtState )
1549 : !
1550 : ! !INPUT PARAMETERS:
1551 : !
1552 : TYPE(Ext_State), POINTER :: ExtState ! Module options
1553 : !
1554 : ! !REVISION HISTORY:
1555 : ! 15 Dec 2013 - C. Keller - Initial version
1556 : ! See https://github.com/geoschem/hemco for complete history
1557 : !EOP
1558 : !------------------------------------------------------------------------------
1559 : !BOC
1560 : !
1561 : !=================================================================
1562 : ! HCOX_SeaSalt_Final begins here!
1563 : !=================================================================
1564 0 : CALL InstRemove ( ExtState%SeaSalt )
1565 :
1566 0 : END SUBROUTINE HCOX_SeaSalt_Final
1567 : !EOC
1568 : !------------------------------------------------------------------------------
1569 : ! Harmonized Emissions Component (HEMCO) !
1570 : !------------------------------------------------------------------------------
1571 : !BOP
1572 : !
1573 : ! !IROUTINE: InstGet
1574 : !
1575 : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
1576 : !\\
1577 : !\\
1578 : ! !INTERFACE:
1579 : !
1580 0 : SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
1581 : !
1582 : ! !INPUT PARAMETERS:
1583 : !
1584 : INTEGER :: Instance
1585 : TYPE(MyInst), POINTER :: Inst
1586 : INTEGER :: RC
1587 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
1588 : !
1589 : ! !REVISION HISTORY:
1590 : ! 18 Feb 2016 - C. Keller - Initial version
1591 : ! See https://github.com/geoschem/hemco for complete history
1592 : !EOP
1593 : !------------------------------------------------------------------------------
1594 : !BOC
1595 : TYPE(MyInst), POINTER :: PrvInst
1596 :
1597 : !=================================================================
1598 : ! InstGet begins here!
1599 : !=================================================================
1600 :
1601 : ! Get instance. Also archive previous instance.
1602 0 : PrvInst => NULL()
1603 0 : Inst => AllInst
1604 0 : DO WHILE ( ASSOCIATED(Inst) )
1605 0 : IF ( Inst%Instance == Instance ) EXIT
1606 0 : PrvInst => Inst
1607 0 : Inst => Inst%NextInst
1608 : END DO
1609 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
1610 0 : RC = HCO_FAIL
1611 0 : RETURN
1612 : ENDIF
1613 :
1614 : ! Pass output arguments
1615 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
1616 :
1617 : ! Cleanup & Return
1618 0 : PrvInst => NULL()
1619 0 : RC = HCO_SUCCESS
1620 :
1621 : END SUBROUTINE InstGet
1622 : !EOC
1623 : !------------------------------------------------------------------------------
1624 : ! Harmonized Emissions Component (HEMCO) !
1625 : !------------------------------------------------------------------------------
1626 : !BOP
1627 : !
1628 : ! !IROUTINE: InstCreate
1629 : !
1630 : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
1631 : !\\
1632 : !\\
1633 : ! !INTERFACE:
1634 : !
1635 0 : SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
1636 : !
1637 : ! !INPUT PARAMETERS:
1638 : !
1639 : INTEGER, INTENT(IN) :: ExtNr
1640 : !
1641 : ! !OUTPUT PARAMETERS:
1642 : !
1643 : INTEGER, INTENT( OUT) :: Instance
1644 : TYPE(MyInst), POINTER :: Inst
1645 : !
1646 : ! !INPUT/OUTPUT PARAMETERS:
1647 : !
1648 : INTEGER, INTENT(INOUT) :: RC
1649 : !
1650 : ! !REVISION HISTORY:
1651 : ! 18 Feb 2016 - C. Keller - Initial version
1652 : ! See https://github.com/geoschem/hemco for complete history
1653 : !EOP
1654 : !------------------------------------------------------------------------------
1655 : !BOC
1656 : TYPE(MyInst), POINTER :: TmpInst
1657 : INTEGER :: nnInst
1658 :
1659 : !=================================================================
1660 : ! InstCreate begins here!
1661 : !=================================================================
1662 :
1663 : ! ----------------------------------------------------------------
1664 : ! Generic instance initialization
1665 : ! ----------------------------------------------------------------
1666 : ! Initialize
1667 0 : Inst => NULL()
1668 :
1669 : ! Get number of already existing instances
1670 0 : TmpInst => AllInst
1671 0 : nnInst = 0
1672 0 : DO WHILE ( ASSOCIATED(TmpInst) )
1673 0 : nnInst = nnInst + 1
1674 0 : TmpInst => TmpInst%NextInst
1675 : END DO
1676 :
1677 : ! Create new instance
1678 0 : ALLOCATE(Inst)
1679 0 : Inst%Instance = nnInst + 1
1680 0 : Inst%ExtNr = ExtNr
1681 :
1682 : ! Init values
1683 0 : Inst%ExtNrSS = -1
1684 0 : Inst%IDTSALA = -1
1685 0 : Inst%IDTSALC = -1
1686 0 : Inst%IDTMOPI = -1
1687 0 : Inst%IDTMOPO = -1
1688 0 : Inst%IDTBrSALA = -1
1689 0 : Inst%IDTBrSALC = -1
1690 0 : Inst%CalcBrSalt = .FALSE.
1691 0 : Inst%BrContent = 1.0
1692 0 : Inst%WindScale = 1.0
1693 0 : Inst%ColdSST = .FALSE.
1694 0 : Inst%EmitSnowSS = .FALSE.
1695 0 : Inst%NSLNT_FYI = 0.0
1696 0 : Inst%NSLNT_MYI = 0.0
1697 0 : Inst%SSLNT_FYI = 0.0
1698 0 : Inst%SSLNT_MYI = 0.0
1699 0 : Inst%NAGE = 0.0
1700 0 : Inst%SAGE = 0.0
1701 0 : Inst%NumP = 1.0
1702 :
1703 : ! Attach to instance list
1704 0 : Inst%NextInst => AllInst
1705 0 : AllInst => Inst
1706 :
1707 : ! Update output instance
1708 0 : Instance = Inst%Instance
1709 :
1710 : ! ----------------------------------------------------------------
1711 : ! Type specific initialization statements follow below
1712 : ! ----------------------------------------------------------------
1713 :
1714 : ! Return w/ success
1715 0 : RC = HCO_SUCCESS
1716 :
1717 0 : END SUBROUTINE InstCreate
1718 : !EOC
1719 : !------------------------------------------------------------------------------
1720 : ! Harmonized Emissions Component (HEMCO) !
1721 : !------------------------------------------------------------------------------
1722 : !BOP
1723 : !
1724 : ! !IROUTINE: InstRemove
1725 : !
1726 : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
1727 : !\\
1728 : !\\
1729 : ! !INTERFACE:
1730 : !
1731 0 : SUBROUTINE InstRemove ( Instance )
1732 : !
1733 : ! !INPUT PARAMETERS:
1734 : !
1735 : INTEGER :: Instance
1736 : !
1737 : ! !REVISION HISTORY:
1738 : ! 18 Feb 2016 - C. Keller - Initial version
1739 : ! See https://github.com/geoschem/hemco for complete history
1740 : !EOP
1741 : !------------------------------------------------------------------------------
1742 : !BOC
1743 : INTEGER :: RC
1744 : TYPE(MyInst), POINTER :: PrevInst
1745 : TYPE(MyInst), POINTER :: Inst
1746 :
1747 : !=================================================================
1748 : ! InstRemove begins here!
1749 : !=================================================================
1750 :
1751 : ! Init
1752 0 : PrevInst => NULL()
1753 0 : Inst => NULL()
1754 :
1755 : ! Get instance. Also archive previous instance.
1756 0 : CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
1757 :
1758 : ! Instance-specific deallocation
1759 0 : IF ( ASSOCIATED(Inst) ) THEN
1760 :
1761 : !---------------------------------------------------------------------
1762 : ! Deallocate fields of Inst before popping off from the list
1763 : ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022)
1764 : !---------------------------------------------------------------------
1765 0 : IF ( ASSOCIATED( Inst%NR ) ) THEN
1766 0 : DEALLOCATE( Inst%NR )
1767 : ENDIF
1768 0 : Inst%NR => NULL()
1769 :
1770 0 : IF ( ASSOCIATED( Inst%SS_DEN ) ) THEN
1771 0 : DEALLOCATE( Inst%SS_DEN )
1772 : ENDIF
1773 0 : Inst%SS_DEN => NULL()
1774 :
1775 0 : IF ( ASSOCIATED( Inst%SRRC ) ) THEN
1776 0 : DEALLOCATE( Inst%SRRC )
1777 : ENDIF
1778 0 : Inst%SRRC => NULL()
1779 :
1780 0 : IF ( ASSOCIATED( Inst%SRRC_N ) ) THEN
1781 0 : DEALLOCATE( Inst%SRRC_N )
1782 : ENDIF
1783 0 : Inst%SRRC_N => NULL()
1784 :
1785 0 : IF ( ASSOCIATED( Inst%RREDGE ) ) THEN
1786 0 : DEALLOCATE( Inst%RREDGE )
1787 : ENDIF
1788 0 : Inst%RREDGE => NULL()
1789 :
1790 0 : IF ( ASSOCIATED( Inst%RRMID ) ) THEN
1791 0 : DEALLOCATE( Inst%RRMID )
1792 : ENDIF
1793 0 : Inst%RRMID => NULL()
1794 :
1795 0 : IF ( ASSOCIATED( Inst%NDENS_SALA ) ) THEN
1796 0 : DEALLOCATE( Inst%NDENS_SALA )
1797 : ENDIF
1798 0 : Inst%NDENS_SALA => NULL()
1799 :
1800 0 : IF ( ASSOCIATED( Inst%NDENS_SALC ) ) THEN
1801 0 : DEALLOCATE( Inst%NDENS_SALC )
1802 : ENDIF
1803 0 : Inst%NDENS_SALC => NULL()
1804 :
1805 0 : IF ( ASSOCIATED( Inst%NDENS_MOPO ) ) THEN
1806 0 : DEALLOCATE( Inst%NDENS_MOPO )
1807 : ENDIF
1808 0 : Inst%NDENS_MOPO => NULL()
1809 :
1810 0 : IF ( ASSOCIATED( Inst%NDENS_MOPI ) ) THEN
1811 0 : DEALLOCATE( Inst%NDENS_MOPI )
1812 : ENDIF
1813 0 : Inst%NDENS_MOPI => NULL()
1814 :
1815 0 : IF ( ASSOCIATED( Inst%CHLR ) ) THEN
1816 0 : DEALLOCATE( Inst%CHLR )
1817 : ENDIF
1818 0 : Inst%CHLR => NULL()
1819 :
1820 0 : IF ( ASSOCIATED( Inst%F_DI_N_FYI ) ) THEN
1821 0 : DEALLOCATE( Inst%F_DI_N_FYI )
1822 : ENDIF
1823 0 : Inst%F_DI_N_FYI => NULL()
1824 :
1825 0 : IF ( ASSOCIATED( Inst%F_DI_N_MYI ) ) THEN
1826 0 : DEALLOCATE( Inst%F_DI_N_MYI )
1827 : ENDIF
1828 0 : Inst%F_DI_N_MYI => NULL()
1829 :
1830 0 : IF ( ASSOCIATED( Inst%F_DI_S_FYI ) ) THEN
1831 0 : DEALLOCATE( Inst%F_DI_S_FYI )
1832 : ENDIF
1833 0 : Inst%F_DI_S_FYI => NULL()
1834 :
1835 0 : IF ( ASSOCIATED( Inst%F_DI_S_MYI ) ) THEN
1836 0 : DEALLOCATE( Inst%F_DI_S_MYI )
1837 : ENDIF
1838 0 : Inst%F_DI_S_MYI => NULL()
1839 :
1840 0 : IF ( ASSOCIATED( Inst%F_DN_N_FYI ) ) THEN
1841 0 : DEALLOCATE( Inst%F_DN_N_FYI )
1842 : ENDIF
1843 0 : Inst%F_DN_N_FYI => NULL()
1844 :
1845 0 : IF ( ASSOCIATED( Inst%F_DN_N_MYI ) ) THEN
1846 0 : DEALLOCATE( Inst%F_DN_N_MYI )
1847 : ENDIF
1848 0 : Inst%F_DN_N_MYI => NULL()
1849 :
1850 0 : IF ( ASSOCIATED( Inst%F_DN_S_FYI ) ) THEN
1851 0 : DEALLOCATE( Inst%F_DN_S_FYI )
1852 : ENDIF
1853 0 : Inst%F_DN_S_FYI => NULL()
1854 :
1855 0 : IF ( ASSOCIATED( Inst%F_DN_S_MYI ) ) THEN
1856 0 : DEALLOCATE( Inst%F_DN_S_MYI )
1857 : ENDIF
1858 0 : Inst%F_DN_S_MYI => NULL()
1859 :
1860 0 : IF ( ASSOCIATED( Inst%MULTIICE ) ) THEN
1861 0 : DEALLOCATE( Inst%MULTIICE )
1862 : ENDIF
1863 0 : Inst%MULTIICE => NULL()
1864 :
1865 : !---------------------------------------------------------------------
1866 : ! Pop off instance from list
1867 : !---------------------------------------------------------------------
1868 0 : IF ( ASSOCIATED(PrevInst) ) THEN
1869 0 : PrevInst%NextInst => Inst%NextInst
1870 : ELSE
1871 0 : AllInst => Inst%NextInst
1872 : ENDIF
1873 0 : DEALLOCATE(Inst)
1874 : ENDIF
1875 :
1876 : ! Free pointers before exiting
1877 0 : PrevInst => NULL()
1878 0 : Inst => NULL()
1879 :
1880 0 : END SUBROUTINE InstRemove
1881 : !EOC
1882 0 : END MODULE HCOX_SeaSalt_Mod
|
