Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hcox_Iodine_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCOX\_Iodine\_Mod contains routines to calculate
9 : ! oceanic iodine emissions (HOI and I2), following carpenter et al. (2014).
10 : ! The emission is parameterised herein using online feilds for O3, 10 metre
11 : ! wind speed, and ocean surface iodide concentration (parameterised from
12 : ! STT following Chance et al (2014)).
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_Iodine_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_Iodine_Init
36 : PUBLIC :: HCOX_Iodine_Run
37 : PUBLIC :: HCOX_Iodine_Final
38 : !
39 : ! !PRIVATE MEMBER FUNCTIONS:
40 : !
41 : ! N/A
42 : !
43 : ! !REVISION HISTORY:
44 : ! 15 Mar 2013 - T. Sherwen - Initial implementation (v9-3-01)
45 : ! See https://github.com/geoschem/hemco for complete history
46 : !EOP
47 : !------------------------------------------------------------------------------
48 : !
49 : ! !PRIVATE TYPES:
50 : !
51 : TYPE :: MyInst
52 : ! Tracer IDs
53 : INTEGER :: Instance
54 : INTEGER :: ExtNr
55 : INTEGER :: IDTI2 ! I2 model species ID
56 : INTEGER :: IDTHOI ! HOI model species ID
57 : LOGICAL :: CalcI2 ! Calculate I2 oceanic emissions?
58 : LOGICAL :: CalcHOI ! Calculate HOI oceanic emissions?
59 : TYPE(MyInst), POINTER :: NextInst => NULL()
60 : END TYPE MyInst
61 :
62 : ! Pointer to instances
63 : TYPE(MyInst), POINTER :: AllInst => NULL()
64 : !
65 : ! !DEFINED PARAMETERS:
66 : !
67 : ! Molecular weight of I2 [kg/mol]
68 : REAL*8, PARAMETER :: MWT_I2 = 2.54d-1
69 : ! Molecular weight of HOI [kg/mol]
70 : REAL*8, PARAMETER :: MWT_HOI = 1.44d-1
71 :
72 : CONTAINS
73 : !EOC
74 : !-------------------------------------------------------------------------------
75 : ! Harmonized Emissions Component (HEMCO) !
76 : !------------------------------------------------------------------------------
77 : !BOP
78 : !
79 : ! !IROUTINE: HCOX_Iodine_Run
80 : !
81 : ! !DESCRIPTION: Subroutine HcoX\_Iodine\_Run is the driver run routine to
82 : ! calculate ocean inorganic iodine emissions in HEMCO.
83 : !\\
84 : !\\
85 : ! !INTERFACE:
86 : !
87 0 : SUBROUTINE HCOX_Iodine_Run( ExtState, HcoState, RC )
88 : !
89 : ! !USES:
90 : !
91 : USE HCO_FluxArr_Mod, ONLY : HCO_EmisAdd
92 : USE HCO_GeoTools_Mod, ONLY : HCO_LANDTYPE
93 : !
94 : ! !INPUT PARAMETERS:
95 : !
96 : TYPE(HCO_State), POINTER :: HcoState ! Output obj
97 : TYPE(Ext_State), POINTER :: ExtState ! Module options
98 : !
99 : ! !INPUT/OUTPUT PARAMETERS:
100 : !
101 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
102 : !
103 : ! !REMARKS:
104 : ! References:
105 : ! ============================================================================
106 : ! (1) Carpenter et al. 2013, https://doi.org/10.1038/ngeo1687
107 : ! (2) Chance et al. 2014, https://doi.org/10.1039/c4em00139g
108 : ! (3) Macdonal et al. 2014, https://doi.org/10.5194/acp-14-5841-2014
109 : ! (4) Sherwen et al. 2016a, https://doi.org/10.5194/acp-16-1161-2016
110 : ! (5) Sherwen et al. 2016b, https://doi.org/10.5194/acp-16-12239-2016
111 : !
112 : ! !REVISION HISTORY:
113 : ! 15 Mar 2013 - T. Sherwen - Initial implementation (v9-3-01)
114 : ! See https://github.com/geoschem/hemco for complete history
115 : !EOP
116 : !------------------------------------------------------------------------------
117 : !BOC
118 : !
119 : ! !LOCAL VARIABLES:
120 : !
121 : INTEGER :: I, J
122 : REAL*8 :: EMIS_HOI
123 : REAL*8 :: EMIS_I2, IODIDE, O3_CONC
124 : REAL*8 :: SST
125 : REAL*8 :: A_M2
126 : REAL*8 :: W10M
127 0 : REAL(hp), TARGET :: FLUXHOI(HcoState%NX,HcoState%NY)
128 0 : REAL(hp), TARGET :: FLUXI2(HcoState%NX,HcoState%NY)
129 : TYPE(MyInst), POINTER :: Inst
130 :
131 : ! Error handling
132 : LOGICAL :: ERR
133 : CHARACTER(LEN=255) :: MSG, LOC
134 :
135 : !=================================================================
136 : ! HCOX_Iodine_Run begins here!
137 : !=================================================================
138 0 : LOC = 'HCOX_Iodine_Run (HCOX_IODINE_MOD.F90)'
139 :
140 : ! Return if extension disabled
141 0 : IF ( ExtState%Inorg_Iodine <= 0 ) RETURN
142 :
143 : ! Enter
144 0 : CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
145 0 : IF ( RC /= HCO_SUCCESS ) THEN
146 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
147 0 : RETURN
148 : ENDIF
149 :
150 : ! Exit status
151 0 : ERR = .FALSE.
152 :
153 : ! Get instance
154 0 : Inst => NULL()
155 0 : CALL InstGet ( ExtState%Inorg_Iodine, Inst, RC )
156 0 : IF ( RC /= HCO_SUCCESS ) THEN
157 0 : WRITE(MSG,*) 'Cannot find iodine instance Nr. ', ExtState%Inorg_Iodine
158 0 : CALL HCO_ERROR(MSG,RC)
159 0 : RETURN
160 : ENDIF
161 :
162 : ! Initialize flux arrays/variables
163 0 : FLUXHOI = 0.0_hp
164 0 : FLUXI2 = 0.0_hp
165 :
166 : !------------------------------------------------------------------------
167 : ! Compute emissions
168 : !------------------------------------------------------------------------
169 : !$OMP PARALLEL DO &
170 : !$OMP DEFAULT( SHARED )&
171 : !$OMP PRIVATE( I, J, A_M2, W10M, SST )&
172 : !$OMP PRIVATE( IODIDE, O3_CONC, EMIS_I2, EMIS_HOI )&
173 : !$OMP COLLAPSE( 2 )&
174 : !$OMP SCHEDULE( DYNAMIC, 4 )
175 0 : DO J = 1, HcoState%NY
176 0 : DO I = 1, HcoState%NX
177 :
178 : ! Zero private variables for safety's sake
179 0 : A_M2 = 0.0d0
180 0 : EMIS_HOI = 0.0d0
181 0 : EMIS_I2 = 0.0d0
182 0 : IODIDE = 0.0d0
183 0 : O3_CONC = 0.0d0
184 0 : SST = 0.0d0
185 0 : W10M = 0.0d0
186 :
187 : ! Advance to next grid box if box is not over ocean
188 0 : IF ( HCO_LANDTYPE( ExtState%FRLAND%Arr%Val(I,J), &
189 0 : ExtState%FRLANDIC%Arr%Val(I,J), &
190 0 : ExtState%FROCEAN%Arr%Val(I,J), &
191 0 : ExtState%FRSEAICE%Arr%Val(I,J), &
192 0 : ExtState%FRLAKE%Arr%Val(I,J) ) /= 0 ) CYCLE
193 :
194 : ! Grid box surface area on simulation grid [m2]
195 0 : A_M2 = HcoState%Grid%AREA_M2%Val( I, J )
196 :
197 : ! Wind speed at 10 m altitude [m/s]
198 0 : W10M = SQRT( ExtState%U10M%Arr%Val(I,J)**2 &
199 0 : + ExtState%V10M%Arr%Val(I,J)**2 )
200 :
201 : ! limit W10M to a minimium of 5 m/s to avoid overestimation of fluxes
202 : ! from CARPENTER et al. (2013) (per. comm.)
203 0 : IF ( W10M .LE. 5.0d0 ) W10M = 5.0d0
204 :
205 : !%%% Comment out unused code (bmy, 09 Mar 2022)
206 : !%%%! ! Sea surface temperature in Celcius
207 : !%%%! SST = ExtState%TSKIN%Arr%Val(I,J) - 273.15d0
208 :
209 : ! Sea surface temperature in Kelvin
210 0 : SST = ExtState%TSKIN%Arr%Val(I,J)
211 :
212 : !%%%% Comment out unused code (bmy, 09 Mar 2022)
213 : !%%%#if defined( MODEL_GEOS )
214 : !%%%! ! Empirical SST scaling factor (jaegle 5/11/11)
215 : !%%%! SCALE = 0.329d0 + 0.0904d0*SST - &
216 : !%%%! 0.00717d0*SST**2d0 + 0.000207d0*SST**3d0
217 : !%%%#endif
218 : !%%%!
219 : !%%%! ! SST dependence of iodide - Chance et al. 2014
220 : !%%%! IODIDE = ( (0.225d0 * ( (SST)**2d0) ) + 19d0 ) / 1d9
221 :
222 : ! SST dependence of iodide - Macdonald et al. 2014
223 0 : IODIDE = 1.46d6 * EXP( (-9134d0/SST) )
224 :
225 : ! Get O3 concentration at the surface ( in mol/mol )
226 : ! ExtState%O3 is in units of kg/kg dry air
227 0 : O3_CONC = ExtState%O3%Arr%Val(I,J,1) &
228 : * HcoState%Phys%AIRMW / 48.0_dp &
229 0 : * 1.0e9_dp
230 :
231 : !%%% Comment out unused code (bmy, 09 Mar 2022)
232 : !%%%#if defined( MODEL_GEOS )
233 : !%%% ! Reset to using original Gong (2003) emissions (jaegle 6/30/11)
234 : !%%% !SCALE = 1.0d0
235 : !%%%
236 : !%%% ! Eventually apply wind scaling factor.
237 : !%%%! SCALE = SCALE * WindScale
238 : !%%%#endif
239 :
240 : !---------------------------------------------------------------------
241 : ! If I2 & emitting, use parameterisation from
242 : ! Carpenter et al (2013) to give emissions in nmol m-2 d-1.
243 : ! Then convert this to kg/m2/s
244 : !---------------------------------------------------------------------
245 0 : IF ( Inst%CalcI2 ) THEN
246 : EMIS_I2 = ( O3_CONC * (IODIDE**1.3d0) * &
247 : ( ( 1.74d9 - ( 6.54d8*LOG( W10M ) ) ) )/ &
248 0 : 24d0/60d0/60d0/1d9*MWT_I2 )
249 :
250 : ! If parametsation results in negative ( W10 too high )
251 : ! flux set to zero
252 0 : IF ( EMIS_I2 .LT. 0.0d0 ) EMIS_I2 = 0.0d0
253 :
254 : ! store I2 flux in tendency array in [kg/m2/s]
255 0 : FLUXI2(I,J) = EMIS_I2
256 :
257 : ENDIF
258 :
259 : !---------------------------------------------------------------------
260 : ! If HOI & emitting, use parameterisation from
261 : ! Carpenter et al (2013) to give emissions in nmol m-2 d-1.
262 : ! Then convert this to kg/m2/s
263 : !---------------------------------------------------------------------
264 0 : IF ( Inst%CalcHOI ) THEN
265 :
266 : EMIS_HOI = O3_CONC * &
267 : ( ( 4.15d5 * ( SQRT(IODIDE)/ W10M ) ) - &
268 : ( 20.6 / W10M ) - ( 2.36d4 * SQRT(IODIDE) ) ) / &
269 0 : 24d0/60d0/60d0/1d9*MWT_HOI
270 :
271 : ! If parametsation results in negative ( W10 too high )
272 : ! flux set to zero
273 0 : IF ( EMIS_HOI .LT. 0.0d0 ) EMIS_HOI = 0.0d0
274 :
275 : ! Store HOI flux in tendency array in [kg/m2/s]
276 0 : FLUXHOI(I,J) = EMIS_HOI
277 : ENDIF
278 :
279 : ENDDO !I
280 : ENDDO !J
281 : !$OMP END PARALLEL DO
282 :
283 : ! Check exit status
284 : IF ( ERR ) THEN
285 : RC = HCO_FAIL
286 : RETURN
287 : ENDIF
288 :
289 : !=================================================================
290 : ! PASS TO HEMCO STATE AND UPDATE DIAGNOSTICS
291 : !=================================================================
292 :
293 : ! HOI
294 0 : IF ( Inst%CalcHOI ) THEN
295 :
296 : ! Add flux to emission array
297 : CALL HCO_EmisAdd( HcoState, FLUXHOI, Inst%IDTHOI, &
298 0 : RC, ExtNr=Inst%ExtNr )
299 0 : IF ( RC /= HCO_SUCCESS ) THEN
300 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXHOI', RC )
301 0 : RETURN
302 : ENDIF
303 :
304 : ENDIF
305 :
306 : ! I2
307 0 : IF ( Inst%CalcI2 ) THEN
308 :
309 : ! Add flux to emission array
310 : CALL HCO_EmisAdd( HcoState, FLUXI2, Inst%IDTI2, &
311 0 : RC, ExtNr=Inst%ExtNr )
312 0 : IF ( RC /= HCO_SUCCESS ) THEN
313 0 : CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXI2', RC )
314 0 : RETURN
315 : ENDIF
316 :
317 : ENDIF
318 :
319 : ! Cleanup
320 0 : Inst => NULL()
321 :
322 : ! Leave w/ success
323 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
324 :
325 : END SUBROUTINE HCOX_Iodine_Run
326 :
327 : !EOC
328 : !------------------------------------------------------------------------------
329 : ! Harmonized Emissions Component (HEMCO) !
330 : !------------------------------------------------------------------------------
331 : !BOP
332 : !
333 : ! !IROUTINE: HCOX_Iodine_Init
334 : !
335 : ! !DESCRIPTION: Subroutine HcoX\_Iodine\_Init initializes all
336 : ! extension variables.
337 : !\\
338 : !\\
339 : ! !INTERFACE:
340 : !
341 0 : SUBROUTINE HCOX_Iodine_Init( HcoState, ExtName, ExtState, RC )
342 : !
343 : ! !USES:
344 : !
345 : USE HCO_State_Mod, ONLY : HCO_GetHcoID
346 : USE HCO_STATE_MOD, ONLY : HCO_GetExtHcoID
347 : USE HCO_ExtList_Mod, ONLY : GetExtNr
348 : USE HCO_ExtList_Mod, ONLY : GetExtOpt
349 : !
350 : ! !INPUT PARAMETERS:
351 : !
352 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
353 : CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name
354 : TYPE(Ext_State), POINTER :: ExtState ! Options object
355 : !
356 : ! !INPUT/OUTPUT PARAMETERS:
357 : !
358 : INTEGER, INTENT(INOUT) :: RC ! Return status
359 : !
360 : ! !REVISION HISTORY:
361 : ! 15 Mar 2013 - T. Sherwen - Initial implementation (v9-3-01)
362 : ! See https://github.com/geoschem/hemco for complete history
363 : !EOP
364 : !------------------------------------------------------------------------------
365 : !BOC
366 : !
367 : ! !LOCAL VARIABLES:
368 : !
369 : INTEGER :: ExtNr, N, R, AS
370 : CHARACTER(LEN=255) :: MSG, LOC
371 : INTEGER :: nSpc, minLen
372 : LOGICAL :: FOUND
373 0 : INTEGER, ALLOCATABLE :: HcoIDs(:)
374 0 : CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:)
375 : TYPE(MyInst), POINTER :: Inst
376 :
377 : !=================================================================
378 : ! HCOX_Iodine_Init begins here!
379 : !=================================================================
380 0 : LOC = 'HCOX_Iodine_Init (HCOX_IODINE_MOD.F90)'
381 :
382 : ! Extension Nr.
383 0 : ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
384 0 : IF ( ExtNr <= 0 ) RETURN
385 :
386 : ! Enter
387 0 : CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
388 0 : IF ( RC /= HCO_SUCCESS ) THEN
389 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
390 0 : RETURN
391 : ENDIF
392 :
393 : ! Init
394 0 : Inst => NULL()
395 :
396 : ! Create Instance
397 0 : CALL InstCreate ( ExtNr, ExtState%Inorg_Iodine, Inst, RC )
398 0 : IF ( RC /= HCO_SUCCESS ) THEN
399 0 : CALL HCO_ERROR ( 'Cannot create InorgIodine instance', RC )
400 0 : RETURN
401 : ENDIF
402 :
403 : ! ----------------------------------------------------------------------
404 : ! Get species IDs and settings
405 : ! ----------------------------------------------------------------------
406 :
407 : ! Read settings specified in configuration file
408 : ! Note: the specified strings have to match those in
409 : ! the config. file!
410 : CALL GetExtOpt ( HcoState%Config, Inst%ExtNr, 'Emit I2', &
411 0 : OptValBool=Inst%CalcI2, RC=RC )
412 0 : IF ( RC /= HCO_SUCCESS ) THEN
413 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
414 0 : RETURN
415 : ENDIF
416 :
417 : CALL GetExtOpt ( HcoState%Config, Inst%ExtNr, 'Emit HOI', &
418 0 : OptValBool=Inst%CalcHOI, RC=RC )
419 0 : IF ( RC /= HCO_SUCCESS ) THEN
420 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
421 0 : RETURN
422 : ENDIF
423 :
424 : ! Set minimum length and update if CalcI2/CalcHOI==True
425 0 : minLen = 0
426 0 : IF ( Inst%CalcI2 ) THEN
427 0 : minLen = minLen +1
428 : ENDIF
429 0 : IF ( Inst%CalcHOI ) THEN
430 0 : minLen = minLen +1
431 : ENDIF
432 : ! Get HEMCO species IDs
433 0 : CALL HCO_GetExtHcoID( HcoState, Inst%ExtNr, HcoIDs, SpcNames, nSpc, RC )
434 0 : IF ( RC /= HCO_SUCCESS ) THEN
435 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
436 0 : RETURN
437 : ENDIF
438 0 : IF ( nSpc < minLen ) THEN
439 0 : MSG = 'Not enough iodine emission species set'
440 0 : CALL HCO_ERROR ( MSG, RC )
441 0 : RETURN
442 : ENDIF
443 :
444 0 : Inst%IDTHOI = HcoIDs(1)
445 0 : Inst%IDTI2 = HcoIDs(2)
446 :
447 : ! Final I2/HOI flag
448 0 : Inst%CalcI2 = ( Inst%CalcI2 .AND. Inst%IDTI2 > 0 )
449 0 : Inst%CalcHOI = ( Inst%CalcHOI .AND. Inst%IDTHOI > 0 )
450 :
451 : ! Verbose mode
452 0 : IF ( HcoState%amIRoot ) THEN
453 :
454 : ! Write the name of the extension regardless of the verbose setting
455 0 : msg = 'Using HEMCO extension: Inorg_Iodine (HOI and I2 emissions)'
456 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
457 0 : CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator
458 : ELSE
459 0 : CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator
460 : ENDIF
461 :
462 : ! Write all other messages as debug printout only
463 0 : IF ( Inst%CalcHOI ) THEN
464 0 : WRITE(MSG,*) 'HOI: ', TRIM(SpcNames(1)), Inst%IDTHOI
465 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
466 : ENDIF
467 :
468 0 : IF ( Inst%CalcI2 ) THEN
469 0 : WRITE(MSG,*) 'I2: ', TRIM(SpcNames(2)), Inst%IDTI2
470 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
471 : ENDIF
472 : ENDIF
473 :
474 : !=======================================================================
475 : ! Activate this module and the fields of ExtState that it uses
476 : !=======================================================================
477 :
478 : ! Activate met fields used by this module
479 0 : ExtState%FRLAND%DoUse = .TRUE.
480 0 : ExtState%FRLANDIC%DoUse = .TRUE.
481 0 : ExtState%FROCEAN%DoUse = .TRUE.
482 0 : ExtState%FRSEAICE%DoUse = .TRUE.
483 0 : ExtState%FRLAKE%DoUse = .TRUE.
484 0 : ExtState%TSKIN%DoUse = .TRUE.
485 0 : ExtState%U10M%DoUse = .TRUE.
486 0 : ExtState%V10M%DoUse = .TRUE.
487 0 : ExtState%O3%DoUse = .TRUE.
488 0 : ExtState%AIR%DoUse = .TRUE.
489 :
490 : ! Enable module
491 : !ExtState%Inorg_Iodine = .TRUE.
492 :
493 : ! Return w/ success
494 0 : Inst => NULL()
495 0 : IF ( ALLOCATED(HcoIDs ) ) DEALLOCATE(HcoIDs )
496 0 : IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames)
497 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
498 :
499 0 : END SUBROUTINE HCOX_Iodine_Init
500 :
501 : !EOC
502 : !------------------------------------------------------------------------------
503 : ! Harmonized Emissions Component (HEMCO) !
504 : !------------------------------------------------------------------------------
505 : !BOP
506 : !
507 : ! !IROUTINE: HCOX_Iodine_Final
508 : !
509 : ! !DESCRIPTION: Subroutine HcoX\_Iodine\_Final deallocates
510 : ! all module arrays.
511 : !\\
512 : !\\
513 : ! !INTERFACE:
514 : !
515 0 : SUBROUTINE HCOX_Iodine_Final ( ExtState )
516 : !
517 : ! !INPUT PARAMETERS:
518 : !
519 : TYPE(Ext_State), POINTER :: ExtState ! Module options
520 : !
521 : ! !REVISION HISTORY:
522 : ! 15 Mar 2013 - T. Sherwen - Initial implementation (v9-3-01)
523 : ! See https://github.com/geoschem/hemco for complete history
524 : !EOP
525 : !------------------------------------------------------------------------------
526 : !BOC
527 : !
528 : !=================================================================
529 : ! HCOX_Iodine_Final begins here!
530 : !=================================================================
531 0 : CALL InstRemove ( ExtState%Inorg_Iodine )
532 :
533 : ! Cleanup module arrays
534 : ! IF ( ALLOCATED ( HcoIDs ) ) DEALLOCATE( HcoIDs )
535 : ! IF ( ALLOCATED ( SpcNames ) ) DEALLOCATE( SpcNames )
536 :
537 0 : END SUBROUTINE HCOX_Iodine_Final
538 : !EOC
539 : !------------------------------------------------------------------------------
540 : ! Harmonized Emissions Component (HEMCO) !
541 : !------------------------------------------------------------------------------
542 : !BOP
543 : !
544 : ! !IROUTINE: InstGet
545 : !
546 : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
547 : !\\
548 : !\\
549 : ! !INTERFACE:
550 : !
551 0 : SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
552 : !
553 : ! !INPUT PARAMETERS:
554 : !
555 : INTEGER :: Instance
556 : TYPE(MyInst), POINTER :: Inst
557 : INTEGER :: RC
558 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
559 : !
560 : ! !REVISION HISTORY:
561 : ! 18 Feb 2016 - C. Keller - Initial version
562 : ! See https://github.com/geoschem/hemco for complete history
563 : !EOP
564 : !------------------------------------------------------------------------------
565 : !BOC
566 : TYPE(MyInst), POINTER :: PrvInst
567 :
568 : !=================================================================
569 : ! InstGet begins here!
570 : !=================================================================
571 :
572 : ! Get instance. Also archive previous instance.
573 0 : PrvInst => NULL()
574 0 : Inst => AllInst
575 0 : DO WHILE ( ASSOCIATED(Inst) )
576 0 : IF ( Inst%Instance == Instance ) EXIT
577 0 : PrvInst => Inst
578 0 : Inst => Inst%NextInst
579 : END DO
580 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
581 0 : RC = HCO_FAIL
582 0 : RETURN
583 : ENDIF
584 :
585 : ! Pass output arguments
586 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
587 :
588 : ! Cleanup & Return
589 0 : PrvInst => NULL()
590 0 : RC = HCO_SUCCESS
591 :
592 : END SUBROUTINE InstGet
593 : !EOC
594 : !------------------------------------------------------------------------------
595 : ! Harmonized Emissions Component (HEMCO) !
596 : !------------------------------------------------------------------------------
597 : !BOP
598 : !
599 : ! !IROUTINE: InstCreate
600 : !
601 : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
602 : !\\
603 : !\\
604 : ! !INTERFACE:
605 : !
606 0 : SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
607 : !
608 : ! !INPUT PARAMETERS:
609 : !
610 : INTEGER, INTENT(IN) :: ExtNr
611 : !
612 : ! !OUTPUT PARAMETERS:
613 : !
614 : INTEGER, INTENT( OUT) :: Instance
615 : TYPE(MyInst), POINTER :: Inst
616 : !
617 : ! !INPUT/OUTPUT PARAMETERS:
618 : !
619 : INTEGER, INTENT(INOUT) :: RC
620 : !
621 : ! !REVISION HISTORY:
622 : ! 18 Feb 2016 - C. Keller - Initial version
623 : ! See https://github.com/geoschem/hemco for complete history
624 : !EOP
625 : !------------------------------------------------------------------------------
626 : !BOC
627 : TYPE(MyInst), POINTER :: TmpInst
628 : INTEGER :: nnInst
629 :
630 : !=================================================================
631 : ! InstCreate begins here!
632 : !=================================================================
633 :
634 : ! ----------------------------------------------------------------
635 : ! Generic instance initialization
636 : ! ----------------------------------------------------------------
637 :
638 : ! Initialize
639 0 : Inst => NULL()
640 :
641 : ! Get number of already existing instances
642 0 : TmpInst => AllInst
643 0 : nnInst = 0
644 0 : DO WHILE ( ASSOCIATED(TmpInst) )
645 0 : nnInst = nnInst + 1
646 0 : TmpInst => TmpInst%NextInst
647 : END DO
648 :
649 : ! Create new instance
650 0 : ALLOCATE(Inst)
651 0 : Inst%Instance = nnInst + 1
652 0 : Inst%ExtNr = ExtNr
653 :
654 : ! Attach to instance list
655 0 : Inst%NextInst => AllInst
656 0 : AllInst => Inst
657 :
658 : ! Update output instance
659 0 : Instance = Inst%Instance
660 :
661 : ! ----------------------------------------------------------------
662 : ! Type specific initialization statements follow below
663 : ! ----------------------------------------------------------------
664 :
665 : ! Return w/ success
666 0 : RC = HCO_SUCCESS
667 :
668 0 : END SUBROUTINE InstCreate
669 : !EOC
670 : !------------------------------------------------------------------------------
671 : ! Harmonized Emissions Component (HEMCO) !
672 : !------------------------------------------------------------------------------
673 : !BOP
674 : !
675 : ! !IROUTINE: InstRemove
676 : !
677 : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
678 : !\\
679 : !\\
680 : ! !INTERFACE:
681 : !
682 0 : SUBROUTINE InstRemove ( Instance )
683 : !
684 : ! !INPUT PARAMETERS:
685 : !
686 : INTEGER :: Instance
687 : !
688 : ! !REVISION HISTORY:
689 : ! 18 Feb 2016 - C. Keller - Initial version
690 : ! See https://github.com/geoschem/hemco for complete history
691 : !EOP
692 : !------------------------------------------------------------------------------
693 : !BOC
694 : INTEGER :: RC
695 : TYPE(MyInst), POINTER :: PrevInst
696 : TYPE(MyInst), POINTER :: Inst
697 :
698 : !=================================================================
699 : ! InstRemove begins here!
700 : !=================================================================
701 :
702 : ! Init
703 0 : PrevInst => NULL()
704 0 : Inst => NULL()
705 :
706 : ! Get instance. Also archive previous instance.
707 0 : CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
708 :
709 : ! Instance-specific deallocation
710 0 : IF ( ASSOCIATED(Inst) ) THEN
711 :
712 : ! Pop off instance from list
713 0 : IF ( ASSOCIATED(PrevInst) ) THEN
714 0 : PrevInst%NextInst => Inst%NextInst
715 : ELSE
716 0 : AllInst => Inst%NextInst
717 : ENDIF
718 0 : DEALLOCATE(Inst)
719 : ENDIF
720 :
721 : ! Free pointers before exiting
722 0 : PrevInst => NULL()
723 0 : Inst => NULL()
724 :
725 0 : END SUBROUTINE InstRemove
726 : !EOC
727 0 : END MODULE HCOX_Iodine_Mod
|
