Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hcox_volcano_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCOX\_Volcano\_Mod.F90 is a HEMCO extension to use
9 : ! volcano emissions (such as AeroCom or OMI) from ascii tables. This module
10 : ! reads the daily data tables and emits the emissions according to the
11 : ! information in this file.
12 : !\\
13 : !\\
14 : ! !INTERFACE:
15 : !
16 : MODULE HCOX_Volcano_Mod
17 : !
18 : ! !USES:
19 : !
20 : USE HCO_Error_MOD
21 : USE HCO_Diagn_MOD
22 : USE HCOX_TOOLS_MOD
23 : USE HCOX_State_MOD, ONLY : Ext_State
24 : USE HCO_State_MOD, ONLY : HCO_State
25 :
26 : IMPLICIT NONE
27 : PRIVATE
28 : !
29 : ! !PUBLIC MEMBER FUNCTIONS:
30 : !
31 : PUBLIC :: HCOX_Volcano_Run
32 : PUBLIC :: HCOX_Volcano_Init
33 : PUBLIC :: HCOX_Volcano_Final
34 : !
35 : ! !PRIVATE MEMBER FUNCTIONS:
36 : !
37 : PRIVATE :: ReadVolcTable
38 : PRIVATE :: EmitVolc
39 : !
40 : ! !REMARKS:
41 : ! Each volcano table (e.g. AeroCom or OMI) is expected to list the volcano
42 : ! location, sulfur emissions (in kg S/s), and the volcano elevation as well
43 : ! as the volcano plume column height. These entries need be separated by space
44 : ! characters. For example:
45 : ! .
46 : ! ### LAT (-90,90), LON (-180,180), SULFUR [kg S/s], ELEVATION [m], CLOUD_COLUMN_HEIGHT [m]
47 : ! ### If elevation=cloud_column_height, emit in layer of elevation
48 : ! ### else, emit in top 1/3 of cloud_column_height
49 : ! volcano::
50 : ! 50.170 6.850 3.587963e-03 600. 600.
51 : ! ::
52 : ! .
53 : ! The sulfur read from table is emitted as the species defined in the
54 : ! Volcano settings section. More than one species can be provided. Mass
55 : ! sulfur is automatically converted to mass of emitted species (using the
56 : ! emitted molecular weight and molecular ratio of the corresponding HEMCO
57 : ! species). Additional scale factors can be defined in the settings section
58 : ! by using the (optional) setting 'Scaling_<SpecName>'.
59 : ! For example, to emit SO2 and BrO from volcanoes, with an additional scale
60 : ! factor of 1e-4 kg BrO / kgS for BrO, use the following setting:
61 : !
62 : !117 Volcano : on SO2/BrO
63 : ! --> Scaling_BrO : 1.0e-4
64 : ! --> Volcano_Source : AeroCom
65 : ! --> Volcano_Table : $ROOT/VOLCANO/v2021-09/$YYYY/$MM/so2_volcanic_emissions_Carns.$YYYY$MM$DD.rc
66 : ! --> Volcano_Climatology : $ROOT/VOLCANO/v2021-09/so2_volcanic_emissions_CARN_v202005.degassing_only.rc
67 : ! .
68 : ! This extension was originally added for usage within GEOS-5 and AeroCom
69 : ! volcanic emissions, but has been modified to work with OMI-based volcanic
70 : ! emissions from Ge et al. (2016).
71 : ! .
72 : ! When using this extension, you should turn off any other volcano emission
73 : ! inventories!
74 : ! .
75 : ! References:
76 : ! ============================================================================
77 : ! (1 ) Ge, C., J. Wang, S. Carn, K. Yang, P. Ginoux, and N. Krotkov,
78 : ! Satellite-based global volcanic SO2 emissions and sulfate direct
79 : ! radiative forcing during 2005-2012, J. Geophys. Res. Atmos., 121(7),
80 : ! 3446-3464, doi:10.1002/2015JD023134, 2016.
81 : !
82 : ! !REVISION HISTORY:
83 : ! 04 Jun 2015 - C. Keller - Initial version
84 : ! See https://github.com/geoschem/hemco for complete history
85 : !EOP
86 : !------------------------------------------------------------------------------
87 : !BOC
88 : !
89 : ! !MODULE VARIABLES:
90 : !
91 : TYPE :: MyInst
92 : INTEGER :: Instance
93 : INTEGER :: ExtNr = -1 ! Extension number
94 : INTEGER :: CatErupt = -1 ! Category of eruptive emissions
95 : INTEGER :: CatDegas = -1 ! Category of degassing emissions
96 : INTEGER :: nSpc = 0 ! # of species
97 : INTEGER :: nVolc = 0 ! # of volcanoes in buffer
98 : INTEGER, ALLOCATABLE :: SpcIDs(:) ! HEMCO species IDs
99 : REAL(sp), ALLOCATABLE :: SpcScl(:) ! Species scale factors
100 : REAL(sp), ALLOCATABLE :: VolcSlf(:) ! Sulface emissions [kg S/s]
101 : REAL(sp), ALLOCATABLE :: VolcElv(:) ! Elevation [m]
102 : REAL(sp), ALLOCATABLE :: VolcCld(:) ! Cloud column height [m]
103 : INTEGER, ALLOCATABLE :: VolcIdx(:) ! Lon grid index
104 : INTEGER, ALLOCATABLE :: VolcJdx(:) ! Lat grid index
105 : INTEGER, ALLOCATABLE :: VolcBeg(:) ! Begin time (optional)
106 : INTEGER, ALLOCATABLE :: VolcEnd(:) ! End time (optional)
107 : CHARACTER(LEN=255) :: FileName ! Volcano file name
108 : CHARACTER(LEN=255) :: ClimFile ! Climatology file name
109 : CHARACTER(LEN=255) :: VolcSource ! Volcano data source
110 : INTEGER :: YmdOnFile = -1 ! Date of file currently in record
111 : CHARACTER(LEN=61), ALLOCATABLE :: SpcScalFldNme(:) ! Names of scale factor fields
112 : TYPE(MyInst), POINTER :: NextInst => NULL()
113 : END TYPE MyInst
114 :
115 : ! Pointer to instances
116 : TYPE(MyInst), POINTER :: AllInst => NULL()
117 :
118 : ! Volcano data is in kgS. Will be converted to kg emitted species.
119 : ! MW_S is the molecular weight of sulfur
120 : REAL(hp), PARAMETER :: MW_S = 32.0_hp
121 :
122 : CONTAINS
123 : !EOC
124 : !------------------------------------------------------------------------------
125 : ! Harmonized Emissions Component (HEMCO) !
126 : !------------------------------------------------------------------------------
127 : !BOP
128 : !
129 : ! !IROUTINE: HCOX_Volcano_Run
130 : !
131 : ! !DESCRIPTION: Subroutine HCOX\_Volcano\_Run is the driver routine
132 : ! for the customizable HEMCO extension.
133 : !\\
134 : !\\
135 : ! !INTERFACE:
136 : !
137 0 : SUBROUTINE HCOX_Volcano_Run( ExtState, HcoState, RC )
138 : !
139 : ! !USES:
140 : !
141 : USE HCO_FluxArr_Mod, ONLY : HCO_EmisAdd
142 : !
143 : ! !INPUT PARAMETERS:
144 : !
145 : TYPE(Ext_State), POINTER :: ExtState ! Module options
146 : !
147 : ! !INPUT/OUTPUT PARAMETERS:
148 : !
149 : TYPE(HCO_State), POINTER :: HcoState ! Hemco state
150 : INTEGER, INTENT(INOUT) :: RC ! Success or failure
151 : !
152 : ! !REVISION HISTORY:
153 : ! 04 Jun 2015 - C. Keller - Initial version
154 : ! See https://github.com/geoschem/hemco for complete history
155 : !EOP
156 : !------------------------------------------------------------------------------
157 : !BOC
158 : !
159 : ! !LOCAL VARIABLES:
160 : !
161 : ! Scalars
162 : INTEGER :: N
163 : LOGICAL :: ERR
164 :
165 : ! Strings
166 : CHARACTER(LEN=255) :: ErrMsg, ThisLoc, LOC
167 :
168 : ! Arrays
169 0 : REAL(sp) :: SO2degas(HcoState%NX,HcoState%NY,HcoState%NZ)
170 0 : REAL(sp) :: SO2erupt(HcoState%NX,HcoState%NY,HcoState%NZ)
171 0 : REAL(sp) :: iFlx (HcoState%NX,HcoState%NY,HcoState%NZ)
172 :
173 : ! Pointers
174 : TYPE(MyInst), POINTER :: Inst
175 :
176 : !=================================================================
177 : ! HCOX_VOLCANO_RUN begins here!
178 : !=================================================================
179 0 : LOC = 'HCOX_VOLCANO_RUN (HCOX_VOLCANO_MOD.F90)'
180 :
181 : ! Assume success
182 0 : RC = HCO_SUCCESS
183 :
184 : ! Sanity check: return if extension not turned on
185 0 : IF ( ExtState%Volcano <= 0 ) RETURN
186 :
187 : ! Enter
188 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
189 0 : IF ( RC /= HCO_SUCCESS ) THEN
190 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
191 0 : RETURN
192 : ENDIF
193 :
194 : ! Define strings for error messgaes
195 0 : ErrMsg = ''
196 : ThisLoc = &
197 0 : ' -> in HCOX_Volcano_Run (in module HEMCO/Extensions/hcox_volcano_mod.F90)'
198 :
199 : ! Get instance
200 0 : Inst => NULL()
201 0 : CALL InstGet( ExtState%Volcano, Inst, RC )
202 0 : IF ( RC /= HCO_SUCCESS ) THEN
203 0 : WRITE( ErrMsg, * ) 'Cannot find Volcano instance Nr. ', ExtState%Volcano
204 0 : CALL HCO_Error( ErrMsg, RC, ThisLoc )
205 0 : RETURN
206 : ENDIF
207 :
208 : !----------------------------------------------
209 : ! Read/update the volcano data
210 : ! (will be done only if this is a new day)
211 : !----------------------------------------------
212 0 : CALL ReadVolcTable( HcoState, ExtState, Inst, RC )
213 0 : IF ( RC /= HCO_SUCCESS ) THEN
214 0 : ErrMsg = 'Error encountered in "ReadVolcTable"!'
215 0 : CALL HCO_Error( ErrMsg, RC, ThisLoc )
216 0 : RETURN
217 : ENDIF
218 :
219 : !=======================================================================
220 : ! Compute volcano emissions for non dry-run simulations
221 : ! (Skip for GEOS-Chem dry-run or HEMCO-standalone dry-run)
222 : !=======================================================================
223 0 : IF ( .not. HcoState%Options%IsDryRun ) THEN
224 :
225 : ! Emit volcanos into SO2degas and SO2erupt arrays [kg S/m2/s]
226 : CALL EmitVolc( HcoState, ExtState, Inst, &
227 0 : SO2degas, SO2erupt, RC )
228 0 : IF ( RC /= HCO_SUCCESS ) THEN
229 0 : ErrMsg = 'Error encountered in "EmitVolc"!'
230 0 : CALL HCO_Error( ErrMsg, RC, ThisLoc )
231 0 : RETURN
232 : ENDIF
233 :
234 : ! Add eruptive and degassing emissions to emission arrays & diagnostics
235 0 : DO N = 1, Inst%nSpc
236 :
237 : !-------------------------------------------
238 : ! Add degassing emissions
239 : !-------------------------------------------
240 :
241 : ! Convert from [kg S/m2/s] to [kg species/m2/s]
242 0 : iFlx = SO2degas * Inst%SpcScl(N)
243 :
244 : ! Apply user-defined scaling (if any) for this species
245 : CALL HCOX_Scale( HcoState, iFlx, &
246 0 : TRIM(Inst%SpcScalFldNme(N)), RC )
247 0 : IF ( RC /= HCO_SUCCESS ) THEN
248 0 : ErrMsg = 'Error encountered in "HCOX_Scale (degassing)"!'
249 0 : CALL HCO_Error( ErrMsg, RC, ThisLoc )
250 0 : RETURN
251 : ENDIF
252 :
253 : ! Add degassing emissions into the HEMCO state
254 0 : CALL HCO_EmisAdd( HcoState, iFlx, Inst%SpcIDs(N), &
255 0 : RC, ExtNr=Inst%ExtNr, Cat=Inst%CatDegas )
256 0 : IF ( RC /= HCO_SUCCESS ) THEN
257 0 : ErrMsg = 'Error encountered in "HCO_EmisAdd" (degassing)!'
258 0 : CALL HCO_Error( ErrMsg, RC, ThisLoc )
259 0 : RETURN
260 : ENDIF
261 :
262 : !-------------------------------------------
263 : ! Add eruptive emissions
264 : !-------------------------------------------
265 :
266 : ! Convert from [kg S/m2/s] to [kg species/m2/s]
267 0 : iFlx = SO2erupt * Inst%SpcScl(N)
268 :
269 : ! Apply user-defined scaling (if any) for this species
270 : CALL HCOX_Scale( HcoState, iFlx, &
271 0 : TRIM(Inst%SpcScalFldNme(N)), RC )
272 0 : IF ( RC /= HCO_SUCCESS ) THEN
273 0 : ErrMsg = 'Error encountered in "HCOX_Scale" (eruptive"!'
274 0 : CALL HCO_Error( ErrMsg, RC, ThisLoc )
275 0 : RETURN
276 : ENDIF
277 :
278 : ! Add eruptive emissions to the HEMCO state
279 0 : CALL HCO_EmisAdd( HcoState, iFlx, Inst%SpcIDs(N), &
280 0 : RC, ExtNr=Inst%ExtNr, Cat=Inst%CatErupt )
281 0 : IF ( RC /= HCO_SUCCESS ) THEN
282 0 : ErrMsg = 'Error encountered in "HCO_EmisAdd" (eruptive)!'
283 0 : CALL HCO_Error( ErrMsg, RC, ThisLoc )
284 0 : RETURN
285 : ENDIF
286 :
287 : ENDDO !N
288 : ENDIF
289 :
290 : !=======================================================================
291 : ! Exit
292 : !=======================================================================
293 :
294 : ! Cleanup
295 0 : Inst => NULL()
296 :
297 : ! Return w/ success
298 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
299 :
300 : END SUBROUTINE HCOX_Volcano_Run
301 : !EOC
302 : !------------------------------------------------------------------------------
303 : ! Harmonized Emissions Component (HEMCO) !
304 : !------------------------------------------------------------------------------
305 : !BOP
306 : !
307 : ! !IROUTINE: HCOX_Volcano_Init
308 : !
309 : ! !DESCRIPTION: Subroutine HCOX\_Volcano\_Init initializes the HEMCO
310 : ! CUSTOM extension.
311 : !\\
312 : !\\
313 : ! !INTERFACE:
314 : !
315 0 : SUBROUTINE HCOX_Volcano_Init( HcoState, ExtName,ExtState, RC )
316 : !
317 : ! !USES:
318 : !
319 : USE HCO_ExtList_Mod, ONLY : GetExtNr
320 : USE HCO_ExtList_Mod, ONLY : GetExtOpt
321 : USE HCO_ExtList_Mod, ONLY : GetExtSpcVal
322 : USE HCO_STATE_MOD, ONLY : HCO_GetExtHcoID
323 : !
324 : ! !INPUT PARAMETERS:
325 : !
326 : CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name
327 : TYPE(Ext_State), POINTER :: ExtState ! Module options
328 : !
329 : ! !INPUT/OUTPUT PARAMETERS:
330 : !
331 : TYPE(HCO_State), POINTER :: HcoState ! Hemco state
332 : INTEGER, INTENT(INOUT) :: RC
333 :
334 : ! !REVISION HISTORY:
335 : ! 04 Jun 2015 - C. Keller - Initial version
336 : ! See https://github.com/geoschem/hemco for complete history
337 : !EOP
338 : !------------------------------------------------------------------------------
339 : !BOC
340 : !
341 : ! !LOCAL VARIABLES:
342 : !
343 : TYPE(MyInst), POINTER :: Inst
344 : REAL(sp) :: ValSp
345 : INTEGER :: ExtNr, N, Dum
346 : LOGICAL :: FOUND
347 0 : CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:)
348 : CHARACTER(LEN=255) :: MSG, Str, LOC
349 :
350 : !=================================================================
351 : ! HCOX_VOLCANO_INIT begins here!
352 : !=================================================================
353 0 : LOC = 'HCOX_VOLCANO_INIT (HCOX_VOLCANO_MOD.F90)'
354 :
355 : ! Extension Nr.
356 0 : ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
357 0 : IF ( ExtNr <= 0 ) THEN
358 0 : MSG = 'The Volcano extension is turned off.'
359 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
360 0 : RETURN
361 : ENDIF
362 :
363 : ! Enter
364 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
365 0 : IF ( RC /= HCO_SUCCESS ) THEN
366 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
367 0 : RETURN
368 : ENDIF
369 :
370 : ! Create Volcano instance for this simulation
371 0 : Inst => NULL()
372 0 : CALL InstCreate( ExtNr, ExtState%Volcano, Inst, RC )
373 0 : IF ( RC /= HCO_SUCCESS ) THEN
374 : CALL HCO_Error( &
375 0 : 'Cannot create Volcano instance', RC )
376 0 : RETURN
377 : ENDIF
378 :
379 : ! Get species IDs.
380 : CALL HCO_GetExtHcoID( HcoState, ExtNr, Inst%SpcIDs, &
381 0 : SpcNames, Inst%nSpc, RC )
382 0 : IF ( RC /= HCO_SUCCESS ) THEN
383 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
384 0 : RETURN
385 : ENDIF
386 :
387 : ! There must be at least one species
388 0 : IF ( Inst%nSpc == 0 ) THEN
389 : CALL HCO_Error( &
390 0 : 'No Volcano species specified', RC )
391 0 : RETURN
392 : ENDIF
393 :
394 : ! Determine scale factor to be applied to each species. This is 1.00
395 : ! by default, but can be set in the HEMCO configuration file via setting
396 : ! Scaling_<SpcName>.
397 : CALL GetExtSpcVal( HcoState%Config, ExtNr, Inst%nSpc, SpcNames, &
398 0 : 'Scaling', 1.0_sp, Inst%SpcScl, RC )
399 0 : IF ( RC /= HCO_SUCCESS ) THEN
400 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
401 0 : RETURN
402 : ENDIF
403 :
404 : ! Get species mask fields
405 : CALL GetExtSpcVal( HcoState%Config, ExtNr, Inst%nSpc, &
406 : SpcNames, 'ScaleField', HCOX_NOSCALE, &
407 0 : Inst%SpcScalFldNme, RC )
408 0 : IF ( RC /= HCO_SUCCESS ) THEN
409 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
410 0 : RETURN
411 : ENDIF
412 :
413 : ! Add conversion factor from kg S to kg species
414 0 : DO N = 1, Inst%nSpc
415 0 : Inst%SpcScl(N) = Inst%SpcScl(N) * HcoState%Spc(Inst%SpcIDs(N))%MW_g &
416 0 : / MW_S
417 : ENDDO
418 :
419 : ! Get location of volcano table. This must be provided.
420 : CALL GetExtOpt( HcoState%Config, ExtNr, 'Volcano_Table', &
421 0 : OptValChar=Inst%FileName, FOUND=FOUND, RC=RC )
422 :
423 0 : IF ( RC /= HCO_SUCCESS .OR. .NOT. FOUND ) THEN
424 : MSG = 'Cannot read Volcano table file name. Please provide ' // &
425 : 'the Volcano table as a setting to the Volcano extension. ' // &
426 0 : 'The name of this setting must be `Volcano_Table`.'
427 0 : CALL HCO_Error( MSG, RC )
428 0 : RETURN
429 : ENDIF
430 :
431 : ! Get location of volcano climatology table. This must be provided.
432 : CALL GetExtOpt( HcoState%Config, ExtNr, 'Volcano_Climatology', &
433 0 : OptValChar=Inst%ClimFile, FOUND=FOUND, RC=RC )
434 :
435 0 : IF ( RC /= HCO_SUCCESS .OR. .NOT. FOUND ) THEN
436 : MSG = 'Cannot read Volcano climatology file name. Please provide ' // &
437 : 'the Volcano climatology as a setting to the Volcano extension. ' // &
438 0 : 'The name of this setting must be `Volcano_Climatology`.'
439 0 : CALL HCO_Error( HcoState%Config%Err, MSG, RC )
440 0 : RETURN
441 : ENDIF
442 :
443 : ! See if emissions data source is given
444 : ! As of v11-02f, options are AeroCom or OMI
445 0 : Inst%VolcSource = 'AeroCom'
446 : CALL GetExtOpt( HcoState%Config, ExtNr, 'Volcano_Source', &
447 0 : OptValChar=Str, FOUND=FOUND, RC=RC )
448 0 : IF ( RC /= HCO_SUCCESS ) THEN
449 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
450 0 : RETURN
451 : ENDIF
452 0 : IF ( FOUND ) Inst%VolcSource = Str
453 :
454 : ! See if eruptive and degassing hierarchies are given
455 0 : Inst%CatErupt = 51
456 0 : Inst%CatDegas = 52
457 : CALL GetExtOpt( HcoState%Config, ExtNr, 'Cat_Degassing', &
458 0 : OptValInt=Dum, FOUND=FOUND, RC=RC )
459 0 : IF ( RC /= HCO_SUCCESS ) THEN
460 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
461 0 : RETURN
462 : ENDIF
463 0 : IF ( FOUND ) Inst%CatDegas = Dum
464 : CALL GetExtOpt( HcoState%Config, ExtNr, 'Cat_Eruptive', &
465 0 : OptValInt=Dum, FOUND=FOUND, RC=RC )
466 0 : IF ( RC /= HCO_SUCCESS ) THEN
467 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
468 0 : RETURN
469 : ENDIF
470 0 : IF ( FOUND ) Inst%CatErupt = Dum
471 :
472 : ! Verbose mode
473 0 : IF ( HcoState%amIRoot ) THEN
474 0 : MSG = 'Use emissions extension `Volcano`:'
475 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
476 :
477 0 : MSG = ' - use the following species (Name, HcoID, Scaling relative to kgS):'
478 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
479 0 : DO N = 1, Inst%nSpc
480 0 : WRITE(MSG,*) TRIM(SpcNames(N)), ', ', Inst%SpcIDs(N), ', ', Inst%SpcScl(N)
481 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
482 0 : WRITE(MSG,*) 'Apply scale field: ', TRIM(Inst%SpcScalFldNme(N))
483 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
484 : ENDDO
485 0 : WRITE(MSG,*) ' - Emissions data source is ', TRIM(Inst%VolcSource)
486 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
487 0 : WRITE(MSG,*) ' - Emit eruptive emissions as category ', Inst%CatErupt
488 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
489 0 : WRITE(MSG,*) ' - Emit degassing emissions as category ', Inst%CatDegas
490 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
491 : ENDIF
492 :
493 : ! Cleanup
494 0 : Inst => NULL()
495 0 : IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames)
496 :
497 0 : CALL HCO_Leave( HcoState%Config%Err, RC )
498 :
499 0 : END SUBROUTINE HCOX_Volcano_Init
500 : !EOC
501 : !------------------------------------------------------------------------------
502 : ! Harmonized Emissions Component (HEMCO) !
503 : !------------------------------------------------------------------------------
504 : !BOP
505 : !
506 : ! !IROUTINE: HCOX_Volcano_Final
507 : !
508 : ! !DESCRIPTION: Subroutine HCOX\_AeroCom\_Final finalizes the HEMCO
509 : ! AeroCom extension.
510 : !\\
511 : !\\
512 : ! !INTERFACE:
513 : !
514 0 : SUBROUTINE HCOX_Volcano_Final( ExtState )
515 : !
516 : ! !INPUT PARAMETERS:
517 : !
518 : TYPE(Ext_State), POINTER :: ExtState ! Module options
519 : !
520 : ! !REVISION HISTORY:
521 : ! 04 Jun 2015 - C. Keller - Initial version
522 : ! See https://github.com/geoschem/hemco for complete history
523 : !EOP
524 : !------------------------------------------------------------------------------
525 : !BOC
526 : !=================================================================
527 : ! HCOX_VOLCANO_FINAL begins here!
528 : !=================================================================
529 0 : CALL InstRemove( ExtState%Volcano )
530 :
531 0 : END SUBROUTINE HCOX_Volcano_Final
532 : !EOC
533 : !------------------------------------------------------------------------------
534 : ! Harmonized Emissions Component (HEMCO) !
535 : !------------------------------------------------------------------------------
536 : !BOP
537 : !
538 : ! !IROUTINE: ReadVolcTable
539 : !
540 : ! !DESCRIPTION: Subroutine ReadVolcTable reads the AeroCom volcano table of the
541 : ! current day.
542 : !\\
543 : !\\
544 : ! !INTERFACE:
545 : !
546 0 : SUBROUTINE ReadVolcTable( HcoState, ExtState, Inst, RC )
547 : !
548 : ! !USES:
549 : !
550 : USE HCO_CharTools_Mod
551 : USE HCO_inquireMod, ONLY : findfreeLun
552 : USE HCO_CLOCK_MOD, ONLY : HcoClock_NewDay
553 : USE HCO_CLOCK_MOD, ONLY : HcoClock_Get
554 : USE HCO_GeoTools_MOD, ONLY : HCO_GetHorzIJIndex
555 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
556 : !
557 : ! !INPUT PARAMETERS:
558 : !
559 : TYPE(Ext_State), POINTER :: ExtState ! Module options
560 : !
561 : ! !INPUT/OUTPUT PARAMETERS:
562 : !
563 : TYPE(HCO_State), POINTER :: HcoState ! Hemco state
564 : TYPE(MyInst), POINTER :: Inst
565 : INTEGER, INTENT(INOUT) :: RC
566 :
567 : ! !REVISION HISTORY:
568 : ! 04 Jun 2015 - C. Keller - Initial version
569 : ! See https://github.com/geoschem/hemco for complete history
570 : !EOP
571 : !------------------------------------------------------------------------------
572 : !BOC
573 : !
574 : ! !LOCAL VARIABLES:
575 : !
576 : INTEGER :: YYYY, MM, DD
577 : INTEGER :: ThisYMD
578 : INTEGER :: N, LUN, IOS, AS
579 : INTEGER :: nVolc, nCol
580 : REAL(sp) :: Dum(10)
581 0 : REAL(hp), ALLOCATABLE :: VolcLon(:) ! Volcano longitude [deg E]
582 0 : REAL(hp), ALLOCATABLE :: VolcLat(:) ! Volcano latitude [deg N]
583 : LOGICAL :: FileExists, EOF
584 : CHARACTER(LEN=255) :: ThisFile, ThisLine
585 : CHARACTER(LEN=255) :: MSG, FileMsg
586 : CHARACTER(LEN=255) :: LOC = 'ReadVolcTable (hcox_volcano_mod.F90)'
587 :
588 : !=================================================================
589 : ! ReadVolcTable begins here!
590 : !=================================================================
591 :
592 : ! Get current year, month, day
593 0 : CALL HcoClock_Get ( HcoState%Clock, cYYYY=YYYY, cMM=MM, cDD=DD, RC=RC )
594 0 : IF ( RC /= HCO_SUCCESS ) RETURN
595 : #if defined( MODEL_GEOS )
596 : ! Error trap: skip leap days
597 : IF ( MM == 2 .AND. DD > 28 ) DD = 28
598 : #endif
599 :
600 : ! Compare current day against day on file
601 0 : ThisYMD = YYYY*10000 + MM*100+ DD
602 :
603 : ! Do only if it's a different day
604 0 : IF ( ThisYMD /= Inst%YmdOnFile ) THEN
605 :
606 : ! Get file name
607 0 : ThisFile = Inst%FileName
608 0 : CALL HCO_CharParse( HcoState%Config, ThisFile, YYYY, MM, DD, 0, 0, RC )
609 0 : IF ( RC /= HCO_SUCCESS ) THEN
610 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
611 0 : RETURN
612 : ENDIF
613 :
614 : !--------------------------------------------------------------------
615 : ! In dry-run mode, print file path to dryrun log and exit.
616 : ! Otherwise, print file path to the HEMCO log file and continue.
617 : !--------------------------------------------------------------------
618 :
619 : ! Test if the file exists
620 0 : INQUIRE( FILE=TRIM( ThisFile ), EXIST=FileExists )
621 :
622 : ! Create a display string based on whether or not the file is found
623 0 : IF ( FileExists ) THEN
624 0 : FileMsg = 'HEMCO (VOLCANO): Opening'
625 : ELSE
626 0 : FileMsg = 'HEMCO (VOLCANO): REQUIRED FILE NOT FOUND'
627 : ENDIF
628 :
629 : ! Write file status to stdout and the HEMCO log
630 0 : IF ( Hcostate%amIRoot ) THEN
631 0 : WRITE( 6, 300 ) TRIM( FileMsg ), TRIM( ThisFile )
632 0 : WRITE( MSG, 300 ) TRIM( FileMsg ), TRIM( ThisFile )
633 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
634 : 300 FORMAT( a, ' ', a )
635 : ENDIF
636 :
637 0 : IF ( .not. FileExists ) THEN
638 :
639 : ! Attempt to use climatology file instead
640 0 : ThisFile = Inst%ClimFile
641 : CALL HCO_CharParse( HcoState%Config, ThisFile, &
642 0 : YYYY, MM, DD, 0, 0, RC )
643 0 : IF ( RC /= HCO_SUCCESS ) THEN
644 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
645 0 : RETURN
646 : ENDIF
647 :
648 : ! Test if the file exists
649 0 : INQUIRE( FILE=TRIM( ThisFile ), EXIST=FileExists )
650 :
651 : ! Write message to stdout and HEMCO log
652 0 : MSG = 'Attempting to read volcano climatology file'
653 0 : WRITE( 6, 300 ) TRIM( MSG )
654 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
655 :
656 : ! Create a display string based on whether or not the file is found
657 0 : IF ( FileExists ) THEN
658 0 : FileMsg = 'HEMCO (VOLCANO): Opening'
659 : ELSE
660 0 : FileMsg = 'HEMCO (VOLCANO): CLIMATOLOGY FILE NOT FOUND'
661 : ENDIF
662 :
663 : ! Write file status to stdout and the HEMCO log
664 0 : IF ( Hcostate%amIRoot ) THEN
665 0 : WRITE( 6, 300 ) TRIM( FileMsg ), TRIM( ThisFile )
666 0 : WRITE( MSG, 300 ) TRIM( FileMsg ), TRIM( ThisFile )
667 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
668 : ENDIF
669 :
670 : ENDIF
671 :
672 : ! For dry-run simulations, return to calling program.
673 : ! For regular simulations, throw an error if we can't find the file.
674 0 : IF ( HcoState%Options%IsDryRun ) THEN
675 : RETURN
676 : ELSE
677 0 : IF ( .not. FileExists ) THEN
678 0 : WRITE( MSG, 300 ) TRIM( FileMsg ), TRIM( ThisFile )
679 0 : CALL HCO_ERROR( MSG, RC )
680 0 : RETURN
681 : ENDIF
682 : ENDIF
683 :
684 : !--------------------------------------------------------------------
685 : ! Read data from files
686 : !--------------------------------------------------------------------
687 :
688 : ! Open file
689 0 : LUN = findFreeLun()
690 0 : OPEN ( LUN, FILE=TRIM(ThisFile), STATUS='OLD', IOSTAT=IOS )
691 0 : IF ( IOS /= 0 ) THEN
692 0 : MSG = 'Error reading ' // TRIM(ThisFile)
693 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
694 0 : RETURN
695 : ENDIF
696 :
697 : ! Get number of volcano records
698 0 : nVolc = 0
699 : DO
700 0 : CALL GetNextLine( LUN, ThisLine, EOF, RC )
701 0 : IF ( RC /= HCO_SUCCESS ) THEN
702 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
703 0 : RETURN
704 : ENDIF
705 0 : IF ( EOF ) EXIT
706 :
707 : ! Skip any entries that contain '::'
708 0 : IF ( INDEX( TRIM(ThisLine), '::') > 0 ) CYCLE
709 :
710 : ! If we make it to here, this is a valid entry
711 0 : nVolc = nVolc + 1
712 : ENDDO
713 :
714 : ! Verbose
715 0 : IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN
716 0 : WRITE(MSG,*) 'Number of volcanoes: ', nVolc
717 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
718 : ENDIF
719 :
720 : ! Allocate arrays
721 0 : IF ( nVolc > 0 ) THEN
722 : ! Eventually deallocate previously allocated data
723 0 : IF ( ALLOCATED(Inst%VolcSlf) ) DEALLOCATE(Inst%VolcSlf)
724 0 : IF ( ALLOCATED(Inst%VolcElv) ) DEALLOCATE(Inst%VolcElv)
725 0 : IF ( ALLOCATED(Inst%VolcCld) ) DEALLOCATE(Inst%VolcCld)
726 0 : IF ( ALLOCATED(Inst%VolcIdx) ) DEALLOCATE(Inst%VolcIdx)
727 0 : IF ( ALLOCATED(Inst%VolcJdx) ) DEALLOCATE(Inst%VolcJdx)
728 0 : IF ( ALLOCATED(Inst%VolcBeg) ) DEALLOCATE(Inst%VolcBeg)
729 0 : IF ( ALLOCATED(Inst%VolcEnd) ) DEALLOCATE(Inst%VolcEnd)
730 :
731 : ALLOCATE( VolcLon(nVolc), &
732 : VolcLat(nVolc), &
733 : Inst%VolcSlf(nVolc), &
734 : Inst%VolcElv(nVolc), &
735 : Inst%VolcCld(nVolc), &
736 : Inst%VolcIdx(nVolc), &
737 : Inst%VolcJdx(nVolc), &
738 : Inst%VolcBeg(nVolc), &
739 : Inst%VolcEnd(nVolc), &
740 0 : STAT=AS )
741 0 : IF ( AS /= 0 ) THEN
742 : CALL HCO_ERROR ( &
743 0 : 'Volc allocation error', RC, THISLOC=LOC )
744 0 : RETURN
745 : ENDIF
746 0 : VolcLon = 0.0_hp
747 0 : VolcLat = 0.0_hp
748 0 : Inst%VolcSlf = 0.0_sp
749 0 : Inst%VolcElv = 0.0_sp
750 0 : Inst%VolcCld = 0.0_sp
751 0 : Inst%VolcBeg = 0
752 0 : Inst%VolcEnd = 0
753 :
754 : ELSE
755 0 : WRITE(MSG,*) 'No volcano data found for year/mm/dd: ', YYYY, MM, DD
756 0 : CALL HCO_WARNING(HcoState%Config%Err,MSG,RC,WARNLEV=1,THISLOC=LOC)
757 : ENDIF
758 :
759 : ! Now read records
760 0 : IF ( nVolc > 0 ) THEN
761 0 : REWIND( LUN )
762 :
763 0 : N = 0
764 : DO
765 0 : CALL GetNextLine( LUN, ThisLine, EOF, RC )
766 0 : IF ( RC /= HCO_SUCCESS ) THEN
767 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
768 0 : RETURN
769 : ENDIF
770 0 : IF ( EOF ) EXIT
771 :
772 : ! Skip any entries that contain '::'
773 0 : IF ( INDEX( TRIM(ThisLine), '::') > 0 ) CYCLE
774 :
775 : ! Write this data into the following vector element
776 0 : N = N + 1
777 0 : IF ( N > nVolc ) THEN
778 0 : WRITE(MSG,*) 'N exceeds nVolc: ', N, nVolc, &
779 0 : ' - This error occurred when reading ', &
780 0 : TRIM(ThisFile), '. This line: ', TRIM(ThisLine)
781 0 : CALL HCO_ERROR ( MSG, RC, THISLOC = LOC )
782 0 : RETURN
783 : ENDIF
784 :
785 : CALL HCO_CharSplit( TRIM(ThisLine), ' ', &
786 : HCO_GetOpt(HcoState%Config%ExtList,'Wildcard'), &
787 0 : Dum, nCol, RC )
788 0 : IF ( RC /= HCO_SUCCESS ) THEN
789 0 : CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
790 0 : RETURN
791 : ENDIF
792 :
793 : ! Allow for 5 or 7 values
794 0 : IF ( nCol /= 5 .and. nCol /= 7 ) THEN
795 0 : WRITE(MSG,*) 'Cannot parse line ', TRIM(ThisLine), &
796 0 : 'Expected five or seven entries, separated by ', &
797 0 : 'space character, instead found ', nCol
798 0 : CALL HCO_ERROR ( MSG, RC, THISLOC = LOC )
799 0 : RETURN
800 : ENDIF
801 :
802 : ! Now pass to vectors
803 0 : VolcLat(N) = Dum(1)
804 0 : VolcLon(N) = Dum(2)
805 0 : Inst%VolcSlf(N) = Dum(3)
806 0 : Inst%VolcElv(N) = Dum(4)
807 0 : Inst%VolcCld(N) = Dum(5)
808 :
809 : ! Some lines also include start and end time
810 0 : IF ( nCol == 7 ) THEN
811 0 : Inst%VolcBeg(N) = Dum(6)
812 0 : Inst%VolcEnd(N) = DUM(7)
813 : ENDIF
814 : ENDDO
815 :
816 : ! At this point, we should have read exactly nVolc entries!
817 0 : IF ( N /= nVolc ) THEN
818 0 : WRITE(MSG,*) 'N /= nVolc: ', N, nVolc, &
819 0 : ' - This error occurred when reading ', TRIM(ThisFile)
820 0 : CALL HCO_ERROR ( MSG, RC, THISLOC = LOC )
821 0 : RETURN
822 : ENDIF
823 :
824 : ENDIF
825 :
826 : ! All done
827 0 : CLOSE ( LUN )
828 :
829 : ! Get grid box indeces for each location
830 0 : IF ( nVolc > 0 ) THEN
831 : CALL HCO_GetHorzIJIndex( HcoState, nVolc, VolcLon, &
832 0 : VolcLat, Inst%VolcIdx, Inst%VolcJdx, RC )
833 0 : IF ( RC /= HCO_SUCCESS ) THEN
834 0 : CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC )
835 0 : RETURN
836 : ENDIF
837 : ENDIF
838 :
839 : ! Save # of volcanoes in archive
840 0 : Inst%nVolc = nVolc
841 :
842 : ! Update date for file on record
843 0 : Inst%YmdOnFile = ThisYMD
844 :
845 : ENDIF ! new day
846 :
847 : ! Cleanup
848 0 : IF ( ALLOCATED(VolcLon) ) DEALLOCATE(VolcLon)
849 0 : IF ( ALLOCATED(VolcLat) ) DEALLOCATE(VolcLat)
850 :
851 : ! Return w/ success
852 0 : RC = HCO_SUCCESS
853 :
854 0 : END SUBROUTINE ReadVolcTable
855 : !EOC
856 : !------------------------------------------------------------------------------
857 : ! Harmonized Emissions Component (HEMCO) !
858 : !------------------------------------------------------------------------------
859 : !BOP
860 : !
861 : ! !IROUTINE: EmitVolc
862 : !
863 : ! !DESCRIPTION: Subroutine EmitVolc reads the AeroCom volcano table of the
864 : ! current day.
865 : !\\
866 : !\\
867 : ! !INTERFACE:
868 : !
869 0 : SUBROUTINE EmitVolc( HcoState, ExtState, Inst, SO2d, SO2e, RC )
870 : !
871 : ! !USES:
872 : !
873 : USE HCO_CLOCK_MOD, ONLY : HcoClock_Get
874 : !
875 : ! !INPUT PARAMETERS:
876 : !
877 : TYPE(Ext_State), POINTER :: ExtState ! Module options
878 : !
879 : ! !INPUT/OUTPUT PARAMETERS:
880 : !
881 : TYPE(HCO_State), POINTER :: HcoState ! Hemco state
882 : TYPE(MyInst), POINTER :: Inst
883 : INTEGER, INTENT(INOUT) :: RC
884 : !
885 : ! !OUTPUT PARAMETERS:
886 : !
887 : REAL(sp), INTENT( OUT) :: SO2e(HcoState%NX,HcoState%NY,HcoState%NZ)
888 : REAL(sp), INTENT( OUT) :: SO2d(HcoState%NX,HcoState%NY,HcoState%NZ)
889 : !
890 : ! !REVISION HISTORY:
891 : ! 04 Jun 2015 - C. Keller - Initial version
892 : ! See https://github.com/geoschem/hemco for complete history
893 : !EOP
894 : !------------------------------------------------------------------------------
895 : !BOC
896 : !
897 : ! !LOCAL VARIABLES:
898 : !
899 : INTEGER :: I, J, L, N, HH, MN, hhmmss
900 : LOGICAL :: Erupt
901 : REAL(sp) :: nSO2, zTop, zBot, PlumeHgt
902 : REAL(sp) :: z1, z2
903 : REAL(sp) :: tmp1, tmp2, Frac
904 : REAL(sp) :: totE, totD, volcE, volcD
905 : CHARACTER(LEN=255) :: MSG
906 : CHARACTER(LEN=255) :: LOC = 'EmitVolc (hcox_volcano_mod.F90)'
907 :
908 : !=================================================================
909 : ! EmitVolc begins here!
910 : !=================================================================
911 :
912 : ! Init
913 0 : SO2e = 0.0_sp
914 0 : SO2d = 0.0_sp
915 0 : totE = 0.0_sp
916 0 : totD = 0.0_sp
917 :
918 : ! Make sure all required grid quantities are defined
919 0 : IF ( .NOT. ASSOCIATED(HcoState%Grid%AREA_M2%Val) ) THEN
920 : CALL HCO_ERROR ( &
921 0 : 'Grid box areas not defined', RC, THISLOC=LOC )
922 0 : RETURN
923 : ENDIF
924 0 : IF ( .NOT. ASSOCIATED(HcoState%Grid%ZSFC%Val) ) THEN
925 : CALL HCO_ERROR ( &
926 0 : 'Surface heights not defined', RC, THISLOC=LOC )
927 0 : RETURN
928 : ENDIF
929 0 : IF ( .NOT. ASSOCIATED(HcoState%Grid%BXHEIGHT_M%Val) ) THEN
930 : CALL HCO_ERROR ( &
931 0 : 'Grid box heights not defined', RC, THISLOC=LOC )
932 0 : RETURN
933 : ENDIF
934 :
935 : ! Get current hour, minute and save as hhmmss
936 0 : CALL HcoClock_Get ( HcoState%Clock, cH=HH, cM=MN, RC=RC )
937 0 : IF ( RC /= HCO_SUCCESS ) THEN
938 0 : CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC )
939 0 : RETURN
940 : ENDIF
941 0 : hhmmss = HH*10000 + MN*100
942 :
943 : ! Do for every volcano
944 0 : IF ( Inst%nVolc > 0 ) THEN
945 0 : DO N = 1, Inst%nVolc
946 :
947 : ! Grid box index for this volcano
948 0 : I = Inst%VolcIdx(N)
949 0 : J = Inst%VolcJdx(N)
950 :
951 : ! Skip if outside of domain
952 0 : IF( I < 1 .OR. J < 1 ) CYCLE
953 :
954 : ! Check if beginning and end time are specified
955 : ! Do not include emissions for this volcano outside of
956 : ! start and end times (mps, 6/20/19)
957 0 : IF ( Inst%VolcBeg(N) > 0 .or. Inst%VolcEnd(N) > 0 ) THEN
958 0 : IF ( hhmmss < Inst%VolcBeg(N) ) CYCLE
959 0 : IF ( hhmmss >= Inst%VolcEnd(N) ) CYCLE
960 : ENDIF
961 :
962 : ! total emissions of this volcano
963 0 : volcE = 0.0_sp
964 0 : volcD = 0.0_sp
965 :
966 0 : z1 = HcoState%Grid%ZSFC%Val(I,J)
967 :
968 : ! Get total emitted kgS/m2/s. Data in table is in kgS/s.
969 0 : nSo2 = Inst%VolcSlf(N) / HcoState%Grid%AREA_M2%Val(I,J)
970 :
971 : ! Elevation of volcano base and volcano cloud top height [m]
972 : ! Make sure that the bottom / top are at least at surface level
973 0 : zBot = MAX(Inst%VolcElv(N),z1)
974 0 : zTop = MAX(Inst%VolcCld(N),z1)
975 :
976 : ! If volcano is eruptive, zBot /= zTop. In this case, evenly
977 : ! distribute emissions in top 1/3 of the plume
978 0 : IF ( zBot /= zTop ) THEN
979 0 : zBot = zTop - ( ( zTop - zBot ) / 3.0_sp )
980 0 : Erupt = .TRUE.
981 : ELSE
982 : Erupt = .FALSE.
983 : ENDIF
984 :
985 : ! Volcano plume height
986 0 : PlumeHgt = zTop - zBot
987 :
988 : ! Distribute emissions into emission arrays. The volcano plume
989 : ! ranges from zBot to zTop.
990 0 : DO L = 1, HcoState%NZ
991 :
992 : ! Get top height of this box
993 0 : z2 = z1 + HcoState%Grid%BXHEIGHT_M%Val(I,J,L)
994 :
995 : ! Skip if the plume bottom is above this grid box top
996 0 : IF ( zBot >= z2 ) THEN
997 : z1 = z2
998 : CYCLE
999 : ENDIF
1000 :
1001 : ! If the plume top is below this grid box bottom, we can exit
1002 : ! since there will be no more emissions to distribute.
1003 0 : IF ( zTop < z1 ) EXIT
1004 :
1005 : ! If we make it to here, the volcano plume is at least partly
1006 : ! within this level. Determine the fraction of the plume that
1007 : ! is within heights z1 to z2.
1008 :
1009 : ! Get the bottom and top height of the plume within this layer.
1010 0 : tmp1 = MAX(z1,zBot) ! this layer's plume bottom
1011 0 : tmp2 = MIN(z2,zTop) ! this layer's plume top
1012 :
1013 : ! Special case that zTop is heigher than the highest level: make
1014 : ! sure that all emissions are going to be used.
1015 0 : IF ( ( L == HcoState%NZ ) .AND. ( zTop > z2 ) ) THEN
1016 0 : tmp2 = zTop
1017 : ENDIF
1018 :
1019 : ! Fraction of total plume that is within this layer
1020 0 : IF ( PlumeHgt == 0.0_sp ) THEN
1021 : Frac = 1.0_sp
1022 : ELSE
1023 0 : Frac = (tmp2-tmp1) / PlumeHgt
1024 : ENDIF
1025 :
1026 : ! Distribute emissions
1027 0 : IF ( Erupt ) THEN
1028 0 : SO2e(I,J,L) = SO2e(I,J,L) + ( Frac * nSo2 )
1029 : volcE = volcE &
1030 0 : + ( Frac * nSo2 * HcoState%Grid%AREA_M2%Val(I,J) )
1031 : ELSE
1032 0 : SO2d(I,J,L) = SO2d(I,J,L) + ( Frac * nSo2 )
1033 : volcD = volcD &
1034 0 : + ( Frac * nSo2 * HcoState%Grid%AREA_M2%Val(I,J) )
1035 : ENDIF
1036 :
1037 : ! The top height is the new bottom
1038 0 : z1 = z2
1039 : ENDDO
1040 :
1041 : ! testing
1042 : !IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN
1043 : ! WRITE(MSG,*) 'Total eruptive emissions of volcano ', N, ' [kgS/s]: ', volcE
1044 : ! CALL HCO_MSG(HcoState%Config%Err,MSG)
1045 : ! WRITE(MSG,*) 'Total degassing emissions of volcano ', N, ' [kgS/s]: ', volcD
1046 : ! CALL HCO_MSG(HcoState%Config%Err,MSG)
1047 : !ENDIF
1048 :
1049 : ! total
1050 0 : totE = totE + volcE
1051 0 : totD = totD + volcD
1052 :
1053 : ENDDO
1054 : ENDIF
1055 :
1056 : ! verbose
1057 0 : IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN
1058 0 : WRITE(MSG,*) 'Total eruptive emissions [kgS/s]: ', totE
1059 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1060 0 : WRITE(MSG,*) 'Total degassing emissions [kgS/s]: ', totD
1061 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1062 : ENDIF
1063 :
1064 : ! Return w/ success
1065 0 : RC = HCO_SUCCESS
1066 :
1067 : END SUBROUTINE EmitVolc
1068 : !EOC
1069 : !------------------------------------------------------------------------------
1070 : ! Harmonized Emissions Component (HEMCO) !
1071 : !------------------------------------------------------------------------------
1072 : !BOP
1073 : !
1074 : ! !IROUTINE: InstGet
1075 : !
1076 : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
1077 : !\\
1078 : !\\
1079 : ! !INTERFACE:
1080 : !
1081 0 : SUBROUTINE InstGet( Instance, Inst, RC, PrevInst )
1082 : !
1083 : ! !INPUT PARAMETERS:
1084 : !
1085 : INTEGER :: Instance
1086 : TYPE(MyInst), POINTER :: Inst
1087 : INTEGER :: RC
1088 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
1089 : !
1090 : ! !REVISION HISTORY:
1091 : ! 18 Feb 2016 - C. Keller - Initial version
1092 : ! See https://github.com/geoschem/hemco for complete history
1093 : !EOP
1094 : !------------------------------------------------------------------------------
1095 : !BOC
1096 : TYPE(MyInst), POINTER :: PrvInst
1097 :
1098 : !=================================================================
1099 : ! InstGet begins here!
1100 : !=================================================================
1101 :
1102 : ! Get instance. Also archive previous instance.
1103 0 : PrvInst => NULL()
1104 0 : Inst => AllInst
1105 0 : DO WHILE ( ASSOCIATED(Inst) )
1106 0 : IF ( Inst%Instance == Instance ) EXIT
1107 0 : PrvInst => Inst
1108 0 : Inst => Inst%NextInst
1109 : END DO
1110 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
1111 0 : RC = HCO_FAIL
1112 0 : RETURN
1113 : ENDIF
1114 :
1115 : ! Pass output arguments
1116 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
1117 :
1118 : ! Cleanup & Return
1119 0 : PrvInst => NULL()
1120 0 : RC = HCO_SUCCESS
1121 :
1122 : END SUBROUTINE InstGet
1123 : !EOC
1124 : !------------------------------------------------------------------------------
1125 : ! Harmonized Emissions Component (HEMCO) !
1126 : !------------------------------------------------------------------------------
1127 : !BOP
1128 : !
1129 : ! !IROUTINE: InstCreate
1130 : !
1131 : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
1132 : !\\
1133 : !\\
1134 : ! !INTERFACE:
1135 : !
1136 0 : SUBROUTINE InstCreate( ExtNr, Instance, Inst, RC )
1137 : !
1138 : ! !INPUT PARAMETERS:
1139 : !
1140 : INTEGER, INTENT(IN) :: ExtNr
1141 : !
1142 : ! !OUTPUT PARAMETERS:
1143 : !
1144 : INTEGER, INTENT( OUT) :: Instance
1145 : TYPE(MyInst), POINTER :: Inst
1146 : !
1147 : ! !INPUT/OUTPUT PARAMETERS:
1148 : !
1149 : INTEGER, INTENT(INOUT) :: RC
1150 : !
1151 : ! !REVISION HISTORY:
1152 : ! 18 Feb 2016 - C. Keller - Initial version
1153 : ! See https://github.com/geoschem/hemco for complete history
1154 : !EOP
1155 : !------------------------------------------------------------------------------
1156 : !BOC
1157 : TYPE(MyInst), POINTER :: TmpInst
1158 : INTEGER :: nnInst
1159 :
1160 : !=================================================================
1161 : ! InstCreate begins here!
1162 : !=================================================================
1163 :
1164 : ! ----------------------------------------------------------------
1165 : ! Generic instance initialization
1166 : ! ----------------------------------------------------------------
1167 :
1168 : ! Initialize
1169 0 : Inst => NULL()
1170 :
1171 : ! Get number of already existing instances
1172 0 : TmpInst => AllInst
1173 0 : nnInst = 0
1174 0 : DO WHILE ( ASSOCIATED(TmpInst) )
1175 0 : nnInst = nnInst + 1
1176 0 : TmpInst => TmpInst%NextInst
1177 : END DO
1178 :
1179 : ! Create new instance
1180 0 : ALLOCATE(Inst)
1181 0 : Inst%Instance = nnInst + 1
1182 0 : Inst%ExtNr = ExtNr
1183 0 : Inst%YmdOnFile = -1
1184 :
1185 : ! Attach to instance list
1186 0 : Inst%NextInst => AllInst
1187 0 : AllInst => Inst
1188 :
1189 : ! Update output instance
1190 0 : Instance = Inst%Instance
1191 :
1192 : ! ----------------------------------------------------------------
1193 : ! Type specific initialization statements follow below
1194 : ! ----------------------------------------------------------------
1195 :
1196 : ! Return w/ success
1197 0 : RC = HCO_SUCCESS
1198 :
1199 0 : END SUBROUTINE InstCreate
1200 : !EOC
1201 : !------------------------------------------------------------------------------
1202 : ! Harmonized Emissions Component (HEMCO) !
1203 : !------------------------------------------------------------------------------
1204 : !BOP
1205 : !
1206 : ! !IROUTINE: InstRemove
1207 : !
1208 : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
1209 : !\\
1210 : !\\
1211 : ! !INTERFACE:
1212 : !
1213 0 : SUBROUTINE InstRemove( Instance )
1214 : !
1215 : ! !INPUT PARAMETERS:
1216 : !
1217 : INTEGER :: Instance
1218 : !
1219 : ! !REVISION HISTORY:
1220 : ! 18 Feb 2016 - C. Keller - Initial version
1221 : ! See https://github.com/geoschem/hemco for complete history
1222 : !EOP
1223 : !------------------------------------------------------------------------------
1224 : !BOC
1225 : INTEGER :: RC
1226 : TYPE(MyInst), POINTER :: PrevInst
1227 : TYPE(MyInst), POINTER :: Inst
1228 :
1229 : !=================================================================
1230 : ! InstRemove begins here!
1231 : !=================================================================
1232 :
1233 : ! Init
1234 0 : PrevInst => NULL()
1235 0 : Inst => NULL()
1236 :
1237 : ! Get instance. Also archive previous instance.
1238 0 : CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
1239 :
1240 : ! Instance-specific deallocation
1241 0 : IF ( ASSOCIATED(Inst) ) THEN
1242 :
1243 : !---------------------------------------------------------------------
1244 : ! Deallocate fields of Inst before popping off from the list
1245 : ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022)
1246 : !---------------------------------------------------------------------
1247 0 : IF ( ALLOCATED( Inst%VolcSlf ) ) THEN
1248 0 : DEALLOCATE( Inst%VolcSlf )
1249 : ENDIF
1250 :
1251 0 : IF ( ALLOCATED( Inst%VolcElv ) ) THEN
1252 0 : DEALLOCATE( Inst%VolcElv )
1253 : ENDIF
1254 :
1255 0 : IF ( ALLOCATED( Inst%VolcCld ) ) THEN
1256 0 : DEALLOCATE( Inst%VolcCld )
1257 : ENDIF
1258 :
1259 0 : IF ( ALLOCATED( Inst%VolcIdx ) ) THEN
1260 0 : DEALLOCATE( Inst%VolcIdx )
1261 : ENDIF
1262 :
1263 0 : IF ( ALLOCATED( Inst%VolcJdx ) ) THEN
1264 0 : DEALLOCATE( Inst%VolcJdx )
1265 : ENDIF
1266 :
1267 0 : IF ( ALLOCATED( Inst%SpcIDs ) ) THEN
1268 0 : DEALLOCATE( Inst%SpcIDs )
1269 : ENDIF
1270 :
1271 0 : IF ( ALLOCATED( Inst%SpcScl ) ) THEN
1272 0 : DEALLOCATE( Inst%SpcScl )
1273 : ENDIF
1274 :
1275 0 : IF ( ALLOCATED( Inst%SpcScalFldNme ) ) THEN
1276 0 : DEALLOCATE( Inst%SpcScalFldNme )
1277 : ENDIF
1278 :
1279 : !---------------------------------------------------------------------
1280 : ! Pop off instance from list
1281 : !---------------------------------------------------------------------
1282 0 : IF ( ASSOCIATED(PrevInst) ) THEN
1283 0 : PrevInst%NextInst => Inst%NextInst
1284 : ELSE
1285 0 : AllInst => Inst%NextInst
1286 : ENDIF
1287 0 : DEALLOCATE(Inst)
1288 : ENDIF
1289 :
1290 : ! Free pointers before exiting
1291 0 : PrevInst => NULL()
1292 0 : Inst => NULL()
1293 :
1294 0 : END SUBROUTINE InstRemove
1295 : !EOC
1296 0 : END MODULE HCOX_Volcano_Mod
|
