Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_state_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCO\_State\_Mod contains definitions and sub-
9 : ! routines for the HEMCO state derived type. The HEMCO state object
10 : ! (HcoState) contains all information related to the HEMCO run, such
11 : ! as the HEMCO clock, information on the emission grid and the data
12 : ! fields to be read, details on all used species, various physical
13 : ! constants, etc.
14 : ! It also contains the final assembled 3D flux and 2D deposition
15 : ! arrays (to be passed to the overlaying model) and a pointer to the
16 : ! HEMCO configuration object (Config). The latter contains error and
17 : ! traceback information and holds the data fields (in the data list
18 : ! ConfigList).
19 : !\\
20 : !\\
21 : ! The HEMCO state object (typically called HcoState) for a given HEMCO
22 : ! run must be defined on the HEMCO-model interface level (subroutine
23 : ! HcoState\_Init).
24 : !\\
25 : !\\
26 : ! !INTERFACE:
27 : !
28 : MODULE HCO_State_Mod
29 : !
30 : ! USES:
31 : !
32 : USE HCO_Types_Mod
33 : USE HCO_Error_Mod
34 : USE HCO_Arr_Mod
35 : USE HCO_VertGrid_Mod
36 :
37 : #if defined(ESMF_)
38 : USE ESMF
39 : #endif
40 :
41 : IMPLICIT NONE
42 : PRIVATE
43 : !
44 : ! !PUBLIC MEMBER FUNCTIONS:
45 : !
46 : PUBLIC :: HcoState_Init
47 : PUBLIC :: HcoState_Final
48 : PUBLIC :: HCO_GetModSpcID
49 : PUBLIC :: HCO_GetHcoID
50 : PUBLIC :: HCO_GetExtHcoID
51 :
52 : !=========================================================================
53 : ! HCO_State: Main HEMCO State derived type
54 : !=========================================================================
55 : TYPE, PUBLIC :: HCO_State
56 :
57 : !%%%%% Species information %%%%%
58 : LOGICAL :: amIRoot ! Is this the root CPU?
59 :
60 : !%%%%% Species information %%%%%
61 : INTEGER :: nSpc ! # of species
62 : TYPE(HcoSpc), POINTER :: Spc(:) ! list of species
63 :
64 : !%%%%% Emission grid information %%%%%
65 : INTEGER :: NX ! # of x-pts (lons) on this CPU
66 : INTEGER :: NY ! # of y-pts (lats) on this CPU
67 : INTEGER :: NZ ! # of z-pts (levs) on this CPU
68 : TYPE(HcoGrid), POINTER :: Grid ! HEMCO grid information
69 : TYPE(HcoClock), POINTER :: Clock ! HEMCO clock
70 :
71 : ! Data array
72 : TYPE(Arr3D_HP), POINTER :: Buffer3D ! Placeholder to store temporary
73 : ! 3D array. Emissions will be
74 : ! written into this array if
75 : ! option FillBuffer = .TRUE.
76 :
77 : !%%%%% Constants and timesteps %%%%%
78 : TYPE(HcoPhys), POINTER :: Phys ! Physical constants
79 : REAL(sp) :: TS_EMIS ! Emission timestep [s]
80 : REAL(sp) :: TS_CHEM ! Chemical timestep [s]
81 : REAL(sp) :: TS_DYN ! Dynamic timestep [s]
82 :
83 : !%%%%% Aerosol quantities %%%%%
84 : INTEGER :: nDust ! # of dust species
85 : LOGICAL :: MarinePOA ! MUse marine organic aerosols?
86 : TYPE(HcoMicroPhys), POINTER :: MicroPhys ! Microphysics settings
87 :
88 : !%%%%% Run time options %%%%%
89 : TYPE(HcoOpt), POINTER :: Options ! HEMCO run options
90 :
91 : !%%%%% ReadLists %%%%%
92 : TYPE(RdList), POINTER :: ReadLists
93 : LOGICAL :: SetReadListCalled
94 :
95 : !%%%%% Emissions linked list %%%%%%
96 : TYPE(ListCont), POINTER :: EmisList
97 : INTEGER :: nnEmisCont = 0 ! # of container in EmisList
98 :
99 : !%%%%% Data container indeces %%%%%
100 : ! Element i of cIDList will point to data-container with container
101 : ! ID i (e.g. cIDList(3) points to data-container with cID = 3).
102 : TYPE(cIDListPnt), POINTER :: cIDList(:) => NULL()
103 :
104 : ! # of defined data containers. Will be automatically increased
105 : ! by one when creating a new data container (DataCont_Init)
106 : INTEGER :: nnDataCont = 0
107 :
108 : ! Define object based on TimeIdxCollection derived type
109 : TYPE(TimeIdxCollection), POINTER :: AlltIDx => NULL()
110 :
111 : ! HEMCO configuration object
112 : TYPE(ConfigObj), POINTER :: Config => NULL()
113 :
114 : ! Pointer to beginning of collections linked list
115 : TYPE(DiagnBundle), POINTER :: Diagn => NULL()
116 :
117 : !%%%%% ESMF objects
118 : #if defined(ESMF_)
119 : TYPE(ESMF_GridComp), POINTER :: GridComp
120 : TYPE(ESMF_State), POINTER :: IMPORT
121 : TYPE(ESMF_State), POINTER :: EXPORT
122 : #endif
123 : #ifdef ADJOINT
124 : LOGICAL :: isAdjoint
125 : #endif
126 : END TYPE HCO_State
127 : !
128 : ! !REVISION HISTORY:
129 : ! 20 Aug 2013 - C. Keller - Initial version, adapted from state_chm_mod.F90
130 : ! See https://github.com/geoschem/hemco for complete history
131 : !EOP
132 : !------------------------------------------------------------------------------
133 : !BOC
134 : CONTAINS
135 : !EOC
136 : !------------------------------------------------------------------------------
137 : ! Harmonized Emissions Component (HEMCO) !
138 : !------------------------------------------------------------------------------
139 : !BOP
140 : !
141 : ! !IROUTINE: HcoState_Init
142 : !
143 : ! !DESCRIPTION: Routine HcoState\_Init initializes the HEMCO state object.
144 : ! This initializes (nullifies) all pointers and sets all HEMCO settings
145 : ! and options to default values.
146 : ! The here defined pointers are defined/connected at the HEMCO-model
147 : ! interface level.
148 : ! The passed HEMCO configuration object (HcoConfig) must be defined,
149 : ! e.g. this subroutine must be called after having read (at least
150 : ! stage 1 of) the HEMCO configuration file (Config\_ReadFile in
151 : ! hco\_config\_mod.F90).
152 : !\\
153 : !\\
154 : ! !INTERFACE:
155 : !
156 0 : SUBROUTINE HcoState_Init( HcoState, HcoConfig, nSpecies, RC )
157 : !
158 : ! !USES:
159 : !
160 : USE HCO_EXTLIST_MOD, ONLY : GetExtOpt, CoreNr
161 : USE HCO_UNIT_MOD, ONLY : HCO_UnitTolerance
162 : !
163 : ! !INPUT PARAMETERS:
164 : !
165 : INTEGER, INTENT(IN) :: nSpecies ! # HEMCO species
166 : !
167 : ! !INPUT/OUTPUT PARAMETERS:
168 : !
169 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO State object
170 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO Config object
171 : INTEGER, INTENT(INOUT) :: RC ! Return code
172 : !
173 : ! !REVISION HISTORY:
174 : ! 20 Aug 2013 - C. Keller - Adapted from gigc_state_chm_mod.F90
175 : ! See https://github.com/geoschem/hemco for complete history
176 : !EOP
177 : !------------------------------------------------------------------------------
178 : !BOC
179 : !
180 : ! !LOCAL VARIABLES:
181 : !
182 : INTEGER :: I, AS
183 : INTEGER :: UnitTolerance
184 : LOGICAL :: FOUND
185 : CHARACTER(LEN=255) :: MSG, LOC
186 :
187 : !=====================================================================
188 : ! HcoState_Init begins here!
189 : !=====================================================================
190 0 : LOC = 'HcoState_Init (HCO_STATE_MOD.F90)'
191 :
192 : ! For error handling
193 0 : CALL HCO_ENTER (HcoConfig%Err, LOC, RC )
194 0 : IF ( RC /= HCO_SUCCESS ) THEN
195 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
196 0 : RETURN
197 : ENDIF
198 :
199 : !=====================================================================
200 : ! Allocate emission field vectors
201 : !=====================================================================
202 :
203 : ! Check if already allocated
204 0 : IF ( ASSOCIATED(HcoState)) THEN
205 0 : CALL HCO_WARNING( HcoConfig%Err,'HcoState already allocated!', RC )
206 0 : RETURN
207 : ENDIF
208 0 : ALLOCATE ( HcoState )
209 :
210 : ! Is this the Root CPU?
211 0 : HcoState%amIRoot = HcoConfig%amIRoot
212 :
213 : ! Initialize vector w/ species information
214 0 : HcoState%nSpc = nSpecies
215 0 : IF ( nSpecies > 0 ) THEN
216 0 : ALLOCATE ( HcoState%Spc (nSpecies ), STAT=AS )
217 0 : IF ( AS /= 0 ) THEN
218 0 : CALL HCO_ERROR( 'Species', RC )
219 0 : RETURN
220 : ENDIF
221 : ENDIF
222 :
223 : ! Initalize species information. The effective values for species
224 : ! names, model IDs, etc. are set in the HEMCO-model interface
225 : ! routine.
226 0 : DO I = 1, nSpecies
227 0 : HcoState%Spc(I)%HcoID = I
228 0 : HcoState%Spc(I)%ModID = -1
229 0 : HcoState%Spc(I)%SpcName = ''
230 0 : HcoState%Spc(I)%MW_g = 0.0_dp
231 0 : HcoState%Spc(I)%HenryK0 = 0.0_dp
232 0 : HcoState%Spc(I)%HenryCR = 0.0_dp
233 0 : HcoState%Spc(I)%HenryPKA = 0.0_dp
234 :
235 : ! Initialize data arrays. Pass dimension zero, which
236 : ! will just create a pointer to the data array (XX%Val).
237 : ! Will specify the arrays in HEMCO-model interface routine
238 : ! or when writing to them for the first time.
239 0 : CALL Hco_ArrInit( HcoState%Spc(I)%Emis, 0, 0, 0, RC )
240 0 : IF ( RC /= HCO_SUCCESS ) THEN
241 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
242 0 : RETURN
243 : ENDIF
244 :
245 0 : CALL Hco_ArrInit( HcoState%Spc(I)%Conc, 0, 0, 0, RC )
246 0 : IF ( RC /= HCO_SUCCESS ) THEN
247 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
248 0 : RETURN
249 : ENDIF
250 :
251 0 : CALL Hco_ArrInit( HcoState%Spc(I)%Depv, 0, 0, RC )
252 0 : IF ( RC /= HCO_SUCCESS ) THEN
253 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
254 0 : RETURN
255 : ENDIF
256 : ENDDO !I
257 :
258 : !=====================================================================
259 : ! Initialize grid
260 : !=====================================================================
261 :
262 : ! Initialize grid dimensions.
263 0 : HcoState%NX = 0
264 0 : HcoState%NY = 0
265 0 : HcoState%NZ = 0
266 0 : ALLOCATE ( HcoState%Grid, STAT = AS )
267 : IF ( AS /= 0 ) THEN
268 0 : CALL HCO_ERROR( 'HEMCO grid', RC )
269 0 : RETURN
270 : ENDIF
271 :
272 : ! Initialize grid arrays.
273 0 : CALL HCO_ArrInit ( HcoState%Grid%XMID, 0, 0, RC )
274 0 : IF ( RC /= HCO_SUCCESS ) THEN
275 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
276 0 : RETURN
277 : ENDIF
278 0 : CALL HCO_ArrInit ( HcoState%Grid%YMID, 0, 0, RC )
279 0 : IF ( RC /= HCO_SUCCESS ) THEN
280 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
281 0 : RETURN
282 : ENDIF
283 0 : CALL HCO_ArrInit ( HcoState%Grid%XEDGE, 0, 0, RC )
284 0 : IF ( RC /= HCO_SUCCESS ) THEN
285 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
286 0 : RETURN
287 : ENDIF
288 0 : CALL HCO_ArrInit ( HcoState%Grid%YEDGE, 0, 0, RC )
289 0 : IF ( RC /= HCO_SUCCESS ) THEN
290 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
291 0 : RETURN
292 : ENDIF
293 0 : CALL HCO_ArrInit ( HcoState%Grid%PEDGE, 0, 0, 0, RC )
294 0 : IF ( RC /= HCO_SUCCESS ) THEN
295 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
296 0 : RETURN
297 : ENDIF
298 0 : CALL HCO_ArrInit ( HcoState%Grid%YSIN, 0, 0, RC )
299 0 : IF ( RC /= HCO_SUCCESS ) THEN
300 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
301 0 : RETURN
302 : ENDIF
303 0 : CALL HCO_ArrInit ( HcoState%Grid%AREA_M2, 0, 0, RC )
304 0 : IF ( RC /= HCO_SUCCESS ) THEN
305 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
306 0 : RETURN
307 : ENDIF
308 0 : CALL HCO_ArrInit ( HcoState%Grid%PBLHEIGHT, 0, 0, RC )
309 0 : IF ( RC /= HCO_SUCCESS ) THEN
310 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
311 0 : RETURN
312 : ENDIF
313 0 : CALL HCO_ArrInit ( HcoState%Grid%BXHEIGHT_M, 0, 0, 0, RC )
314 0 : IF ( RC /= HCO_SUCCESS ) THEN
315 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
316 0 : RETURN
317 : ENDIF
318 0 : CALL HCO_ArrInit ( HcoState%Grid%ZSFC, 0, 0, RC )
319 0 : IF ( RC /= HCO_SUCCESS ) THEN
320 0 : CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
321 0 : RETURN
322 : ENDIF
323 0 : CALL HCO_ArrInit ( HcoState%Grid%PSFC, 0, 0, RC )
324 0 : IF ( RC /= HCO_SUCCESS ) THEN
325 0 : CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC )
326 0 : RETURN
327 : ENDIF
328 :
329 : ! Initialize vertical grid
330 0 : HcoState%Grid%ZGRID => NULL()
331 0 : CALL HCO_VertGrid_Init( HcoState%Grid%ZGRID, RC )
332 0 : IF ( RC /= HCO_SUCCESS ) THEN
333 0 : CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC )
334 0 : RETURN
335 : ENDIF
336 :
337 : !=====================================================================
338 : ! Set misc. parameter
339 : !=====================================================================
340 :
341 : ! Physical constants (Source: NIST, 2014)
342 0 : ALLOCATE ( HcoState%Phys, STAT = AS )
343 : IF ( AS /= 0 ) THEN
344 0 : CALL HCO_ERROR( 'HEMCO physical constants', RC )
345 0 : RETURN
346 : ENDIF
347 0 : HcoState%Phys%Avgdr = 6.022140857e23_dp
348 0 : HcoState%Phys%PI = 3.14159265358979323_dp
349 0 : HcoState%Phys%PI_180 = HcoState%Phys%PI / 180.0_dp
350 0 : HcoState%Phys%Re = 6.3710072e+6_dp ! Was 6.375e6_dp
351 0 : HcoState%Phys%AIRMW = 28.9644_dp ! Was 28.97_dp
352 0 : HcoState%Phys%g0 = 9.80665_dp
353 0 : HcoState%Phys%Rd = 287.0_dp
354 0 : HcoState%Phys%Rdg0 = HcoState%Phys%Rd / HcoState%Phys%g0
355 0 : HcoState%Phys%RSTARG = 8.3144598_dp ! Was 8.31450_dp
356 :
357 : ! Timesteps
358 0 : HcoState%TS_EMIS = 0.0_sp
359 0 : HcoState%TS_CHEM = 0.0_sp
360 0 : HcoState%TS_DYN = 0.0_sp
361 :
362 : #ifdef ADJOINT
363 : HcoState%isAdjoint = .false.
364 : #endif
365 :
366 : ! Nullify temporary array. This array may be used as temporary
367 : ! place to write emissions into.
368 0 : HcoState%Buffer3D => NULL()
369 0 : CALL HCO_ArrInit( HcoState%Buffer3D, 0, 0, 0, RC )
370 0 : IF ( RC /= 0 ) RETURN
371 :
372 : ! Dust bins (set default to 4)
373 0 : HcoState%nDust = 4
374 :
375 : ! Turn off marine POA by default
376 0 : HcoState%MarinePOA = .FALSE.
377 :
378 : ! Aerosol options
379 0 : ALLOCATE ( HcoState%MicroPhys, STAT = AS )
380 : IF ( AS /= 0 ) THEN
381 0 : CALL HCO_ERROR( 'HEMCO aerosol microphysics options', RC )
382 0 : RETURN
383 : ENDIF
384 0 : HcoState%MicroPhys%nBins = 0
385 0 : HcoState%MicroPhys%nActiveModeBins = 0
386 0 : NULLIFY( HcoState%MicroPhys%BinBound )
387 :
388 : ! Default HEMCO options
389 : ! ==> execute HEMCO core; use all species, categories; not ESMF; not dryrun
390 0 : ALLOCATE( HcoState%Options )
391 0 : HcoState%Options%ExtNr = 0
392 0 : HcoState%Options%SpcMin = 1
393 0 : HcoState%Options%SpcMax = -1
394 0 : HcoState%Options%CatMin = 1
395 0 : HcoState%Options%CatMax = -1
396 0 : HcoState%Options%AutoFillDiagn = .TRUE.
397 0 : HcoState%Options%HcoWritesDiagn = .FALSE.
398 0 : HcoState%Options%FillBuffer = .FALSE.
399 0 : HcoState%Options%isESMF = .FALSE.
400 0 : HcoState%Options%isDryRun = .FALSE.
401 :
402 : ! SetReadList has not been called yet
403 0 : HcoState%SetReadListCalled = .FALSE.
404 :
405 : ! Get negative flag value from configuration file. If not found, set to 0.
406 : CALL GetExtOpt ( HcoConfig, CoreNr, 'Negative values', &
407 0 : OptValInt=HcoState%Options%NegFlag, Found=Found, RC=RC )
408 0 : IF ( RC /= HCO_SUCCESS ) THEN
409 0 : CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC )
410 0 : RETURN
411 : ENDIF
412 0 : IF ( .NOT. Found ) HcoState%Options%NegFlag = 0
413 :
414 : ! Get PBL_DRYDEP flag from configuration file. If not found, set to default
415 : ! value of false.
416 : CALL GetExtOpt ( HcoConfig, CoreNr, 'PBL dry deposition', &
417 0 : OptValBool=HcoState%Options%PBL_DRYDEP, Found=Found, RC=RC )
418 0 : IF ( RC /= HCO_SUCCESS ) THEN
419 0 : CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC )
420 0 : RETURN
421 : ENDIF
422 0 : IF ( .NOT. Found ) HcoState%Options%PBL_DRYDEP = .FALSE.
423 :
424 : ! Apply uniform scale factors specified in HEMCO_Config.rc?
425 : CALL GetExtOpt ( HcoConfig, CoreNr, 'Scale emissions', &
426 0 : OptValBool=HcoState%Options%ScaleEmis, Found=Found, RC=RC )
427 0 : IF ( RC /= HCO_SUCCESS ) THEN
428 0 : CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC )
429 0 : RETURN
430 : ENDIF
431 0 : IF ( .NOT. Found ) HcoState%Options%ScaleEmis = .TRUE.
432 :
433 : ! Only shift hh/mm when applying time shift?
434 : CALL GetExtOpt ( HcoConfig, CoreNr, 'Cap time shift', &
435 : OptValBool=HcoState%Options%TimeShiftCap, &
436 0 : Found=Found, RC=RC )
437 0 : IF ( RC /= HCO_SUCCESS ) THEN
438 0 : CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC )
439 0 : RETURN
440 : ENDIF
441 0 : IF ( .NOT. Found ) HcoState%Options%TimeShiftCap = .FALSE.
442 :
443 : ! Get MaxDepExp from configuration file. If not found, set to default
444 : ! value of 20.
445 : CALL GetExtOpt ( HcoConfig, CoreNr, 'Maximum dep x ts', &
446 0 : OptValHp=HcoState%Options%MaxDepExp, Found=Found, RC=RC )
447 0 : IF ( RC /= HCO_SUCCESS ) THEN
448 0 : CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC )
449 0 : RETURN
450 : ENDIF
451 0 : IF ( .NOT. Found ) HcoState%Options%MaxDepExp = 20.0_hp
452 :
453 : ! Get binary mask flag from configuration file. If not found, set to default
454 : ! value of TRUE.
455 : CALL GetExtOpt ( HcoConfig, CoreNr, 'Mask fractions', &
456 0 : OptValBool=HcoState%Options%MaskFractions, Found=Found, RC=RC )
457 0 : IF ( RC /= HCO_SUCCESS ) THEN
458 0 : CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC )
459 0 : RETURN
460 : ENDIF
461 0 : IF ( .NOT. Found ) HcoState%Options%MaskFractions = .FALSE.
462 :
463 : CALL GetExtOpt ( HcoConfig, CoreNr, 'ConfigField to diagnostics', &
464 0 : OptValBool=HcoState%Options%Field2Diagn, Found=Found, RC=RC )
465 0 : IF ( RC /= HCO_SUCCESS ) THEN
466 0 : CALL HCO_ERROR( 'ERROR 22', RC, THISLOC=LOC )
467 0 : RETURN
468 : ENDIF
469 0 : IF ( .NOT. Found ) HcoState%Options%Field2Diagn = .FALSE.
470 :
471 : CALL GetExtOpt ( HcoConfig, CoreNr, 'Vertical weights', &
472 0 : OptValBool=HcoState%Options%VertWeight, Found=Found, RC=RC )
473 0 : IF ( RC /= HCO_SUCCESS ) THEN
474 0 : CALL HCO_ERROR( 'ERROR 23', RC, THISLOC=LOC )
475 0 : RETURN
476 : ENDIF
477 0 : IF ( .NOT. Found ) HcoState%Options%VertWeight = .TRUE.
478 :
479 : ! Make sure ESMF pointers are not dangling
480 : #if defined(ESMF_)
481 : HcoState%GridComp => NULL()
482 : HcoState%IMPORT => NULL()
483 : HcoState%EXPORT => NULL()
484 : #endif
485 :
486 : ! Read unit tolerance
487 0 : UnitTolerance = HCO_UnitTolerance( HcoConfig )
488 :
489 : ! Connect to config object
490 0 : HcoState%Config => HcoConfig
491 :
492 : ! Make sure pointers are not dangling
493 0 : HcoState%Diagn => NULL()
494 0 : HcoState%EmisList => NULL()
495 0 : HcoState%ReadLists => NULL()
496 0 : HcoState%Clock => NULL()
497 0 : HcoState%cIDList => NULL()
498 0 : HcoState%AlltIDx => NULL()
499 :
500 : ! Verbose mode
501 0 : IF ( HCO_IsVerb( HcoConfig%Err ) ) THEN
502 0 : WRITE(MSG,'(A68)') 'Initialized HEMCO state. Will use the following settings:'
503 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
504 0 : WRITE(MSG,'(A33,I2)') 'Unit tolerance : ', UnitTolerance
505 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
506 0 : WRITE(MSG,'(A33,I2)') 'Negative values : ', HcoState%Options%NegFlag
507 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
508 0 : WRITE(MSG,'(A33,L2)') 'Mask fractions : ', HcoState%Options%MaskFractions
509 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
510 0 : WRITE(MSG,'(A33,L2)') 'Do drydep over entire PBL : ', HcoState%Options%PBL_DRYDEP
511 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
512 0 : WRITE(MSG,'(A33,F6.2)') 'Upper limit for deposition x ts: ', HcoState%Options%MaxDepExp
513 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
514 0 : WRITE(MSG,'(A33,L2)') 'Scale emissions : ', HcoState%Options%ScaleEmis
515 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
516 0 : WRITE(MSG,'(A33,L2)') 'Cap time shift : ', HcoState%Options%TimeShiftCap
517 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
518 : ENDIF
519 :
520 : ! Leave w/ success
521 0 : CALL HCO_LEAVE ( HcoConfig%Err, RC )
522 :
523 : END SUBROUTINE HcoState_Init
524 : !EOC
525 : !------------------------------------------------------------------------------
526 : ! Harmonized Emissions Component (HEMCO) !
527 : !------------------------------------------------------------------------------
528 : !BOP
529 : !
530 : ! !IROUTINE: HcoState_Final
531 : !
532 : ! !DESCRIPTION: Routine HcoState\_CLEANUP cleans up HcoState.
533 : !\\
534 : !\\
535 : ! !INTERFACE:
536 : !
537 0 : SUBROUTINE HcoState_Final( HcoState )
538 : !
539 : ! !INPUT/OUTPUT PARAMETERS:
540 : !
541 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO State object
542 : !
543 : ! !REVISION HISTORY:
544 : ! 20 Aug 2013 - C. Keller - Adapted from gigc_state_chm_mod.F90
545 : ! See https://github.com/geoschem/hemco for complete history
546 : !EOP
547 : !------------------------------------------------------------------------------
548 : !BOC
549 : !
550 : ! !LOCAL VARIABLES:
551 : !
552 : INTEGER :: I
553 :
554 : !=====================================================================
555 : ! HcoState_Final begins here!
556 : !=====================================================================
557 :
558 : ! Deallocate buffer array
559 0 : CALL HCO_ArrCleanup ( HcoState%Buffer3D )
560 :
561 : ! Deallocate all species arrays
562 0 : IF ( ASSOCIATED ( HcoState%Spc ) .and. HcoState%nSpc > 0 ) THEN
563 0 : DO I = 1, HcoState%nSpc
564 0 : CALL HCO_ArrCleanup( HcoState%Spc(I)%Emis )
565 0 : CALL HCO_ArrCleanup( HcoState%Spc(I)%Conc )
566 0 : CALL HCO_ArrCleanup( HcoState%Spc(I)%Depv )
567 : ENDDO
568 0 : DEALLOCATE( HcoState%Spc )
569 : ENDIF
570 :
571 : ! Deallocate grid information
572 0 : IF ( ASSOCIATED ( HcoState%Grid) ) THEN
573 0 : CALL HCO_VertGrid_Cleanup( HcoState%Grid%ZGRID )
574 0 : CALL HCO_ArrCleanup( HcoState%Grid%XMID )
575 0 : CALL HCO_ArrCleanup( HcoState%Grid%YMID )
576 0 : CALL HCO_ArrCleanup( HcoState%Grid%XEDGE )
577 0 : CALL HCO_ArrCleanup( HcoState%Grid%YEDGE )
578 0 : CALL HCO_ArrCleanup( HcoState%Grid%PEDGE )
579 0 : CALL HCO_ArrCleanup( HcoState%Grid%YSIN )
580 0 : CALL HCO_ArrCleanup( HcoState%Grid%AREA_M2 )
581 0 : CALL HCO_ArrCleanup( HcoState%Grid%PBLHEIGHT )
582 0 : CALL HCO_ArrCleanup( HcoState%Grid%BXHEIGHT_M )
583 0 : CALL HCO_ArrCleanup( HcoState%Grid%ZSFC )
584 0 : CALL HCO_ArrCleanup( HcoState%Grid%PSFC )
585 0 : DEALLOCATE(HcoState%Grid)
586 : ENDIF
587 :
588 : ! Deallocate microphysics information
589 0 : IF ( ASSOCIATED( HcoState%MicroPhys ) ) THEN
590 0 : IF ( HcoState%MicroPhys%nBins > 0 ) THEN
591 0 : IF ( ASSOCIATED( HcoState%MicroPhys%BinBound ) ) THEN
592 0 : NULLIFY( HcoState%MicroPhys%BinBound )
593 : ENDIF
594 0 : DEALLOCATE( HcoState%MicroPhys )
595 : ENDIF
596 : ENDIf
597 :
598 : ! Cleanup various types
599 0 : IF ( ASSOCIATED ( HcoState%Options ) ) DEALLOCATE ( HcoState%Options )
600 0 : IF ( ASSOCIATED ( HcoState%Phys ) ) DEALLOCATE ( HcoState%Phys )
601 :
602 : #if defined(ESMF_)
603 : HcoState%GridComp => NULL()
604 : HcoState%IMPORT => NULL()
605 : HcoState%EXPORT => NULL()
606 : #endif
607 :
608 0 : END SUBROUTINE HcoState_Final
609 : !EOC
610 : !------------------------------------------------------------------------------
611 : ! Harmonized Emissions Component (HEMCO) !
612 : !------------------------------------------------------------------------------
613 : !BOP
614 : !
615 : ! !IROUTINE: HCO_GetModSpcId
616 : !
617 : ! !DESCRIPTION: Function HCO\_GetModSpcId returns the model species index
618 : ! of a species by name. Returns -1 if given species is not found, 0 if
619 : ! name corresponds to the HEMCO wildcard character.
620 : !\\
621 : !\\
622 : ! !INTERFACE:
623 : !
624 0 : FUNCTION HCO_GetModSpcID( name, HcoState ) RESULT( Indx )
625 : !
626 : ! !USES:
627 : !
628 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
629 : !
630 : ! !INPUT PARAMETERS:
631 : !
632 : CHARACTER(LEN=*), INTENT(IN) :: name ! Species name
633 : !
634 : ! !INPUT/OUTPUT PARAMETERS:
635 : !
636 : TYPE(HCO_State), INTENT(INOUT) :: HcoState ! HEMCO State
637 : !
638 : ! !RETURN VALUE:
639 : !
640 : INTEGER :: Indx ! Index of this species
641 : !
642 : ! !REVISION HISTORY:
643 : ! 20 Aug 2013 - C. Keller - Adapted from gigc_state_chm_mod.F90
644 : ! See https://github.com/geoschem/hemco for complete history
645 : !EOP
646 : !------------------------------------------------------------------------------
647 : !BOC
648 : !
649 : ! !LOCAL VARIABLES:
650 : !
651 : INTEGER :: N
652 :
653 : ! Default
654 0 : Indx = -1
655 :
656 : ! Return 0 if wildcard character
657 0 : IF ( TRIM(name) == TRIM(HCO_GetOpt(HcoState%Config%ExtList,'Wildcard')) ) THEN
658 0 : Indx = 0
659 0 : RETURN
660 : ENDIF
661 :
662 : ! Loop over all species names
663 0 : DO N = 1, HcoState%nSpc
664 :
665 : ! Return the index of the sought-for species
666 0 : IF( TRIM( name ) == TRIM( HcoState%Spc(N)%SpcName ) ) THEN
667 0 : Indx = HcoState%Spc(N)%ModID
668 0 : EXIT
669 : ENDIF
670 :
671 : ENDDO
672 :
673 : END FUNCTION HCO_GetModSpcID
674 : !EOC
675 : !------------------------------------------------------------------------------
676 : ! Harmonized Emissions Component (HEMCO) !
677 : !------------------------------------------------------------------------------
678 : !BOP
679 : !
680 : ! !IROUTINE: HCO_GetHcoId
681 : !
682 : ! !DESCRIPTION: Function HCO\_GetHcoIdHCO returns the HEMCO species index
683 : ! of a species by name. Returns -1 if given species is not found, 0 if
684 : ! name corresponds to the HEMCO wildcard character.
685 : !\\
686 : !\\
687 : ! !INTERFACE:
688 : !
689 0 : FUNCTION HCO_GetHcoID( name, HcoState ) RESULT( Indx )
690 : !
691 : ! !USES:
692 : !
693 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
694 : !
695 : ! !INPUT PARAMETERS:
696 : !
697 : CHARACTER(LEN=*), INTENT(IN) :: name ! Species name
698 : TYPE(HCO_State), INTENT(INOUT) :: HcoState ! HEMCO State
699 : !
700 : ! !RETURN VALUE:
701 : !
702 : INTEGER :: Indx ! Index of this species
703 : !
704 : ! !REVISION HISTORY:
705 : ! 20 Aug 2013 - C. Keller - Adapted from gigc_state_chm_mod.F90
706 : ! See https://github.com/geoschem/hemco for complete history
707 : !EOP
708 : !------------------------------------------------------------------------------
709 : !BOC
710 : !
711 : ! !LOCAL VARIABLES:
712 : !
713 : INTEGER :: N
714 :
715 : ! Default
716 0 : Indx = -1
717 :
718 : ! Return 0 if wildcard character
719 0 : IF ( TRIM(name) == TRIM(HCO_GetOpt(HcoState%Config%ExtList,'Wildcard')) ) THEN
720 0 : Indx = 0
721 0 : RETURN
722 : ENDIF
723 :
724 : ! Loop over all species names
725 0 : DO N = 1, HcoState%nSpc
726 :
727 : ! Return the index of the sought-for species
728 0 : IF( TRIM( name ) == TRIM( HcoState%Spc(N)%SpcName ) ) THEN
729 0 : Indx = N
730 0 : EXIT
731 : ENDIF
732 : ENDDO
733 :
734 : END FUNCTION HCO_GetHcoID
735 : !EOC
736 : !------------------------------------------------------------------------------
737 : ! Harmonized Emissions Component (HEMCO) !
738 : !------------------------------------------------------------------------------
739 : !BOP
740 : !
741 : ! !ROUTINE: HCO_GetExtHcoID
742 : !
743 : ! !DESCRIPTION: Subroutine HCO\_GetExtHcoID returns the HEMCO species IDs
744 : ! and names for all species assigned to the given extension (identified by
745 : ! its extension number).
746 : !\\
747 : !\\
748 : ! !INTERFACE:
749 : !
750 0 : SUBROUTINE HCO_GetExtHcoID( HcoState, ExtNr, HcoIDs, &
751 : SpcNames, nSpc, RC )
752 : !
753 : ! !USES:
754 : !
755 : USE HCO_CHARPAK_MOD, ONLY : STRSPLIT
756 : USE HCO_EXTLIST_MOD, ONLY : GetExtSpcStr
757 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
758 : !
759 : ! !INPUT PARAMETERS:
760 : !
761 : TYPE(HCO_State), POINTER :: HcoState
762 : INTEGER, INTENT(IN ) :: ExtNr ! Extension #
763 : !
764 : ! !OUTPUT PARAMETERS:
765 : !
766 : INTEGER, ALLOCATABLE, INTENT( OUT) :: HcoIDs(:) ! Species IDs
767 : !
768 : ! !INPUT/OUTPUT PARAMETERS:
769 : !
770 : CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: SpcNames(:) ! Species names
771 : INTEGER, INTENT(INOUT) :: nSpc ! # of species
772 : INTEGER, INTENT(INOUT) :: RC ! Success/fail
773 : !
774 : ! !REVISION HISTORY:
775 : ! 10 Jan 2014 - C. Keller: Initialization (update)
776 : ! See https://github.com/geoschem/hemco for complete history
777 : !EOP
778 : !------------------------------------------------------------------------------
779 : !BOC
780 : !
781 : ! !LOCAL VARIABLES:
782 : !
783 : INTEGER :: I, AS
784 : CHARACTER(LEN=255) :: MSG, LOC
785 : CHARACTER(LEN=2047) :: SpcStr, SUBSTR(255)
786 : CHARACTER(LEN=2047) :: TmpStr
787 :
788 : !======================================================================
789 : ! HCO_GetExtHcoID begins here
790 : !======================================================================
791 :
792 : ! Enter
793 0 : LOC = 'HCO_GetExtHcoID (hco_state_mod.F90)'
794 :
795 : ! Get all species names belonging to extension Nr. ExtNr
796 0 : CALL GetExtSpcStr( HcoState%Config, ExtNr, SpcStr, RC )
797 0 : IF ( RC /= HCO_SUCCESS ) THEN
798 0 : CALL HCO_ERROR( 'ERROR 24', RC, THISLOC=LOC )
799 0 : RETURN
800 : ENDIF
801 :
802 : ! Split character into species string.
803 0 : CALL STRSPLIT( SpcStr, HCO_GetOpt(HcoState%Config%ExtList,'Separator'), SUBSTR, nSpc )
804 :
805 : ! nothing to do if there are no species
806 0 : IF ( nSpc == 0 ) RETURN
807 :
808 : ! Allocate arrays
809 0 : IF ( ALLOCATED(HcoIDs ) ) DEALLOCATE(HcoIDs )
810 0 : IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames)
811 0 : ALLOCATE(HcoIDs(nSpc), SpcNames(nSpc), STAT=AS)
812 : #if defined( MODEL_GEOS )
813 : SpcNames(:) = ''
814 : HcoIDs(:) = -1
815 : #endif
816 0 : IF ( AS/=0 ) THEN
817 0 : CALL HCO_ERROR('HcoIDs allocation error', RC, THISLOC=LOC)
818 0 : RETURN
819 : ENDIF
820 :
821 : ! Extract species information
822 0 : DO I = 1, nSpc
823 : !---------------------------------------------------------------------
824 : ! Prior to 6/26/18:
825 : ! This code can cause issues with certain compiler versions,
826 : ! so let's rewrite it slightly (bmy, 6/26/18)
827 : !SpcNames(I) = SUBSTR(I)
828 : !HcoIDs(I) = HCO_GetHcoID( TRIM(SpcNames(I)), HcoState )
829 : !---------------------------------------------------------------------
830 :
831 : ! Rewrite this code to be a little more friendly to compilers with
832 : ! strict string-parsing syntax, such as ifort 17. ALSO NOTE: We don't
833 : ! necessarily have to do the TRIM in the call to HCO_GetHcoID, because
834 : ! the species name will be TRIMmed internally. We have noticed that
835 : ! some compilers don't like taking the TRIM of an array element as
836 : ! an argument to a function call. (bmy, 6/26/18)
837 0 : TmpStr = SubStr(I)
838 0 : SpcNames(I) = TRIM( TmpStr )
839 0 : HcoIDs(I) = HCO_GetHcoID( TmpStr, HcoState )
840 : ENDDO
841 :
842 : ! Return w/ success
843 0 : RC = HCO_SUCCESS
844 :
845 0 : END SUBROUTINE HCO_GetExtHcoID
846 : !EOC
847 0 : END MODULE HCO_STATE_MOD
|
