Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hcox_finn_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCOX\_FINN\_MOD contains routines and variables to
9 : ! calculate FINN biomass burning emissions in HEMCO.
10 : !
11 : ! !INTERFACE:
12 : !
13 : MODULE HcoX_FINN_Mod
14 : !
15 : ! !USES:
16 : !
17 : USE HCO_Error_Mod
18 : USE HCO_Diagn_Mod
19 : USE HCOX_TOOLS_MOD
20 : USE HCO_State_Mod, ONLY : HCO_State
21 : USE HCOX_State_Mod, ONLY : Ext_State
22 :
23 : IMPLICIT NONE
24 : PRIVATE
25 : !
26 : ! !PUBLIC MEMBER FUNCTIONS:
27 : !
28 : PUBLIC :: HCOX_FINN_Init
29 : PUBLIC :: HCOX_FINN_Run
30 : PUBLIC :: HCOX_FINN_Final
31 : !
32 : ! !REMARKS:
33 : ! Emissions of biomass burning species are read at monthly or daily
34 : ! resolution. Note: no emission factors are used here - emissions of
35 : ! individual species are given in input files. Emissions on the FINN 0.5x0.5
36 : ! degree grid are regridded to the current model grid.
37 : ! .
38 : ! FINN biomass burning emissions are computed for the following gas-phase
39 : ! and aerosol-phase species:
40 : ! .
41 : ! (1 ) NOx [ kg/m2/s] (13) BC [kgC/m2/s]
42 : ! (2 ) CO [ kg/m2/s] (14) OC [kgC/m2/s]
43 : ! (3 ) ALK4 [kgC/m2/s] (15) MGLY [ kg/m2/s]
44 : ! (4 ) ACET [kgC/m2/s] (16) BENZ [kgC/m2/s]
45 : ! (5 ) MEK [kgC/m2/s] (17) TOLU [kgC/m2/s]
46 : ! (6 ) ALD2 [kgC/m2/s] (18) C2H4 [kgC/m2/s]
47 : ! (7 ) PRPE [kgC/m2/s] (19) C2H2 [kgC/m2/s]
48 : ! (8 ) C3H8 [kgC/m2/s] (20) GLYC [ kg/m2/s]
49 : ! (9 ) CH2O [ kg/m2/s] (21) HAC [ kg/m2/s]
50 : ! (10) C2H6 [kgC/m2/s] (22) CO2 [ kg/m2/s]
51 : ! (11) SO2 [ kg/m2/s] (23) CH4 [ kg/m2/s]
52 : ! (12) NH3 [ kg/m2/s] (24)
53 : !
54 : !
55 : ! All species to be used must be listed in the settings section of the HEMCO
56 : ! configuration file. For every listed species, individual scale factors as
57 : ! well as masks can be defined. For example, to scale FINN CO emissions by a
58 : ! factor of 1.05 and restrict them to North America, as well as to scale NO
59 : ! emissions by a factor of 1.5:
60 : !
61 : !114 FINN : on NO/CO/ALK4/ACET/MEK/ALD2/PRPE/C3H8/CH2O/C2H6/SO2/NH3/BCPI/BCPO/OCPI/OCPO/GLYC/HAC
62 : ! --> FINN_daily : false
63 : ! --> hydrophilic BC : 0.2
64 : ! --> hydrophilic OC : 0.5
65 : ! --> Mask_CO : NAMASK
66 : ! --> Scaling_CO : 1.05
67 : ! --> Scaling_NO : 1.5
68 : !
69 : ! Field NAMASK must be defined in section mask of the HEMCO configuration file.
70 : !
71 : ! References:
72 : ! ============================================================================
73 : ! (1 ) Original FINN database from Christine Wiedinmyer
74 : ! http://bai.acd.ucar.edu/Data/fire/
75 : ! (2 ) Wiedinmyer, C., Akagi, S.K., Yokelson, R.J., Emmons, L.K.,
76 : ! Al-Saadi, J.A., Orlando, J.J., and Soja, A.J.: The Fire
77 : ! INventory from NCAR (FINN): a high resolution global model to
78 : ! estimate the emissions from open burning, Geoscientific Model
79 : ! Development, 4, 625-641, doi:10.5194/gmd-4-625-2011, 2011.
80 : !
81 : ! !REVISION HISTORY:
82 : ! 02 Jan 2013 - J. Mao & J.A. Fisher - Initial version, based on GFED3
83 : ! See https://github.com/geoschem/hemco for complete history
84 : !EOP
85 : !------------------------------------------------------------------------------
86 : !BOC
87 : !
88 : ! !DEFINED PARAMETERS:
89 : !
90 : !=================================================================
91 : ! MODULE PARAMETERS
92 : !
93 : ! nSpcMax : Maximum number of emitted species
94 : ! N_EMFAC : Number of emission factors per species
95 : ! N_SPEC : Number of FINN species
96 : ! MW_CO2 : Molecular weight of CO2 (g/mol)
97 : ! MW_NMOC : Molecular weight of NMOC (g/mol). Assumed MW for NMOC
98 : ! is 68 g/mol.
99 : !=================================================================
100 : INTEGER, PARAMETER :: nSpcMax = 100
101 : INTEGER, PARAMETER :: N_EMFAC = 6
102 : INTEGER, PARAMETER :: N_SPEC = 58
103 : REAL(dp), PARAMETER :: MW_CO2 = 44.01_dp
104 : REAL(dp), PARAMETER :: MW_NMOC = 68.00_dp
105 : !
106 : ! !PRIVATE TYPES:
107 : !
108 : TYPE :: MyInst
109 : !=================================================================
110 : ! HEMCO VARIABLES
111 : !
112 : ! ExtNr : Extension number
113 : ! UseDay : True if daily data is used
114 : !=================================================================
115 : INTEGER :: Instance
116 : INTEGER :: ExtNr
117 : LOGICAL :: UseDay
118 :
119 : !=================================================================
120 : ! SPECIES VARIABLES
121 : !
122 : ! nSpc : Number of used species (specified in config. file)
123 : ! SpcNames : Names of all used species
124 : ! HcoIDs : HEMCO species IDs of all used species
125 : ! FinnIDs : Index of used species within FINN
126 : ! FINN_SPEC_NAME : Names of all FINN species
127 : !=================================================================
128 : INTEGER :: nSpc
129 : CHARACTER(LEN=31), POINTER :: SpcNames(:)
130 : CHARACTER(LEN=61), POINTER :: SpcScalFldNme(:)
131 : INTEGER, POINTER :: HcoIDs(:)
132 : INTEGER, POINTER :: FinnIDs(:)
133 : CHARACTER(LEN=6), POINTER :: FINN_SPEC_NAME(:)
134 :
135 : !=================================================================
136 : ! SCALE FACTORS
137 : !
138 : ! FINN_EMFAC: emission scale factors for each species and
139 : ! emission factor type. The filename of the emissions
140 : ! emissions factor table is specified in the HEMCO
141 : ! configuration file. The scale factors are converted
142 : ! to kg species/kg CO2 when reading them from disk.
143 : ! OCPIfrac : Fraction of OC that converts into hydrophilic OC.
144 : ! Can be set in HEMCO configuration file (default=0.5)
145 : ! BCPIfrac : Fraction of BC that converts into hydrophilic BC.
146 : ! Can be set in HEMCO configuration file (default=0.2)
147 : ! SpcScal : Additional scaling factors assigned to species through
148 : ! the HEMCO configuration file (e.g. Scaling_CO).
149 : !=================================================================
150 : REAL(dp), POINTER :: FINN_EMFAC(:,:)
151 : REAL(sp), POINTER :: SpcScal(:)
152 : REAL(sp) :: OCPIfrac
153 : REAL(sp) :: BCPIfrac
154 :
155 : !=================================================================
156 : ! DATA ARRAY POINTERS
157 : !
158 : ! These are the pointers to the 6 vegetation type data arrays
159 : ! specified in the configuration file
160 : !=================================================================
161 : REAL(hp), POINTER :: VEGTYP1(:,:) => NULL()
162 : REAL(hp), POINTER :: VEGTYP2(:,:) => NULL()
163 : REAL(hp), POINTER :: VEGTYP3(:,:) => NULL()
164 : REAL(hp), POINTER :: VEGTYP4(:,:) => NULL()
165 : REAL(hp), POINTER :: VEGTYP5(:,:) => NULL()
166 : REAL(hp), POINTER :: VEGTYP9(:,:) => NULL()
167 :
168 : TYPE(MyInst), POINTER :: NextInst => NULL()
169 : END TYPE MyInst
170 :
171 : ! Pointer to instances
172 : TYPE(MyInst), POINTER :: AllInst => NULL()
173 :
174 : CONTAINS
175 : !EOC
176 : !------------------------------------------------------------------------------
177 : ! Harmonized Emissions Component (HEMCO) !
178 : !------------------------------------------------------------------------------
179 : !BOP
180 : !
181 : ! !IROUTINE: HCOX_FINN_Run
182 : !
183 : ! !DESCRIPTION: Subroutine HCOX\_FINN\_Run computes the FINN biomass
184 : ! burning emissions for the current date.
185 : !\\
186 : !\\
187 : ! !INTERFACE:
188 : !
189 0 : SUBROUTINE HCOX_FINN_Run( ExtState, HcoState, RC )
190 : !
191 : ! !USES:
192 : !
193 : USE HCO_EmisList_mod, ONLY : HCO_GetPtr
194 : USE HCO_Calc_Mod, ONLY : HCO_EvalFld
195 : USE HCO_FluxArr_mod, ONLY : HCO_EmisAdd
196 : USE HCO_State_mod, ONLY : HCO_GetHcoID
197 : USE HCO_Clock_mod, ONLY : HcoClock_Get
198 : USE HCO_Clock_mod, ONLY : HcoClock_First
199 : USE HCO_Clock_mod, ONLY : HcoClock_NewMonth, HcoClock_NewDay
200 : !
201 : ! !INPUT PARAMETERS:
202 : !
203 : TYPE(Ext_State), POINTER :: ExtState ! Module options
204 : !
205 : ! !INPUT/OUTPUT PARAMETERS:
206 : !
207 : TYPE(HCO_State), POINTER :: HcoState ! Output obj
208 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
209 : !
210 : ! !REVISION HISTORY:
211 : ! 02 Jan 2012 - J. Mao & J. Fisher - Initial version, based on GFED3
212 : ! See https://github.com/geoschem/hemco for complete history
213 : !EOP
214 : !------------------------------------------------------------------------------
215 : !BOC
216 : !
217 : ! !LOCAL VARIABLES:
218 : !
219 : ! Scalars
220 : INTEGER :: N, M, NF
221 : INTEGER :: FinnID, HcoID
222 : ! LOGICAL, SAVE :: FIRST = .TRUE.
223 : LOGICAL :: DoRepeat
224 : INTEGER :: Cnt
225 : CHARACTER(LEN=31) :: PREFIX, FLDNME
226 : INTEGER :: NDAYS, cYYYY, cMM, cDD
227 : REAL(dp) :: TOTAL
228 : CHARACTER(LEN=255) :: MSG, LOC
229 :
230 : ! Arrays
231 0 : REAL(hp), TARGET :: SpcArr(HcoState%NX,HcoState%NY)
232 0 : REAL(hp), TARGET :: TypArr(HcoState%NX,HcoState%NY)
233 :
234 : !==============================================================================
235 : ! This code is required for the vertical distribution of biomass burning emiss.
236 : ! We will keep it here for a future implementation. (mps, 4/24/17)
237 : ! INTEGER :: I, J, L, N, M
238 : ! INTEGER :: PBL_MAX
239 : ! REAL(hp) :: PBL_FRAC, F_OF_PBL, F_OF_FT
240 : ! REAL(hp) :: DELTPRES, TOTPRESFT
241 : ! REAL(hp), TARGET :: SpcArr3D(HcoState%NX,HcoState%NY,HcoState%NZ)
242 : !==============================================================================
243 :
244 : ! Pointers
245 0 : REAL(hp), POINTER :: THISTYP(:,:)
246 :
247 : ! Local instance
248 : TYPE(MyInst), POINTER :: Inst
249 :
250 : !=======================================================================
251 : ! HCOX_FINN_Run begins here!
252 : !=======================================================================
253 0 : LOC = 'HCOX_FINN_Run (HCOX_FINN_MOD.F90)'
254 :
255 : ! Return if extension disabled
256 0 : IF ( ExtState%FINN <= 0 ) RETURN
257 :
258 : ! Enter
259 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
260 0 : IF ( RC /= HCO_SUCCESS ) THEN
261 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
262 0 : RETURN
263 : ENDIF
264 :
265 : ! Init
266 0 : THISTYP => NULL()
267 :
268 : ! Get instance
269 0 : Inst => NULL()
270 0 : CALL InstGet ( ExtState%FINN, Inst, RC )
271 0 : IF ( RC /= HCO_SUCCESS ) THEN
272 0 : WRITE(MSG,*) 'Cannot find FINN instance Nr. ', ExtState%FINN
273 0 : CALL HCO_ERROR(MSG,RC)
274 0 : RETURN
275 : ENDIF
276 :
277 : !==============================================================================
278 : ! This code is required for the vertical distribution of biomass burning emiss.
279 : ! We will keep it here for a future implementation. (mps, 4/24/17)
280 : ! ! Add only 65% biomass burning source to boundary layer, the
281 : ! ! rest is emitted into the free troposphere (mps from evf+tjb, 3/10/17)
282 : ! PBL_FRAC = 0.65_hp
283 : !==============================================================================
284 :
285 : !-----------------------------------------------------------------------
286 : ! Get pointers to data arrays
287 : !-----------------------------------------------------------------------
288 : !IF ( HcoClock_First(HcoState%Clock,.TRUE.) ) THEN
289 0 : IF ( Inst%UseDay ) THEN
290 0 : PREFIX = 'FINN_DAILY_'
291 : ELSE
292 0 : PREFIX = 'FINN_'
293 : ENDIF
294 :
295 0 : FLDNME = TRIM(PREFIX) // 'VEGTYP1'
296 0 : CALL HCO_EvalFld( HcoState, TRIM(FLDNME), Inst%VEGTYP1, RC )
297 0 : IF ( RC /= HCO_SUCCESS ) THEN
298 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
299 0 : RETURN
300 : ENDIF
301 :
302 0 : FLDNME = TRIM(PREFIX) // 'VEGTYP2'
303 0 : CALL HCO_EvalFld( HcoState, TRIM(FLDNME), Inst%VEGTYP2, RC )
304 0 : IF ( RC /= HCO_SUCCESS ) THEN
305 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
306 0 : RETURN
307 : ENDIF
308 :
309 0 : FLDNME = TRIM(PREFIX) // 'VEGTYP3'
310 0 : CALL HCO_EvalFld( HcoState, TRIM(FLDNME), Inst%VEGTYP3, RC )
311 0 : IF ( RC /= HCO_SUCCESS ) THEN
312 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
313 0 : RETURN
314 : ENDIF
315 :
316 0 : FLDNME = TRIM(PREFIX) // 'VEGTYP4'
317 0 : CALL HCO_EvalFld( HcoState, TRIM(FLDNME), Inst%VEGTYP4, RC )
318 0 : IF ( RC /= HCO_SUCCESS ) THEN
319 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
320 0 : RETURN
321 : ENDIF
322 :
323 0 : FLDNME = TRIM(PREFIX) // 'VEGTYP5'
324 0 : CALL HCO_EvalFld( HcoState, TRIM(FLDNME), Inst%VEGTYP5, RC )
325 0 : IF ( RC /= HCO_SUCCESS ) THEN
326 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
327 0 : RETURN
328 : ENDIF
329 :
330 0 : FLDNME = TRIM(PREFIX) // 'VEGTYP9'
331 0 : CALL HCO_EvalFld( HcoState, TRIM(FLDNME), Inst%VEGTYP9, RC )
332 0 : IF ( RC /= HCO_SUCCESS ) THEN
333 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
334 0 : RETURN
335 : ENDIF
336 :
337 : ! FIRST = .FALSE.
338 : !ENDIF
339 :
340 : ! For logfile
341 0 : IF ( HcoState%amIRoot ) THEN
342 0 : IF ( Inst%UseDay ) THEN
343 0 : IF ( HcoClock_NewDay( HcoState%Clock, .TRUE. ) ) THEN
344 : CALL HcoClock_Get( HcoState%Clock, &
345 0 : cYYYY=cYYYY, cMM=cMM, cDD=cDD, RC=RC )
346 0 : IF ( RC/=HCO_SUCCESS ) RETURN
347 0 : WRITE(MSG, 100) cYYYY, cMM, cDD
348 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
349 : 100 FORMAT( 'FINN daily emissions for year, month, day: ', &
350 : i4, '/', i2.2, '/', i2.2 )
351 : ENDIF
352 : ELSE
353 0 : IF ( HcoClock_NewMonth( HcoState%Clock, .TRUE. ) ) THEN
354 : CALL HcoClock_Get( HcoState%Clock, &
355 0 : cYYYY=cYYYY, cMM=cMM, LMD=NDAYS, RC=RC)
356 0 : IF ( RC/=HCO_SUCCESS ) RETURN
357 0 : WRITE(MSG, 110) cYYYY, cMM
358 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
359 : 110 FORMAT( 'FINN monthly emissions for year, month: ', &
360 : i4, '/', i2.2 )
361 : ENDIF
362 : ENDIF
363 : ENDIF
364 :
365 : !-----------------------------------------------------------------------
366 : ! Calculate emissions for all selected species
367 : !-----------------------------------------------------------------------
368 :
369 : ! Loop over all emitted species
370 0 : DO N = 1, Inst%nSpc
371 :
372 : ! ID is the FINN species index of this species
373 0 : FinnID = Inst%FinnIDs(N)
374 0 : IF ( FinnID <= 0 ) CYCLE
375 :
376 : ! HcoID is the HEMCO species index of this species
377 0 : HcoID = Inst%HcoIDs(N)
378 0 : IF ( HcoID < 0 ) CYCLE
379 :
380 : ! Species with no emission factor have FINN_EMFAC=0
381 0 : IF ( MAXVAL(Inst%FINN_EMFAC(FinnID,:)) <= 0.0_hp ) CYCLE
382 :
383 : ! SpcArr are the total biomass burning emissions for this
384 : ! species. TypArr are the emissions from a given vegetation type.
385 0 : SpcArr = 0.0_hp
386 : !==============================================================================
387 : ! This code is required for the vertical distribution of biomass burning emiss.
388 : ! We will keep it here for a future implementation. (mps, 4/24/17)
389 : ! SpcArr3D = 0.0_hp
390 : !==============================================================================
391 :
392 : ! Calculate emissions for all source types
393 0 : DO NF = 1, N_EMFAC
394 :
395 : ! Select emission factor array
396 : IF ( NF == 1 ) THEN
397 0 : THISTYP => Inst%VEGTYP1
398 : ELSEIF ( NF == 2 ) THEN
399 0 : THISTYP => Inst%VEGTYP2
400 : ELSEIF ( NF == 3 ) THEN
401 0 : THISTYP => Inst%VEGTYP3
402 : ELSEIF ( NF == 4 ) THEN
403 0 : THISTYP => Inst%VEGTYP4
404 : ELSEIF ( NF == 5 ) THEN
405 0 : THISTYP => Inst%VEGTYP5
406 : ELSEIF ( NF == 6 ) THEN
407 0 : THISTYP => Inst%VEGTYP9
408 : ELSE
409 0 : CALL HCO_ERROR ( 'Undefined emission factor', RC )
410 0 : RETURN
411 : ENDIF
412 :
413 : ! Multiply CO2 emissions by appropriate ratio for each land
414 : ! type and sum to get total emissions for the species on the
415 : ! native grid - emissions are in [kg CO2/m2/s[. FINN_EMFAC is
416 : ! in [kg X]/[kg CO2].
417 0 : TypArr(:,:) = THISTYP(:,:) * Inst%FINN_EMFAC(FinnID,NF)
418 :
419 : ! TODO: Add to diagnostics here
420 :
421 : ! Add to species array
422 0 : SpcArr = SpcArr + TypArr
423 : ENDDO !NF
424 :
425 : ! Apply species specific scale factors
426 0 : SpcArr = SpcArr * Inst%SpcScal(N)
427 :
428 : ! Check for masking
429 0 : CALL HCOX_SCALE( HcoState, SpcArr, TRIM(Inst%SpcScalFldNme(N)), RC )
430 0 : IF ( RC /= HCO_SUCCESS ) THEN
431 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
432 0 : RETURN
433 : ENDIF
434 :
435 0 : SELECT CASE ( Inst%SpcNames(N) )
436 : CASE ( 'OCPI' )
437 0 : SpcArr = SpcArr * Inst%OCPIfrac
438 : CASE ( 'OCPO' )
439 0 : SpcArr = SpcArr * (1.0_sp - Inst%OCPIfrac)
440 : CASE ( 'BCPI' )
441 0 : SpcArr = SpcArr * Inst%BCPIfrac
442 : CASE ( 'BCPO' )
443 0 : SpcArr = SpcArr * (1.0_sp - Inst%BCPIfrac)
444 : END SELECT
445 :
446 : !==============================================================================
447 : ! This code is required for the vertical distribution of biomass burning emiss.
448 : ! We will keep it here for a future implementation. (mps, 4/24/17)
449 : !
450 : ! !--------------------------------------------------------------------
451 : ! ! For grid boxes with emissions, distribute 65% to PBL and 35% to FT
452 : ! !--------------------------------------------------------------------
453 : ! DO J = 1, HcoState%Ny
454 : ! DO I = 1, HcoState%Nx
455 : !
456 : ! IF ( SpcArr(I,J) > 0e+0_hp ) THEN
457 : !
458 : ! ! Initialize
459 : ! PBL_MAX = 1
460 : ! F_OF_PBL = 0e+0_hp
461 : ! F_OF_FT = 0e+0_hp
462 : ! DELTPRES = 0e+0_hp
463 : !
464 : ! ! Determine PBL height
465 : ! DO L = HcoState%NZ, 1, -1
466 : ! IF ( ExtState%FRAC_OF_PBL%Arr%Val(I,J,L) > 0.0_hp ) THEN
467 : ! PBL_MAX = L
468 : ! EXIT
469 : ! ENDIF
470 : ! ENDDO
471 : !
472 : ! ! Loop over the boundary layer
473 : ! DO L = 1, PBL_MAX
474 : !
475 : ! ! Fraction of PBL that box (I,J,L) makes up [unitless]
476 : ! F_OF_PBL = ExtState%FRAC_OF_PBL%Arr%Val(I,J,L)
477 : !
478 : ! ! Add only 65% biomass burning source to PBL
479 : ! ! Distribute emissions thru the entire boundary layer
480 : ! ! (mps from evf+tjb, 3/10/17)
481 : ! SpcArr3D(I,J,L) = SpcArr(I,J) * PBL_FRAC * F_OF_PBL
482 : !
483 : ! ENDDO
484 : !
485 : ! ! Total thickness of the free troposphere [hPa]
486 : ! ! (considered here to be 10 levels above the PBL)
487 : ! TOTPRESFT = HcoState%Grid%PEDGE%Val(I,J,PBL_MAX+1) - &
488 : ! HcoState%Grid%PEDGE%Val(I,J,PBL_MAX+11)
489 : !
490 : ! ! Loop over the free troposphere
491 : ! DO L = PBL_MAX+1, PBL_MAX+10
492 : !
493 : ! ! Thickness of level L [hPa]
494 : ! DELTPRES= HcoState%Grid%PEDGE%Val(I,J,L) - &
495 : ! HcoState%Grid%PEDGE%Val(I,J,L+1)
496 : !
497 : ! ! Fraction of FT that box (I,J,L) makes up [unitless]
498 : ! F_OF_FT = DELTPRES / TOTPRESFT
499 : !
500 : ! ! Add 35% of biomass burning source to free troposphere
501 : ! ! Distribute emissions thru 10 model levels above the BL
502 : ! ! (mps from evf+tjb, 3/10/17)
503 : ! SpcArr3D(I,J,L) = SpcArr(I,J) * (1.0-PBL_FRAC) * F_OF_FT
504 : !
505 : ! ENDDO
506 : !
507 : ! ENDIF
508 : !
509 : ! ENDDO
510 : ! ENDDO
511 : !
512 : ! ! Add flux to HEMCO emission array
513 : ! ! Now 3D flux (mps, 3/10/17)
514 : ! CALL HCO_EmisAdd( HcoState, SpcArr3D, HcoID, &
515 : ! RC, ExtNr=ExtNr, Cat=-1, Hier=-1 )
516 : !==============================================================================
517 :
518 : ! Add flux to HEMCO emission array
519 : CALL HCO_EmisAdd( HcoState, SpcArr, HcoID, &
520 0 : RC, ExtNr=Inst%ExtNr, Cat=-1, Hier=-1 )
521 0 : IF ( RC /= HCO_SUCCESS ) THEN
522 0 : MSG = 'HCO_EmisAdd error: ' // TRIM(HcoState%Spc(HcoID)%SpcName)
523 0 : CALL HCO_ERROR(MSG, RC )
524 0 : RETURN
525 : ENDIF
526 :
527 : ! Write out total (daily or monthly) emissions to log-file
528 0 : IF ( HcoState%amIRoot ) THEN
529 0 : IF ( Inst%UseDay ) THEN
530 0 : IF ( HcoClock_NewDay( HcoState%Clock, .TRUE. ) ) THEN
531 0 : TOTAL = SUM(SpcArr(:,:)*HcoState%Grid%AREA_M2%Val(:,:))
532 0 : TOTAL = TOTAL * 86400.0_hp * 1e-9_hp
533 0 : WRITE(MSG, 120) HcoState%Spc(HcoID)%SpcName, TOTAL
534 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
535 : 120 FORMAT( 'SUM biomass ', a4,1x,': ', f11.4,1x,'[Tg]' )
536 : ENDIF
537 : ELSE
538 0 : IF ( HcoClock_NewMonth( HcoState%Clock, .TRUE. ) ) THEN
539 0 : TOTAL = SUM(SpcArr(:,:)*HcoState%Grid%AREA_M2%Val(:,:))
540 0 : TOTAL = TOTAL * NDAYS * 86400.0_hp * 1e-9_hp
541 0 : WRITE(MSG, 130) HcoState%Spc(HcoID)%SpcName, TOTAL
542 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
543 : 130 FORMAT( 'SUM biomass ', a4,1x,': ', f11.4,1x,'[Tg]' )
544 : ENDIF
545 : ENDIF
546 : ENDIF
547 :
548 : ENDDO !N
549 :
550 : ! Nullify pointers
551 0 : THISTYP => NULL()
552 0 : Inst => NULL()
553 :
554 : ! Leave w/ success
555 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
556 :
557 0 : END SUBROUTINE HCOX_FINN_Run
558 : !EOC
559 : !------------------------------------------------------------------------------
560 : ! Harmonized Emissions Component (HEMCO) !
561 : !------------------------------------------------------------------------------
562 : !BOP
563 : !
564 : ! !IROUTINE: HCOX_FINN_Init
565 : !
566 : ! !DESCRIPTION: Subroutine HCOX\_FINN\_INIT initializes all module
567 : ! arrays and variables.
568 : !\\
569 : !\\
570 : ! !INTERFACE:
571 : !
572 0 : SUBROUTINE HCOX_FINN_Init( HcoState, ExtName, ExtState, RC )
573 : !
574 : ! !USES:
575 : !
576 : USE HCO_State_Mod, ONLY : HCO_GetHcoID
577 : USE HCO_State_Mod, ONLY : HCO_GetExtHcoID
578 : USE HCO_ExtList_Mod, ONLY : GetExtNr, GetExtOpt
579 : USE HCO_ExtList_Mod, ONLY : GetExtSpcVal
580 : !
581 : ! !INPUT PARAMETERS:
582 : !
583 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
584 : CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name
585 : TYPE(Ext_State), POINTER :: ExtState ! Extensions object
586 : !
587 : ! !INPUT/OUTPUT PARAMETERS:
588 : !
589 : INTEGER, INTENT(INOUT) :: RC ! Return status
590 : !
591 : ! !REVISION HISTORY:
592 : ! 02 Jan 2013 - J. Mao & J. Fisher - Initial version, based on GFED3
593 : ! See https://github.com/geoschem/hemco for complete history
594 : !EOP
595 : !------------------------------------------------------------------------------
596 : !BOC
597 : !
598 : ! !LOCAL VARIABLES
599 : !
600 : ! Scalars
601 : INTEGER :: ExtNr
602 : INTEGER :: N_SPEC_EMFAC ! # of CO2 file emission species
603 : INTEGER :: N_NMOC ! # of VOC file NMOC ratios
604 : INTEGER :: IU_FILE, L, N_LUMPED, tmpNr
605 : INTEGER :: AS, IOS, M, N, NDUM
606 : INTEGER :: N_SPECSTRS, N_NMOCSTRS
607 : INTEGER :: NCHAR
608 : LOGICAL :: IS_NMOC, Matched, Missing, FOUND
609 : CHARACTER(LEN=1023) :: ADUM
610 : CHARACTER(LEN=255) :: SDUM(255)
611 : CHARACTER(LEN=255) :: IN_SPEC_NAME(255)
612 : CHARACTER(LEN=255) :: IN_NMOC_NAME(255)
613 : CHARACTER(LEN=255) :: TMPNAME
614 : CHARACTER(LEN= 6) :: SPCNAME
615 : REAL*8 :: C_MOLEC
616 : REAL(dp) :: AdjFact
617 : REAL(sp) :: ValSp
618 : CHARACTER(LEN=255) :: MSG, EF_CO2_FILE, VOC_SPEC_FILE, LOC
619 :
620 : ! Temporary variables. These values will be passed to module
621 : ! array nSpc, SpcNames, etc.
622 : INTEGER :: tnSpc
623 0 : CHARACTER(LEN=31), ALLOCATABLE :: tSpcNames(:)
624 0 : CHARACTER(LEN=61), ALLOCATABLE :: tSpcScalFldNme(:)
625 0 : REAL(sp), ALLOCATABLE :: tSpcScal(:)
626 0 : INTEGER, ALLOCATABLE :: tHcoIDs(:)
627 :
628 : ! Arrays
629 0 : REAL(dp), ALLOCATABLE :: EMFAC_IN(:,:)
630 0 : REAL(dp), ALLOCATABLE :: NMOC_RATIO_IN(:,:)
631 : REAL*8 :: NMOC_EMFAC(N_EMFAC), NMOC_RATIO(N_EMFAC)
632 :
633 : ! Local instance
634 : TYPE(MyInst), POINTER :: Inst
635 :
636 : !=======================================================================
637 : ! HCOX_FINN_INIT begins here!
638 : !=======================================================================
639 0 : LOC = 'HCOX_FINN_INIT (HCOX_FINN_MOD.F90)'
640 :
641 : ! Extension Nr.
642 0 : ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
643 0 : IF ( ExtNr <= 0 ) RETURN
644 :
645 : ! Enter
646 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
647 0 : IF ( RC /= HCO_SUCCESS ) THEN
648 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
649 0 : RETURN
650 : ENDIF
651 :
652 : ! Create local instance for this simulation
653 0 : Inst => NULL()
654 0 : CALL InstCreate ( ExtNr, ExtState%FINN, Inst, RC )
655 0 : IF ( RC /= HCO_SUCCESS ) THEN
656 0 : CALL HCO_ERROR ( 'Cannot create FINN instance', RC )
657 0 : RETURN
658 : ENDIF
659 :
660 : ! Check if this is GFED4
661 : !-----------------------------------------------------------------------
662 : ! Get settings
663 : ! The CO scale factor (to account for oxidation from VOCs) as well as
664 : ! the speciation of carbon aerosols into hydrophilic and hydrophobic
665 : ! fractions can be specified in the configuration file, e.g.:
666 : ! 100 GFED3 : on NO/CO/OCPI/OCPO/BCPI/BCPO
667 : ! --> hydrophilic BC : 0.2
668 : ! --> hydrophilic OC : 0.5
669 : !
670 : ! Setting these values is optional and default values are applied if
671 : ! they are not specified. The values only take effect if the
672 : ! corresponding species (CO, BCPI/BCPO, OCPI/OCPO) are listed as species
673 : ! to be used.
674 : !-----------------------------------------------------------------------
675 :
676 : ! Try to read hydrophilic fractions of BC. Defaults to 0.2.
677 : CALL GetExtOpt( HcoState%Config, ExtNr, 'hydrophilic BC', &
678 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
679 0 : IF ( RC /= HCO_SUCCESS ) THEN
680 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
681 0 : RETURN
682 : ENDIF
683 0 : IF ( .NOT. FOUND ) THEN
684 0 : Inst%BCPIfrac = 0.2
685 : ELSE
686 0 : Inst%BCPIfrac = ValSp
687 : ENDIF
688 :
689 : ! Try to read hydrophilic fractions of OC. Defaults to 0.5.
690 : CALL GetExtOpt( HcoState%Config, ExtNr, 'hydrophilic OC', &
691 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
692 0 : IF ( RC /= HCO_SUCCESS ) THEN
693 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
694 0 : RETURN
695 : ENDIF
696 0 : IF ( .NOT. FOUND ) THEN
697 0 : Inst%OCPIfrac = 0.5
698 : ELSE
699 0 : Inst%OCPIfrac = ValSp
700 : ENDIF
701 :
702 : ! Error check: OCPIfrac and BCPI frac must be between 0 and 1
703 : IF ( Inst%OCPIfrac < 0.0_sp .OR. Inst%OCPIfrac > 1.0_sp .OR. &
704 0 : Inst%BCPIfrac < 0.0_sp .OR. Inst%BCPIfrac > 1.0_sp ) THEN
705 0 : WRITE(MSG,*) 'hydrophilic fractions must be between 0-1: ', &
706 0 : Inst%OCPIfrac, Inst%BCPIfrac
707 0 : CALL HCO_ERROR(MSG, RC )
708 0 : RETURN
709 : ENDIF
710 :
711 : ! Use daily data?
712 : CALL GetExtOpt( HcoState%Config, ExtNr, 'FINN_daily', &
713 0 : OptValBool=Inst%UseDay, FOUND=FOUND, RC=RC )
714 0 : IF ( RC /= HCO_SUCCESS ) THEN
715 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
716 0 : RETURN
717 : ENDIF
718 0 : IF ( .NOT. FOUND ) THEN
719 0 : Inst%UseDay = .FALSE.
720 : ENDIF
721 :
722 : !-----------------------------------------------------------------------
723 : ! Allocate arrays
724 : !-----------------------------------------------------------------------
725 :
726 : ! FINN species names
727 0 : ALLOCATE ( Inst%FINN_SPEC_NAME ( N_SPEC ), STAT=AS )
728 0 : IF ( AS/=0 ) THEN
729 0 : CALL HCO_ERROR( 'Cannot allocate FINN_SPEC_NAME', RC )
730 0 : RETURN
731 : ENDIF
732 0 : Inst%FINN_SPEC_NAME = ''
733 :
734 : ! Allocate scale factors table: FINN_EMFAC holds the species/CO2
735 : ! scale factors for all FINN species.
736 0 : ALLOCATE ( Inst%FINN_EMFAC ( N_SPEC, N_EMFAC ), STAT=AS )
737 : IF ( AS/=0 ) THEN
738 0 : CALL HCO_ERROR( 'Cannot allocate FINN_EMFAC', RC )
739 0 : RETURN
740 : ENDIF
741 0 : Inst%FINN_EMFAC = 0.0_dp
742 :
743 : ! Allocate and initialize vectors holding species information for
744 : ! all species to be emitted
745 : ALLOCATE ( Inst%FinnIDs(nSpcMax), Inst%HcoIDs(nSpcMax), Inst%SpcNames(nSpcMax), &
746 0 : Inst%SpcScal(nSpcMax), Inst%SpcScalFldNme(nSpcMax), STAT=AS )
747 :
748 0 : IF ( AS/=0 ) THEN
749 0 : CALL HCO_ERROR( 'Cannot allocate FinnIDs', RC )
750 0 : RETURN
751 : ENDIF
752 0 : Inst%nSpc = 0
753 0 : Inst%FinnIDs(:) = -1
754 0 : Inst%HcoIDs(:) = -1
755 0 : Inst%SpcScal = 1.0_sp
756 0 : Inst%SpcNames(:) = ''
757 0 : Inst%SpcScalFldNme(:) = HCOX_NOSCALE
758 :
759 : ALLOCATE ( Inst%VEGTYP1(HcoState%NX,HcoState%NY), &
760 : Inst%VEGTYP2(HcoState%NX,HcoState%NY), &
761 : Inst%VEGTYP3(HcoState%NX,HcoState%NY), &
762 : Inst%VEGTYP4(HcoState%NX,HcoState%NY), &
763 : Inst%VEGTYP5(HcoState%NX,HcoState%NY), &
764 0 : Inst%VEGTYP9(HcoState%NX,HcoState%NY), STAT=AS )
765 0 : IF ( AS/=0 ) THEN
766 0 : CALL HCO_ERROR( 'Cannot allocate VEGTYP', RC )
767 0 : RETURN
768 : ENDIF
769 0 : Inst%VEGTYP1 = 0.0_hp
770 0 : Inst%VEGTYP2 = 0.0_hp
771 0 : Inst%VEGTYP3 = 0.0_hp
772 0 : Inst%VEGTYP4 = 0.0_hp
773 0 : Inst%VEGTYP5 = 0.0_hp
774 0 : Inst%VEGTYP9 = 0.0_hp
775 :
776 : !-----------------------------------------------------------------------
777 : ! Define FINN species names
778 : !-----------------------------------------------------------------------
779 :
780 : ! Species listed in emission factor ratios (CO2/X) table (except NMOC,
781 : ! which is speciated as specified in the VOC speciation table).
782 0 : Inst%FINN_SPEC_NAME(1) = 'CO2'
783 0 : Inst%FINN_SPEC_NAME(2) = 'CO'
784 0 : Inst%FINN_SPEC_NAME(3) = 'CH4'
785 0 : Inst%FINN_SPEC_NAME(4) = 'NOx'
786 0 : Inst%FINN_SPEC_NAME(5) = 'SO2'
787 0 : Inst%FINN_SPEC_NAME(6) = 'OC'
788 0 : Inst%FINN_SPEC_NAME(7) = 'BC'
789 0 : Inst%FINN_SPEC_NAME(8) = 'NH3'
790 0 : Inst%FINN_SPEC_NAME(9) = 'NO' ! Currently not used
791 0 : Inst%FINN_SPEC_NAME(10) = 'NO2' ! Currently not used
792 :
793 : ! Species listed in VOC speciation table
794 0 : Inst%FINN_SPEC_NAME(11) = 'ACET'
795 0 : Inst%FINN_SPEC_NAME(12) = 'ACTA' ! Not currently emitted by BB in GC
796 0 : Inst%FINN_SPEC_NAME(13) = 'ALD2'
797 0 : Inst%FINN_SPEC_NAME(14) = 'ALK4'
798 0 : Inst%FINN_SPEC_NAME(15) = 'APINE' ! Currently lumped into MTPA
799 0 : Inst%FINN_SPEC_NAME(16) = 'AROM' ! Currently not used
800 0 : Inst%FINN_SPEC_NAME(17) = 'BENZ'
801 0 : Inst%FINN_SPEC_NAME(18) = 'BPINE' ! Currently lumped into MTPA
802 0 : Inst%FINN_SPEC_NAME(19) = 'C2H2'
803 0 : Inst%FINN_SPEC_NAME(20) = 'C2H4'
804 0 : Inst%FINN_SPEC_NAME(21) = 'C2H6'
805 0 : Inst%FINN_SPEC_NAME(22) = 'C3H8'
806 0 : Inst%FINN_SPEC_NAME(23) = 'CARENE' ! Currently lumped into MTPA
807 0 : Inst%FINN_SPEC_NAME(24) = 'CH2Br2'
808 0 : Inst%FINN_SPEC_NAME(25) = 'CH2O'
809 0 : Inst%FINN_SPEC_NAME(26) = 'CH3Br'
810 0 : Inst%FINN_SPEC_NAME(27) = 'CH3CN'
811 0 : Inst%FINN_SPEC_NAME(28) = 'CH3I'
812 0 : Inst%FINN_SPEC_NAME(29) = 'DMS'
813 0 : Inst%FINN_SPEC_NAME(30) = 'EOH' ! Not currently emitted in GC
814 0 : Inst%FINN_SPEC_NAME(31) = 'ETBENZ' ! Currently lumped with TOLU
815 0 : Inst%FINN_SPEC_NAME(32) = 'FUR' ! Currently not used
816 0 : Inst%FINN_SPEC_NAME(33) = 'GLYC'
817 0 : Inst%FINN_SPEC_NAME(34) = 'GLYX'
818 0 : Inst%FINN_SPEC_NAME(35) = 'HAC'
819 0 : Inst%FINN_SPEC_NAME(36) = 'HCN' ! Not currently emitted in GC
820 0 : Inst%FINN_SPEC_NAME(37) = 'HCOOH' ! Not currently emitted by BB in GC
821 0 : Inst%FINN_SPEC_NAME(38) = 'HNO2' ! Not currently emitted in GC
822 0 : Inst%FINN_SPEC_NAME(39) = 'ISOP' ! Not currently emitted by BB in GC
823 0 : Inst%FINN_SPEC_NAME(40) = 'LIMO'
824 0 : Inst%FINN_SPEC_NAME(41) = 'MACR' ! Not currently emitted in GC
825 0 : Inst%FINN_SPEC_NAME(42) = 'MEK'
826 0 : Inst%FINN_SPEC_NAME(43) = 'MGLY'
827 0 : Inst%FINN_SPEC_NAME(44) = 'MNO3'
828 0 : Inst%FINN_SPEC_NAME(45) = 'MOH' ! Not currently emitted in GC
829 0 : Inst%FINN_SPEC_NAME(46) = 'MTPO' ! Not currently emitted in GC
830 0 : Inst%FINN_SPEC_NAME(47) = 'MVK' ! Not currently emitted in GC
831 0 : Inst%FINN_SPEC_NAME(48) = 'PRPE'
832 0 : Inst%FINN_SPEC_NAME(49) = 'R4N2' ! Not currently emitted in GC
833 0 : Inst%FINN_SPEC_NAME(50) = 'RCHO' ! Not currently emitted by BB in GC
834 0 : Inst%FINN_SPEC_NAME(51) = 'RCOOH' ! Currently not used
835 0 : Inst%FINN_SPEC_NAME(52) = 'ROH' ! Currently not used
836 0 : Inst%FINN_SPEC_NAME(53) = 'SESQ' ! Currently not used
837 0 : Inst%FINN_SPEC_NAME(54) = 'STYR' ! Currently lumped with TOLU
838 0 : Inst%FINN_SPEC_NAME(55) = 'TMB' ! Currently lumped with XYLE
839 0 : Inst%FINN_SPEC_NAME(56) = 'TOLU'
840 0 : Inst%FINN_SPEC_NAME(57) = 'XYLE'
841 0 : Inst%FINN_SPEC_NAME(58) = 'H2' ! Currently not used
842 :
843 : !=======================================================================
844 : ! We now get the following input information from hard-coded F90
845 : ! assignment statements in the include file "hcox_finn_include.H":
846 : !
847 : ! Quantities formerly defined in the "FINN_EFratios_CO2.csv" file:
848 : ! ----------------------------------------------------------------------
849 : ! (1 ) N_SPEC_EMFAC : # of species in the FINN_EFratios_CO2.csv file
850 : ! (2 ) N_SPECSTRS : Synonym for N_SPEC_EMFAC
851 : ! (3 ) IN_SPEC_NAME : Name of emissions species
852 : ! (4 ) EMFAC_IN : Emission ratios for each species
853 : !
854 : ! Quantities formerly defined in the "FINN_VOC_speciation.csv" file:
855 : ! ----------------------------------------------------------------------
856 : ! (5 ) N_NMOC_ : # of species in the FINN_EFratios_CO2.csv file
857 : ! (6 ) N_NMOCSTRS : Synonym for N_NMOC
858 : ! (7 ) IN_NMOC_NAME : Name of NMOC ratios
859 : ! (8 ) NMOC_RATIO_IN : NMOC ratios for each species
860 : !
861 : ! Furthermore, the F90 statements to allocate the arrays IN_SPEC_NAME
862 : ! and IN_NMOC_NAME are included in "hcox_finn_include.H".
863 : !
864 : ! NOTE: If new FINN emisison factors and NMOC ratios are issued in the
865 : ! future, you can regenerate the include file "hcox_finn_include.H"
866 : ! with the Perl script HEMCO/Extensions/Preprocess/finn.pl.
867 : !=======================================================================
868 : #include "hcox_finn_include.H"
869 :
870 : !-----------------------------------------------------------------------
871 : ! Match specified species with FINN species. The species to be used are
872 : ! specified in the HEMCO configuration file.
873 : !-----------------------------------------------------------------------
874 :
875 : ! Write to log file
876 0 : IF ( HcoState%amIRoot ) THEN
877 :
878 : ! Write the name of the extension regardless of the verbose setting
879 0 : msg = 'Using HEMCO extension: FINN (biomass burning)'
880 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
881 0 : CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator
882 : ELSE
883 0 : CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator
884 : ENDIF
885 :
886 : ! Other print statements will only be written as debug output
887 0 : WRITE(MSG,*) ' - Use daily data : ', Inst%UseDay
888 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
889 : ENDIF
890 :
891 : ! Get HEMCO species IDs of all species specified in configuration file
892 0 : CALL HCO_GetExtHcoID( HcoState, ExtNr, tHcoIDs, tSpcNames, tnSpc, RC)
893 0 : IF ( RC /= HCO_SUCCESS ) THEN
894 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
895 0 : RETURN
896 : ENDIF
897 0 : IF ( tnSpc == 0 ) THEN
898 0 : MSG = 'No FINN species specified'
899 0 : CALL HCO_ERROR(MSG, RC )
900 0 : RETURN
901 : ENDIF
902 :
903 : ! Get species scale factors
904 : CALL GetExtSpcVal( HcoState%Config, ExtNr, tnSpc, &
905 0 : tSpcNames, 'Scaling', 1.0_sp, tSpcScal, RC )
906 0 : IF ( RC /= HCO_SUCCESS ) THEN
907 0 : CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
908 0 : RETURN
909 : ENDIF
910 :
911 : ! Get species mask fields
912 : CALL GetExtSpcVal( HcoState%Config, ExtNr, tnSpc, &
913 0 : tSpcNames, 'ScaleField', HCOX_NOSCALE, tSpcScalFldNme, RC )
914 0 : IF ( RC /= HCO_SUCCESS ) THEN
915 0 : CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC )
916 0 : RETURN
917 : ENDIF
918 :
919 : ! Error trap: in previous versions, CO, POA and NAP scale factor were given as
920 : ! 'CO scale factor', etc. Make sure those attributes do not exist any more!
921 : CALL GetExtOpt( HcoState%Config, ExtNr, 'CO scale factor', &
922 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
923 0 : IF ( .NOT. FOUND ) THEN
924 : CALL GetExtOpt( HcoState%Config, ExtNr, 'POA scale factor', &
925 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
926 : ENDIF
927 0 : IF ( .NOT. FOUND ) THEN
928 : CALL GetExtOpt( HcoState%Config, ExtNr, 'NAP scale factor', &
929 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
930 : ENDIF
931 0 : IF ( FOUND ) THEN
932 : MSG = 'Found old definition of CO, POA and/or NAP scale factor! ' // &
933 : 'This version of HEMCO expects species scale factors to be ' // &
934 : 'set as `Scaling_XX` instead of `XX scale factor`. ' // &
935 0 : 'Please update the FINN settings section accordingly.'
936 0 : CALL HCO_ERROR(MSG, RC )
937 0 : RETURN
938 : ENDIF
939 :
940 : ! Find matching FINN index for each specified species.
941 : ! Also get appropriate emission ratios to CO2 (jaf, 10/2/13).
942 : ! Do this only for species selected for emission calculation. For
943 : ! all others, keep default values in FINN_EMFAC.
944 0 : DO L = 1, tnSpc
945 0 : IF ( tHcoIDs(L) < 0 ) CYCLE
946 0 : SpcName = tSpcNames(L)
947 0 : N_LUMPED = 0
948 0 : Matched = .FALSE.
949 0 : Missing = .TRUE.
950 :
951 : ! Reduce species if needed
952 0 : NCHAR = LEN(SpcName)
953 : IF ( NCHAR > 3 ) THEN
954 0 : IF ( SpcName(1:3) == 'CO2' ) THEN
955 0 : SpcName = 'CO2'
956 0 : ELSEIF ( SpcName(1:3) == 'CH4' ) THEN
957 0 : SpcName = 'CH4'
958 0 : ELSEIF ( SpcName(1:3) == 'CO_' ) THEN
959 0 : SpcName = 'CO'
960 0 : ELSEIF ( SpcName(1:2) == 'BC' ) THEN
961 0 : SpcName = 'BC'
962 0 : ELSEIF ( SpcName(1:2) == 'OC' ) THEN
963 0 : SpcName = 'OC'
964 : ENDIF
965 : ENDIF
966 : ! For model species NO, the emission factors are taken from FINN
967 : ! species NOx. For model species MTPA, the emission factors are
968 : ! taken from FINN species APINE (BPINE and CARENE will be lumped
969 : ! into it as well).
970 0 : IF ( TRIM(SpcName) == 'POA1' ) SpcName = 'OC'
971 0 : IF ( TRIM(SpcName) == 'NAP' ) SpcName = 'CO'
972 0 : IF ( TRIM(SpcName) == 'NO' ) SpcName = 'NOx'
973 0 : IF ( TRIM(SpcName) == 'MTPA' ) SpcName = 'APINE'
974 0 : IF ( TRIM(SpcName) == 'Hg0' ) SpcName = 'CO'
975 0 : IF ( TRIM(SpcName) == 'SOAP' ) SpcName = 'CO'
976 :
977 : ! For lumped species, we have to repeat the lookup multiple times,
978 : ! so use a while loop here. For example, for species TOLU this will
979 : ! make sure that FINN species 'TOLU', 'ETBENZ', and 'STYR' are
980 : ! associated with HEMCO species TOLU. Variable nSpc keeps track of
981 : ! the total number of species emitted by FINN. All species vectors
982 : ! (FinnIDs, HcoIDs, SpcNames, SpcScal, etc.) contain nSpc valid
983 : ! elements.
984 0 : DO WHILE ( Missing )
985 :
986 : ! Search for SpcName in FINN
987 0 : DO N = 1, N_SPEC
988 0 : IF ( TRIM(SpcName) == TRIM(Inst%FINN_SPEC_NAME(N)) ) THEN
989 :
990 : ! Update number of species to be emitted via FINN and
991 : ! archive all related information in vectors FinnIDs,
992 : ! HcoIDs, SpcNames, etc.
993 :
994 : ! nSpc is the total number of emitted FINN species. Must
995 : ! not exceed nSpcMax.
996 0 : Inst%nSpc = Inst%nSpc + 1
997 0 : IF ( Inst%nSpc > nSpcMax ) THEN
998 : MSG = 'nSpc greater than nSpcMax, please increase ' // &
999 0 : 'parameter `nSpcMax` in hcox_finn_mod.F90'
1000 0 : CALL HCO_ERROR ( MSG, RC )
1001 0 : RETURN
1002 : ENDIF
1003 :
1004 : ! Archive corresponding FINN species ID, HEMCO species ID,
1005 : ! scale factor, etc.
1006 0 : Matched = .TRUE.
1007 0 : Inst%FinnIDs(Inst%nSpc) = N
1008 0 : Inst%HcoIDs (Inst%nSpc) = tHcoIDs(L)
1009 0 : Inst%SpcNames(Inst%nSpc) = tSpcNames(L)
1010 0 : Inst%SpcScalFldNme(Inst%nSpc) = tSpcScalFldNme(L)
1011 0 : Inst%SpcScal(Inst%nSpc) = tSpcScal(L)
1012 :
1013 : ! Verbose
1014 0 : IF ( HcoState%amIRoot ) THEN
1015 0 : MSG = ' - FINN species ' // TRIM(Inst%FINN_SPEC_NAME(N)) // &
1016 0 : ' will be emitted as ' // TRIM(Inst%SpcNames(Inst%nSpc))
1017 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
1018 0 : WRITE(MSG,*) ' --> Uniform scale factor : ', Inst%SpcScal(Inst%nSpc)
1019 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
1020 0 : WRITE(MSG,*) ' --> Scale field : ', TRIM(Inst%SpcScalFldNme(Inst%nSpc))
1021 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
1022 : ENDIF
1023 :
1024 : ! Reset variables
1025 0 : IS_NMOC = .FALSE.
1026 0 : C_MOLEC = 1d0
1027 0 : NMOC_RATIO = 0d0
1028 :
1029 : ! Get emission factor in [kg X]/[kg CO2].
1030 0 : DO M = 1, N_SPECSTRS
1031 0 : TMPNAME = IN_SPEC_NAME(M)
1032 0 : IF ( TRIM(Inst%FINN_SPEC_NAME(N)) == TRIM(TMPNAME(5:8)) ) THEN
1033 : ! First two entries are not species. Also, EMFAC
1034 : ! is stored as [mole CO2]/[mole X], but we want the
1035 : ! inverse. This gives us [mole X]/[mole CO2].
1036 : ! To convert this to [kg X]/[kg CO2], we also need
1037 : ! to adjust for the molecular weights of species X
1038 : ! and CO2. The EF ratios of OC and BC are in
1039 : ! [mole CO2]/[g X], so the adjustment factor is
1040 : ! calculated slightly differently for those two
1041 : ! species!
1042 0 : IF ( TRIM(Inst%FINN_SPEC_NAME(N)) == 'OC' .OR. &
1043 0 : TRIM(Inst%FINN_SPEC_NAME(N)) == 'BC' ) THEN
1044 : AdjFact = 1.0_dp / MW_CO2
1045 :
1046 : ! Make sure that adjustment factor for CO is always
1047 : ! computed using the MW of CO. CO might be used as
1048 : ! proxy for other species (e.g. Hg0), in which case
1049 : ! we still want to normalize by the MW of CO.
1050 0 : ELSEIF ( TRIM(Inst%FINN_SPEC_NAME(N)) == 'CO' ) THEN
1051 : AdjFact = 28.01_dp / MW_CO2
1052 :
1053 : ! Normalize by species' molecular weight.
1054 : ELSE
1055 : AdjFact = 1.0_dp / MW_CO2 * &
1056 0 : HcoState%Spc(Inst%HcoIDs(Inst%nSpc))%MW_g
1057 : ENDIF
1058 0 : Inst%FINN_EMFAC(N,:) = AdjFact / EMFAC_IN(M,:)
1059 0 : IF ( HcoState%amIRoot ) THEN
1060 0 : WRITE( MSG, 200 ) TRIM( Inst%FINN_SPEC_NAME(N))
1061 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
1062 : ENDIF
1063 0 : EXIT
1064 :
1065 : ! NMOC_EMFAC is converted to [kg NMOC]/[kg CO2].
1066 : ! Input unit is [mole CO2]/[mole NMOC].
1067 0 : ELSE IF ( TRIM(TMPNAME(5:8)) == 'NMOC' ) THEN
1068 0 : AdjFact = MW_NMOC / MW_CO2
1069 0 : NMOC_EMFAC = AdjFact / EMFAC_IN(M,:)
1070 :
1071 : ENDIF
1072 : ENDDO
1073 : 200 FORMAT( 'Found FINN emission ratio for species ',a5 )
1074 :
1075 0 : DO M = 1, N_NMOCSTRS
1076 0 : TMPNAME = IN_NMOC_NAME(M)
1077 0 : IF ( TRIM(Inst%FINN_SPEC_NAME(N)) == TRIM(TMPNAME) ) THEN
1078 : ! First two entries are not species
1079 0 : NMOC_RATIO = NMOC_RATIO_IN(M,:)
1080 0 : IS_NMOC = .TRUE.
1081 0 : IF ( HcoState%amIRoot ) THEN
1082 0 : WRITE( MSG, 201 ) TRIM( Inst%FINN_SPEC_NAME(N) )
1083 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
1084 : ENDIF
1085 0 : EXIT
1086 : ENDIF
1087 : ENDDO
1088 : 201 FORMAT( 'Found FINN NMOC factor for species ',a5 )
1089 :
1090 : ! Create emission factor for NMOC species
1091 : ! NMOC_EMFAC is [kg NMOC] / [kg CO2]
1092 : ! NMOC_RATIO is [mole X] / [kg NMOC]
1093 : ! To convert NMOC_RATIO to [kg X] / [kg NMOC], we need to
1094 : ! multiply by the MW of X (kg/mol this time).
1095 0 : IF ( IS_NMOC ) THEN
1096 0 : DO M = 1, N_EMFAC
1097 0 : AdjFact = HcoState%Spc(Inst%HcoIDs(Inst%nSpc))%MW_g
1098 0 : Inst%FINN_EMFAC(N,M) = NMOC_EMFAC(M) * &
1099 : NMOC_RATIO(M) * &
1100 0 : ( AdjFact * 1e-3_hp )
1101 : ENDDO
1102 : ENDIF
1103 : ENDIF
1104 :
1105 : ENDDO !N
1106 :
1107 : ! Update variable Missing. Missing has to be False to exit the
1108 : ! while loop.
1109 0 : Missing = .FALSE.
1110 :
1111 : ! For lumped species, we have to repeat the lookup for all
1112 : ! lumped species. For lumped species, we just assign the same
1113 : ! HEMCO species ID to multiple FINN species, so that all of
1114 : ! them will be added to the same model species.
1115 :
1116 : ! --> TMB is lumped into XYLE
1117 0 : IF ( Inst%SpcNames(Inst%nSpc) == 'XYLE' ) THEN
1118 0 : IF ( N_LUMPED == 0 ) THEN
1119 0 : SpcName = 'TMB'
1120 0 : Missing = .TRUE.
1121 0 : N_LUMPED = N_LUMPED + 1
1122 : ENDIF
1123 : ENDIF
1124 :
1125 : ! --> ETBENZ and STYR are lumped into TOLU
1126 0 : IF ( Inst%SpcNames(Inst%nSpc) == 'TOLU' ) THEN
1127 0 : IF ( N_LUMPED == 0 ) THEN
1128 0 : SpcName = 'ETBENZ'
1129 0 : Missing = .TRUE.
1130 0 : N_LUMPED = N_LUMPED + 1
1131 0 : ELSEIF ( N_LUMPED == 1 ) THEN
1132 0 : SpcName = 'STYR'
1133 0 : Missing = .TRUE.
1134 0 : N_LUMPED = N_LUMPED + 1
1135 : ENDIF
1136 : ENDIF
1137 :
1138 : ! --> BPINE and CARENE are lumped into MTPA
1139 0 : IF ( Inst%SpcNames(Inst%nSpc) == 'MTPA' ) THEN
1140 0 : IF ( N_LUMPED == 0 ) THEN
1141 0 : SpcName = 'BPINE'
1142 0 : Missing = .TRUE.
1143 0 : N_LUMPED = N_LUMPED + 1
1144 0 : ELSEIF ( N_LUMPED == 1 ) THEN
1145 0 : SpcName = 'CARENE'
1146 0 : Missing = .TRUE.
1147 0 : N_LUMPED = N_LUMPED + 1
1148 : ENDIF
1149 : ENDIF
1150 :
1151 : ENDDO !While missing
1152 :
1153 : ! Error check: we must not specify a species that is not defined
1154 : ! in FINN.
1155 0 : IF ( .NOT. Matched ) THEN
1156 0 : MSG = 'Species '// TRIM(SpcName) //' not found in FINN'
1157 0 : CALL HCO_ERROR(MSG, RC )
1158 0 : RETURN
1159 : ENDIF
1160 : ENDDO !L
1161 :
1162 : !=======================================================================
1163 : ! Activate this module and the fields of ExtState that it uses
1164 : !=======================================================================
1165 :
1166 : !==============================================================================
1167 : ! This code is required for the vertical distribution of biomass burning emiss.
1168 : ! We will keep it here for a future implementation. (mps, 4/24/17)
1169 : ! ! Activate met fields required by this extension
1170 : ! ExtState%FRAC_OF_PBL%DoUse = .TRUE.
1171 : !==============================================================================
1172 :
1173 : ! Cleanup
1174 0 : IF ( ALLOCATED(EMFAC_IN )) DEALLOCATE( EMFAC_IN )
1175 0 : IF ( ALLOCATED(NMOC_RATIO_IN )) DEALLOCATE( NMOC_RATIO_IN )
1176 0 : IF ( ALLOCATED(tHcoIDs )) DEALLOCATE( tHcoIDs )
1177 0 : IF ( ALLOCATED(tSpcNames )) DEALLOCATE( tSpcNames )
1178 0 : IF ( ALLOCATED(tSpcScalFldNme )) DEALLOCATE( tSpcScalFldNme )
1179 0 : IF ( ALLOCATED(tSpcScal )) DEALLOCATE( tSpcScal )
1180 :
1181 : ! Return w/ success
1182 0 : Inst => NULL()
1183 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
1184 :
1185 0 : END SUBROUTINE HCOX_FINN_Init
1186 : !EOC
1187 : !------------------------------------------------------------------------------
1188 : ! Harmonized Emissions Component (HEMCO) !
1189 : !------------------------------------------------------------------------------
1190 : !BOP
1191 : !
1192 : ! !IROUTINE: HCOX_FINN_Final
1193 : !
1194 : ! !DESCRIPTION: Subroutine HCOX\_FINN\_FINAL deallocates all module
1195 : ! arrays.
1196 : !\\
1197 : !\\
1198 : ! !INTERFACE:
1199 : !
1200 0 : SUBROUTINE HCOX_FINN_FINAL( ExtState )
1201 : !
1202 : ! !INPUT PARAMETERS:
1203 : !
1204 : TYPE(Ext_State), POINTER :: ExtState ! Module options
1205 : !
1206 : ! !REVISION HISTORY:
1207 : ! 02 Jan 2013 - J. Mao & J. Fisher - Initial version, based on GFED3
1208 : ! See https://github.com/geoschem/hemco for complete history
1209 : !EOP
1210 : !------------------------------------------------------------------------------
1211 : !BOC
1212 : !
1213 : !=================================================================
1214 : ! HCOX_FINN_FINAL begins here!
1215 : !=================================================================
1216 :
1217 0 : CALL InstRemove ( ExtState%FINN )
1218 :
1219 0 : END SUBROUTINE HCOX_FINN_Final
1220 : !EOC
1221 : !------------------------------------------------------------------------------
1222 : ! Harmonized Emissions Component (HEMCO) !
1223 : !------------------------------------------------------------------------------
1224 : !BOP
1225 : !
1226 : ! !IROUTINE: InstGet
1227 : !
1228 : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
1229 : !\\
1230 : !\\
1231 : ! !INTERFACE:
1232 : !
1233 0 : SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
1234 : !
1235 : ! !INPUT PARAMETERS:
1236 : !
1237 : INTEGER :: Instance
1238 : TYPE(MyInst), POINTER :: Inst
1239 : INTEGER :: RC
1240 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
1241 : !
1242 : ! !REVISION HISTORY:
1243 : ! 18 Feb 2016 - C. Keller - Initial version
1244 : ! See https://github.com/geoschem/hemco for complete history
1245 : !EOP
1246 : !------------------------------------------------------------------------------
1247 : !BOC
1248 : TYPE(MyInst), POINTER :: PrvInst
1249 :
1250 : !=================================================================
1251 : ! InstGet begins here!
1252 : !=================================================================
1253 :
1254 : ! Get instance. Also archive previous instance.
1255 0 : PrvInst => NULL()
1256 0 : Inst => AllInst
1257 0 : DO WHILE ( ASSOCIATED(Inst) )
1258 0 : IF ( Inst%Instance == Instance ) EXIT
1259 0 : PrvInst => Inst
1260 0 : Inst => Inst%NextInst
1261 : END DO
1262 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
1263 0 : RC = HCO_FAIL
1264 0 : RETURN
1265 : ENDIF
1266 :
1267 : ! Pass output arguments
1268 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
1269 :
1270 : ! Cleanup & Return
1271 0 : PrvInst => NULL()
1272 0 : RC = HCO_SUCCESS
1273 :
1274 : END SUBROUTINE InstGet
1275 : !EOC
1276 : !------------------------------------------------------------------------------
1277 : ! Harmonized Emissions Component (HEMCO) !
1278 : !------------------------------------------------------------------------------
1279 : !BOP
1280 : !
1281 : ! !IROUTINE: InstCreate
1282 : !
1283 : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
1284 : !\\
1285 : !\\
1286 : ! !INTERFACE:
1287 : !
1288 0 : SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
1289 : !
1290 : ! !INPUT PARAMETERS:
1291 : !
1292 : INTEGER, INTENT(IN) :: ExtNr
1293 : !
1294 : ! !OUTPUT PARAMETERS:
1295 : !
1296 : INTEGER, INTENT( OUT) :: Instance
1297 : TYPE(MyInst), POINTER :: Inst
1298 : !
1299 : ! !INPUT/OUTPUT PARAMETERS:
1300 : !
1301 : INTEGER, INTENT(INOUT) :: RC
1302 : !
1303 : ! !REVISION HISTORY:
1304 : ! 18 Feb 2016 - C. Keller - Initial version
1305 : ! See https://github.com/geoschem/hemco for complete history
1306 : !EOP
1307 : !------------------------------------------------------------------------------
1308 : !BOC
1309 : TYPE(MyInst), POINTER :: TmpInst
1310 : INTEGER :: nnInst
1311 :
1312 : !=================================================================
1313 : ! InstCreate begins here!
1314 : !=================================================================
1315 :
1316 : ! ----------------------------------------------------------------
1317 : ! Generic instance initialization
1318 : ! ----------------------------------------------------------------
1319 :
1320 : ! Initialize
1321 0 : Inst => NULL()
1322 :
1323 : ! Get number of already existing instances
1324 0 : TmpInst => AllInst
1325 0 : nnInst = 0
1326 0 : DO WHILE ( ASSOCIATED(TmpInst) )
1327 0 : nnInst = nnInst + 1
1328 0 : TmpInst => TmpInst%NextInst
1329 : END DO
1330 :
1331 : ! Create new instance
1332 0 : ALLOCATE(Inst)
1333 0 : Inst%Instance = nnInst + 1
1334 0 : Inst%ExtNr = ExtNr
1335 :
1336 : ! Attach to instance list
1337 0 : Inst%NextInst => AllInst
1338 0 : AllInst => Inst
1339 :
1340 : ! Update output instance
1341 0 : Instance = Inst%Instance
1342 :
1343 : ! ----------------------------------------------------------------
1344 : ! Type specific initialization statements follow below
1345 : ! ----------------------------------------------------------------
1346 :
1347 : ! Return w/ success
1348 0 : RC = HCO_SUCCESS
1349 :
1350 0 : END SUBROUTINE InstCreate
1351 : !EOC
1352 : !------------------------------------------------------------------------------
1353 : ! Harmonized Emissions Component (HEMCO) !
1354 : !------------------------------------------------------------------------------
1355 : !BOP
1356 : !
1357 : ! !IROUTINE: InstRemove
1358 : !
1359 : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
1360 : !\\
1361 : !\\
1362 : ! !INTERFACE:
1363 : !
1364 0 : SUBROUTINE InstRemove ( Instance )
1365 : !
1366 : ! !INPUT PARAMETERS:
1367 : !
1368 : INTEGER :: Instance
1369 : !
1370 : ! !REVISION HISTORY:
1371 : ! 18 Feb 2016 - C. Keller - Initial version
1372 : ! See https://github.com/geoschem/hemco for complete history
1373 : !EOP
1374 : !------------------------------------------------------------------------------
1375 : !BOC
1376 : INTEGER :: RC
1377 : TYPE(MyInst), POINTER :: PrevInst
1378 : TYPE(MyInst), POINTER :: Inst
1379 :
1380 : !=================================================================
1381 : ! InstRemove begins here!
1382 : !=================================================================
1383 :
1384 : ! Init
1385 0 : PrevInst => NULL()
1386 0 : Inst => NULL()
1387 :
1388 : ! Get instance. Also archive previous instance.
1389 0 : CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
1390 :
1391 : ! Instance-specific deallocation
1392 0 : IF ( ASSOCIATED(Inst) ) THEN
1393 :
1394 : !---------------------------------------------------------------------
1395 : ! Deallocate fields of Inst before popping off from the list
1396 : ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022)
1397 : !---------------------------------------------------------------------
1398 0 : IF ( ASSOCIATED( Inst%VEGTYP1 ) ) THEN
1399 0 : DEALLOCATE( Inst%VEGTYP1 )
1400 : ENDIF
1401 0 : Inst%VEGTYP1 => NULL()
1402 :
1403 0 : IF ( ASSOCIATED( Inst%VEGTYP2 ) ) THEN
1404 0 : DEALLOCATE( Inst%VEGTYP2 )
1405 : ENDIF
1406 0 : Inst%VEGTYP2 => NULL()
1407 :
1408 0 : IF ( ASSOCIATED( Inst%VEGTYP3 ) ) THEN
1409 0 : DEALLOCATE( Inst%VEGTYP3 )
1410 : ENDIF
1411 0 : Inst%VEGTYP3 => NULL()
1412 :
1413 0 : IF ( ASSOCIATED( Inst%VEGTYP4 ) ) THEN
1414 0 : DEALLOCATE(Inst%VEGTYP4 )
1415 : ENDIF
1416 0 : Inst%VEGTYP4 => NULL()
1417 :
1418 0 : IF ( ASSOCIATED( Inst%VEGTYP5 ) ) THEN
1419 0 : DEALLOCATE( Inst%VEGTYP5 )
1420 : ENDIF
1421 0 : Inst%VEGTYP5 => NULL()
1422 :
1423 0 : IF ( ASSOCIATED( Inst%VEGTYP9 ) ) THEN
1424 0 : DEALLOCATE( Inst%VEGTYP9 )
1425 : ENDIF
1426 0 : Inst%VEGTYP9 => NULL()
1427 :
1428 0 : IF ( ASSOCIATED( Inst%FINN_EMFAC ) ) THEN
1429 0 : DEALLOCATE( Inst%FINN_EMFAC )
1430 : ENDIF
1431 0 : Inst%FINN_EMFAC => NULL()
1432 :
1433 0 : IF ( ASSOCIATED( Inst%FinnIDs ) ) THEN
1434 0 : DEALLOCATE( Inst%FinnIDs )
1435 : ENDIF
1436 0 : Inst%FinnIDs => NULL()
1437 :
1438 0 : IF ( ASSOCIATED( Inst%HcoIDs ) ) THEN
1439 0 : DEALLOCATE( Inst%HcoIDs )
1440 : ENDIF
1441 0 : Inst%HcoIDs => NULL()
1442 :
1443 0 : IF ( ASSOCIATED( Inst%SpcNames ) ) THEN
1444 0 : DEALLOCATE( Inst%SpcNames )
1445 : ENDIF
1446 0 : Inst%SpcNames => NULL()
1447 :
1448 0 : IF ( ASSOCIATED( Inst%SpcScalFldNme ) ) THEN
1449 0 : DEALLOCATE( Inst%SpcScalFldNme )
1450 : ENDIF
1451 0 : Inst%SpcScalFldNme => NULL()
1452 :
1453 0 : IF ( ASSOCIATED( Inst%SpcScal ) ) THEN
1454 0 : DEALLOCATE( Inst%SpcScal )
1455 : ENDIF
1456 0 : Inst%SpcScal => NULL()
1457 :
1458 0 : IF ( ASSOCIATED( Inst%FINN_SPEC_NAME ) ) THEN
1459 0 : DEALLOCATE( Inst%FINN_SPEC_NAME )
1460 : ENDIF
1461 0 : Inst%FINN_SPEC_NAME => NULL()
1462 :
1463 : !---------------------------------------------------------------------
1464 : ! Pop off instance from list
1465 : !---------------------------------------------------------------------
1466 0 : IF ( ASSOCIATED(PrevInst) ) THEN
1467 0 : PrevInst%NextInst => Inst%NextInst
1468 : ELSE
1469 0 : AllInst => Inst%NextInst
1470 : ENDIF
1471 0 : DEALLOCATE(Inst)
1472 : ENDIF
1473 :
1474 : ! Free pointers before exiting
1475 0 : PrevInst => NULL()
1476 0 : Inst => NULL()
1477 :
1478 0 : END SUBROUTINE InstRemove
1479 : !EOC
1480 0 : END MODULE HCOX_FINN_Mod
|
