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 0 : MSG = 'Use inorganic iodine emissions (extension module)'
454 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='-')
455 :
456 0 : IF ( Inst%CalcHOI ) THEN
457 0 : WRITE(MSG,*) 'HOI: ', TRIM(SpcNames(1)), Inst%IDTHOI
458 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
459 : ENDIF
460 :
461 0 : IF ( Inst%CalcI2 ) THEN
462 0 : WRITE(MSG,*) 'I2: ', TRIM(SpcNames(2)), Inst%IDTI2
463 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
464 : ENDIF
465 : ENDIF
466 :
467 : !=======================================================================
468 : ! Activate this module and the fields of ExtState that it uses
469 : !=======================================================================
470 :
471 : ! Activate met fields used by this module
472 0 : ExtState%FRLAND%DoUse = .TRUE.
473 0 : ExtState%FRLANDIC%DoUse = .TRUE.
474 0 : ExtState%FROCEAN%DoUse = .TRUE.
475 0 : ExtState%FRSEAICE%DoUse = .TRUE.
476 0 : ExtState%FRLAKE%DoUse = .TRUE.
477 0 : ExtState%TSKIN%DoUse = .TRUE.
478 0 : ExtState%U10M%DoUse = .TRUE.
479 0 : ExtState%V10M%DoUse = .TRUE.
480 0 : ExtState%O3%DoUse = .TRUE.
481 0 : ExtState%AIR%DoUse = .TRUE.
482 :
483 : ! Enable module
484 : !ExtState%Inorg_Iodine = .TRUE.
485 :
486 : ! Return w/ success
487 0 : Inst => NULL()
488 0 : IF ( ALLOCATED(HcoIDs ) ) DEALLOCATE(HcoIDs )
489 0 : IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames)
490 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
491 :
492 0 : END SUBROUTINE HCOX_Iodine_Init
493 :
494 : !EOC
495 : !------------------------------------------------------------------------------
496 : ! Harmonized Emissions Component (HEMCO) !
497 : !------------------------------------------------------------------------------
498 : !BOP
499 : !
500 : ! !IROUTINE: HCOX_Iodine_Final
501 : !
502 : ! !DESCRIPTION: Subroutine HcoX\_Iodine\_Final deallocates
503 : ! all module arrays.
504 : !\\
505 : !\\
506 : ! !INTERFACE:
507 : !
508 0 : SUBROUTINE HCOX_Iodine_Final ( ExtState )
509 : !
510 : ! !INPUT PARAMETERS:
511 : !
512 : TYPE(Ext_State), POINTER :: ExtState ! Module options
513 : !
514 : ! !REVISION HISTORY:
515 : ! 15 Mar 2013 - T. Sherwen - Initial implementation (v9-3-01)
516 : ! See https://github.com/geoschem/hemco for complete history
517 : !EOP
518 : !------------------------------------------------------------------------------
519 : !BOC
520 : !
521 : !=================================================================
522 : ! HCOX_Iodine_Final begins here!
523 : !=================================================================
524 0 : CALL InstRemove ( ExtState%Inorg_Iodine )
525 :
526 : ! Cleanup module arrays
527 : ! IF ( ALLOCATED ( HcoIDs ) ) DEALLOCATE( HcoIDs )
528 : ! IF ( ALLOCATED ( SpcNames ) ) DEALLOCATE( SpcNames )
529 :
530 0 : END SUBROUTINE HCOX_Iodine_Final
531 : !EOC
532 : !------------------------------------------------------------------------------
533 : ! Harmonized Emissions Component (HEMCO) !
534 : !------------------------------------------------------------------------------
535 : !BOP
536 : !
537 : ! !IROUTINE: InstGet
538 : !
539 : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
540 : !\\
541 : !\\
542 : ! !INTERFACE:
543 : !
544 0 : SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
545 : !
546 : ! !INPUT PARAMETERS:
547 : !
548 : INTEGER :: Instance
549 : TYPE(MyInst), POINTER :: Inst
550 : INTEGER :: RC
551 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
552 : !
553 : ! !REVISION HISTORY:
554 : ! 18 Feb 2016 - C. Keller - Initial version
555 : ! See https://github.com/geoschem/hemco for complete history
556 : !EOP
557 : !------------------------------------------------------------------------------
558 : !BOC
559 : TYPE(MyInst), POINTER :: PrvInst
560 :
561 : !=================================================================
562 : ! InstGet begins here!
563 : !=================================================================
564 :
565 : ! Get instance. Also archive previous instance.
566 0 : PrvInst => NULL()
567 0 : Inst => AllInst
568 0 : DO WHILE ( ASSOCIATED(Inst) )
569 0 : IF ( Inst%Instance == Instance ) EXIT
570 0 : PrvInst => Inst
571 0 : Inst => Inst%NextInst
572 : END DO
573 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
574 0 : RC = HCO_FAIL
575 0 : RETURN
576 : ENDIF
577 :
578 : ! Pass output arguments
579 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
580 :
581 : ! Cleanup & Return
582 0 : PrvInst => NULL()
583 0 : RC = HCO_SUCCESS
584 :
585 : END SUBROUTINE InstGet
586 : !EOC
587 : !------------------------------------------------------------------------------
588 : ! Harmonized Emissions Component (HEMCO) !
589 : !------------------------------------------------------------------------------
590 : !BOP
591 : !
592 : ! !IROUTINE: InstCreate
593 : !
594 : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
595 : !\\
596 : !\\
597 : ! !INTERFACE:
598 : !
599 0 : SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
600 : !
601 : ! !INPUT PARAMETERS:
602 : !
603 : INTEGER, INTENT(IN) :: ExtNr
604 : !
605 : ! !OUTPUT PARAMETERS:
606 : !
607 : INTEGER, INTENT( OUT) :: Instance
608 : TYPE(MyInst), POINTER :: Inst
609 : !
610 : ! !INPUT/OUTPUT PARAMETERS:
611 : !
612 : INTEGER, INTENT(INOUT) :: RC
613 : !
614 : ! !REVISION HISTORY:
615 : ! 18 Feb 2016 - C. Keller - Initial version
616 : ! See https://github.com/geoschem/hemco for complete history
617 : !EOP
618 : !------------------------------------------------------------------------------
619 : !BOC
620 : TYPE(MyInst), POINTER :: TmpInst
621 : INTEGER :: nnInst
622 :
623 : !=================================================================
624 : ! InstCreate begins here!
625 : !=================================================================
626 :
627 : ! ----------------------------------------------------------------
628 : ! Generic instance initialization
629 : ! ----------------------------------------------------------------
630 :
631 : ! Initialize
632 0 : Inst => NULL()
633 :
634 : ! Get number of already existing instances
635 0 : TmpInst => AllInst
636 0 : nnInst = 0
637 0 : DO WHILE ( ASSOCIATED(TmpInst) )
638 0 : nnInst = nnInst + 1
639 0 : TmpInst => TmpInst%NextInst
640 : END DO
641 :
642 : ! Create new instance
643 0 : ALLOCATE(Inst)
644 0 : Inst%Instance = nnInst + 1
645 0 : Inst%ExtNr = ExtNr
646 :
647 : ! Attach to instance list
648 0 : Inst%NextInst => AllInst
649 0 : AllInst => Inst
650 :
651 : ! Update output instance
652 0 : Instance = Inst%Instance
653 :
654 : ! ----------------------------------------------------------------
655 : ! Type specific initialization statements follow below
656 : ! ----------------------------------------------------------------
657 :
658 : ! Return w/ success
659 0 : RC = HCO_SUCCESS
660 :
661 0 : END SUBROUTINE InstCreate
662 : !EOC
663 : !------------------------------------------------------------------------------
664 : ! Harmonized Emissions Component (HEMCO) !
665 : !------------------------------------------------------------------------------
666 : !BOP
667 : !
668 : ! !IROUTINE: InstRemove
669 : !
670 : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
671 : !\\
672 : !\\
673 : ! !INTERFACE:
674 : !
675 0 : SUBROUTINE InstRemove ( Instance )
676 : !
677 : ! !INPUT PARAMETERS:
678 : !
679 : INTEGER :: Instance
680 : !
681 : ! !REVISION HISTORY:
682 : ! 18 Feb 2016 - C. Keller - Initial version
683 : ! See https://github.com/geoschem/hemco for complete history
684 : !EOP
685 : !------------------------------------------------------------------------------
686 : !BOC
687 : INTEGER :: RC
688 : TYPE(MyInst), POINTER :: PrevInst
689 : TYPE(MyInst), POINTER :: Inst
690 :
691 : !=================================================================
692 : ! InstRemove begins here!
693 : !=================================================================
694 :
695 : ! Init
696 0 : PrevInst => NULL()
697 0 : Inst => NULL()
698 :
699 : ! Get instance. Also archive previous instance.
700 0 : CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
701 :
702 : ! Instance-specific deallocation
703 0 : IF ( ASSOCIATED(Inst) ) THEN
704 :
705 : ! Pop off instance from list
706 0 : IF ( ASSOCIATED(PrevInst) ) THEN
707 0 : PrevInst%NextInst => Inst%NextInst
708 : ELSE
709 0 : AllInst => Inst%NextInst
710 : ENDIF
711 0 : DEALLOCATE(Inst)
712 : ENDIF
713 :
714 : ! Free pointers before exiting
715 0 : PrevInst => NULL()
716 0 : Inst => NULL()
717 :
718 0 : END SUBROUTINE InstRemove
719 : !EOC
720 0 : END MODULE HCOX_Iodine_Mod
|
