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