Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hcox_gfed_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCOX\_GFED\_MOD contains routines to calculate
9 : ! GFED4 biomass burning emissions in HEMCO.
10 : !
11 : ! !INTERFACE:
12 : !
13 : MODULE HCOX_GFED_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_GFED_Init
29 : PUBLIC :: HCOX_GFED_Run
30 : PUBLIC :: HCOX_GFED_Final
31 : !
32 : ! !REMARKS:
33 : ! Monthly emissions of DM are read from disk,
34 : ! multiplied by daily and 3hourly fractions (if necessary), and then
35 : ! multiplied by the appropriate emission factors to produce biomass
36 : ! burning emissions.
37 : !
38 : ! All species to be used must be listed in the settings section of the HEMCO
39 : ! configuration file. For every listed species, individual scale factors as
40 : ! well as masks can be defined. For example, to scale FINN CO emissions by a
41 : ! factor of 1.05 and restrict them to North America, as well as to scale NO
42 : ! emissions by a factor of 1.5:
43 : !
44 : !111 GFED : on NO/CO/ALK4/ACET/MEK/ALD2/PRPE/C3H8/CH2O/C2H6/SO2/NH3/BC/OC/GLYC/MGLY/BENZ/TOLU/XYLE/C2H4/C2H2/GLYC/CO2/CH4/HCOOH/DMS/ISOP/LIMO/MOH/EOH/ACTA/GLYX/HAC
45 : ! --> GFED4 : true
46 : ! --> GFED_daily : false
47 : ! --> GFED_3hourly : false
48 : ! --> hydrophilic BC : 0.2
49 : ! --> hydrophilic OC : 0.5
50 : ! --> Mask_CO : NAMASK
51 : ! --> Scaling_CO : 1.05
52 : ! --> Scaling_NO : 1.5
53 : !
54 : ! Field NAMASK must be defined in section mask of the HEMCO configuration file.
55 : !
56 : ! For SOA_SVPOA mechanism:
57 : ! * If tracers POG1 and POG2 are specified, emissions are calculated from OC,
58 : ! multiplied by a POG scale factor (Scaling_POG1, Scaling_POG2) that must be
59 : ! specified in the HEMCO configuration file.
60 : ! * If tracer NAP is specified, emissions are calculated from CO, multiplied
61 : ! by a NAP scale factor (Scaling_NAP) that must be specified in the HEMCO
62 : ! configuration file.
63 : !
64 : ! References:
65 : ! ============================================================================
66 : ! (1 ) Original GFED3 database from Guido van der Werf
67 : ! http://www.falw.vu/~gwerf/GFED/GFED3/emissions/
68 : ! (2 ) Giglio, L., Randerson, J. T., van der Werf, G. R., Kasibhatla, P. S.,
69 : ! Collatz, G. J., Morton, D. C., and DeFries, R. S.: Assessing
70 : ! variability and long-term trends in burned area by merging multiple
71 : ! satellite fire products, Biogeosciences, 7, 1171-1186,
72 : ! doi:10.5194/bg-7-1171-2010, 2010.
73 : ! (3 ) van der Werf, G. R., Randerson, J. T., Giglio, L., Collatz, G. J.,
74 : ! Mu, M., Kasibhatla, P. S., Morton, D. C., DeFries, R. S., Jin, Y.,
75 : ! and van Leeuwen, T. T.: Global fire emissions and the contribution of
76 : ! deforestation, savanna, forest, agricultural, and peat fires
77 : ! (1997â~@~S2009), Atmos. Chem. Phys., 10, 11707-11735,
78 : ! doi:10.5194/acp-10-11707-2010, 2010.
79 : !
80 : ! !REVISION HISTORY:
81 : ! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
82 : ! See https://github.com/geoschem/hemco for complete history
83 : !EOP
84 : !------------------------------------------------------------------------------
85 : !
86 : ! !DEFINED PARAMETERS:
87 : !
88 : !=================================================================
89 : ! MODULE PARAMETERS
90 : !
91 : ! N_EMFAC : Number of emission factors per species
92 : ! N_SPEC : Max. number of species
93 : !=================================================================
94 : INTEGER, PARAMETER :: N_EMFAC = 6
95 : INTEGER, PARAMETER :: N_SPEC = 45
96 : !
97 : ! !PRIVATE TYPES:
98 : !
99 : TYPE :: MyInst
100 : !=================================================================
101 : ! HEMCO VARIABLES
102 : !
103 : ! ExtNr : Extension number
104 : ! DoDay : TRUE if dialy scale factors are used
105 : ! Do3Hr : TRUE if 3-hourly scale factors are used
106 : !=================================================================
107 : INTEGER :: Instance
108 : INTEGER :: ExtNr
109 : LOGICAL :: DoDay
110 : LOGICAL :: Do3Hr
111 : LOGICAL :: IsGFED4
112 :
113 : !=================================================================
114 : ! SPECIES VARIABLES
115 : !
116 : ! nSpc : Number of GFED species (specified in config. file)
117 : ! SpcNames : Names of all used GFED species
118 : ! HcoIDs : HEMCO species IDs of all used GFED species
119 : ! gfedIDs : Index of used GFED species in scale factor table
120 : ! SpcScal : Additional scaling factors assigned to species through
121 : ! the HEMCO configuration file (e.g. Scaling_CO).
122 : !=================================================================
123 : INTEGER :: nSpc
124 : CHARACTER(LEN=31), POINTER :: SpcNames(:) => NULL()
125 : CHARACTER(LEN=61), POINTER :: SpcScalFldNme(:) => NULL()
126 : INTEGER, POINTER :: HcoIDs(:) => NULL()
127 : INTEGER, POINTER :: GfedIDs(:) => NULL()
128 : REAL(sp), POINTER :: SpcScal(:) => NULL()
129 :
130 : !=================================================================
131 : ! SCALE FACTORS
132 : !
133 : ! GFED_EMFAC: emission scale factors for each species and
134 : ! emission factor type. The filename of the emissions
135 : ! emissions factor table is specified in the HEMCO
136 : ! configuration file. All scale factors in kg/kgDM.
137 : ! OCPIfrac : Fraction of OC that converts into hydrophilic OC.
138 : ! Can be set in HEMCO configuration file (default=0.5)
139 : ! BCPIfrac : Fraction of BC that converts into hydrophilic BC.
140 : ! Can be set in HEMCO configuration file (default=0.2)
141 : ! POG1frac : Fraction of SVOC that is assigned to POG1.
142 : ! Can be set in HEMCO configuration file (default=0.49)
143 : !=================================================================
144 : REAL(hp), POINTER :: GFED4_EMFAC(:,:) => NULL()
145 : REAL(hp), POINTER :: GFED_EMFAC (:,:) => NULL()
146 : REAL(sp) :: OCPIfrac
147 : REAL(sp) :: BCPIfrac
148 : REAL(sp) :: POG1frac
149 : REAL(sp) :: SOAPfrac
150 :
151 : !=================================================================
152 : ! DATA ARRAY POINTERS
153 : !
154 : ! These are the pointers to the 6 input data specified in the
155 : ! the configuration file
156 : !=================================================================
157 : REAL(hp), POINTER :: GFED_SAVA(:,:) => NULL()
158 : REAL(hp), POINTER :: GFED_BORF(:,:) => NULL()
159 : REAL(hp), POINTER :: GFED_TEMP(:,:) => NULL()
160 : REAL(hp), POINTER :: GFED_DEFO(:,:) => NULL()
161 : REAL(hp), POINTER :: GFED_PEAT(:,:) => NULL()
162 : REAL(hp), POINTER :: GFED_AGRI(:,:) => NULL()
163 : REAL(hp), POINTER :: DAYSCAL (:,:) => NULL()
164 : REAL(hp), POINTER :: HRSCAL (:,:) => NULL()
165 :
166 : TYPE(MyInst), POINTER :: NextInst => NULL()
167 : END TYPE MyInst
168 :
169 : ! Pointer to instances
170 : TYPE(MyInst), POINTER :: AllInst => NULL()
171 :
172 : CONTAINS
173 : !EOC
174 : !------------------------------------------------------------------------------
175 : ! Harmonized Emissions Component (HEMCO) !
176 : !------------------------------------------------------------------------------
177 : !BOP
178 : !
179 : ! !IROUTINE: HCOX_GFED_Run
180 : !
181 : ! !DESCRIPTION: Subroutine HcoX\_GFED\_Run is the driver run routine to
182 : ! calculate seasalt emissions in HEMCO.
183 : !\\
184 : !\\
185 : ! !INTERFACE:
186 : !
187 0 : SUBROUTINE HCOX_GFED_Run( ExtState, HcoState, RC )
188 : !
189 : ! !USES:
190 : !
191 : USE HCO_Calc_Mod, ONLY : HCO_EvalFld
192 : USE HCO_EmisList_Mod, ONLY : HCO_GetPtr
193 : USE HCO_FluxArr_MOD, ONLY : HCO_EmisAdd
194 : !
195 : ! !INPUT/OUTPUT PARAMETERS:
196 : !
197 : TYPE(HCO_State), POINTER :: HcoState ! Output obj
198 : TYPE(Ext_State), POINTER :: ExtState ! Module options
199 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
200 : !
201 : ! !REVISION HISTORY:
202 : ! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
203 : ! See https://github.com/geoschem/hemco for complete history
204 : !EOP
205 : !------------------------------------------------------------------------------
206 : !BOC
207 : !
208 : ! !LOCAL VARIABLES:
209 : !
210 : LOGICAL, SAVE :: FIRST = .TRUE.
211 : INTEGER :: N, M
212 0 : REAL(hp), POINTER :: TmpPtr(:,:)
213 : CHARACTER(LEN=63) :: MSG
214 : CHARACTER(LEN=255) :: LOC
215 :
216 0 : REAL(hp), TARGET :: SpcArr(HcoState%NX,HcoState%NY)
217 0 : REAL(hp), TARGET :: TypArr(HcoState%NX,HcoState%NY)
218 :
219 : TYPE(MyInst), POINTER :: Inst
220 :
221 : !==============================================================================
222 : ! This code is required for the vertical distribution of biomass burning emiss.
223 : ! We will keep it here for a future implementation. (mps, 4/24/17)
224 : ! INTEGER :: I, J, L, N, M
225 : ! INTEGER :: PBL_MAX
226 : ! REAL(hp) :: PBL_FRAC, F_OF_PBL, F_OF_FT
227 : ! REAL(hp) :: DELTPRES, TOTPRESFT
228 : ! REAL(hp), TARGET :: SpcArr3D(HcoState%NX,HcoState%NY,HcoState%NZ)
229 : !==============================================================================
230 :
231 : !=================================================================
232 : ! HCOX_GFED_Run begins here!
233 : !=================================================================
234 0 : LOC = 'HCOX_GFED_Run (HCOX_GFED_MOD.F90)'
235 :
236 : ! Return if extension disabled
237 0 : IF ( ExtState%GFED <= 0 ) RETURN
238 :
239 : ! Enter
240 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
241 0 : IF ( RC /= HCO_SUCCESS ) THEN
242 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
243 0 : RETURN
244 : ENDIF
245 :
246 : ! Get instance
247 0 : Inst => NULL()
248 0 : CALL InstGet ( ExtState%GFED, Inst, RC )
249 0 : IF ( RC /= HCO_SUCCESS ) THEN
250 0 : WRITE(MSG,*) 'Cannot find GFED instance Nr. ', ExtState%GFED
251 0 : CALL HCO_ERROR(MSG,RC)
252 0 : RETURN
253 : ENDIF
254 :
255 : !==============================================================================
256 : ! This code is required for the vertical distribution of biomass burning emiss.
257 : ! We will keep it here for a future implementation. (mps, 4/24/17)
258 : ! ! Add only 65% biomass burning source to boundary layer, the
259 : ! ! rest is emitted into the free troposphere (mps from evf+tjb, 3/10/17)
260 : ! PBL_FRAC = 0.65_hp
261 : !==============================================================================
262 :
263 : !-----------------------------------------------------------------
264 : ! Get pointers to data arrays
265 : !-----------------------------------------------------------------
266 : !IF ( FIRST ) THEN
267 :
268 0 : IF ( Inst%IsGFED4 ) THEN
269 0 : CALL HCO_EvalFld ( HcoState, 'GFED_SAVA', Inst%GFED_SAVA, RC )
270 0 : IF ( RC /= HCO_SUCCESS ) THEN
271 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
272 0 : RETURN
273 : ENDIF
274 0 : CALL HCO_EvalFld ( HcoState, 'GFED_BORF', Inst%GFED_BORF, RC )
275 0 : IF ( RC /= HCO_SUCCESS ) THEN
276 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
277 0 : RETURN
278 : ENDIF
279 0 : CALL HCO_EvalFld ( HcoState, 'GFED_TEMP', Inst%GFED_TEMP, RC )
280 0 : IF ( RC /= HCO_SUCCESS ) THEN
281 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
282 0 : RETURN
283 : ENDIF
284 0 : CALL HCO_EvalFld ( HcoState, 'GFED_DEFO', Inst%GFED_DEFO, RC )
285 0 : IF ( RC /= HCO_SUCCESS ) THEN
286 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
287 0 : RETURN
288 : ENDIF
289 0 : CALL HCO_EvalFld ( HcoState, 'GFED_PEAT', Inst%GFED_PEAT, RC )
290 0 : IF ( RC /= HCO_SUCCESS ) THEN
291 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
292 0 : RETURN
293 : ENDIF
294 0 : CALL HCO_EvalFld ( HcoState, 'GFED_AGRI', Inst%GFED_AGRI, RC )
295 0 : IF ( RC /= HCO_SUCCESS ) THEN
296 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
297 0 : RETURN
298 : ENDIF
299 : ENDIF
300 :
301 : ! Also point to scale factors if needed
302 0 : IF ( Inst%DoDay ) THEN
303 : CALL HCO_EvalFld ( HcoState, 'GFED_FRAC_DAY', &
304 0 : Inst%DAYSCAL, RC )
305 0 : IF ( RC /= HCO_SUCCESS ) THEN
306 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
307 0 : RETURN
308 : ENDIF
309 : ENDIF
310 0 : IF ( Inst%Do3Hr ) THEN
311 : CALL HCO_EvalFld ( HcoState, 'GFED_FRAC_3HOUR', &
312 0 : Inst%HRSCAL, RC )
313 0 : IF ( RC /= HCO_SUCCESS ) THEN
314 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
315 0 : RETURN
316 : ENDIF
317 : ENDIF
318 :
319 0 : FIRST = .FALSE.
320 : !ENDIF
321 :
322 : !-----------------------------------------------------------------
323 : ! Calculate emissions for defined species
324 : !-----------------------------------------------------------------
325 0 : DO N = 1, Inst%nSpc
326 :
327 : ! Continue if species not defined
328 0 : IF ( Inst%HcoIDs(N) < 0 ) CYCLE
329 0 : IF ( Inst%GfedIDs(N) < 0 ) CYCLE
330 :
331 : ! SpcArr are the total biomass burning emissions for this
332 : ! species. TypArr are the emissions from a given source type.
333 0 : SpcArr = 0.0_hp
334 : !==============================================================================
335 : ! This code is required for the vertical distribution of biomass burning emiss.
336 : ! We will keep it here for a future implementation. (mps, 4/24/17)
337 : ! SpcArr3D = 0.0_hp
338 : !==============================================================================
339 :
340 : ! Calculate emissions for all source types
341 0 : DO M = 1, N_EMFAC
342 :
343 : ! Point to the emission factor array for each source type
344 0 : SELECT CASE ( M )
345 : CASE( 1 )
346 0 : TMPPTR => Inst%GFED_SAVA
347 : CASE( 2 )
348 0 : TMPPTR => Inst%GFED_BORF
349 : CASE( 3 )
350 0 : TMPPTR => Inst%GFED_TEMP
351 : CASE( 4 )
352 0 : TMPPTR => Inst%GFED_DEFO
353 : CASE( 5 )
354 0 : TMPPTR => Inst%GFED_PEAT
355 : CASE( 6 )
356 0 : TMPPTR => Inst%GFED_AGRI
357 : CASE DEFAULT
358 0 : CALL HCO_ERROR ( 'Undefined emission factor', RC )
359 0 : RETURN
360 : END SELECT
361 :
362 : ! Calculate emissions for this type. The emission factors
363 : ! per type are in kgDM/m2/s, and the GFED_EMFAC scale factors
364 : ! are in kg/kgDM. This gives us TypArr in kg/m2/s.
365 : ! Use woodland emission factors for 'deforestation' outside
366 : ! humid tropical forest.
367 : ! Deforestation emissions now use the weighted sum of
368 : ! deforestation and woodland scale factors, based on the value
369 : ! of the humid tropical forest mask. This makes the calculation
370 : ! less dependent on model resolution. (ckeller, 4/3/15)
371 0 : TypArr = TmpPtr * Inst%GFED_EMFAC(Inst%GfedIDs(N),M)
372 :
373 : ! Eventually add daily / 3-hourly scale factors. These scale
374 : ! factors are unitless.
375 0 : IF ( Inst%DoDay ) THEN
376 : !IF ( ASSOCIATED(DAYSCAL) ) THEN
377 0 : TypArr = TypArr * Inst%DAYSCAL
378 : !ENDIF
379 : ENDIF
380 0 : IF ( Inst%Do3Hr ) THEN
381 : !IF ( ASSOCIATED(HRSCAL) ) THEN
382 0 : TypArr = TypArr * Inst%HRSCAL
383 : !ENDIF
384 : ENDIF
385 :
386 : ! Add to output array
387 0 : SpcArr = SpcArr + TypArr
388 :
389 : ! Nullify pointer
390 0 : TmpPtr => NULL()
391 :
392 : ENDDO !M
393 :
394 : ! Apply species specific scale factors
395 0 : SpcArr = SpcArr * Inst%SpcScal(N)
396 :
397 0 : SELECT CASE ( Inst%SpcNames(N) )
398 : CASE ( 'OCPI' )
399 0 : SpcArr = SpcArr * Inst%OCPIfrac
400 : CASE ( 'OCPO' )
401 0 : SpcArr = SpcArr * (1.0_sp - Inst%OCPIfrac)
402 : CASE ( 'BCPI' )
403 0 : SpcArr = SpcArr * Inst%BCPIfrac
404 : CASE ( 'BCPO' )
405 0 : SpcArr = SpcArr * (1.0_sp - Inst%BCPIfrac)
406 : CASE ( 'POG1' )
407 0 : SpcArr = SpcArr * Inst%POG1frac
408 : CASE ( 'POG2' )
409 0 : SpcArr = SpcArr * (1.0_sp - Inst%POG1frac)
410 : CASE ( 'SOAP' )
411 0 : SpcArr = SpcArr * Inst%SOAPfrac
412 : !==============================================================================
413 : ! This code is required for partitioning NOx emissions directly to PAN and HNO3.
414 : ! We will keep it here as an option for users focusing on North American fires.
415 : ! (mps, 5/12/17)
416 : ! ! Put 40% of NOx Biomass emissions into PAN
417 : ! ! and 20% into HNO3 (evf, 9/9/11, 9/15/11)
418 : ! ! Sensitivity study with Hudman 2007 recommendation
419 : ! ! of 80% of NOX as PAN. (evf, 4/25/12)
420 : ! CASE ( 'NO' )
421 : ! SpcArr = SpcArr * 0.40_sp
422 : ! CASE ( 'PAN' )
423 : ! SpcArr = SpcArr * 0.40_sp
424 : ! CASE ( 'HNO3' )
425 : ! SpcArr = SpcArr * 0.20_sp
426 : !==============================================================================
427 : END SELECT
428 :
429 : ! Check for masking
430 0 : CALL HCOX_SCALE( HcoState, SpcArr, TRIM(Inst%SpcScalFldNme(N)), RC )
431 0 : IF ( RC /= HCO_SUCCESS ) THEN
432 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
433 0 : RETURN
434 : ENDIF
435 :
436 : !==============================================================================
437 : ! This code is required for the vertical distribution of biomass burning emiss.
438 : ! We will keep it here for a future implementation. (mps, 4/24/17)
439 : !
440 : ! !--------------------------------------------------------------------
441 : ! ! For grid boxes with emissions, distribute 65% to PBL and 35% to FT
442 : ! !--------------------------------------------------------------------
443 : ! DO J = 1, HcoState%Ny
444 : ! DO I = 1, HcoState%Nx
445 : !
446 : ! IF ( SpcArr(I,J) > 0e+0_hp ) THEN
447 : !
448 : ! ! Initialize
449 : ! PBL_MAX = 1
450 : ! F_OF_PBL = 0e+0_hp
451 : ! F_OF_FT = 0e+0_hp
452 : ! DELTPRES = 0e+0_hp
453 : !
454 : ! ! Determine PBL height
455 : ! DO L = HcoState%NZ, 1, -1
456 : ! IF ( ExtState%FRAC_OF_PBL%Arr%Val(I,J,L) > 0.0_hp ) THEN
457 : ! PBL_MAX = L
458 : ! EXIT
459 : ! ENDIF
460 : ! ENDDO
461 : !
462 : ! ! Loop over the boundary layer
463 : ! DO L = 1, PBL_MAX
464 : !
465 : ! ! Fraction of PBL that box (I,J,L) makes up [unitless]
466 : ! F_OF_PBL = ExtState%FRAC_OF_PBL%Arr%Val(I,J,L)
467 : !
468 : ! ! Add only 65% biomass burning source to PBL
469 : ! ! Distribute emissions thru the entire boundary layer
470 : ! ! (mps from evf+tjb, 3/10/17)
471 : ! SpcArr3D(I,J,L) = SpcArr(I,J) * PBL_FRAC * F_OF_PBL
472 : !
473 : ! ENDDO
474 : !
475 : !
476 : ! ! Total thickness of the free troposphere [hPa]
477 : ! ! (considered here to be 10 levels above the PBL)
478 : ! TOTPRESFT = HcoState%Grid%PEDGE%Val(I,J,PBL_MAX+1) - &
479 : ! HcoState%Grid%PEDGE%Val(I,J,PBL_MAX+11)
480 : !
481 : !
482 : ! ! Loop over the free troposphere
483 : ! DO L = PBL_MAX+1, PBL_MAX+10
484 : !
485 : ! ! Thickness of level L [hPa]
486 : ! DELTPRES = HcoState%Grid%PEDGE%Val(I,J,L) - &
487 : ! HcoState%Grid%PEDGE%Val(I,J,L+1)
488 : !
489 : ! ! Fraction of FT that box (I,J,L) makes up [unitless]
490 : ! F_OF_FT = DELTPRES / TOTPRESFT
491 : !
492 : ! ! Add 35% of biomass burning source to free troposphere
493 : ! ! Distribute emissions thru 10 model levels above the BL
494 : ! ! (mps from evf+tjb, 3/10/17)
495 : ! SpcArr3D(I,J,L) = SpcArr(I,J) * (1.0-PBL_FRAC) * F_OF_FT
496 : !
497 : ! ENDDO
498 : !
499 : ! ENDIF
500 : !
501 : ! ENDDO
502 : ! ENDDO
503 : !
504 : ! ! Add flux to HEMCO emission array
505 : ! ! Now 3D flux (mps, 3/10/17)
506 : ! CALL HCO_EmisAdd( HcoState, SpcArr3D, HcoIDs(N), &
507 : ! RC, ExtNr=ExtNr )
508 : !==============================================================================
509 :
510 : ! Add flux to HEMCO emission array
511 0 : CALL HCO_EmisAdd( HcoState, SpcArr, Inst%HcoIDs(N), RC, ExtNr=Inst%ExtNr )
512 0 : IF ( RC /= HCO_SUCCESS ) THEN
513 0 : MSG = 'HCO_EmisAdd error: ' // TRIM(HcoState%Spc(Inst%HcoIDs(N))%SpcName)
514 0 : CALL HCO_ERROR(MSG, RC )
515 0 : RETURN
516 : ENDIF
517 :
518 : ENDDO !N
519 :
520 : ! Nullify pointers for safety's sake
521 0 : TmpPtr => NULL()
522 0 : Inst => NULL()
523 :
524 : ! Leave w/ success
525 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
526 :
527 0 : END SUBROUTINE HCOX_GFED_Run
528 : !EOC
529 : !------------------------------------------------------------------------------
530 : ! Harmonized Emissions Component (HEMCO) !
531 : !------------------------------------------------------------------------------
532 : !BOP
533 : !
534 : ! !IROUTINE: HCOX_GFED_Init
535 : !
536 : ! !DESCRIPTION: Subroutine HcoX\_GFED\_Init initializes all
537 : ! extension variables.
538 : !\\
539 : !\\
540 : ! !INTERFACE:
541 : !
542 0 : SUBROUTINE HCOX_GFED_Init ( HcoState, ExtName, ExtState, RC )
543 : !
544 : ! !USES:
545 : !
546 : USE HCO_STATE_MOD, ONLY : HCO_GetHcoID
547 : USE HCO_STATE_MOD, ONLY : HCO_GetExtHcoID
548 : USE HCO_ExtList_Mod, ONLY : GetExtNr, GetExtOpt
549 : USE HCO_ExtList_Mod, ONLY : GetExtSpcVal
550 : !
551 : ! !INPUT/OUTPUT PARAMETERS:
552 : !
553 : CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name
554 : TYPE(Ext_State), POINTER :: ExtState ! Options object
555 : !
556 : ! !INPUT/OUTPUT PARAMETERS:
557 : !
558 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
559 : INTEGER, INTENT(INOUT) :: RC ! Return status
560 : !
561 : ! !REVISION HISTORY:
562 : ! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
563 : ! See https://github.com/geoschem/hemco for complete history
564 : !EOP
565 : !------------------------------------------------------------------------------
566 : !BOC
567 : !
568 : ! !LOCAL VARIABLES:
569 : !
570 : CHARACTER(LEN=255) :: MSG, ScalFile, LOC
571 : INTEGER :: ExtNr, tmpNr, AS, IU_FILE, IOS
572 : INTEGER :: nSpc, N, M, NDUM, NCHAR
573 : CHARACTER(LEN=31) :: tmpName
574 : CHARACTER(LEN=31) :: SpcName
575 : LOGICAL :: FOUND, Matched
576 : REAL(sp) :: ValSp
577 : TYPE(MyInst), POINTER :: Inst
578 :
579 : CHARACTER(LEN=255), POINTER :: GFED_SPEC_NAME (:) => NULL()
580 : CHARACTER(LEN=255), TARGET :: GFED4_SPEC_NAME(N_SPEC)
581 :
582 0 : CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:)
583 0 : CHARACTER(LEN=61), ALLOCATABLE :: SpcScalFldNme(:)
584 0 : INTEGER, ALLOCATABLE :: HcoIDs(:)
585 0 : REAL(sp), ALLOCATABLE :: SpcScal(:)
586 :
587 : !=================================================================
588 :
589 : !=================================================================
590 : ! HCOX_GFED_Init begins here!
591 : !=================================================================
592 0 : LOC = 'HCOX_GFED_Init (HCOX_GFED_MOD.F90)'
593 :
594 : ! Extension Nr.
595 0 : ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
596 0 : IF ( ExtNr <= 0 ) RETURN
597 :
598 : ! Enter
599 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
600 0 : IF ( RC /= HCO_SUCCESS ) THEN
601 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
602 0 : RETURN
603 : ENDIF
604 :
605 : ! Create local instance for this simulation
606 0 : Inst => NULL()
607 0 : CALL InstCreate ( ExtNr, ExtState%GFED, Inst, RC )
608 0 : IF ( RC /= HCO_SUCCESS ) THEN
609 0 : CALL HCO_ERROR ( 'Cannot create GFED instance', RC )
610 0 : RETURN
611 : ENDIF
612 :
613 : ! Check if this is GFED4
614 : CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'GFED4', &
615 0 : OptValBool=Inst%IsGFED4, FOUND=FOUND, RC=RC )
616 0 : IF ( .NOT. FOUND ) THEN
617 0 : Inst%IsGFED4 = .FALSE.
618 : ENDIF
619 :
620 : ! Error checks
621 0 : IF ( .NOT. Inst%IsGFED4 ) THEN
622 : MSG = 'GFED is enabled but no GFED version is selected. ' // &
623 0 : 'Please set GFED4 in HEMCO configuration file.'
624 0 : CALL HCO_ERROR(MSG, RC )
625 0 : RETURN
626 : ENDIF
627 :
628 : ! ----------------------------------------------------------------------
629 : ! Get settings
630 : ! The speciation of carbon aerosols into hydrophilic and hydrophobic
631 : ! fractions can be specified in the configuration file, e.g.:
632 : ! 100 GFED : on NO/CO/OCPI/OCPO/BCPI/BCPO
633 : ! --> hydrophilic BC : 0.2
634 : ! --> hydrophilic OC : 0.5
635 : !
636 : ! Setting these values is optional and default values are applied if
637 : ! they are not specified. The values only take effect if the
638 : ! corresponding species (CO, BCPI/BCPO, OCPI/OCPO) are listed as species
639 : ! to be used.
640 : ! ----------------------------------------------------------------------
641 :
642 : ! Try to read hydrophilic fractions of BC. Defaults to 0.2.
643 : CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'hydrophilic BC', &
644 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
645 0 : IF ( RC /= HCO_SUCCESS ) THEN
646 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
647 0 : RETURN
648 : ENDIF
649 0 : IF ( .NOT. FOUND ) THEN
650 0 : Inst%BCPIfrac = 0.2
651 : ELSE
652 0 : Inst%BCPIfrac = ValSp
653 : ENDIF
654 :
655 : ! Try to read hydrophilic fractions of OC. Defaults to 0.5.
656 : CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'hydrophilic OC', &
657 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
658 0 : IF ( RC /= HCO_SUCCESS ) THEN
659 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
660 0 : RETURN
661 : ENDIF
662 0 : IF ( .NOT. FOUND ) THEN
663 0 : Inst%OCPIfrac = 0.5
664 : ELSE
665 0 : Inst%OCPIfrac = ValSp
666 : ENDIF
667 :
668 : ! Try to read POG1 fraction of SVOC. Defaults to 0.49.
669 : CALL GetExtOpt ( HcoState%Config, ExtNr, 'fraction POG1', &
670 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
671 0 : IF ( RC /= HCO_SUCCESS ) THEN
672 0 : CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
673 0 : RETURN
674 : ENDIF
675 0 : IF ( .NOT. FOUND ) THEN
676 0 : Inst%POG1frac = 0.49
677 : ELSE
678 0 : Inst%POG1frac = ValSp
679 : ENDIF
680 :
681 : CALL GetExtOpt( HcoState%Config, ExtNr, 'CO to SOAP', &
682 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
683 0 : IF ( RC /= HCO_SUCCESS ) THEN
684 0 : CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC )
685 0 : RETURN
686 : ENDIF
687 0 : IF ( .NOT. FOUND ) THEN
688 0 : Inst%SOAPfrac = 0.0
689 : ELSE
690 0 : Inst%SOAPfrac = ValSp
691 : ENDIF
692 :
693 : ! Error check: OCPIfrac, BCPIfrac, and POG1frac must be between 0 and 1
694 : IF ( Inst%OCPIfrac < 0.0_sp .OR. Inst%OCPIfrac > 1.0_sp .OR. &
695 : Inst%BCPIfrac < 0.0_sp .OR. Inst%BCPIfrac > 1.0_sp .OR. &
696 : Inst%SOAPfrac < 0.0_sp .OR. Inst%SOAPfrac > 1.0_sp .OR. &
697 0 : Inst%POG1frac < 0.0_sp .OR. Inst%POG1frac > 1.0_sp ) THEN
698 0 : WRITE(MSG,*) 'fractions must be between 0-1: ', &
699 0 : Inst%OCPIfrac, Inst%BCPIfrac, Inst%POG1frac, Inst%SOAPfrac
700 0 : CALL HCO_ERROR(MSG, RC )
701 0 : RETURN
702 : ENDIF
703 :
704 : ! Use daily scale factors?
705 : CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'GFED_daily', &
706 0 : OptValBool=Inst%DoDay, FOUND=FOUND, RC=RC )
707 0 : IF ( RC /= HCO_SUCCESS ) THEN
708 0 : CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC )
709 0 : RETURN
710 : ENDIF
711 0 : IF ( .NOT. FOUND ) THEN
712 0 : Inst%DoDay = .FALSE.
713 : ENDIF
714 :
715 : ! Use 3-hourly scale factors?
716 : CALL GetExtOpt( HcoState%Config, ExtNr, 'GFED_3hourly', &
717 0 : OptValBool=Inst%Do3Hr, FOUND=FOUND, RC=RC )
718 0 : IF ( RC /= HCO_SUCCESS ) THEN
719 0 : CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC )
720 0 : RETURN
721 : ENDIF
722 0 : IF ( .NOT. FOUND ) THEN
723 0 : Inst%Do3Hr = .FALSE.
724 : ENDIF
725 :
726 : !-----------------------------------------------------------------------
727 : ! Initialize GFED scale factors
728 : !-----------------------------------------------------------------------
729 :
730 : ! Allocate scale factors table
731 0 : ALLOCATE ( Inst%GFED4_EMFAC ( N_SPEC, N_EMFAC ), STAT=AS )
732 0 : IF ( AS/=0 ) THEN
733 0 : CALL HCO_ERROR( 'Cannot allocate GFED_EMFAC', RC )
734 0 : RETURN
735 : ENDIF
736 0 : Inst%GFED4_EMFAC = 0.0_hp
737 :
738 0 : ALLOCATE( Inst%GFED_SAVA(HcoState%NX,HcoState%NY) )
739 0 : ALLOCATE( Inst%GFED_BORF(HcoState%NX,HcoState%NY) )
740 0 : ALLOCATE( Inst%GFED_TEMP(HcoState%NX,HcoState%NY) )
741 0 : ALLOCATE( Inst%GFED_DEFO(HcoState%NX,HcoState%NY) )
742 0 : ALLOCATE( Inst%GFED_PEAT(HcoState%NX,HcoState%NY) )
743 0 : ALLOCATE( Inst%GFED_AGRI(HcoState%NX,HcoState%NY) )
744 0 : ALLOCATE( Inst%DAYSCAL (HcoState%NX,HcoState%NY) )
745 0 : ALLOCATE( Inst%HRSCAL (HcoState%NX,HcoState%NY) )
746 :
747 : ! Now get definitions for GFED_EMFAC and GFED_SPEC_NAME from an include
748 : ! file. This avoids ASCII file reads in the ESMF environment. To update
749 : ! the emission factors, one just needs to modify the include file.
750 : ! This can be done with the script HEMCO/Extensions/Preprocess/gfed.pl,
751 : ! (bmy, 8/14/14)
752 : #include "hcox_gfed_include_gfed4.H"
753 :
754 : ! Set working pointers
755 0 : IF ( Inst%IsGFED4 ) THEN
756 0 : Inst%GFED_EMFAC => Inst%GFED4_EMFAC
757 0 : GFED_SPEC_NAME => GFED4_SPEC_NAME
758 : ENDIF
759 :
760 : !-----------------------------------------------------------------------
761 : ! Match specified species with GFED species
762 : ! The species to be used are specified in the HEMCO configuration file.
763 : ! Match these species with the ones found in the scale factors table.
764 : !-----------------------------------------------------------------------
765 :
766 : ! Prompt to log file
767 0 : IF ( HcoState%amIRoot ) THEN
768 :
769 : ! Write the name of the extension regardless of the verbose setting
770 0 : msg = 'Using HEMCO extension: GFED (biomass burning)'
771 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
772 0 : CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator
773 : ELSE
774 0 : CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator
775 : ENDIF
776 :
777 : ! Write all other messages as debug printout only
778 0 : WRITE(MSG,*) ' - Use GFED-4 : ', Inst%IsGFED4
779 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
780 0 : WRITE(MSG,*) ' - Use daily scale factors : ', Inst%DoDay
781 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
782 0 : WRITE(MSG,*) ' - Use hourly scale factors: ', Inst%Do3Hr
783 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
784 0 : WRITE(MSG,*) ' - Hydrophilic OC fraction : ', Inst%OCPIfrac
785 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
786 0 : WRITE(MSG,*) ' - Hydrophilic BC fraction : ', Inst%BCPIfrac
787 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
788 0 : WRITE(MSG,*) ' - POG1 fraction : ', Inst%POG1frac
789 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
790 0 : WRITE(MSG,*) ' - SOAP fraction : ', Inst%SOAPfrac
791 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
792 : ENDIF
793 :
794 : ! Get HEMCO species IDs of all species specified in configuration file
795 0 : CALL HCO_GetExtHcoID( HcoState, Inst%ExtNr, HcoIDs, SpcNames, Inst%nSpc, RC )
796 0 : IF ( RC /= HCO_SUCCESS ) THEN
797 0 : CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC )
798 0 : RETURN
799 : ENDIF
800 0 : IF ( Inst%nSpc == 0 ) THEN
801 0 : MSG = 'No GFED species specified'
802 0 : CALL HCO_ERROR(MSG, RC )
803 0 : RETURN
804 : ENDIF
805 0 : ALLOCATE(Inst%HcoIDs(Inst%nSpc),Inst%SpcNames(Inst%nSpc))
806 0 : Inst%HcoIDs = HcoIDs
807 0 : Inst%SpcNames = SpcNames
808 0 : DEALLOCATE(HcoIDs,SpcNames)
809 :
810 : ! Get species scale factors
811 : CALL GetExtSpcVal( HcoState%Config, Inst%ExtNr, Inst%nSpc, &
812 0 : Inst%SpcNames, 'Scaling', 1.0_sp, SpcScal, RC )
813 0 : IF ( RC /= HCO_SUCCESS ) THEN
814 0 : CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC )
815 0 : RETURN
816 : ENDIF
817 :
818 : ! Get species mask fields
819 : CALL GetExtSpcVal( HcoState%Config, Inst%ExtNr, Inst%nSpc, &
820 0 : Inst%SpcNames, 'ScaleField', HCOX_NOSCALE, SpcScalFldNme, RC )
821 0 : IF ( RC /= HCO_SUCCESS ) THEN
822 0 : CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC )
823 0 : RETURN
824 : ENDIF
825 :
826 : ! Pass to instance
827 0 : nSpc = Inst%nSpc
828 0 : ALLOCATE(Inst%SpcScal(nSpc),Inst%SpcScalFldNme(nSpc))
829 0 : Inst%SpcScal = SpcScal
830 0 : Inst%SpcScalFldNme = SpcScalFldNme
831 0 : DEALLOCATE(SpcScal,SpcScalFldNme)
832 :
833 : ! Error trap: in previous versions, CO, POA and NAP scale factor were given as
834 : ! 'CO scale factor', etc. Make sure those attributes do not exist any more!
835 : CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'CO scale factor', &
836 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
837 0 : IF ( .NOT. FOUND ) THEN
838 : CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'POA scale factor', &
839 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
840 : ENDIF
841 0 : IF ( .NOT. FOUND ) THEN
842 : CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'NAP scale factor', &
843 0 : OptValSp=ValSp, FOUND=FOUND, RC=RC )
844 : ENDIF
845 0 : IF ( FOUND ) THEN
846 : MSG = 'Found old definition of CO, POA and/or NAP scale factor! ' // &
847 : 'This version of HEMCO expects species scale factors to be ' // &
848 : 'set as `Scaling_XX` instead of `XX scale factor`. ' // &
849 0 : 'Please update the GFED settings section accordingly.'
850 0 : CALL HCO_ERROR(MSG, RC )
851 0 : RETURN
852 : ENDIF
853 :
854 : ! GFEDIDS are the matching indeces of the HEMCO species in GFED_EMFAC.
855 0 : ALLOCATE ( Inst%GfedIDs(Inst%nSpc), STAT=AS )
856 : IF ( AS/=0 ) THEN
857 0 : CALL HCO_ERROR( 'Cannot allocate GfedIDs', RC )
858 0 : RETURN
859 : ENDIF
860 0 : Inst%GfedIDs = -1
861 :
862 : ! Find matching GFED index for each specified species
863 0 : DO N = 1, Inst%nSpc
864 0 : IF ( Inst%HcoIDs(N) < 0 ) CYCLE
865 :
866 : ! SpcName is the GFED species name to be searched. Adjust
867 : ! if necessary.
868 0 : SpcName = Inst%SpcNames(N)
869 0 : NCHAR = LEN(SpcName)
870 : IF ( NCHAR > 3 ) THEN
871 0 : IF ( SpcName(1:3) == 'CO2' ) THEN
872 0 : SpcName = 'CO2'
873 0 : ELSEIF ( SpcName(1:3) == 'CH4' ) THEN
874 0 : SpcName = 'CH4'
875 0 : ELSEIF ( SpcName(1:3) == 'CO_' ) THEN
876 0 : SpcName = 'CO'
877 0 : ELSEIF ( SpcName(1:2) == 'BC' .or. SpcName(1:4) == 'bc_a' ) THEN
878 0 : SpcName = 'BC'
879 0 : ELSEIF ( SpcName(1:2) == 'OC' .or. SpcName(1:5) == 'pom_a' ) THEN
880 0 : SpcName = 'OC'
881 : ! CAM-chem species conversion to HEMCO (GEOS-Chem) species list, hplin, 5/17/21
882 0 : ELSEIF ( SpcName(1:6) == 'BIGALK' ) THEN
883 0 : SpcName = 'ALK4'
884 0 : ELSEIF ( SpcName(1:8) == 'CH3COCH3' ) THEN
885 0 : SpcName = 'ACET'
886 0 : ELSEIF ( SpcName(1:6) == 'CH3CHO' ) THEN
887 0 : SpcName = 'ALD2'
888 0 : ELSEIF ( SpcName(1:4) == 'C3H6' ) THEN
889 0 : SpcName = 'PRPE'
890 0 : ELSEIF ( SpcName(1:5) == 'MTERP' ) THEN
891 0 : SpcName = 'MTPA'
892 0 : ELSEIF ( SpcName(1:7) == 'BENZENE' ) THEN
893 0 : SpcName = 'BENZ'
894 0 : ELSEIF ( SpcName(1:7) == 'TOLUENE' ) THEN
895 0 : SpcName = 'TOLU'
896 0 : ELSEIF ( SpcName(1:7) == 'XYLENES' ) THEN
897 0 : SpcName = 'XYLE'
898 0 : ELSEIF ( SpcName(1:6) == 'C2H5OH' ) THEN
899 0 : SpcName = 'EOH'
900 0 : ELSEIF ( SpcName(1:5) == 'CH3OH' ) THEN
901 0 : SpcName = 'MOH'
902 : ENDIF
903 : ENDIF
904 0 : IF ( TRIM(SpcName) == 'POG1' ) SpcName = 'OC'
905 0 : IF ( TRIM(SpcName) == 'POG2' ) SpcName = 'OC'
906 0 : IF ( TRIM(SpcName) == 'NAP' ) SpcName = 'CO'
907 : !==============================================================================
908 : ! This code is required for partitioning NOx emissions directly to PAN and HNO3.
909 : ! We will keep it here as an option for users focusing on North American fires.
910 : ! (mps, 5/12/17)
911 : ! IF ( TRIM(SpcName) == 'PAN' ) SpcName = 'NO'
912 : ! IF ( TRIM(SpcName) == 'HNO3' ) SpcName = 'NO'
913 : !==============================================================================
914 :
915 : ! adjust SOAP scale factor by CO scale factor (SOAP co-emitted with CO)
916 0 : IF ( TRIM(SpcName) == 'CO' ) THEN
917 0 : Inst%SOAPfrac = Inst%SOAPfrac * Inst%SpcScal(N)
918 : END IF
919 :
920 : ! Search for matching GFED species by name
921 0 : Matched = .FALSE.
922 0 : DO M = 1, N_SPEC
923 :
924 0 : IF ( TRIM(SpcName) == TRIM(GFED_SPEC_NAME(M)) ) THEN
925 0 : Inst%GfedIDs(N) = M
926 0 : Matched = .TRUE.
927 :
928 : ! Verbose
929 0 : IF ( HcoState%amIRoot ) THEN
930 0 : MSG = ' - Emit GFED species ' // TRIM(GFED_SPEC_NAME(M)) // &
931 0 : ' as model species ' // TRIM(Inst%SpcNames(N))
932 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
933 0 : WRITE(MSG,*) ' --> Will use scale factor: ', Inst%SpcScal(N)
934 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
935 0 : WRITE(MSG,*) ' --> Will use scale field : ', TRIM(Inst%SpcScalFldNme(N))
936 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
937 : ENDIF
938 0 : EXIT ! go to next species
939 : ENDIF
940 : ENDDO
941 0 : IF ( .NOT. Matched ) THEN
942 0 : MSG = 'Species '// TRIM(SpcName) //' not found in GFED'
943 0 : CALL HCO_ERROR(MSG, RC )
944 0 : RETURN
945 : ENDIF
946 : ENDDO !N
947 :
948 : !=======================================================================
949 : ! Activate this module and the fields of ExtState that it uses
950 : !=======================================================================
951 :
952 : !==============================================================================
953 : ! This code is required for the vertical distribution of biomass burning emiss.
954 : ! We will keep it here for a future implementation. (mps, 4/24/17)
955 : ! ! Activate met fields required by this extension
956 : ! ExtState%FRAC_OF_PBL%DoUse = .TRUE.
957 : !==============================================================================
958 :
959 : ! Enable module
960 : !ExtState%GFED = .TRUE.
961 :
962 : ! Cleanup
963 0 : GFED_SPEC_NAME => NULL()
964 0 : Inst => NULL()
965 :
966 : ! Return w/ success
967 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
968 :
969 0 : END SUBROUTINE HCOX_GFED_Init
970 : !EOC
971 : !------------------------------------------------------------------------------
972 : ! Harmonized Emissions Component (HEMCO) !
973 : !------------------------------------------------------------------------------
974 : !BOP
975 : !
976 : ! !IROUTINE: HCOX_GFED_Final
977 : !
978 : ! !DESCRIPTION: Subroutine HcoX\_GFED\_Final deallocates
979 : ! all module arrays.
980 : !\\
981 : !\\
982 : ! !INTERFACE:
983 : !
984 0 : SUBROUTINE HCOX_GFED_Final ( ExtState )
985 : !
986 : ! !INPUT PARAMETERS:
987 : !
988 : TYPE(Ext_State), POINTER :: ExtState ! Module options
989 : !
990 : ! !REVISION HISTORY:
991 : ! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
992 : ! See https://github.com/geoschem/hemco for complete history
993 : !EOP
994 : !------------------------------------------------------------------------------
995 : !BOC
996 : !
997 : !=================================================================
998 : ! HCOX_GFED_Final begins here!
999 : !=================================================================
1000 :
1001 0 : CALL InstRemove ( ExtState%GFED )
1002 :
1003 0 : END SUBROUTINE HCOX_GFED_Final
1004 : !EOC
1005 : !------------------------------------------------------------------------------
1006 : ! Harmonized Emissions Component (HEMCO) !
1007 : !------------------------------------------------------------------------------
1008 : !BOP
1009 : !
1010 : ! !IROUTINE: InstGet
1011 : !
1012 : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
1013 : !\\
1014 : !\\
1015 : ! !INTERFACE:
1016 : !
1017 0 : SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
1018 : !
1019 : ! !INPUT PARAMETERS:
1020 : !
1021 : INTEGER :: Instance
1022 : TYPE(MyInst), POINTER :: Inst
1023 : INTEGER :: RC
1024 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
1025 : !
1026 : ! !REVISION HISTORY:
1027 : ! 18 Feb 2016 - C. Keller - Initial version
1028 : ! See https://github.com/geoschem/hemco for complete history
1029 : !EOP
1030 : !------------------------------------------------------------------------------
1031 : !BOC
1032 : TYPE(MyInst), POINTER :: PrvInst
1033 :
1034 : !=================================================================
1035 : ! InstGet begins here!
1036 : !=================================================================
1037 :
1038 : ! Get instance. Also archive previous instance.
1039 0 : PrvInst => NULL()
1040 0 : Inst => AllInst
1041 0 : DO WHILE ( ASSOCIATED(Inst) )
1042 0 : IF ( Inst%Instance == Instance ) EXIT
1043 0 : PrvInst => Inst
1044 0 : Inst => Inst%NextInst
1045 : END DO
1046 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
1047 0 : RC = HCO_FAIL
1048 0 : RETURN
1049 : ENDIF
1050 :
1051 : ! Pass output arguments
1052 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
1053 :
1054 : ! Cleanup & Return
1055 0 : PrvInst => NULL()
1056 0 : RC = HCO_SUCCESS
1057 :
1058 : END SUBROUTINE InstGet
1059 : !EOC
1060 : !------------------------------------------------------------------------------
1061 : ! Harmonized Emissions Component (HEMCO) !
1062 : !------------------------------------------------------------------------------
1063 : !BOP
1064 : !
1065 : ! !IROUTINE: InstCreate
1066 : !
1067 : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
1068 : !\\
1069 : !\\
1070 : ! !INTERFACE:
1071 : !
1072 0 : SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
1073 : !
1074 : ! !INPUT PARAMETERS:
1075 : !
1076 : INTEGER, INTENT(IN) :: ExtNr
1077 : !
1078 : ! !OUTPUT PARAMETERS:
1079 : !
1080 : INTEGER, INTENT( OUT) :: Instance
1081 : TYPE(MyInst), POINTER :: Inst
1082 : !
1083 : ! !INPUT/OUTPUT PARAMETERS:
1084 : !
1085 : INTEGER, INTENT(INOUT) :: RC
1086 : !
1087 : ! !REVISION HISTORY:
1088 : ! 18 Feb 2016 - C. Keller - Initial version
1089 : ! See https://github.com/geoschem/hemco for complete history
1090 : !EOP
1091 : !------------------------------------------------------------------------------
1092 : !BOC
1093 : TYPE(MyInst), POINTER :: TmpInst
1094 : INTEGER :: nnInst
1095 :
1096 : !=================================================================
1097 : ! InstCreate begins here!
1098 : !=================================================================
1099 :
1100 : ! ----------------------------------------------------------------
1101 : ! Generic instance initialization
1102 : ! ----------------------------------------------------------------
1103 :
1104 : ! Initialize
1105 0 : Inst => NULL()
1106 :
1107 : ! Get number of already existing instances
1108 0 : TmpInst => AllInst
1109 0 : nnInst = 0
1110 0 : DO WHILE ( ASSOCIATED(TmpInst) )
1111 0 : nnInst = nnInst + 1
1112 0 : TmpInst => TmpInst%NextInst
1113 : END DO
1114 :
1115 : ! Create new instance
1116 0 : ALLOCATE(Inst)
1117 0 : Inst%Instance = nnInst + 1
1118 0 : Inst%ExtNr = ExtNr
1119 :
1120 : ! Attach to instance list
1121 0 : Inst%NextInst => AllInst
1122 0 : AllInst => Inst
1123 :
1124 : ! Update output instance
1125 0 : Instance = Inst%Instance
1126 :
1127 : ! ----------------------------------------------------------------
1128 : ! Type specific initialization statements follow below
1129 : ! ----------------------------------------------------------------
1130 :
1131 : ! Return w/ success
1132 0 : RC = HCO_SUCCESS
1133 :
1134 0 : END SUBROUTINE InstCreate
1135 : !EOC
1136 : !------------------------------------------------------------------------------
1137 : ! Harmonized Emissions Component (HEMCO) !
1138 : !------------------------------------------------------------------------------
1139 : !BOP
1140 : !BOP
1141 : !
1142 : ! !IROUTINE: InstRemove
1143 : !
1144 : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
1145 : !\\
1146 : !\\
1147 : ! !INTERFACE:
1148 : !
1149 0 : SUBROUTINE InstRemove ( Instance )
1150 : !
1151 : ! !INPUT PARAMETERS:
1152 : !
1153 : INTEGER :: Instance
1154 : !
1155 : ! !REVISION HISTORY:
1156 : ! 18 Feb 2016 - C. Keller - Initial version
1157 : ! See https://github.com/geoschem/hemco for complete history
1158 : !EOP
1159 : !------------------------------------------------------------------------------
1160 : !BOC
1161 : INTEGER :: RC
1162 : TYPE(MyInst), POINTER :: PrevInst
1163 : TYPE(MyInst), POINTER :: Inst
1164 :
1165 : !=================================================================
1166 : ! InstRemove begins here!
1167 : !=================================================================
1168 :
1169 : ! Init
1170 0 : PrevInst => NULL()
1171 0 : Inst => NULL()
1172 :
1173 : !=================================================================
1174 : ! Finalize all instances
1175 : !=================================================================
1176 :
1177 : ! Get instance. Also archive previous instance.
1178 0 : CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
1179 :
1180 : ! Instance-specific deallocation
1181 0 : IF ( ASSOCIATED( Inst ) ) THEN
1182 :
1183 : !---------------------------------------------------------------------
1184 : ! Deallocate fields of Inst before popping Inst off the list
1185 : ! in order to avoid memory leaks (Bob Yantosca, 17 Aug 2020)
1186 : !---------------------------------------------------------------------
1187 0 : IF ( ASSOCIATED( Inst%GFED_SAVA ) ) THEN
1188 0 : DEALLOCATE( Inst%GFED_SAVA )
1189 : ENDIF
1190 0 : Inst%GFED_SAVA => NULL()
1191 :
1192 0 : IF ( ASSOCIATED( Inst%GFED_BORF ) ) THEN
1193 0 : DEALLOCATE( Inst%GFED_BORF )
1194 : ENDIF
1195 0 : Inst%GFED_BORF => NULL()
1196 :
1197 0 : IF ( ASSOCIATED( Inst%GFED_TEMP ) ) THEN
1198 0 : DEALLOCATE( Inst%GFED_TEMP )
1199 : ENDIF
1200 0 : Inst%GFED_TEMP => NULL()
1201 :
1202 0 : IF ( ASSOCIATED( Inst%GFED_DEFO ) ) THEN
1203 0 : DEALLOCATE( Inst%GFED_DEFO )
1204 : ENDIF
1205 0 : Inst%GFED_DEFO => NULL()
1206 :
1207 0 : IF ( ASSOCIATED( Inst%GFED_PEAT ) ) THEN
1208 0 : DEALLOCATE( Inst%GFED_PEAT )
1209 : ENDIF
1210 0 : Inst%GFED_PEAT => NULL()
1211 :
1212 0 : IF ( ASSOCIATED( Inst%GFED_AGRI ) ) THEN
1213 0 : DEALLOCATE( Inst%GFED_AGRI )
1214 : ENDIF
1215 0 : Inst%GFED_AGRI => NULL()
1216 :
1217 0 : IF ( ASSOCIATED( Inst%DAYSCAL ) ) THEN
1218 0 : DEALLOCATE( Inst%DAYSCAL )
1219 : ENDIF
1220 0 : Inst%DAYSCAL => NULL()
1221 :
1222 0 : IF ( ASSOCIATED( Inst%HRSCAL ) ) THEN
1223 0 : DEALLOCATE( Inst%HRSCAL )
1224 : ENDIF
1225 0 : Inst%HRSCAL => NULL()
1226 :
1227 0 : IF ( ASSOCIATED( Inst%GFED4_EMFAC ) ) THEN
1228 0 : DEALLOCATE( Inst%GFED4_EMFAC )
1229 : ENDIF
1230 0 : Inst%GFED4_EMFAC => NULL()
1231 0 : Inst%GFED_EMFAC => NULL() ! Points to GFED4_EMFAC
1232 :
1233 0 : IF ( ASSOCIATED( Inst%GfedIDs ) ) THEN
1234 0 : DEALLOCATE( Inst%GfedIDs )
1235 : ENDIF
1236 0 : Inst%GfedIDs => NULL()
1237 :
1238 0 : IF ( ASSOCIATED( Inst%HcoIDs ) ) THEN
1239 0 : DEALLOCATE( Inst%HcoIDs )
1240 : ENDIF
1241 0 : Inst%HcoIDs => NULL()
1242 :
1243 0 : IF ( ASSOCIATED( Inst%SpcNames ) ) THEN
1244 0 : DEALLOCATE( Inst%SpcNames )
1245 : ENDIF
1246 0 : Inst%SpcNames => NULL()
1247 :
1248 0 : IF ( ASSOCIATED( Inst%SpcScal ) ) THEN
1249 0 : DEALLOCATE( Inst%SpcScal )
1250 : ENDIF
1251 0 : Inst%SpcScal => NULL()
1252 :
1253 0 : IF ( ASSOCIATED( Inst%SpcScalFldNme ) ) THEN
1254 0 : DEALLOCATE( Inst%SpcScalFldNme )
1255 : ENDIF
1256 0 : Inst%SpcScalFldNme => NULL()
1257 :
1258 : !---------------------------------------------------------------------
1259 : ! Pop off instance from list
1260 : !---------------------------------------------------------------------
1261 0 : IF ( ASSOCIATED( PrevInst ) ) THEN
1262 0 : PrevInst%NextInst => Inst%NextInst
1263 : ELSE
1264 0 : AllInst => Inst%NextInst
1265 : ENDIF
1266 0 : DEALLOCATE( Inst )
1267 : ENDIF
1268 :
1269 : ! Free pointers before exiting
1270 0 : PrevInst => NULL()
1271 0 : Inst => NULL()
1272 :
1273 0 : END SUBROUTINE InstRemove
1274 : !EOC
1275 0 : END MODULE HCOX_GFED_MOD
|
