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 0 : MSG = 'Use sea salt aerosol emissions (extension module)'
1001 0 : CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' )
1002 :
1003 0 : IF ( HcoState%MarinePOA ) THEN
1004 0 : MSG = 'Use marine organic aerosols option'
1005 0 : CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' )
1006 : ENDIF
1007 :
1008 0 : WRITE(MSG,*) 'Accumulation aerosol: ', TRIM(SpcNamesSS(1)), &
1009 0 : ':', Inst%IDTSALA
1010 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1011 0 : WRITE(MSG,*) ' - size range : ', SALA_REDGE_um
1012 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1013 0 : WRITE(MSG,*) 'Coarse aerosol : ', TRIM(SpcNamesSS(2)), &
1014 0 : ':', Inst%IDTSALC
1015 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1016 0 : WRITE(MSG,*) ' - size range : ', SALA_REDGE_um
1017 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1018 0 : WRITE(MSG,*) ' - wind scale factor: ', Inst%WindScale
1019 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1020 :
1021 0 : IF ( Inst%EmitSnowSS ) THEN
1022 0 : WRITE(MSG,*) ' - Arctic Snow Salinity on FYI (psu): ', Inst%NSLNT_FYI
1023 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1024 0 : WRITE(MSG,*) ' - Arctic Snow Salinity on MYI (psu): ', Inst%NSLNT_MYI
1025 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1026 0 : WRITE(MSG,*) ' - Antarctic Snow Salinity on FYI (psu): ', Inst%SSLNT_FYI
1027 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1028 0 : WRITE(MSG,*) ' - Antarctic Snow Salinity on FYI (psu): ', Inst%SSLNT_MYI
1029 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1030 0 : WRITE(MSG,*) ' - Arctic Snow age (days): ', Inst%NAGE
1031 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1032 0 : WRITE(MSG,*) ' - Antarctic Snow age(days): ', Inst%SAGE
1033 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1034 0 : WRITE(MSG,*) ' - Number of particle per snowflake: ', Inst%NumP
1035 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1036 : ENDIF
1037 :
1038 0 : WRITE(MSG,*) 'Accumulation Chloride: ', TRIM(SpcNamesSS(3)), &
1039 0 : ':', Inst%IDTSALACL
1040 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1041 0 : WRITE(MSG,*) 'Coarse Chloride: ', TRIM(SpcNamesSS(4)), &
1042 0 : ':', Inst%IDTSALCCL
1043 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1044 0 : WRITE(MSG,*) 'Accumulation Alkalinity: ', TRIM(SpcNamesSS(5)), &
1045 0 : ':', Inst%IDTSALAAL
1046 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1047 0 : WRITE(MSG,*) 'Coarse Alkalinity: ', TRIM(SpcNamesSS(6)), &
1048 0 : ':', Inst%IDTSALCAL
1049 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1050 :
1051 0 : IF ( Inst%CalcBrSalt ) THEN
1052 0 : WRITE(MSG,*) 'BrSALA: ', TRIM(SpcNamesSS(7)), Inst%IDTBrSALA
1053 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1054 0 : WRITE(MSG,*) 'BrSALC: ', TRIM(SpcNamesSS(8)), Inst%IDTBrSALC
1055 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1056 0 : WRITE(MSG,*) 'Br- mass content: ', Inst%BrContent
1057 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1058 : ENDIF
1059 :
1060 0 : IF ( HcoState%MarinePOA ) THEN
1061 0 : WRITE(MSG,*) 'Hydrophobic marine organic aerosol: ', &
1062 0 : TRIM(SpcNamesSS(9)), ':', Inst%IDTMOPO
1063 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1064 :
1065 0 : WRITE(MSG,*) 'Hydrophilic marine organic aerosol: ', &
1066 0 : TRIM(SpcNamesSS(10)), ':', Inst%IDTMOPI
1067 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1068 : ENDIF
1069 : ENDIF
1070 :
1071 : ! ----------------------------------------------------------------------
1072 : ! Allocate module and subroutine arrays
1073 : ! ----------------------------------------------------------------------
1074 :
1075 : ! Number of tracers dependent on MarinePOA (ewl, 7/9/15)
1076 0 : IF ( HcoState%MarinePOA ) THEN
1077 0 : Inst%NSALT = 4
1078 : ELSE
1079 0 : Inst%NSALT = 2
1080 : ENDIF
1081 :
1082 0 : ALLOCATE ( Inst%NR ( Inst%NSALT ), STAT=AS )
1083 0 : IF ( AS/=0 ) THEN
1084 0 : CALL HCO_ERROR( 'Cannot allocate NR', RC )
1085 0 : RETURN
1086 : ENDIF
1087 0 : Inst%NR = 0
1088 :
1089 0 : ALLOCATE ( Inst%SS_DEN ( Inst%NSALT ), STAT=AS )
1090 : IF ( AS/=0 ) THEN
1091 0 : CALL HCO_ERROR( 'Cannot allocate SS_DEN', RC )
1092 0 : RETURN
1093 : ENDIF
1094 0 : Inst%SS_DEN = 2200.d0
1095 :
1096 0 : ALLOCATE ( Inst%SRRC ( NR_MAX, Inst%NSALT ), STAT=AS )
1097 : IF ( AS/=0 ) THEN
1098 0 : CALL HCO_ERROR( 'Cannot allocate SRRC', RC )
1099 0 : RETURN
1100 : ENDIF
1101 0 : Inst%SRRC = 0d0
1102 0 : ALLOCATE ( Inst%SRRC_N ( NR_MAX, Inst%NSALT ), STAT=AS )
1103 : IF ( AS/=0 ) THEN
1104 0 : CALL HCO_ERROR( 'Cannot allocate SRRC_N', RC )
1105 0 : RETURN
1106 : ENDIF
1107 0 : Inst%SRRC_N = 0d0
1108 0 : ALLOCATE ( Inst%RREDGE ( 0:NR_MAX, Inst%NSALT ), STAT=AS )
1109 : IF ( AS/=0 ) THEN
1110 0 : CALL HCO_ERROR( 'Cannot allocate RREDGE', RC )
1111 0 : RETURN
1112 : ENDIF
1113 0 : Inst%RREDGE = 0d0
1114 0 : ALLOCATE ( Inst%RRMID ( NR_MAX, Inst%NSALT ), STAT=AS )
1115 : IF ( AS/=0 ) THEN
1116 0 : CALL HCO_ERROR( 'Cannot allocate RRMID', RC )
1117 0 : RETURN
1118 : ENDIF
1119 0 : Inst%RRMID = 0d0
1120 :
1121 0 : ALLOCATE ( Inst%NDENS_SALA( HcoState%NX, HcoState%NY), STAT=AS )
1122 : IF ( AS/=0 ) THEN
1123 0 : CALL HCO_ERROR( 'Cannot allocate NDENS_SALA', RC )
1124 0 : RETURN
1125 : ENDIF
1126 0 : Inst%NDENS_SALA = 0.0_sp
1127 :
1128 0 : ALLOCATE ( Inst%NDENS_SALC( HcoState%NX, HcoState%NY), STAT=AS )
1129 : IF ( AS/=0 ) THEN
1130 0 : CALL HCO_ERROR( 'Cannot allocate NDENS_SALC', RC )
1131 0 : RETURN
1132 : ENDIF
1133 0 : Inst%NDENS_SALC = 0.0_sp
1134 :
1135 : ! Allocate for blowing snow simulation
1136 0 : IF ( Inst%EmitSnowSS ) THEN
1137 0 : ALLOCATE ( Inst%F_DI_N_FYI( NR_MAX, Inst%NSALT ), STAT=AS )
1138 : IF ( AS/=0 ) THEN
1139 0 : CALL HCO_ERROR( 'Cannot allocate F_DI_N_FYI', RC )
1140 0 : RETURN
1141 : ENDIF
1142 0 : Inst%F_DI_N_FYI = 0.0_sp
1143 :
1144 0 : ALLOCATE ( Inst%F_DI_N_MYI( NR_MAX, Inst%NSALT ), STAT=AS )
1145 : IF ( AS/=0 ) THEN
1146 0 : CALL HCO_ERROR( 'Cannot allocate F_DI_N_MYI', RC )
1147 0 : RETURN
1148 : ENDIF
1149 0 : Inst%F_DI_N_MYI = 0.0_sp
1150 :
1151 0 : ALLOCATE ( Inst%F_DN_N_FYI( NR_MAX, Inst%NSALT ), STAT=AS )
1152 : IF ( AS/=0 ) THEN
1153 0 : CALL HCO_ERROR( 'Cannot allocate F_DN_N_FYI', RC )
1154 0 : RETURN
1155 : ENDIF
1156 0 : Inst%F_DN_N_FYI = 0.0_sp
1157 :
1158 0 : ALLOCATE ( Inst%F_DN_N_MYI( NR_MAX, Inst%NSALT ), STAT=AS )
1159 : IF ( AS/=0 ) THEN
1160 0 : CALL HCO_ERROR( 'Cannot allocate F_DN_N_MYI', RC )
1161 0 : RETURN
1162 : ENDIF
1163 0 : Inst%F_DN_N_MYI = 0.0_sp
1164 :
1165 0 : ALLOCATE ( Inst%F_DI_S_FYI( NR_MAX, Inst%NSALT ), STAT=AS )
1166 : IF ( AS/=0 ) THEN
1167 0 : CALL HCO_ERROR( 'Cannot allocate F_DI_S_FYI', RC )
1168 0 : RETURN
1169 : ENDIF
1170 0 : Inst%F_DI_S_FYI = 0.0_sp
1171 :
1172 0 : ALLOCATE ( Inst%F_DI_S_MYI( NR_MAX, Inst%NSALT ), STAT=AS )
1173 : IF ( AS/=0 ) THEN
1174 0 : CALL HCO_ERROR( 'Cannot allocate F_DI_S_MYI', RC )
1175 0 : RETURN
1176 : ENDIF
1177 0 : Inst%F_DI_S_MYI = 0.0_sp
1178 :
1179 0 : ALLOCATE ( Inst%F_DN_S_FYI( NR_MAX, Inst%NSALT ), STAT=AS )
1180 : IF ( AS/=0 ) THEN
1181 0 : CALL HCO_ERROR( 'Cannot allocate F_DN_S_FYI', RC )
1182 0 : RETURN
1183 : ENDIF
1184 0 : Inst%F_DN_S_FYI = 0.0_sp
1185 :
1186 0 : ALLOCATE ( Inst%F_DN_S_MYI( NR_MAX, Inst%NSALT ), STAT=AS )
1187 : IF ( AS/=0 ) THEN
1188 0 : CALL HCO_ERROR( 'Cannot allocate F_DN_S_MYI', RC )
1189 0 : RETURN
1190 : ENDIF
1191 0 : Inst%F_DN_S_MYI = 0.0_sp
1192 : ENDIF
1193 :
1194 0 : IF ( HcoState%MarinePOA ) THEN
1195 :
1196 : ! Allocate density of phobic marine organic aerosols
1197 0 : ALLOCATE ( Inst%NDENS_MOPO( HcoState%NX, HcoState%NY), STAT=AS )
1198 : IF ( AS/=0 ) THEN
1199 0 : CALL HCO_ERROR( 'Cannot allocate NDENS_MOPO', RC )
1200 0 : RETURN
1201 : ENDIF
1202 0 : Inst%NDENS_MOPO = 0.0_sp
1203 :
1204 : ! Allocate density of philic marine organic aerosols
1205 0 : ALLOCATE ( Inst%NDENS_MOPI( HcoState%NX, HcoState%NY), STAT=AS )
1206 : IF ( AS/=0 ) THEN
1207 0 : CALL HCO_ERROR( 'Cannot allocate NDENS_MOPI', RC )
1208 0 : RETURN
1209 : ENDIF
1210 0 : Inst%NDENS_MOPI = 0.0_sp
1211 :
1212 0 : ALLOCATE ( Inst%CHLR( HcoState%NX, HcoState%NY), STAT=AS )
1213 : IF ( AS/=0 ) THEN
1214 0 : CALL HCO_ERROR( 'Cannot allocate CHLR', RC )
1215 0 : RETURN
1216 : ENDIF
1217 0 : Inst%CHLR = 0.0_hp
1218 :
1219 : ENDIF
1220 :
1221 : !=================================================================
1222 : ! Define edges and midpoints of each incremental radius bin
1223 : !=================================================================
1224 :
1225 : ! Constant [volume * time * other stuff??]
1226 : !CONST = 4d0/3d0 * PI * DR * DTEMIS * 1.d-18 * 1.373d0
1227 :
1228 : !CONST_N = DTEMIS * DR * 1.373d0
1229 : ! Constant for converting from [#/m2/s/um] to [#/m2]
1230 0 : CONST_N = HcoState%TS_EMIS * (DR * BETHA)
1231 :
1232 : ! Do for accumulation, fine mode, and marine organics (if enabled)
1233 0 : DO N = 1,Inst%NSALT
1234 :
1235 : ! Lower and upper limit of size bin N [um]
1236 : ! Note that these are dry size bins. In order to
1237 : ! get wet (RH=80%) sizes, we need to multiply by
1238 : ! BETHA.
1239 :
1240 : ! Accumulation mode
1241 0 : IF ( N==1 ) THEN
1242 0 : R0 = SALA_REDGE_um(1)
1243 0 : R1 = SALA_REDGE_um(2)
1244 :
1245 : ! Coarse mode
1246 0 : ELSEIF ( N==2 ) THEN
1247 0 : R0 = SALC_REDGE_um(1)
1248 0 : R1 = SALC_REDGE_um(2)
1249 :
1250 : ! Marine phobic (mj, bg, 7/9/15)
1251 0 : ELSEIF ( N==3 ) THEN
1252 0 : R0 = SALA_REDGE_um(1)
1253 0 : R1 = SALA_REDGE_um(2)
1254 :
1255 : ! Marine philic (mj, bg, 7/9/15)
1256 0 : ELSEIF ( N==4 ) THEN
1257 0 : R0 = SALC_REDGE_um(1)
1258 0 : R1 = SALC_REDGE_um(2)
1259 : ENDIF
1260 :
1261 : ! Number of radius size bins
1262 0 : Inst%NR(N) = INT( ( ( R1 - R0 ) / DR ) + 0.5d0 )
1263 :
1264 : ! Error check
1265 0 : IF ( Inst%NR(N) > NR_MAX ) THEN
1266 0 : MSG = 'Too many bins'
1267 0 : CALL HCO_ERROR(MSG, RC )
1268 0 : RETURN
1269 : ENDIF
1270 :
1271 : ! Lower edge of 0th bin
1272 0 : Inst%RREDGE(0,N) = R0
1273 :
1274 : ! Loop over the # of radius bins
1275 0 : DO R = 1, Inst%NR(N)
1276 :
1277 : ! Midpoint of IRth bin
1278 0 : Inst%RRMID(R,N) = Inst%RREDGE(R-1,N) + ( DR / 2d0 )
1279 :
1280 : ! Upper edge of IRth bin
1281 0 : Inst%RREDGE(R,N) = Inst%RREDGE(R-1,N) + DR
1282 :
1283 : ! Sea salt base source [#/m2]. Note that the Gong formulation
1284 : ! is for r80 (radius at 80% RH), so we need to multiply RRMID
1285 : ! by the scaling factor BETHA=2.
1286 0 : A = 4.7*(1.+30.*(BETHA*Inst%RRMID(R,N))) &
1287 0 : **(-0.017*(BETHA*Inst%RRMID(R,N))**(-1.44))
1288 0 : B = (0.433d0-LOG10(BETHA*Inst%RRMID(R,N))) / 0.433d0
1289 0 : Inst%SRRC_N(R,N) = CONST_N * 1.373 &
1290 : * (1.d0/(BETHA*Inst%RRMID(R,N))**(A)) &
1291 : * (1.d0+0.057d0*(BETHA*Inst%RRMID(R,N))**3.45d0) &
1292 0 : * 10d0**(1.607d0*EXP(-(B**2)))
1293 :
1294 : ! Sea salt base source [kg/m2]: multiply the number of particles
1295 : ! by the dry volume multiplied by the dry density of sea-salt.
1296 0 : Inst%SRRC(R,N) = Inst%SRRC_N(R,N) * 4d0/3d0 * HcoState%Phys%PI * 1.d-18 &
1297 0 : * Inst%SS_DEN( N ) * (Inst%RRMID(R,N))**3
1298 :
1299 : !-----------------------------------------------------------
1300 : ! IMPORTANT NOTE!
1301 : !
1302 : ! In mathematics, "LOG" means "log10".
1303 : ! In Fortran, "LOG" means "ln" (and LOG10 is "log10").
1304 : !
1305 : ! The following equations require log to the base 10, so
1306 : ! we need to use the Fortran function LOG10 instead of LOG.
1307 : ! (jaegle, bmy, 11/23/09)
1308 : !-----------------------------------------------------------
1309 :
1310 : ! ! Old Monahan et al. (1986) formulation
1311 : ! ! Sea salt base source [kg/m2]
1312 : ! CONST_N = DTEMIS * (DR * BETHA)
1313 : ! SRRC(R,N) = CONST * SS_DEN( N )
1314 : ! & * ( 1.d0 + 0.057d0*( BETHA * RRMID(R,N) )**1.05d0 )
1315 : ! & * 10d0**( 1.19d0*
1316 : ! & EXP(-((0.38d0-LOG10(BETHA*RRMID(R,N)))/0.65d0)**2))
1317 : ! & / BETHA**2
1318 :
1319 : ! ! Sea salt base source [#/m2] (bec, bmy, 4/13/05)
1320 : ! SRRC_N(R,N) = CONST_N * (1.d0/RRMID(R,N)**3)
1321 : ! & * (1.d0+0.057d0*(BETHA*RRMID(R,N))**1.05d0)
1322 : ! & * 10d0**(1.19d0*EXP(-((0.38d0-LOG10(BETHA*RRMID(R,N)))
1323 : ! & /0.65d0)**2))/ BETHA**2
1324 :
1325 : !### Debug
1326 : !### WRITE( 6, 100 ) R,RREDGE(R-1,N),RRMID(R,N),RREDGE(R,N),SRRC(R,N)
1327 : !### 100 FORMAT( 'IR, R0, RRMID, R1: ', i3, 3f11.4,2x,es13.6 )
1328 : ENDDO !R
1329 :
1330 : !size bins for blowing snow - Huang 6/12/20
1331 0 : IF ( Inst%EmitSnowSS .and. N .LT. 3 ) THEN
1332 : !-------------- Define size distribution ---------------------
1333 : ! for southern hemisphere FYI
1334 : D_SNOW = 1.0d0
1335 0 : DO ND = 1, NR_MAX
1336 : D_DRY = ( Inst%NSLNT_FYI * RHOICE / (1000.d0 &
1337 0 : * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
1338 :
1339 0 : IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
1340 :
1341 : !----------------------------------------------------------
1342 : ! NOTES:
1343 : ! For size distribution
1344 : ! define the two-parameter gamma probability density funtion here
1345 : ! Yang et al 2008 eq (6)
1346 : !----------------------------------------------------------
1347 : ! Midpoint of IRth bin
1348 0 : Inst%F_DI_N_FYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
1349 : * D_SNOW**( A_SALT - 1.d0 ) &
1350 0 : / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
1351 : ELSE
1352 0 : Inst%F_DI_N_FYI(ND, N) = 0d0
1353 : ENDIF
1354 0 : Inst%F_DN_N_FYI(ND, N) = Inst%F_DI_N_FYI(ND,N) / (4d0/3d0 * HcoState%Phys%PI &
1355 0 : * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
1356 :
1357 0 : D_SNOW = D_SNOW + DDSNOW
1358 : ENDDO
1359 :
1360 : ! for southern hemisphere MYI
1361 : D_SNOW = 1.0d0
1362 0 : DO ND = 1, NR_MAX
1363 : D_DRY = ( Inst%NSLNT_MYI * RHOICE / (1000.d0 &
1364 0 : * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
1365 :
1366 0 : IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
1367 : ! Midpoint of IRth bin
1368 0 : Inst%F_DI_N_MYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
1369 : * D_SNOW**( A_SALT - 1.d0 ) &
1370 0 : / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
1371 : ELSE
1372 0 : Inst%F_DI_N_MYI(ND, N) = 0d0
1373 : ENDIF
1374 0 : Inst%F_DN_N_MYI(ND, N) = Inst%F_DI_N_MYI(ND,N) / (4d0/3d0 * HcoState%Phys%PI &
1375 0 : * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
1376 :
1377 0 : D_SNOW = D_SNOW + DDSNOW
1378 : ENDDO
1379 :
1380 : ! for southern hemisphere FYI
1381 : D_SNOW = 1.0d0
1382 0 : DO ND = 1, NR_MAX
1383 : D_DRY = ( Inst%SSLNT_FYI * RHOICE / (1000.d0 &
1384 0 : * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
1385 :
1386 0 : IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
1387 : ! Midpoint of IRth bin
1388 0 : Inst%F_DI_S_FYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
1389 : * D_SNOW**( A_SALT - 1.d0 ) &
1390 0 : / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
1391 : ELSE
1392 0 : Inst%F_DI_S_FYI(ND, N) = 0d0
1393 : ENDIF
1394 0 : Inst%F_DN_S_FYI(ND, N) = Inst%F_DI_S_FYI(ND,N)/ (4d0/3d0 * HcoState%Phys%PI &
1395 0 : * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
1396 0 : D_SNOW = D_SNOW + DDSNOW
1397 : ENDDO
1398 :
1399 : ! for southern hemisphere MYI
1400 : D_SNOW = 1.0d0
1401 0 : DO ND = 1, NR_MAX
1402 : D_DRY = ( Inst%SSLNT_MYI * RHOICE / (1000.d0 &
1403 0 : * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
1404 :
1405 0 : IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
1406 : ! Midpoint of IRth bin
1407 0 : Inst%F_DI_S_MYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
1408 : * D_SNOW**( A_SALT - 1.d0 ) &
1409 0 : / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
1410 : ELSE
1411 0 : Inst%F_DI_S_MYI(ND, N) = 0d0
1412 : ENDIF
1413 0 : Inst%F_DN_S_MYI(ND, N) = Inst%F_DI_S_MYI(ND,N)/ (4d0/3d0 * HcoState%Phys%PI &
1414 0 : * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
1415 0 : D_SNOW = D_SNOW + DDSNOW
1416 : ENDDO
1417 :
1418 : ENDIF
1419 :
1420 : ENDDO !N
1421 :
1422 : !=======================================================================
1423 : ! Create diagnostics. The number densities of both modes are always
1424 : ! written into a diagnostics so that they can be used by other routines
1425 : ! and from outside of HEMCO. These diagnostics just hold a pointer
1426 : ! to the respective density arrays filled by the run method of this
1427 : ! module.
1428 : !=======================================================================
1429 : CALL Diagn_Create ( HcoState = HcoState, &
1430 : cName = 'SEASALT_DENS_FINE', &
1431 : ExtNr = Inst%ExtNrSS, &
1432 : Cat = -1, &
1433 : Hier = -1, &
1434 : HcoID = Inst%IDTSALA, &
1435 : SpaceDim = 2, &
1436 : OutUnit = 'number_dens', &
1437 : AutoFill = 0, &
1438 : Trgt2D = Inst%NDENS_SALA, &
1439 : COL = HcoState%Diagn%HcoDiagnIDManual, &
1440 0 : RC = RC )
1441 0 : IF ( RC /= HCO_SUCCESS ) THEN
1442 0 : CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC )
1443 0 : RETURN
1444 : ENDIF
1445 :
1446 : CALL Diagn_Create ( HcoState = HcoState, &
1447 : cName = 'SEASALT_DENS_COARSE', &
1448 : ExtNr = Inst%ExtNrSS, &
1449 : Cat = -1, &
1450 : Hier = -1, &
1451 : HcoID = Inst%IDTSALC, &
1452 : SpaceDim = 2, &
1453 : OutUnit = 'number_dens', &
1454 : AutoFill = 0, &
1455 : Trgt2D = Inst%NDENS_SALC, &
1456 : COL = HcoState%Diagn%HcoDiagnIDManual, &
1457 0 : RC = RC )
1458 0 : IF ( RC /= HCO_SUCCESS ) THEN
1459 0 : CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC )
1460 0 : RETURN
1461 : ENDIF
1462 :
1463 : ! Create marine density diagnostics only if marine POA enabled
1464 0 : IF ( HcoState%MarinePOA ) THEN
1465 :
1466 : CALL Diagn_Create ( HcoState = HcoState, &
1467 : cName = 'SEASALT_DENS_PHOBIC', &
1468 : ExtNr = Inst%ExtNrSS, &
1469 : Cat = -1, &
1470 : Hier = -1, &
1471 : HcoID = Inst%IDTMOPO, &
1472 : SpaceDim = 2, &
1473 : OutUnit = 'number_dens', &
1474 : AutoFill = 0, &
1475 : Trgt2D = Inst%NDENS_MOPO, &
1476 : COL = HcoState%Diagn%HcoDiagnIDManual, &
1477 0 : RC = RC )
1478 0 : IF ( RC /= HCO_SUCCESS ) THEN
1479 0 : CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC )
1480 0 : RETURN
1481 : ENDIF
1482 :
1483 : CALL Diagn_Create ( HcoState = HcoState, &
1484 : cName = 'SEASALT_DENS_PHILIC', &
1485 : ExtNr = Inst%ExtNrSS, &
1486 : Cat = -1, &
1487 : Hier = -1, &
1488 : HcoID = Inst%IDTMOPI, &
1489 : SpaceDim = 2, &
1490 : OutUnit = 'number_dens', &
1491 : AutoFill = 0, &
1492 : Trgt2D = Inst%NDENS_MOPI, &
1493 : COL = HcoState%Diagn%HcoDiagnIDManual, &
1494 0 : RC = RC )
1495 0 : IF ( RC /= HCO_SUCCESS ) THEN
1496 0 : CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC )
1497 0 : RETURN
1498 : ENDIF
1499 :
1500 : ENDIF
1501 :
1502 : !=======================================================================
1503 : ! Activate this module and the fields of ExtState that it uses
1504 : !=======================================================================
1505 :
1506 : ! Activate met fields used by this module
1507 0 : ExtState%TSKIN%DoUse = .TRUE.
1508 0 : ExtState%U10M%DoUse = .TRUE.
1509 0 : ExtState%V10M%DoUse = .TRUE.
1510 0 : ExtState%FROCEAN%DoUse = .TRUE.
1511 0 : ExtState%FRSEAICE%DoUse = .TRUE.
1512 :
1513 : ! for blowing snow
1514 0 : IF ( Inst%EmitSnowSS ) THEN
1515 0 : ExtState%USTAR%DoUse = .TRUE.
1516 0 : ExtState%T2M%DoUse = .TRUE.
1517 0 : ExtState%QV2M%DoUse = .TRUE.
1518 : ENDIF
1519 :
1520 : ! Return w/ success
1521 0 : IF ( ALLOCATED(HcoIDsSS ) ) DEALLOCATE(HcoIDsSS )
1522 0 : IF ( ALLOCATED(SpcNamesSS ) ) DEALLOCATE(SpcNamesSS )
1523 :
1524 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
1525 :
1526 0 : END SUBROUTINE HCOX_SeaSalt_Init
1527 : !EOC
1528 : !------------------------------------------------------------------------------
1529 : ! Harmonized Emissions Component (HEMCO) !
1530 : !------------------------------------------------------------------------------
1531 : !BOP
1532 : !
1533 : ! !IROUTINE: HCOX_SeaSalt_Final
1534 : !
1535 : ! !DESCRIPTION: Subroutine HcoX\_SeaSalt\_Final deallocates
1536 : ! all module arrays.
1537 : !\\
1538 : !\\
1539 : ! !INTERFACE:
1540 : !
1541 0 : SUBROUTINE HCOX_SeaSalt_Final ( ExtState )
1542 : !
1543 : ! !INPUT PARAMETERS:
1544 : !
1545 : TYPE(Ext_State), POINTER :: ExtState ! Module options
1546 : !
1547 : ! !REVISION HISTORY:
1548 : ! 15 Dec 2013 - C. Keller - Initial version
1549 : ! See https://github.com/geoschem/hemco for complete history
1550 : !EOP
1551 : !------------------------------------------------------------------------------
1552 : !BOC
1553 : !
1554 : !=================================================================
1555 : ! HCOX_SeaSalt_Final begins here!
1556 : !=================================================================
1557 0 : CALL InstRemove ( ExtState%SeaSalt )
1558 :
1559 0 : END SUBROUTINE HCOX_SeaSalt_Final
1560 : !EOC
1561 : !------------------------------------------------------------------------------
1562 : ! Harmonized Emissions Component (HEMCO) !
1563 : !------------------------------------------------------------------------------
1564 : !BOP
1565 : !
1566 : ! !IROUTINE: InstGet
1567 : !
1568 : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
1569 : !\\
1570 : !\\
1571 : ! !INTERFACE:
1572 : !
1573 0 : SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
1574 : !
1575 : ! !INPUT PARAMETERS:
1576 : !
1577 : INTEGER :: Instance
1578 : TYPE(MyInst), POINTER :: Inst
1579 : INTEGER :: RC
1580 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
1581 : !
1582 : ! !REVISION HISTORY:
1583 : ! 18 Feb 2016 - C. Keller - Initial version
1584 : ! See https://github.com/geoschem/hemco for complete history
1585 : !EOP
1586 : !------------------------------------------------------------------------------
1587 : !BOC
1588 : TYPE(MyInst), POINTER :: PrvInst
1589 :
1590 : !=================================================================
1591 : ! InstGet begins here!
1592 : !=================================================================
1593 :
1594 : ! Get instance. Also archive previous instance.
1595 0 : PrvInst => NULL()
1596 0 : Inst => AllInst
1597 0 : DO WHILE ( ASSOCIATED(Inst) )
1598 0 : IF ( Inst%Instance == Instance ) EXIT
1599 0 : PrvInst => Inst
1600 0 : Inst => Inst%NextInst
1601 : END DO
1602 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
1603 0 : RC = HCO_FAIL
1604 0 : RETURN
1605 : ENDIF
1606 :
1607 : ! Pass output arguments
1608 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
1609 :
1610 : ! Cleanup & Return
1611 0 : PrvInst => NULL()
1612 0 : RC = HCO_SUCCESS
1613 :
1614 : END SUBROUTINE InstGet
1615 : !EOC
1616 : !------------------------------------------------------------------------------
1617 : ! Harmonized Emissions Component (HEMCO) !
1618 : !------------------------------------------------------------------------------
1619 : !BOP
1620 : !
1621 : ! !IROUTINE: InstCreate
1622 : !
1623 : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
1624 : !\\
1625 : !\\
1626 : ! !INTERFACE:
1627 : !
1628 0 : SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
1629 : !
1630 : ! !INPUT PARAMETERS:
1631 : !
1632 : INTEGER, INTENT(IN) :: ExtNr
1633 : !
1634 : ! !OUTPUT PARAMETERS:
1635 : !
1636 : INTEGER, INTENT( OUT) :: Instance
1637 : TYPE(MyInst), POINTER :: Inst
1638 : !
1639 : ! !INPUT/OUTPUT PARAMETERS:
1640 : !
1641 : INTEGER, INTENT(INOUT) :: RC
1642 : !
1643 : ! !REVISION HISTORY:
1644 : ! 18 Feb 2016 - C. Keller - Initial version
1645 : ! See https://github.com/geoschem/hemco for complete history
1646 : !EOP
1647 : !------------------------------------------------------------------------------
1648 : !BOC
1649 : TYPE(MyInst), POINTER :: TmpInst
1650 : INTEGER :: nnInst
1651 :
1652 : !=================================================================
1653 : ! InstCreate begins here!
1654 : !=================================================================
1655 :
1656 : ! ----------------------------------------------------------------
1657 : ! Generic instance initialization
1658 : ! ----------------------------------------------------------------
1659 : ! Initialize
1660 0 : Inst => NULL()
1661 :
1662 : ! Get number of already existing instances
1663 0 : TmpInst => AllInst
1664 0 : nnInst = 0
1665 0 : DO WHILE ( ASSOCIATED(TmpInst) )
1666 0 : nnInst = nnInst + 1
1667 0 : TmpInst => TmpInst%NextInst
1668 : END DO
1669 :
1670 : ! Create new instance
1671 0 : ALLOCATE(Inst)
1672 0 : Inst%Instance = nnInst + 1
1673 0 : Inst%ExtNr = ExtNr
1674 :
1675 : ! Init values
1676 0 : Inst%ExtNrSS = -1
1677 0 : Inst%IDTSALA = -1
1678 0 : Inst%IDTSALC = -1
1679 0 : Inst%IDTMOPI = -1
1680 0 : Inst%IDTMOPO = -1
1681 0 : Inst%IDTBrSALA = -1
1682 0 : Inst%IDTBrSALC = -1
1683 0 : Inst%CalcBrSalt = .FALSE.
1684 0 : Inst%BrContent = 1.0
1685 0 : Inst%WindScale = 1.0
1686 0 : Inst%ColdSST = .FALSE.
1687 0 : Inst%EmitSnowSS = .FALSE.
1688 0 : Inst%NSLNT_FYI = 0.0
1689 0 : Inst%NSLNT_MYI = 0.0
1690 0 : Inst%SSLNT_FYI = 0.0
1691 0 : Inst%SSLNT_MYI = 0.0
1692 0 : Inst%NAGE = 0.0
1693 0 : Inst%SAGE = 0.0
1694 0 : Inst%NumP = 1.0
1695 :
1696 : ! Attach to instance list
1697 0 : Inst%NextInst => AllInst
1698 0 : AllInst => Inst
1699 :
1700 : ! Update output instance
1701 0 : Instance = Inst%Instance
1702 :
1703 : ! ----------------------------------------------------------------
1704 : ! Type specific initialization statements follow below
1705 : ! ----------------------------------------------------------------
1706 :
1707 : ! Return w/ success
1708 0 : RC = HCO_SUCCESS
1709 :
1710 0 : END SUBROUTINE InstCreate
1711 : !EOC
1712 : !------------------------------------------------------------------------------
1713 : ! Harmonized Emissions Component (HEMCO) !
1714 : !------------------------------------------------------------------------------
1715 : !BOP
1716 : !
1717 : ! !IROUTINE: InstRemove
1718 : !
1719 : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
1720 : !\\
1721 : !\\
1722 : ! !INTERFACE:
1723 : !
1724 0 : SUBROUTINE InstRemove ( Instance )
1725 : !
1726 : ! !INPUT PARAMETERS:
1727 : !
1728 : INTEGER :: Instance
1729 : !
1730 : ! !REVISION HISTORY:
1731 : ! 18 Feb 2016 - C. Keller - Initial version
1732 : ! See https://github.com/geoschem/hemco for complete history
1733 : !EOP
1734 : !------------------------------------------------------------------------------
1735 : !BOC
1736 : INTEGER :: RC
1737 : TYPE(MyInst), POINTER :: PrevInst
1738 : TYPE(MyInst), POINTER :: Inst
1739 :
1740 : !=================================================================
1741 : ! InstRemove begins here!
1742 : !=================================================================
1743 :
1744 : ! Init
1745 0 : PrevInst => NULL()
1746 0 : Inst => NULL()
1747 :
1748 : ! Get instance. Also archive previous instance.
1749 0 : CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
1750 :
1751 : ! Instance-specific deallocation
1752 0 : IF ( ASSOCIATED(Inst) ) THEN
1753 :
1754 : !---------------------------------------------------------------------
1755 : ! Deallocate fields of Inst before popping off from the list
1756 : ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022)
1757 : !---------------------------------------------------------------------
1758 0 : IF ( ASSOCIATED( Inst%NR ) ) THEN
1759 0 : DEALLOCATE( Inst%NR )
1760 : ENDIF
1761 0 : Inst%NR => NULL()
1762 :
1763 0 : IF ( ASSOCIATED( Inst%SS_DEN ) ) THEN
1764 0 : DEALLOCATE( Inst%SS_DEN )
1765 : ENDIF
1766 0 : Inst%SS_DEN => NULL()
1767 :
1768 0 : IF ( ASSOCIATED( Inst%SRRC ) ) THEN
1769 0 : DEALLOCATE( Inst%SRRC )
1770 : ENDIF
1771 0 : Inst%SRRC => NULL()
1772 :
1773 0 : IF ( ASSOCIATED( Inst%SRRC_N ) ) THEN
1774 0 : DEALLOCATE( Inst%SRRC_N )
1775 : ENDIF
1776 0 : Inst%SRRC_N => NULL()
1777 :
1778 0 : IF ( ASSOCIATED( Inst%RREDGE ) ) THEN
1779 0 : DEALLOCATE( Inst%RREDGE )
1780 : ENDIF
1781 0 : Inst%RREDGE => NULL()
1782 :
1783 0 : IF ( ASSOCIATED( Inst%RRMID ) ) THEN
1784 0 : DEALLOCATE( Inst%RRMID )
1785 : ENDIF
1786 0 : Inst%RRMID => NULL()
1787 :
1788 0 : IF ( ASSOCIATED( Inst%NDENS_SALA ) ) THEN
1789 0 : DEALLOCATE( Inst%NDENS_SALA )
1790 : ENDIF
1791 0 : Inst%NDENS_SALA => NULL()
1792 :
1793 0 : IF ( ASSOCIATED( Inst%NDENS_SALC ) ) THEN
1794 0 : DEALLOCATE( Inst%NDENS_SALC )
1795 : ENDIF
1796 0 : Inst%NDENS_SALC => NULL()
1797 :
1798 0 : IF ( ASSOCIATED( Inst%NDENS_MOPO ) ) THEN
1799 0 : DEALLOCATE( Inst%NDENS_MOPO )
1800 : ENDIF
1801 0 : Inst%NDENS_MOPO => NULL()
1802 :
1803 0 : IF ( ASSOCIATED( Inst%NDENS_MOPI ) ) THEN
1804 0 : DEALLOCATE( Inst%NDENS_MOPI )
1805 : ENDIF
1806 0 : Inst%NDENS_MOPI => NULL()
1807 :
1808 0 : IF ( ASSOCIATED( Inst%CHLR ) ) THEN
1809 0 : DEALLOCATE( Inst%CHLR )
1810 : ENDIF
1811 0 : Inst%CHLR => NULL()
1812 :
1813 0 : IF ( ASSOCIATED( Inst%F_DI_N_FYI ) ) THEN
1814 0 : DEALLOCATE( Inst%F_DI_N_FYI )
1815 : ENDIF
1816 0 : Inst%F_DI_N_FYI => NULL()
1817 :
1818 0 : IF ( ASSOCIATED( Inst%F_DI_N_MYI ) ) THEN
1819 0 : DEALLOCATE( Inst%F_DI_N_MYI )
1820 : ENDIF
1821 0 : Inst%F_DI_N_MYI => NULL()
1822 :
1823 0 : IF ( ASSOCIATED( Inst%F_DI_S_FYI ) ) THEN
1824 0 : DEALLOCATE( Inst%F_DI_S_FYI )
1825 : ENDIF
1826 0 : Inst%F_DI_S_FYI => NULL()
1827 :
1828 0 : IF ( ASSOCIATED( Inst%F_DI_S_MYI ) ) THEN
1829 0 : DEALLOCATE( Inst%F_DI_S_MYI )
1830 : ENDIF
1831 0 : Inst%F_DI_S_MYI => NULL()
1832 :
1833 0 : IF ( ASSOCIATED( Inst%F_DN_N_FYI ) ) THEN
1834 0 : DEALLOCATE( Inst%F_DN_N_FYI )
1835 : ENDIF
1836 0 : Inst%F_DN_N_FYI => NULL()
1837 :
1838 0 : IF ( ASSOCIATED( Inst%F_DN_N_MYI ) ) THEN
1839 0 : DEALLOCATE( Inst%F_DN_N_MYI )
1840 : ENDIF
1841 0 : Inst%F_DN_N_MYI => NULL()
1842 :
1843 0 : IF ( ASSOCIATED( Inst%F_DN_S_FYI ) ) THEN
1844 0 : DEALLOCATE( Inst%F_DN_S_FYI )
1845 : ENDIF
1846 0 : Inst%F_DN_S_FYI => NULL()
1847 :
1848 0 : IF ( ASSOCIATED( Inst%F_DN_S_MYI ) ) THEN
1849 0 : DEALLOCATE( Inst%F_DN_S_MYI )
1850 : ENDIF
1851 0 : Inst%F_DN_S_MYI => NULL()
1852 :
1853 0 : IF ( ASSOCIATED( Inst%MULTIICE ) ) THEN
1854 0 : DEALLOCATE( Inst%MULTIICE )
1855 : ENDIF
1856 0 : Inst%MULTIICE => NULL()
1857 :
1858 : !---------------------------------------------------------------------
1859 : ! Pop off instance from list
1860 : !---------------------------------------------------------------------
1861 0 : IF ( ASSOCIATED(PrevInst) ) THEN
1862 0 : PrevInst%NextInst => Inst%NextInst
1863 : ELSE
1864 0 : AllInst => Inst%NextInst
1865 : ENDIF
1866 0 : DEALLOCATE(Inst)
1867 : ENDIF
1868 :
1869 : ! Free pointers before exiting
1870 0 : PrevInst => NULL()
1871 0 : Inst => NULL()
1872 :
1873 0 : END SUBROUTINE InstRemove
1874 : !EOC
1875 0 : END MODULE HCOX_SeaSalt_Mod
|
