Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_diagn_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCO\_Diagn\_mod contains routines and
9 : ! variables to handle the HEMCO diagnostics. The HEMCO diagnostics
10 : ! consist of a flexible suite of diagnostics container organized
11 : ! in list DiagnList. Each diagnostics container contains information
12 : ! about the diagnostics type (extension number, emission category /
13 : ! hierarchy, species ID), data structure (Scalar, 2D, 3D), and output
14 : ! units (area, time).
15 : !\\
16 : !\\
17 : ! The HEMCO diagnostics module can store multiple, independent
18 : ! diagnostics `collections`, identifiable through the assigned
19 : ! collection number. Each collection has an output frequency assigned
20 : ! to it, as well as an output file name (prefix). All containers of
21 : ! the same collection will have the same output frequency. Currently,
22 : ! the following output frequencies are defined: 'Hourly', 'Daily',
23 : ! 'Monthly', 'Annually', 'End', 'Manual'.
24 : !\\
25 : !\\
26 : ! HEMCO has three default built-in diagnostic collections: default,
27 : ! manual, and restart. These three collections become automatically
28 : ! defined during initialization of HEMCO, and diagnostic containers
29 : ! can be added to them anytime afterwards.
30 : ! The output frequency of the default collection can be specified
31 : ! in the HEMCO configuration file through argument 'DiagnFreq'.
32 : ! This can be a character indicating the output frequency (valid
33 : ! entries are 'Always', 'Hourly', 'Daily', 'Monthly', 'Annually',
34 : ! 'Manual', and 'End') or by two integer strings of format
35 : ! '00000000 000000' denoting the year-month-day and hour-minute-
36 : ! second output interval, respectively. For example, setting
37 : ! DiagnFreq to '00000001 000000' would be equivalent to setting
38 : ! it to 'Daily'. A value of '00000000 030000' indicates that the
39 : ! diagnostics shall be written out every 3 hours.
40 : !\\
41 : !\\
42 : ! The restart collection always gets an output frequency of 'End',
43 : ! but writing its content to disk can be forced at any given time
44 : ! using routine HcoDiagn\_Write (see below). The manual diagnostics
45 : ! has an output frequency of 'Manual', which means that its content
46 : ! is never written to disk. Instead, its fields need to be fetched
47 : ! explicitly from other routines via routine Diagn\_Get.
48 : !\\
49 : !\\
50 : ! The public module variables HcoDiagnIDDefault, HcoDiagnIDManual,
51 : ! and HcoDiagnRestart can be used to refer to these collections.
52 : ! The user can also define its own collections. It is recommended
53 : ! to do this outside of this module, e.g. at the model - HEMCO
54 : ! interface.
55 : !\\
56 : !\\
57 : ! Diagnostic collections are written to disk using the routines in
58 : ! module hcoio\_diagn\_mod.F90. Routine HcoDiagn\_Write will write
59 : ! out the three built-in HEMCO collections. Other collections need
60 : ! be written out explicitly using routine HCOIO\_Diagn\_WriteOut.
61 : ! The HEMCO option 'HcoWritesDiagn' determines if the three HEMCO
62 : ! collections are automatically written out by the HEMCO driver
63 : ! routines (hco\_driver\_mod.F90). If HcoWritesDiagn is set to
64 : ! FALSE, the user can freely decide when to write out the
65 : ! diagnostics. This is useful if the HEMCO diagnostics contain
66 : ! fields that are used/filled outside of HEMCO.
67 : !\\
68 : !\\
69 : ! Diagnostics container are created at the beginning of a simulation
70 : ! using subroutine Diagn\_Create. During the simulation, content is
71 : ! added to the individual containers via Diagn\_Update. Diagnostics
72 : ! data is fetched using Diagn\_Get. All emissions are stored in units
73 : ! of [kg/m2] and only converted to desired output units when returning
74 : ! the data. The container variable IsOutFormat denotes whether data
75 : ! is currently stored in output units or internal units. Variable
76 : ! nnGetCalls counts the number of times a diagnostics is called through
77 : ! Diagn\_Get without updating its content. This is useful if you want to
78 : ! make sure that data is only written once per time step.
79 : !\\
80 : !\\
81 : ! There are two types of emission diagnostics: automatic (`AutoFill`)
82 : ! and manual diagnostics. AutoFill diagnostics become automatically
83 : ! filled during execution of HEMCO. AutoFill diagnostics can be at
84 : ! species level (level 1), ExtNr level (level 2), emission category level
85 : ! (level 3), or hierarchy level (level 4). Level 1 diagnostics write out
86 : ! the collected emissions of the specified species, level 2 diagnostics
87 : ! write out emissions for the given ExtNr only (ignoring emissions from
88 : ! all other ExtNr's), etc.
89 : ! Manual diagnostics can represent any content. They never become filled
90 : ! automatically and all update calls (Diagn\_Update) have to be set
91 : ! manually.
92 : !\\
93 : !\\!\\
94 : ! Individual diagnostics are identified by its name and/or container ID.
95 : ! Both are specified when creating the diagnostics (Diagn\_Create).
96 : !\\
97 : !\\
98 : ! Before adding diagnostics to a collection, the collection needs to be
99 : ! created using subroutine DiagnCollection\_Create. The collection number
100 : ! argument (COL) should always be specified when creating, editing or
101 : ! obtaining a diagnostics. If this argument is omitted, the default HEMCO
102 : ! collection (HcoDiagnIDDefault) is taken.
103 : !\\
104 : !\\
105 : ! !INTERFACE:
106 : !
107 : MODULE HCO_Diagn_Mod
108 : !
109 : ! !USES:
110 : !
111 : USE HCO_Error_Mod
112 : USE HCO_Types_Mod
113 : USE HCO_Arr_Mod
114 : USE HCO_Clock_Mod
115 : USE HCO_State_Mod, ONLY : HCO_State
116 :
117 : IMPLICIT NONE
118 : PRIVATE
119 : !
120 : ! !PUBLIC MEMBER FUNCTIONS:
121 : !
122 : PUBLIC :: HcoDiagn_AutoUpdate
123 : PUBLIC :: HcoDiagn_Init
124 : PUBLIC :: Diagn_Create
125 : PUBLIC :: Diagn_Update
126 : PUBLIC :: Diagn_Get
127 : PUBLIC :: Diagn_TotalGet
128 : PUBLIC :: Diagn_AutoFillLevelDefined
129 : PUBLIC :: Diagn_Print
130 : PUBLIC :: Diagn_DefineFromConfig
131 : PUBLIC :: DiagnCont_Find
132 : PUBLIC :: DiagnCollection_Create
133 : PUBLIC :: DiagnCollection_Cleanup
134 : PUBLIC :: DiagnCollection_Get
135 : PUBLIC :: DiagnCollection_Set
136 : PUBLIC :: DiagnCollection_GetDefaultDelta
137 : PUBLIC :: DiagnCollection_IsTimeToWrite
138 : PUBLIC :: DiagnCollection_LastTimesSet
139 : PUBLIC :: DiagnFileOpen
140 : PUBLIC :: DiagnFileGetNext
141 : PUBLIC :: DiagnFileClose
142 : PUBLIC :: DiagnBundle_Cleanup
143 : PUBLIC :: DiagnBundle_Init
144 : !
145 : ! !PRIVATE MEMBER FUNCTIONS:
146 : !
147 : PRIVATE :: DiagnList_Cleanup
148 : PRIVATE :: DiagnCont_Init
149 : PRIVATE :: DiagnCont_PrepareOutput
150 : PRIVATE :: DiagnCont_Link_2D
151 : PRIVATE :: DiagnCont_Link_3D
152 : PRIVATE :: DiagnCont_Cleanup
153 : PRIVATE :: DiagnCollection_DefineID
154 : PRIVATE :: DiagnCollection_Find
155 : PRIVATE :: Diagn_UpdateDriver
156 : PRIVATE :: Diagn_UpdateSp0d
157 : PRIVATE :: Diagn_UpdateSp2d
158 : PRIVATE :: Diagn_UpdateSp3d
159 : PRIVATE :: Diagn_UpdateDp0d
160 : PRIVATE :: Diagn_UpdateDp2d
161 : PRIVATE :: Diagn_UpdateDp3d
162 :
163 : INTERFACE Diagn_Update
164 : MODULE PROCEDURE Diagn_UpdateSp0d
165 : MODULE PROCEDURE Diagn_UpdateSp2d
166 : MODULE PROCEDURE Diagn_UpdateSp3d
167 : MODULE PROCEDURE Diagn_UpdateDp0d
168 : MODULE PROCEDURE Diagn_UpdateDp2d
169 : MODULE PROCEDURE Diagn_UpdateDp3d
170 : END INTERFACE
171 : !
172 : ! !REVISION HISTORY:
173 : ! 19 Dec 2013 - C. Keller - Initialization
174 : ! See https://github.com/geoschem/hemco for complete history
175 : !EOP
176 : !------------------------------------------------------------------------------
177 : !BOC
178 : !
179 : ! !PRIVATE TYPES:
180 : !
181 : !
182 : ! !DEFINED PARAMETERS:
183 : !
184 : ! Parameter for averaging and summing non-standard data
185 : ! AvgFlagMean : calculates the arithmetic mean
186 : ! AvgFlagSum : calculates the sum, resets after every writeout
187 : ! AvgFlagCumulSum: calculates the cumulative sum, never resets.
188 : ! AvgFlagInst : uses the instantaneous value, overwrites existing
189 : INTEGER, PARAMETER :: AvgFlagMean = 1
190 : INTEGER, PARAMETER :: AvgFlagSum = 2
191 : INTEGER, PARAMETER :: AvgFlagCumulSum = 3
192 : INTEGER, PARAMETER :: AvgFlagInst = 4
193 :
194 : ! Parameter for output time stamp. This is the time stamp that will be used
195 : ! on the output file. End means the simulation date at output time is used,
196 : ! 'Mid' uses the midpoint of the diagnostics windows, 'Start' uses the
197 : ! beginning of the window.
198 : INTEGER, PARAMETER, PUBLIC :: HcoDiagnStart = 1
199 : INTEGER, PARAMETER, PUBLIC :: HcoDiagnMid = 2
200 : INTEGER, PARAMETER, PUBLIC :: HcoDiagnEnd = 3
201 :
202 : CONTAINS
203 : !EOC
204 : !------------------------------------------------------------------------------
205 : ! Harmonized Emissions Component (HEMCO) !
206 : !------------------------------------------------------------------------------
207 : !BOP
208 : !
209 : ! !IROUTINE: HcoDiagn_autoupdate
210 : !
211 : ! !DESCRIPTION: Subroutine HCODIAGN\_AUTOUPDATE updates the AutoFill
212 : ! diagnostics at species level. This routine should be called after
213 : ! running HEMCO core and all extensions.
214 : !\\
215 : !\\
216 : ! !INTERFACE:
217 : !
218 0 : SUBROUTINE HcoDiagn_AutoUpdate( HcoState, RC )
219 : !
220 : ! !USES:
221 : !
222 : USE HCO_STATE_MOD, ONLY : HCO_GetHcoID
223 : USE HCO_STATE_MOD, ONLY : HCO_State
224 : !
225 : ! !INPUT/OUTPUT PARAMETERS:
226 : !
227 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
228 : INTEGER, INTENT(INOUT) :: RC ! Failure or success
229 : !
230 : ! !REVISION HISTORY:
231 : ! 19 Dec 2013 - C. Keller - Initial version
232 : ! See https://github.com/geoschem/hemco for complete history
233 : !EOP
234 : !------------------------------------------------------------------------------
235 : !BOC
236 : !
237 : ! !LOCAL VARIABLES:
238 : !
239 : CHARACTER(LEN=255) :: MSG, LOC
240 : INTEGER :: I, tmpID
241 0 : REAL(hp), POINTER :: Arr3D(:,:,:)
242 0 : REAL(hp), POINTER :: Arr2D(:,:)
243 :
244 : !=================================================================
245 : ! HCODIAGN_AUTOUPDATE begins here!
246 : !=================================================================
247 :
248 : ! Init
249 0 : LOC = 'HCODIAGN_AUTOUPDATE (hco_diagn_mod.F90)'
250 0 : RC = HCO_SUCCESS
251 0 : Arr3D => NULL()
252 0 : Arr2D => NULL()
253 :
254 : ! ================================================================
255 : ! AutoFill diagnostics: only write diagnostics at species level
256 : ! (level 1). Higher level diagnostics have been written in the
257 : ! respective subroutines (hco_calc & extension modules).
258 : ! ================================================================
259 0 : DO I = 1, HcoState%nSpc
260 0 : IF ( ASSOCIATED(HcoState%Spc(I)%Emis) ) THEN
261 0 : IF ( ASSOCIATED(HcoState%Spc(I)%Emis%Val) ) THEN
262 0 : Arr3D => HcoState%Spc(I)%Emis%Val
263 : CALL Diagn_Update( HcoState, &
264 : ExtNr = -1, &
265 : Cat = -1, &
266 : Hier = -1, &
267 : HcoID = I, &
268 : AutoFill = 1, &
269 : Array3D = Arr3D, &
270 : COL = -1, &
271 0 : RC = RC )
272 0 : IF ( RC/= HCO_SUCCESS ) RETURN
273 0 : Arr3D => NULL()
274 : ENDIF
275 : ENDIF
276 : ENDDO
277 :
278 : ! Return
279 0 : RC = HCO_SUCCESS
280 :
281 0 : END SUBROUTINE HcoDiagn_AutoUpdate
282 : !EOC
283 : !------------------------------------------------------------------------------
284 : ! Harmonized Emissions Component (HEMCO) !
285 : !------------------------------------------------------------------------------
286 : !BOP
287 : !
288 : ! !IROUTINE: HcoDiagn_Init
289 : !
290 : ! !DESCRIPTION: Subroutine HCODIAGN\_INIT initializes the three built-in
291 : ! HEMCO diagnostic collections: default, restart, and manual. The
292 : ! identification ID of each collection is written into public variable
293 : ! HcoDiagnIDDefault, HcoDiagnIDRestart, and HcoDiagnIDManual, respectively.
294 : ! Those are used to easily refer to one of the diagnostics when adding
295 : ! fields ('containers') to a collection or fetching it's content.
296 : !\\
297 : !\\
298 : ! !INTERFACE:
299 : !
300 0 : SUBROUTINE HcoDiagn_Init( HcoState, RC )
301 : !
302 : ! !USES:
303 : !
304 : USE HCO_STATE_MOD, ONLY : HCO_GetHcoID
305 : USE HCO_STATE_MOD, ONLY : HCO_State
306 : USE HCO_ExtList_Mod, ONLY : GetExtOpt
307 : USE HCO_ExtList_Mod, ONLY : CoreNr
308 : USE HCO_CHARPAK_MOD, ONLY : TRANLC
309 : !
310 : ! !INPUT/OUTPUT PARAMETERS:
311 : !
312 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
313 : INTEGER, INTENT(INOUT) :: RC ! Failure or success
314 : !
315 : ! !REVISION HISTORY:
316 : ! 03 Apr 2015 - C. Keller - Initial version
317 : ! See https://github.com/geoschem/hemco for complete history
318 : !EOP
319 : !-----------------------------------------------------------------------
320 : !BOC
321 : !
322 : ! !LOCAL VARIABLES:
323 : !
324 : INTEGER :: CollectionID
325 : INTEGER :: deltaYMD, deltaHMS
326 : INTEGER :: OutTimeStamp
327 : LOGICAL :: FOUND
328 : CHARACTER(LEN=255) :: MSG, LOC, DiagnPrefix, OutTimeStampChar
329 :
330 : !=================================================================
331 : ! HCODIAGN_INIT begins here!
332 : !=================================================================
333 :
334 : ! Init
335 0 : LOC = 'HCODIAGN_INIT (hco_diagn_mod.F90)'
336 :
337 : ! Initialize diagnostics bundle
338 0 : CALL DiagnBundle_Init ( HcoState%Diagn )
339 :
340 : ! ------------------------------------------------------------------
341 : ! Default diagnostics
342 : ! ------------------------------------------------------------------
343 0 : CALL DiagnCollection_GetDefaultDelta ( HcoState, deltaYMD, deltaHMS, RC )
344 0 : IF ( RC /= HCO_SUCCESS ) THEN
345 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
346 0 : RETURN
347 : ENDIF
348 :
349 : ! Try to get prefix from configuration file
350 : CALL GetExtOpt ( HcoState%Config, CoreNr, 'DiagnPrefix', &
351 0 : OptValChar=DiagnPrefix, FOUND=FOUND, RC=RC )
352 0 : IF ( RC /= HCO_SUCCESS ) THEN
353 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
354 0 : RETURN
355 : ENDIF
356 0 : IF ( .NOT. FOUND ) THEN
357 : #if defined( MODEL_GEOS )
358 : DiagnPrefix = 'HEMCO_Diagnostics.$YYYY$MM$DD$HH$MN.nc'
359 : #else
360 0 : DiagnPrefix = 'HEMCO_diagnostics'
361 : #endif
362 : ENDIF
363 :
364 : ! Output time stamp location
365 : CALL GetExtOpt ( HcoState%Config, CoreNr, 'DiagnTimeStamp', &
366 0 : OptValChar=OutTimeStampChar, FOUND=FOUND, RC=RC )
367 0 : IF ( RC /= HCO_SUCCESS ) THEN
368 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
369 0 : RETURN
370 : ENDIF
371 0 : IF ( .NOT. FOUND ) THEN
372 0 : OutTimeStamp = HcoDiagnStart
373 : ELSE
374 0 : CALL TRANLC( OutTimeStampChar )
375 0 : IF ( TRIM(OutTimeStampChar) == 'start' ) THEN
376 0 : OutTimeStamp = HcoDiagnStart
377 :
378 0 : ELSEIF ( TRIM(OutTimeStampChar) == 'mid' ) THEN
379 0 : OutTimeStamp = HcoDiagnMid
380 :
381 0 : ELSEIF ( TRIM(OutTimeStampChar) == 'end' ) THEN
382 0 : OutTimeStamp = HcoDiagnEnd
383 :
384 : ELSE
385 0 : WRITE(MSG,*) 'Unrecognized output time stamp location: ', &
386 0 : TRIM(OutTimeStampChar), ' - will use default (start)'
387 0 : CALL HCO_WARNING(HcoState%Config%Err,MSG,RC,THISLOC=LOC)
388 0 : OutTimeStamp = HcoDiagnStart
389 : ENDIF
390 : ENDIF
391 :
392 : CALL DiagnCollection_Create( HcoState%Diagn, &
393 : NX = HcoState%NX, &
394 : NY = HcoState%NY, &
395 : NZ = HcoState%NZ, &
396 : TS = HcoState%TS_EMIS, &
397 : AM2 = HcoState%Grid%AREA_M2%Val, &
398 : COL = CollectionID, &
399 : PREFIX = TRIM(DiagnPrefix), &
400 : deltaYMD = deltaYMD, &
401 : deltaHMS = deltaHMS, &
402 : OutTimeStamp = OutTimeStamp, &
403 0 : RC = RC )
404 0 : IF ( RC /= HCO_SUCCESS ) THEN
405 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
406 0 : RETURN
407 : ENDIF
408 :
409 : ! Pass this collection ID to fixed variable for easy further
410 : ! reference to this collection
411 0 : HcoState%Diagn%HcoDiagnIDDefault = CollectionID
412 :
413 : ! ------------------------------------------------------------------
414 : ! HEMCO restart
415 : ! ------------------------------------------------------------------
416 : #if defined ( ESMF_ )
417 : deltaYMD = 0
418 : deltaHMS = 1
419 : #else
420 0 : deltaYMD = 99999999
421 0 : deltaHMS = 999999
422 : #endif
423 : #if defined( MODEL_GEOS )
424 : DiagnPrefix = 'HEMCO_restart.$YYYY$MM$DD$HH$MN.nc'
425 : #else
426 0 : DiagnPrefix = 'HEMCO_restart'
427 : #endif
428 : CALL DiagnCollection_Create( HcoState%Diagn, &
429 : NX = HcoState%NX, &
430 : NY = HcoState%NY, &
431 : NZ = HcoState%NZ, &
432 : TS = HcoState%TS_EMIS, &
433 : AM2 = HcoState%Grid%AREA_M2%Val, &
434 : COL = CollectionID, &
435 : PREFIX = TRIM(DiagnPrefix), &
436 : deltaYMD = deltaYMD, &
437 : deltaHMS = deltaHMS, &
438 : OutTimeStamp = HcoDiagnEnd, &
439 0 : RC = RC )
440 0 : IF ( RC /= HCO_SUCCESS ) THEN
441 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
442 0 : RETURN
443 : ENDIF
444 :
445 : ! Pass this collection ID to fixed variable for easy further
446 : ! reference to this collection
447 0 : HcoState%Diagn%HcoDiagnIDRestart = CollectionID
448 : #ifdef ADJOINT
449 : IF ( HcoState%isAdjoint ) THEN
450 : ! ------------------------------------------------------------------
451 : ! Default diagnostics
452 : ! ------------------------------------------------------------------
453 : CALL DiagnCollection_GetDefaultDelta ( HcoState, &
454 : deltaYMD, deltaHMS, RC )
455 : IF ( RC /= HCO_SUCCESS ) THEN
456 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
457 : RETURN
458 : ENDIF
459 :
460 : ! Try to get prefix from configuration file
461 : CALL GetExtOpt ( HcoState%Config, CoreNr, 'DiagnPrefix', &
462 : OptValChar=DiagnPrefix, FOUND=FOUND, RC=RC )
463 : IF ( RC /= HCO_SUCCESS ) THEN
464 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
465 : RETURN
466 : ENDIF
467 : IF ( .NOT. FOUND ) THEN
468 : #if defined( MODEL_GEOS )
469 : DiagnPrefix = 'HEMCO_Diagnostics.$YYYY$MM$DD$HH$MN.nc'
470 : #else
471 : DiagnPrefix = 'HEMCO_diagnostics'
472 : #endif
473 : ENDIF
474 :
475 : ! Output time stamp location
476 : CALL GetExtOpt ( HcoState%Config, CoreNr, 'DiagnTimeStamp', &
477 : OptValChar=OutTimeStampChar, FOUND=FOUND, RC=RC )
478 : IF ( RC /= HCO_SUCCESS ) THEN
479 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
480 : RETURN
481 : ENDIF
482 : IF ( .NOT. FOUND ) THEN
483 : OutTimeStamp = HcoDiagnStart
484 : ELSE
485 : CALL TRANLC( OutTimeStampChar )
486 : IF ( TRIM(OutTimeStampChar) == 'start' ) THEN
487 : OutTimeStamp = HcoDiagnStart
488 :
489 : ELSEIF ( TRIM(OutTimeStampChar) == 'mid' ) THEN
490 : OutTimeStamp = HcoDiagnMid
491 :
492 : ELSEIF ( TRIM(OutTimeStampChar) == 'end' ) THEN
493 : OutTimeStamp = HcoDiagnEnd
494 :
495 : ELSE
496 : WRITE(MSG,*) 'Unrecognized output time stamp location: ', &
497 : TRIM(OutTimeStampChar), ' - will use default (start)'
498 : CALL HCO_WARNING(HcoState%Config%Err,MSG,RC,THISLOC=LOC)
499 : OutTimeStamp = HcoDiagnStart
500 : ENDIF
501 : ENDIF
502 :
503 : CALL DiagnCollection_Create( HcoState%Diagn, &
504 : NX = HcoState%NX, &
505 : NY = HcoState%NY, &
506 : NZ = HcoState%NZ, &
507 : TS = HcoState%TS_EMIS, &
508 : AM2 = HcoState%Grid%AREA_M2%Val, &
509 : COL = CollectionID, &
510 : PREFIX = TRIM(DiagnPrefix), &
511 : deltaYMD = deltaYMD, &
512 : deltaHMS = deltaHMS, &
513 : OutTimeStamp = OutTimeStamp, &
514 : RC = RC )
515 : IF ( RC /= HCO_SUCCESS ) THEN
516 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
517 : RETURN
518 : ENDIF
519 :
520 : ! Pass this collection ID to fixed variable for easy further
521 : ! reference to this collection
522 : HcoState%Diagn%HcoDiagnIDAdjoint = CollectionID
523 : endif
524 : #endif
525 :
526 : ! ------------------------------------------------------------------
527 : ! Manual diagnostics
528 : ! ------------------------------------------------------------------
529 : #if defined ( ESMF_ )
530 : deltaYMD = 0
531 : deltaHMS = 1
532 : #else
533 0 : deltaYMD = -1
534 0 : deltaHMS = -1
535 : #endif
536 : #if defined( MODEL_GEOS )
537 : DiagnPrefix = 'HEMCO_manual.$YYYY$MM$DD$HH$MN.nc'
538 : #else
539 0 : DiagnPrefix = 'HEMCO_manual'
540 : #endif
541 : CALL DiagnCollection_Create( HcoState%Diagn, &
542 : NX = HcoState%NX, &
543 : NY = HcoState%NY, &
544 : NZ = HcoState%NZ, &
545 : TS = HcoState%TS_EMIS, &
546 : AM2 = HcoState%Grid%AREA_M2%Val, &
547 : COL = CollectionID, &
548 : PREFIX = TRIM(DiagnPrefix), &
549 : deltaYMD = deltaYMD, &
550 : deltaHMS = deltaHMS, &
551 0 : RC = RC )
552 0 : IF ( RC /= HCO_SUCCESS ) THEN
553 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
554 0 : RETURN
555 : ENDIF
556 :
557 : ! Pass this collection ID to fixed variable for easy further
558 : ! reference to this collection
559 0 : HcoState%Diagn%HcoDiagnIDManual = CollectionID
560 :
561 : ! ------------------------------------------------------------------
562 : ! Now that collections are defined, add diagnostics specified in the
563 : ! HEMCO diagnostics definition file. The latter can be specified in
564 : ! the HEMCO configuration file. These diagnostics are all written
565 : ! into the default HEMCO collection.
566 : ! ------------------------------------------------------------------
567 0 : CALL Diagn_DefineFromConfig( HcoState, RC )
568 0 : IF ( RC /= HCO_SUCCESS ) THEN
569 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
570 0 : RETURN
571 : ENDIF
572 :
573 : ! Return w/ success
574 0 : RC = HCO_SUCCESS
575 :
576 : END SUBROUTINE HcoDiagn_Init
577 : !EOC
578 : !------------------------------------------------------------------------------
579 : ! Harmonized Emissions Component (HEMCO) !
580 : !------------------------------------------------------------------------------
581 : !BOP
582 : !
583 : ! !IROUTINE: Diagn_DefineFromConfig
584 : !
585 : ! !DESCRIPTION: Subroutine Diagn\_DefineFromConfig defines HEMCO
586 : ! diagnostic containers as specified in the diagnostics input file.
587 : !\\
588 : !\\
589 : ! This routine reads information from a HEMCO diagnostics definition
590 : ! file (specified in the main HEMCO configuration file) and creates
591 : ! HEMCO diagnostic containers for each entry of the diagnostics
592 : ! definition file. Each line of the diagnostics definition file
593 : ! represents a diagnostics container and is expected to consist of
594 : ! 7 entries: container name (character), HEMCO species (character),
595 : ! extension number (integer), emission category (integer), emission
596 : ! hierarchy (integer), space dimension (2 or 3), output unit
597 : ! (character).
598 : !\\
599 : !\\
600 : ! The HEMCO setting 'DiagnFile' can be used to specify a diagnostics
601 : ! file. This setting should be placed in the settings section of the
602 : ! HEMCO configuration file.
603 : !\\
604 : !\\
605 : ! If argument `Add2MaplExp` is set to true, the diagnostics field
606 : ! defined in the diagnostics definition file are not added to the
607 : ! HEMCO diagnostics collection (yet), but rather added to the MAPL
608 : ! export state. This is useful in an ESMF environment to automate
609 : ! the coupling of HEMCO diagnostics, e.g. subroutine
610 : ! Diagn\_DefineFromConfig can be called during SetServices to make
611 : ! sure that all diagnostic fields defined in DiagnFile have a
612 : ! corresponding Export state object (and can thus be written out
613 : ! via the MAPL History component).
614 : !\\
615 : !\\
616 : ! !INTERFACE:
617 : !
618 0 : SUBROUTINE Diagn_DefineFromConfig( HcoState, RC )
619 : !
620 : ! !USES:
621 : !
622 : USE HCO_CharTools_Mod
623 : USE HCO_CHARPAK_Mod, ONLY : STRREPL, STRSPLIT
624 : USE HCO_inquireMod, ONLY : findFreeLUN
625 : USE HCO_STATE_MOD, ONLY : HCO_GetHcoID
626 : USE HCO_STATE_MOD, ONLY : HCO_State
627 : USE HCO_EXTLIST_MOD, ONLY : GetExtOpt
628 : !
629 : ! !INPUT/OUTPUT PARAMETERS:
630 : !
631 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
632 : INTEGER, INTENT(INOUT) :: RC ! Failure or success
633 : !
634 : ! !REVISION HISTORY:
635 : ! 10 Apr 2015 - C. Keller - Initial version
636 : ! See https://github.com/geoschem/hemco for complete history
637 : !EOP
638 : !------------------------------------------------------------------------------
639 : !BOC
640 : !
641 : ! !LOCAL VARIABLES:
642 : !
643 : INTEGER :: N, LUN
644 : LOGICAL :: EOF, FOUND, DefaultSet
645 : CHARACTER(LEN=31) :: SpcName, OutUnit
646 : CHARACTER(LEN=63) :: cName, dLname, dSname
647 : INTEGER :: HcoID, ExtNr, Cat, Hier, SpaceDim
648 : CHARACTER(LEN=255) :: lName, LOC, MSG
649 :
650 : !=================================================================
651 : ! Diagn_DefineFromConfig begins here!
652 : !=================================================================
653 :
654 : ! Init
655 0 : LOC = 'Diagn_DefineFromConfig (hco_diagn_mod.F90)'
656 :
657 : ! Load DiagnFile into buffer
658 0 : CALL DiagnFileOpen( HcoState%Config, LUN, RC )
659 0 : IF ( RC /= HCO_SUCCESS ) THEN
660 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
661 0 : RETURN
662 : ENDIF
663 :
664 : ! If defined, sequentially get all entries
665 0 : IF ( LUN > 0 ) THEN
666 :
667 : ! Do for every line
668 0 : DO
669 :
670 : ! Get next line
671 : CALL DiagnFileGetNext( HcoState%Config, LUN, cName, &
672 : SpcName, ExtNr, Cat, Hier, &
673 : SpaceDim, OutUnit, EOF, RC, &
674 0 : lName=lName )
675 0 : IF ( RC /= HCO_SUCCESS ) THEN
676 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
677 0 : RETURN
678 : ENDIF
679 :
680 : ! Leave here if end of file
681 0 : IF ( EOF ) EXIT
682 :
683 : ! Get HEMCO species ID. Skip entry if HEMCO ID not
684 : ! defined for this species
685 0 : HcoID = HCO_GetHcoID( TRIM(SpcName), HcoState )
686 0 : IF ( HcoID <= 0 ) CYCLE
687 :
688 : #ifdef ADJOINT
689 : if ( cName(1:6) == 'SFEmis' ) then
690 : ! ------------------------------------------------------------------
691 : ! Add it to the HEMCO diagnostics collection
692 : ! ------------------------------------------------------------------
693 : CALL Diagn_Create( HcoState, &
694 : cName = cName, &
695 : long_name = lName, &
696 : HcoID = HcoID, &
697 : ExtNr = ExtNr, &
698 : Cat = Cat, &
699 : Hier = Hier, &
700 : SpaceDim = SpaceDim, &
701 : OutUnit = OutUnit, &
702 : OutOper = 'CumulSum', &
703 : AutoFill = 1, &
704 : COL = HcoState%Diagn%HcoDiagnIDAdjoint, &
705 : RC = RC )
706 : else
707 : #endif
708 : ! ------------------------------------------------------------------
709 : ! Add it to the HEMCO diagnostics collection
710 : ! ------------------------------------------------------------------
711 : CALL Diagn_Create( HcoState, &
712 : cName = cName, &
713 : long_name = lName, &
714 : HcoID = HcoID, &
715 : ExtNr = ExtNr, &
716 : Cat = Cat, &
717 : Hier = Hier, &
718 : SpaceDim = SpaceDim, &
719 : OutUnit = OutUnit, &
720 : AutoFill = 1, &
721 : COL = HcoState%Diagn%HcoDiagnIDDefault, &
722 0 : RC = RC )
723 : #ifdef ADJOINT
724 : endif
725 : #endif
726 0 : IF ( RC /= HCO_SUCCESS ) THEN
727 0 : CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
728 0 : RETURN
729 : ENDIF
730 :
731 : ENDDO
732 :
733 : ! Close file
734 0 : CALL DiagnFileClose ( LUN )
735 :
736 : ENDIF ! LUN > 0
737 :
738 : ! ---------------------------------------------------------------------
739 : ! Eventually prepare a diagnostics for every HEMCO species.
740 : ! This is optional and controlled by HEMCO setting DefaultDiagnSet.
741 : ! ---------------------------------------------------------------------
742 : CALL GetExtOpt( HcoState%Config, -999, 'DefaultDiagnOn', &
743 0 : OptValBool=DefaultSet, FOUND=FOUND, RC=RC )
744 0 : IF ( .NOT. FOUND ) DefaultSet = .FALSE.
745 0 : IF ( DefaultSet ) THEN
746 :
747 : ! Search for default diagnostics variable prefix
748 : CALL GetExtOpt( HcoState%Config, -999, 'DefaultDiagnSname', &
749 0 : OptValChar=dSname, FOUND=FOUND, RC=RC )
750 0 : IF ( .NOT. FOUND ) dSname = 'HEMCO_EMIS_'
751 :
752 : CALL GetExtOpt( HcoState%Config, -999, 'DefaultDiagnLname', &
753 0 : OptValChar=dLname, FOUND=FOUND, RC=RC )
754 0 : IF ( .NOT. FOUND ) dLname = 'HEMCO_emissions_of_species_'
755 :
756 : ! Search for default diagnostics dimension
757 : CALL GetExtOpt( HcoState%Config, -999, 'DefaultDiagnDim', &
758 0 : OptValInt=SpaceDim, FOUND=FOUND, RC=RC )
759 0 : IF ( .NOT. FOUND ) SpaceDim = 3
760 0 : SpaceDim = MAX(MIN(SpaceDim,3),2)
761 :
762 : ! Get units
763 : CALL GetExtOpt( HcoState%Config, -999, 'DefaultDiagnUnit', &
764 0 : OptValChar=OutUnit, FOUND=FOUND, RC=RC )
765 0 : IF ( .NOT. FOUND ) OutUnit = 'kg m-2 s-1'
766 :
767 : ! Loop over all species and create diagnostics
768 0 : DO N = 1, HcoState%nSpc
769 0 : cName = TRIM(dSname)//TRIM(HcoState%Spc(N)%SpcName)
770 0 : lName = TRIM(dLname)//TRIM(HcoState%Spc(N)%SpcName)
771 :
772 : CALL Diagn_Create( HcoState, &
773 : cName = cName, &
774 : long_name = lName, &
775 0 : HcoID = HcoState%Spc(N)%HcoID, &
776 : ExtNr = -1, &
777 : Cat = -1, &
778 : Hier = -1, &
779 : SpaceDim = SpaceDim, &
780 : OutUnit = OutUnit, &
781 : AutoFill = 1, &
782 : COL = HcoState%Diagn%HcoDiagnIDDefault, &
783 0 : RC = RC )
784 0 : IF ( RC /= HCO_SUCCESS ) THEN
785 0 : CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC )
786 0 : RETURN
787 : ENDIF
788 : ENDDO
789 : ENDIF
790 :
791 : ! Return w/ success
792 0 : RC = HCO_SUCCESS
793 :
794 : END SUBROUTINE Diagn_DefineFromConfig
795 : !EOC
796 : !------------------------------------------------------------------------------
797 : ! Harmonized Emissions Component (HEMCO) !
798 : !------------------------------------------------------------------------------
799 : !BOP
800 : !
801 : ! !IROUTINE: Diagn_Create
802 : !
803 : ! !DESCRIPTION: Subroutine Diagn\_Create creates a new diagnostics. This
804 : ! routine takes the following input arguments:
805 : !\begin{itemize}
806 : !\item cName: distinct diagnostics (container) name.
807 : !\item long\_name: long\_name attribute used for netCDF output.
808 : !\item ExtNr: emissions extension number.
809 : !\item Cat: emissions category.
810 : !\item Hier: emissions hierarchy.
811 : !\item HcoID: HEMCO species ID of diagnostics species.
812 : !\item SpaceDim: spatial dimension: 1 (scalar), 2 (lon-lat),
813 : ! or 3 (lon-lat-lev).
814 : !\item OutUnit: output unit. Emissions will be converted to this unit.
815 : ! Conversion factors will be determined using the HEMCO unit
816 : ! module (see HCO\_UNITS\_Mod.F90). No unit conversions will be
817 : ! performed if the argument OutOper is set (see below).
818 : !\item HcoState: HEMCO state object. Used to determine the species
819 : ! properties.
820 : !\item OutOper: output operation for non-standard units. If this
821 : ! argument is used, the specified operation is performed and all
822 : ! unit specifications are ignored. Can be one of 'Mean', 'Sum',
823 : ! 'CumulSum', or 'Instantaneous'.
824 : !\item AutoFill: containers with an AutoFill flag of 1 will be auto-
825 : ! matically updated by the HEMCO standard diagnostics calls
826 : ! (e.g. in hco\_calc\_mod.F90). If set to 0, the diagnostics
827 : ! updates have to be set manually.
828 : !\item Trgt2D: 2D target array. If specified, the diagnostics array
829 : ! will point to this data. This disables all time averaging,
830 : ! unit conversions, etc., and the data will be written to disk
831 : ! as is.
832 : !\item Trgt3D: as Trgt2D, but for 3D data.
833 : !\item ScaleFact: constant scale factor. If provided, the diagnostics
834 : ! are scaled uniformly by this value before outputting. Will be
835 : ! applied on top of any other unit conversions. Does not work on
836 : ! data pointers.
837 : !\item cID: assigned container ID. Useful for later reference to this
838 : ! diagnostics container.
839 : !\item RC: HEMCO return code.
840 : !\end{itemize}
841 : !
842 : ! !INTERFACE:
843 : !
844 0 : SUBROUTINE Diagn_Create( HcoState, cName, &
845 : ExtNr, Cat, Hier, &
846 : HcoID, SpaceDim, OutUnit, &
847 : OutOper, LevIdx, AutoFill, &
848 0 : Trgt2D, Trgt3D, ScaleFact, &
849 : cID, RC, COL, OkIfExist, &
850 : long_name )
851 : !
852 : ! !USES:
853 : !
854 : USE HCO_State_Mod, ONLY : HCO_State
855 : USE HCO_Unit_Mod, ONLY : HCO_Unit_GetAreaScal
856 : USE HCO_Unit_Mod, ONLY : HCO_Unit_GetTimeScal
857 : !
858 : ! !INPUT PARAMETERS:
859 : !
860 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj.
861 : CHARACTER(LEN=*), INTENT(IN ) :: cName ! Diagnostics name
862 : CHARACTER(LEN=*), INTENT(IN ) :: OutUnit ! Output units
863 : INTEGER, INTENT(IN ), OPTIONAL :: SpaceDim ! Spatial dimension
864 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr ! Extension #
865 : INTEGER, INTENT(IN ), OPTIONAL :: Cat ! Category
866 : INTEGER, INTENT(IN ), OPTIONAL :: Hier ! Hierarchy
867 : INTEGER, INTENT(IN ), OPTIONAL :: HcoID ! HEMCO species ID
868 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: OutOper ! Output operation
869 : INTEGER, INTENT(IN ), OPTIONAL :: LevIdx ! Level index to use
870 : INTEGER, INTENT(IN ), OPTIONAL :: AutoFill ! 1=fill auto.;0=don't
871 : REAL(sp), INTENT(IN ), OPTIONAL :: Trgt2D(:,:) ! 2D target data
872 : REAL(sp), INTENT(IN ), OPTIONAL :: Trgt3D(:,:,:) ! 3D target data
873 : REAL(hp), INTENT(IN ), OPTIONAL :: ScaleFact ! uniform scale factor
874 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! Collection number
875 : INTEGER, INTENT(IN ), OPTIONAL :: cID ! Container ID
876 : LOGICAL, INTENT(IN ), OPTIONAL :: OkIfExist ! Is it ok if already exists?
877 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: long_name ! long name attribute
878 : !
879 : ! !INPUT/OUTPUT PARAMETERS:
880 : !
881 : INTEGER, INTENT(INOUT) :: RC ! Return code
882 : !
883 : ! !REVISION HISTORY:
884 : ! 19 Dec 2013 - C. Keller - Initialization
885 : ! See https://github.com/geoschem/hemco for complete history
886 : !EOP
887 : !------------------------------------------------------------------------------
888 : !BOC
889 : !
890 : ! !LOCAL VARIABLES:
891 : !
892 : ! Pointers
893 : TYPE(DiagnCont), POINTER :: ThisDiagn
894 : TYPE(DiagnCont), POINTER :: TmpDiagn
895 : TYPE(DiagnCollection), POINTER :: ThisColl
896 :
897 : ! Scalars
898 : CHARACTER(LEN=255) :: LOC, MSG
899 : INTEGER :: PS, Flag
900 : REAL(hp) :: Scal
901 : LOGICAL :: ForceMean, FOUND
902 :
903 : !======================================================================
904 : ! Diagn_Create begins here!
905 : !======================================================================
906 :
907 : ! Nullify
908 0 : ThisDiagn => NULL()
909 0 : TmpDiagn => NULL()
910 0 : ThisColl => NULL()
911 :
912 : ! Init
913 0 : LOC = 'Diagn_Create (hco_diagn_mod.F90)'
914 : CALL DiagnCollection_DefineID( HcoState%Diagn, PS, RC, COL=COL, &
915 0 : HcoState=HcoState, InUse=FOUND, ThisColl=ThisColl )
916 0 : IF ( RC /= HCO_SUCCESS ) THEN
917 0 : CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC )
918 0 : RETURN
919 : ENDIF
920 :
921 : ! Error if collection does not exist
922 0 : IF ( .NOT. FOUND ) THEN
923 0 : WRITE(MSG,*) 'Cannot create diagnostics ', TRIM(cName), &
924 0 : ' - collection does not exist: ', PS
925 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
926 0 : RETURN
927 : ENDIF
928 :
929 : !----------------------------------------------------------------------
930 : ! Check if diagnostics already exists
931 : !----------------------------------------------------------------------
932 0 : IF ( PRESENT(OkIfExist) ) THEN
933 0 : IF ( OkIfExist ) THEN
934 0 : IF ( PRESENT(cID) ) THEN
935 : CALL DiagnCont_Find( HcoState%Diagn, cID, -1, -1, -1, -1, &
936 0 : '', -1, FOUND, TmpDiagn, COL=PS )
937 : ELSE
938 : CALL DiagnCont_Find( HcoState%Diagn, -1, -1, -1, -1, -1, &
939 0 : TRIM(ADJUSTL(cName)), -1, FOUND, TmpDiagn, COL=PS )
940 : ENDIF
941 0 : TmpDiagn => NULL()
942 :
943 : ! Exit if found
944 0 : IF ( FOUND ) THEN
945 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
946 0 : WRITE(MSG,*) 'Diagnostics already exists - ', &
947 0 : 'will not be added again: ', TRIM(cName)
948 0 : CALL HCO_MSG ( HcoState%Config%Err, MSG )
949 : ENDIF
950 0 : RC = HCO_SUCCESS
951 0 : RETURN
952 : ENDIF
953 : ENDIF
954 : ! End conflict (ewl, 1/8/15)
955 : ENDIF
956 :
957 : !----------------------------------------------------------------------
958 : ! Initalize diagnostics container.
959 : !----------------------------------------------------------------------
960 0 : CALL DiagnCont_Init( ThisDiagn )
961 :
962 : !----------------------------------------------------------------------
963 : ! Pass input variables
964 : !----------------------------------------------------------------------
965 0 : ThisDiagn%cName = ADJUSTL(cName)
966 0 : ThisDiagn%OutUnit = TRIM(OutUnit)
967 :
968 : ! Optional arguments. If not provided, use default values set in
969 : ! DiagnCont_Init
970 0 : IF ( PRESENT(ExtNr) ) ThisDiagn%ExtNr = ExtNr
971 0 : IF ( PRESENT(Cat ) ) ThisDiagn%Cat = Cat
972 0 : IF ( PRESENT(Hier ) ) ThisDiagn%Hier = Hier
973 0 : IF ( PRESENT(HcoID) ) ThisDiagn%HcoID = HcoID
974 0 : IF ( PRESENT(SpaceDim) ) ThisDiagn%SpaceDim = SpaceDim
975 0 : IF ( PRESENT(LevIdx) ) ThisDiagn%LevIdx = LevIdx
976 0 : IF ( PRESENT(AutoFill) ) ThisDiagn%AutoFill = AutoFill
977 :
978 : ! long_name attribute. Defaults to container name
979 0 : IF ( PRESENT(long_name) ) THEN
980 0 : ThisDiagn%long_name = TRIM(long_name)
981 : ELSE
982 0 : ThisDiagn%long_name = TRIM(ADJUSTL(cName))
983 : ENDIF
984 :
985 : !----------------------------------------------------------------------
986 : ! Eventually link to data array. This will disable all time averaging,
987 : ! unit conversions, etc. (data will just be returned as is).
988 : !----------------------------------------------------------------------
989 0 : IF ( PRESENT(Trgt2D) ) THEN
990 : CALL DiagnCont_Link_2D( ThisDiagn, ThisColl, Trgt2D, RC, &
991 0 : HcoState=HcoState )
992 0 : IF ( RC /= HCO_SUCCESS ) THEN
993 0 : CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC )
994 0 : RETURN
995 : ENDIF
996 : ENDIF
997 0 : IF ( PRESENT(Trgt3D) ) THEN
998 : CALL DiagnCont_Link_3D( ThisDiagn, ThisColl, Trgt3D, RC, &
999 0 : HcoState=HcoState )
1000 0 : IF ( RC /= HCO_SUCCESS ) THEN
1001 0 : CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC )
1002 0 : RETURN
1003 : ENDIF
1004 : ENDIF
1005 :
1006 : ! Update module variable AF_LevelDefined. For all AutoFill diagnostics,
1007 : ! we store whether or not there is (at least one) diagnostics container
1008 : ! defined at species level, ExtNr level, etc.
1009 0 : IF ( ThisDiagn%AutoFill == 1 ) THEN
1010 :
1011 : ! At species level: no ExtNr defined
1012 0 : IF ( ThisDiagn%ExtNr < 0 ) THEN
1013 0 : ThisColl%AF_LevelDefined(1) = .TRUE.
1014 :
1015 : ! At ExtNr level: no category defined
1016 0 : ELSEIF ( ThisDiagn%Cat < 0 ) THEN
1017 0 : ThisColl%AF_LevelDefined(2) = .TRUE.
1018 :
1019 : ! At category level: no hierarchy defined
1020 0 : ELSEIF ( ThisDiagn%Hier < 0 ) THEN
1021 0 : ThisColl%AF_LevelDefined(3) = .TRUE.
1022 :
1023 : ! At hierarchy level: all defined
1024 : ELSE
1025 0 : ThisColl%AF_LevelDefined(4) = .TRUE.
1026 : ENDIF
1027 :
1028 : ENDIF
1029 :
1030 : !----------------------------------------------------------------------
1031 : ! Determine scale factors to be applied to data. These values are
1032 : ! determined from the specified output unit, assuming that the original
1033 : ! HEMCO data is in kg/m2/s. If the optional argument OutOper is set,
1034 : ! the output unit is ignored and the specified operation ('mean' or
1035 : ! 'sum') is performed. This is particular useful for data with
1036 : ! non-standard units, e.g. unitless data.
1037 : ! Don't need to be done for pointer data, which ignores all time
1038 : ! averaging, unit conversions, etc.
1039 : !----------------------------------------------------------------------
1040 :
1041 : ! Uniform scale factor
1042 0 : IF ( PRESENT(ScaleFact) ) THEN
1043 0 : IF ( ThisDiagn%DtaIsPtr ) THEN
1044 : MSG = 'Cannot use scale factor on diagnostics that '// &
1045 0 : 'are pointers to other data: '//TRIM(cName)
1046 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
1047 0 : RETURN
1048 : ENDIF
1049 0 : IF ( TRIM(OutOper) == 'CumulSum' ) THEN
1050 : MSG = 'Cannot use scale factor on diagnostics that '// &
1051 0 : 'are cumulative sums: '//TRIM(cName)
1052 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
1053 0 : RETURN
1054 : ENDIF
1055 0 : ThisDiagn%ScaleFact = ScaleFact
1056 : ENDIF
1057 :
1058 : ! Unit conversion factors don't need be defined for pointers
1059 0 : IF ( ThisDiagn%DtaIsPtr ) THEN
1060 :
1061 : ! Pointer diagnostics are always instantaneous
1062 0 : ThisDiagn%AvgName = 'Instantaneous'
1063 :
1064 : ! Unit conversion factors for containers that are not pointers
1065 : ELSE
1066 :
1067 : ! Enforce specified output operator
1068 0 : IF ( PRESENT(OutOper) ) THEN
1069 :
1070 : ! Pass to diagnostics
1071 0 : ThisDiagn%AvgName = TRIM(OutOper)
1072 :
1073 : ! Set flag accordingly
1074 0 : IF ( TRIM(OutOper) == 'Mean' ) THEN
1075 0 : ThisDiagn%AvgFlag = AvgFlagMean
1076 0 : ELSEIF ( TRIM(OutOper) == 'Sum' ) THEN
1077 0 : ThisDiagn%AvgFlag = AvgFlagSum
1078 0 : ELSEIF ( TRIM(OutOper) == 'CumulSum' ) THEN
1079 0 : ThisDiagn%AvgFlag = AvgFlagCumulSum
1080 0 : ELSEIF ( TRIM(OutOper) == 'Instantaneous' ) THEN
1081 0 : ThisDiagn%AvgFlag = AvgFlagInst
1082 : ELSE
1083 0 : MSG = 'Illegal output operator: ' // TRIM(OutOper)
1084 : MSG = TRIM(MSG) // '. Allowed are `Mean`, `Sum`, '// &
1085 0 : '`CumulSum`, `Instantaneous`.'
1086 0 : MSG = TRIM(MSG) // ' (' // TRIM(cName) // ')'
1087 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
1088 0 : RETURN
1089 : ENDIF
1090 :
1091 : ! If OutOper is not set, determine scale factors from output unit:
1092 : ELSE
1093 :
1094 : ! Will calculate the mean
1095 0 : ThisDiagn%AvgName = 'mean'
1096 :
1097 : !----------------------------------------------------------------
1098 : ! Scale factor for area. This determines the scale factor from
1099 : ! HEMCO area unit (m2) to the desired output unit.
1100 : ! HCO_UNIT_AreaScal returns the area scale factor from OutUnit to
1101 : ! HEMCO unit, hence need to invert this value!
1102 : !----------------------------------------------------------------
1103 0 : CALL HCO_UNIT_GetAreaScal( OutUnit, Scal, Flag )
1104 0 : ThisDiagn%AreaFlag = Flag
1105 0 : IF ( Flag > 0 ) THEN
1106 0 : ThisDiagn%AreaScal = 1.0_hp / Scal
1107 : ENDIF
1108 :
1109 0 : IF ( HCO_IsVerb(HcoState%Config%Err) ) THEN
1110 0 : WRITE(MSG, *) ' ThisDiagn%AreaScal = ', ThisDiagn%AreaScal
1111 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
1112 0 : WRITE(MSG, *) ' ThisDiagn%MassScal = ', ThisDiagn%MassScal
1113 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
1114 : ENDIF
1115 : !----------------------------------------------------------------
1116 : ! Determine the normalization factors applied to the diagnostics
1117 : ! before they are written out. Diagnostics are always stored
1118 : ! internally in units of kg/m2, and the following flags make sure
1119 : ! that they are normalized by the desired time interval, e.g. to
1120 : ! get units of per second, per hour, etc.
1121 : !----------------------------------------------------------------
1122 :
1123 : ! HCO_UNIT_GetTimeScal returns 1.0 for units of per second, 1/3600
1124 : ! for per hour, etc. Returns -999.0 if no time unit could be found.
1125 0 : CALL HCO_UNIT_GetTimeScal( OutUnit, 1, 2001, Scal, Flag )
1126 0 : Scal = 1.0_dp / Scal
1127 :
1128 : ! No time unit found: don't enable any switch
1129 0 : IF ( Scal < 0.0_dp ) THEN
1130 : ! Nothing to do
1131 :
1132 : ! Normalize by seconds
1133 0 : ELSEIF ( Scal == 1.0_dp ) THEN
1134 0 : ThisDiagn%TimeAvg = 1
1135 :
1136 : ! Normalize by hours
1137 0 : ELSEIF ( Scal == 3600.0_dp ) THEN
1138 0 : ThisDiagn%TimeAvg = 2
1139 :
1140 : ! Normalize by days
1141 0 : ELSEIF ( Scal == 86400.0_dp ) THEN
1142 0 : ThisDiagn%TimeAvg = 3
1143 :
1144 : ! Normalize by months
1145 0 : ELSEIF ( Scal == 2678400.0_dp ) THEN
1146 0 : ThisDiagn%TimeAvg = 4
1147 :
1148 : ! Normalize by years
1149 0 : ELSEIF ( Scal == 31536000.0_dp ) THEN
1150 0 : ThisDiagn%TimeAvg = 5
1151 :
1152 : ! Error otherwise
1153 : ELSE
1154 0 : MSG = 'Cannot determine time normalization: '//TRIM(OutUnit)
1155 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
1156 0 : RETURN
1157 : ENDIF
1158 : ENDIF ! OutOper not set
1159 : ENDIF ! .NOT. DtaIsPtr
1160 :
1161 : !-----------------------------------------------------------------------
1162 : ! Make sure that there is no other diagnostics with this name
1163 : !-----------------------------------------------------------------------
1164 : CALL DiagnCont_Find( HcoState%Diagn, -1, -1, -1, -1, -1, &
1165 0 : Trim(ADJUSTL(cName)), -1, FOUND, TmpDiagn, COL=PS )
1166 0 : IF ( FOUND ) THEN
1167 : ! MSG = 'There is already a diagnostics with this name: ' // TRIM(cName)
1168 : ! CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
1169 : ! RETURN
1170 0 : ThisDiagn%cName = trim(cName) // '_a'
1171 0 : MSG = 'Changed Diagn name to ' // trim(ThisDiagn%cName)
1172 0 : CALL HCO_MSG ( HcoState%Config%Err, MSG )
1173 : ENDIF
1174 :
1175 : !-----------------------------------------------------------------------
1176 : ! Set container ID (if defined). There must not be two containers with
1177 : ! the same container ID.
1178 : !-----------------------------------------------------------------------
1179 0 : IF ( PRESENT(cID) ) THEN
1180 0 : IF ( cID > 0 ) THEN
1181 :
1182 : ! Check if there is already a diagnostics with this container ID.
1183 0 : TmpDiagn => NULL()
1184 : CALL DiagnCont_Find( HcoState%Diagn, cID, -1, -1, -1, -1, &
1185 0 : '', -1, FOUND, TmpDiagn, COL=PS )
1186 0 : IF ( FOUND ) THEN
1187 0 : WRITE(MSG,*) 'Diagnostics ', TRIM(TmpDiagn%cName), ' already has ID ', &
1188 0 : cID, ' - cannot create diagnostics ', TRIM(cName)
1189 :
1190 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
1191 0 : RETURN
1192 : ENDIF
1193 :
1194 : ! Set container ID
1195 0 : ThisDiagn%cID = cID
1196 : ENDIF
1197 : ENDIF
1198 :
1199 : !-----------------------------------------------------------------------
1200 : ! Add to diagnostics list of this collection.
1201 : ! Insert at the beginning of the list.
1202 : !-----------------------------------------------------------------------
1203 :
1204 0 : IF ( ThisColl%nnDiagn > 0 ) THEN
1205 0 : ThisDiagn%NextCont => ThisColl%DiagnList
1206 : ENDIF
1207 0 : ThisColl%DiagnList => ThisDiagn
1208 :
1209 : ! This diagnostics is now part of this collection
1210 0 : ThisDiagn%CollectionID = PS
1211 :
1212 : ! Increase diagnostics counter and set container ID accordingly.
1213 0 : ThisColl%nnDiagn = ThisColl%nnDiagn + 1
1214 :
1215 : ! Verbose mode
1216 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
1217 : WRITE(MSG,'(a, i4)') 'Successfully added diagnostic '// &
1218 0 : TRIM(ThisDiagn%cName) // ' to collection ', PS
1219 0 : CALL HCO_MSG ( HcoState%Config%Err, MSG )
1220 : ENDIF
1221 :
1222 : ! Cleanup
1223 0 : ThisDiagn => NULL()
1224 0 : ThisColl => NULL()
1225 :
1226 : ! Return
1227 0 : RC = HCO_SUCCESS
1228 :
1229 0 : END SUBROUTINE Diagn_Create
1230 : !EOC
1231 : !------------------------------------------------------------------------------
1232 : ! Harmonized Emissions Component (HEMCO) !
1233 : !------------------------------------------------------------------------------
1234 : !BOP
1235 : !
1236 : ! !ROUTINE: Diagn_UpdateSp0d
1237 : !
1238 : ! !DESCRIPTION: Subroutine Diagn\_UpdateSp0d is the wrapper routine to update
1239 : ! the diagnostics for single precision scalar values. It invokes the main
1240 : ! diagnostics update routine with the appropriate arguments.
1241 : !\\
1242 : !\\
1243 : ! !INTERFACE:
1244 : !
1245 0 : SUBROUTINE Diagn_UpdateSp0d( HcoState, cID, cName, ExtNr, &
1246 : Cat, Hier, HcoID, AutoFill, &
1247 : Scalar, Total, PosOnly, COL, &
1248 : MinDiagnLev, RC )
1249 : !
1250 : ! !INPUT PARAMETERS:
1251 : !
1252 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
1253 : INTEGER, INTENT(IN ), OPTIONAL :: cID ! Assigned
1254 : ! container ID
1255 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cName ! Diagnostics
1256 : ! name
1257 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr ! Extension #
1258 : INTEGER, INTENT(IN ), OPTIONAL :: Cat ! Category
1259 : INTEGER, INTENT(IN ), OPTIONAL :: Hier ! Hierarchy
1260 : INTEGER, INTENT(IN ), OPTIONAL :: HcoID ! HEMCO species
1261 : ! ID number
1262 : INTEGER, INTENT(IN ), OPTIONAL :: AutoFill ! 1=yes; 0=no;
1263 : ! -1=either
1264 : REAL(sp), INTENT(IN ) :: Scalar ! 0D scalar
1265 : REAL(sp), INTENT(IN ), OPTIONAL :: Total ! Total
1266 : LOGICAL, INTENT(IN ), OPTIONAL :: PosOnly ! Use only vals
1267 : ! >= 0?
1268 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! Collection Nr.
1269 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev ! minimum diagn level
1270 : !
1271 : ! !INPUT/OUTPUT PARAMETERS:
1272 : !
1273 : INTEGER, INTENT(INOUT) :: RC ! Return code
1274 : !
1275 : ! !REVISION HISTORY:
1276 : ! 20 Apr 2015 - C. Keller - Initialization
1277 : ! See https://github.com/geoschem/hemco for complete history
1278 : !EOP
1279 : !------------------------------------------------------------------------------
1280 : !BOC
1281 :
1282 : ! Call down to driver routine
1283 : CALL Diagn_UpdateDriver( HcoState, &
1284 : cID = cID, &
1285 : cName = cName, &
1286 : ExtNr = ExtNr, &
1287 : Cat = Cat, &
1288 : Hier = Hier, &
1289 : HcoID = HcoID, &
1290 : AutoFill = AutoFill, &
1291 : Scalar_SP = Scalar, &
1292 : Total_SP = Total, &
1293 : PosOnly = PosOnly, &
1294 : COL = COL, &
1295 : MinDiagnLev = MinDiagnLev, &
1296 0 : RC = RC )
1297 :
1298 0 : END SUBROUTINE Diagn_UpdateSp0d
1299 : !EOC
1300 : !------------------------------------------------------------------------------
1301 : ! Harmonized Emissions Component (HEMCO) !
1302 : !------------------------------------------------------------------------------
1303 : !BOP
1304 : !
1305 : ! !ROUTINE: Diagn_UpdateSp2d
1306 : !
1307 : ! !DESCRIPTION: Subroutine Diagn\_UpdateSp2d is the wrapper routine to update
1308 : ! the diagnostics for single precision 2-D arrays. It invokes the main
1309 : ! diagnostics update routine with the appropriate arguments.
1310 : !\\
1311 : !\\
1312 : ! !INTERFACE:
1313 : !
1314 0 : SUBROUTINE Diagn_UpdateSp2d( HcoState, cID, cName, ExtNr, &
1315 : Cat, Hier, HcoID, AutoFill, &
1316 0 : Array2D, Total, PosOnly, COL, &
1317 : MinDiagnLev, RC )
1318 : !
1319 : ! !INPUT PARAMETERS:
1320 : !
1321 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
1322 : INTEGER, INTENT(IN ), OPTIONAL :: cID ! Assigned
1323 : ! container ID
1324 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cName ! Diagnostics
1325 : ! name
1326 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr ! Extension #
1327 : INTEGER, INTENT(IN ), OPTIONAL :: Cat ! Category
1328 : INTEGER, INTENT(IN ), OPTIONAL :: Hier ! Hierarchy
1329 : INTEGER, INTENT(IN ), OPTIONAL :: HcoID ! HEMCO species
1330 : ! ID number
1331 : INTEGER, INTENT(IN ), OPTIONAL :: AutoFill ! 1=yes; 0=no;
1332 : ! -1=either
1333 : REAL(sp), INTENT(IN ) :: Array2D(:,:) ! 2D array
1334 : REAL(sp), INTENT(IN ), OPTIONAL :: Total ! Total
1335 : LOGICAL, INTENT(IN ), OPTIONAL :: PosOnly ! Use only vals
1336 : ! >= 0?
1337 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! Collection Nr.
1338 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev ! minimum diagn level
1339 : !
1340 : ! !INPUT/OUTPUT PARAMETERS:
1341 : !
1342 : INTEGER, INTENT(INOUT) :: RC ! Return code
1343 : !
1344 : ! !REVISION HISTORY:
1345 : ! 20 Apr 2015 - C. Keller - Initialization
1346 : ! See https://github.com/geoschem/hemco for complete history
1347 : !EOP
1348 : !------------------------------------------------------------------------------
1349 : !BOC
1350 :
1351 : ! Call down to driver routine
1352 : CALL Diagn_UpdateDriver( HcoState, &
1353 : cID = cID, &
1354 : cName = cName, &
1355 : ExtNr = ExtNr, &
1356 : Cat = Cat, &
1357 : Hier = Hier, &
1358 : HcoID = HcoID, &
1359 : AutoFill = AutoFill, &
1360 : Array2D_SP = Array2D, &
1361 : Total_SP = Total, &
1362 : PosOnly = PosOnly, &
1363 : COL = COL, &
1364 : MinDiagnLev = MinDiagnLev, &
1365 0 : RC = RC )
1366 :
1367 0 : END SUBROUTINE Diagn_UpdateSp2d
1368 : !EOC
1369 : !------------------------------------------------------------------------------
1370 : ! Harmonized Emissions Component (HEMCO) !
1371 : !------------------------------------------------------------------------------
1372 : !BOP
1373 : !
1374 : ! !ROUTINE: Diagn_UpdateSp3d
1375 : !
1376 : ! !DESCRIPTION: Subroutine Diagn\_UpdateSp is the wrapper routine to update
1377 : ! the diagnostics for single precision 3-D arrays. It invokes the main
1378 : ! diagnostics update routine with the appropriate arguments.
1379 : !\\
1380 : !\\
1381 : ! !INTERFACE:
1382 : !
1383 0 : SUBROUTINE Diagn_UpdateSp3d( HcoState, cID, cName, ExtNr, &
1384 : Cat, Hier, HcoID, AutoFill, &
1385 0 : Array3D, Total, PosOnly, COL, &
1386 : MinDiagnLev, RC )
1387 : !
1388 : ! !INPUT PARAMETERS:
1389 : !
1390 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
1391 : INTEGER, INTENT(IN ), OPTIONAL :: cID ! Assigned
1392 : ! container ID
1393 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cName ! Diagnostics
1394 : ! name
1395 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr ! Extension #
1396 : INTEGER, INTENT(IN ), OPTIONAL :: Cat ! Category
1397 : INTEGER, INTENT(IN ), OPTIONAL :: Hier ! Hierarchy
1398 : INTEGER, INTENT(IN ), OPTIONAL :: HcoID ! HEMCO species
1399 : ! ID number
1400 : INTEGER, INTENT(IN ), OPTIONAL :: AutoFill ! 1=yes; 0=no;
1401 : ! -1=either
1402 : REAL(sp), INTENT(IN ) :: Array3D(:,:,:) ! 3D array
1403 : REAL(sp), INTENT(IN ), OPTIONAL :: Total ! Total
1404 : LOGICAL, INTENT(IN ), OPTIONAL :: PosOnly ! Use only vals
1405 : ! >= 0?
1406 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! Collection Nr.
1407 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev ! minimum diagn level
1408 : !
1409 : ! !INPUT/OUTPUT PARAMETERS:
1410 : !
1411 : INTEGER, INTENT(INOUT) :: RC ! Return code
1412 : !
1413 : ! !REVISION HISTORY:
1414 : ! 20 Apr 2015 - C. Keller - Initialization
1415 : ! See https://github.com/geoschem/hemco for complete history
1416 : !EOP
1417 : !------------------------------------------------------------------------------
1418 : !BOC
1419 :
1420 : ! Call down to driver routine
1421 : CALL Diagn_UpdateDriver( HcoState, &
1422 : cID = cID, &
1423 : cName = cName, &
1424 : ExtNr = ExtNr, &
1425 : Cat = Cat, &
1426 : Hier = Hier, &
1427 : HcoID = HcoID, &
1428 : AutoFill = AutoFill, &
1429 : Array3D_SP = Array3D, &
1430 : Total_SP = Total, &
1431 : PosOnly = PosOnly, &
1432 : COL = COL, &
1433 : MinDiagnLev = MinDiagnLev, &
1434 0 : RC = RC )
1435 :
1436 0 : END SUBROUTINE Diagn_UpdateSp3d
1437 : !EOC
1438 : !------------------------------------------------------------------------------
1439 : ! Harmonized Emissions Component (HEMCO) !
1440 : !------------------------------------------------------------------------------
1441 : !BOP
1442 : !
1443 : ! !ROUTINE: Diagn_UpdateDp0d
1444 : !
1445 : ! !DESCRIPTION: Subroutine Diagn\_UpdateSp0d is the wrapper routine to update
1446 : ! the diagnostics for double-precision scalar values. It invokes the main
1447 : ! diagnostics update routine with the appropriate arguments.
1448 : !\\
1449 : !\\
1450 : ! !INTERFACE:
1451 : !
1452 0 : SUBROUTINE Diagn_UpdateDp0d( HcoState, cID, cName, ExtNr, &
1453 : Cat, Hier, HcoID, AutoFill, &
1454 : Scalar, Total, PosOnly, COL, &
1455 : MinDiagnLev, RC )
1456 : !
1457 : ! !INPUT PARAMETERS:
1458 : !
1459 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
1460 : INTEGER, INTENT(IN ), OPTIONAL :: cID ! Assigned
1461 : ! container ID
1462 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cName ! Diagnostics
1463 : ! name
1464 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr ! Extension #
1465 : INTEGER, INTENT(IN ), OPTIONAL :: Cat ! Category
1466 : INTEGER, INTENT(IN ), OPTIONAL :: Hier ! Hierarchy
1467 : INTEGER, INTENT(IN ), OPTIONAL :: HcoID ! HEMCO species
1468 : ! ID number
1469 : INTEGER, INTENT(IN ), OPTIONAL :: AutoFill ! 1=yes; 0=no;
1470 : ! -1=either
1471 : REAL(dp), INTENT(IN ) :: Scalar ! 1D scalar
1472 : REAL(dp), INTENT(IN ), OPTIONAL :: Total ! Total
1473 : LOGICAL, INTENT(IN ), OPTIONAL :: PosOnly ! Use only vals
1474 : ! >= 0?
1475 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! Collection Nr.
1476 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev ! minimum diagn level
1477 : !
1478 : ! !INPUT/OUTPUT PARAMETERS:
1479 : !
1480 : INTEGER, INTENT(INOUT) :: RC ! Return code
1481 : !
1482 : ! !REVISION HISTORY:
1483 : ! 20 Apr 2015 - C. Keller - Initialization
1484 : ! See https://github.com/geoschem/hemco for complete history
1485 : !EOP
1486 : !------------------------------------------------------------------------------
1487 : !BOC
1488 :
1489 : ! Call down to driver routine
1490 : CALL Diagn_UpdateDriver( HcoState, &
1491 : cID = cID, &
1492 : cName = cName, &
1493 : ExtNr = ExtNr, &
1494 : Cat = Cat, &
1495 : Hier = Hier, &
1496 : HcoID = HcoID, &
1497 : AutoFill = AutoFill, &
1498 : Scalar = Scalar, &
1499 : Total = Total, &
1500 : PosOnly = PosOnly, &
1501 : COL = COL, &
1502 : MinDiagnLev = MinDiagnLev, &
1503 0 : RC = RC )
1504 :
1505 0 : END SUBROUTINE Diagn_UpdateDp0d
1506 : !EOC
1507 : !------------------------------------------------------------------------------
1508 : ! Harmonized Emissions Component (HEMCO) !
1509 : !------------------------------------------------------------------------------
1510 : !BOP
1511 : !
1512 : ! !ROUTINE: Diagn_UpdateDp2d
1513 : !
1514 : ! !DESCRIPTION: Subroutine Diagn\_UpdateSp2d is the wrapper routine to update
1515 : ! the diagnostics for single precision 2D arrays. It invokes the main
1516 : ! diagnostics update routine with the appropriate arguments.
1517 : !\\
1518 : !\\
1519 : ! !INTERFACE:
1520 : !
1521 0 : SUBROUTINE Diagn_UpdateDp2d( HcoState, cID, cName, ExtNr, &
1522 : Cat, Hier, HcoID, AutoFill, &
1523 0 : Array2D, Total, PosOnly, COL, &
1524 : MinDiagnLev, RC )
1525 : !
1526 : ! !INPUT PARAMETERS:
1527 : !
1528 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
1529 : INTEGER, INTENT(IN ), OPTIONAL :: cID ! Assigned
1530 : ! container ID
1531 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cName ! Diagnostics
1532 : ! name
1533 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr ! Extension #
1534 : INTEGER, INTENT(IN ), OPTIONAL :: Cat ! Category
1535 : INTEGER, INTENT(IN ), OPTIONAL :: Hier ! Hierarchy
1536 : INTEGER, INTENT(IN ), OPTIONAL :: HcoID ! HEMCO species
1537 : ! ID number
1538 : INTEGER, INTENT(IN ), OPTIONAL :: AutoFill ! 1=yes; 0=no;
1539 : ! -1=either
1540 : REAL(dp), INTENT(IN ) :: Array2D(:,:) ! 2D array
1541 : REAL(dp), INTENT(IN ), OPTIONAL :: Total ! Total
1542 : LOGICAL, INTENT(IN ), OPTIONAL :: PosOnly ! Use only vals
1543 : ! >= 0?
1544 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! Collection Nr.
1545 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev ! minimum diagn level
1546 : !
1547 : ! !INPUT/OUTPUT PARAMETERS:
1548 : !
1549 : INTEGER, INTENT(INOUT) :: RC ! Return code
1550 : !
1551 : ! !REVISION HISTORY:
1552 : ! 20 Apr 2015 - C. Keller - Initialization
1553 : ! See https://github.com/geoschem/hemco for complete history
1554 : !EOP
1555 : !------------------------------------------------------------------------------
1556 : !BOC
1557 :
1558 : ! Call down to driver routine
1559 : CALL Diagn_UpdateDriver( HcoState, &
1560 : cID = cID, &
1561 : cName = cName, &
1562 : ExtNr = ExtNr, &
1563 : Cat = Cat, &
1564 : Hier = Hier, &
1565 : HcoID = HcoID, &
1566 : AutoFill = AutoFill, &
1567 : Array2D = Array2D, &
1568 : Total = Total, &
1569 : PosOnly = PosOnly, &
1570 : COL = COL, &
1571 : MinDiagnLev = MinDiagnLev, &
1572 0 : RC = RC )
1573 :
1574 0 : END SUBROUTINE Diagn_UpdateDp2d
1575 : !EOC
1576 : !------------------------------------------------------------------------------
1577 : ! Harmonized Emissions Component (HEMCO) !
1578 : !------------------------------------------------------------------------------
1579 : !BOP
1580 : !
1581 : ! !ROUTINE: Diagn_UpdateDp3d
1582 : !
1583 : ! !DESCRIPTION: Subroutine Diagn\_UpdateSp3d is the wrapper routine to update
1584 : ! the diagnostics for single precision arrays. It invokes the main diagnostics
1585 : ! update routine with the appropriate arguments.
1586 : !\\
1587 : !\\
1588 : ! !INTERFACE:
1589 : !
1590 0 : SUBROUTINE Diagn_UpdateDp3d( HcoState, cID, cName, ExtNr, &
1591 : Cat, Hier, HcoID, AutoFill, &
1592 0 : Array3D, Total, PosOnly, COL, &
1593 : MinDiagnLev, RC )
1594 : !
1595 : ! !USES:
1596 : !
1597 : USE HCO_State_Mod, ONLY : HCO_State
1598 : !
1599 : ! !INPUT PARAMETERS:
1600 : !
1601 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
1602 : INTEGER, INTENT(IN ), OPTIONAL :: cID ! Assigned
1603 : ! container ID
1604 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cName ! Diagnostics
1605 : ! name
1606 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr ! Extension #
1607 : INTEGER, INTENT(IN ), OPTIONAL :: Cat ! Category
1608 : INTEGER, INTENT(IN ), OPTIONAL :: Hier ! Hierarchy
1609 : INTEGER, INTENT(IN ), OPTIONAL :: HcoID ! HEMCO species
1610 : ! ID number
1611 : INTEGER, INTENT(IN ), OPTIONAL :: AutoFill ! 1=yes; 0=no;
1612 : ! -1=either
1613 : REAL(dp), INTENT(IN ) :: Array3D(:,:,:) ! 3D array
1614 : REAL(dp), INTENT(IN ), OPTIONAL :: Total ! Total
1615 : LOGICAL, INTENT(IN ), OPTIONAL :: PosOnly ! Use only vals
1616 : ! >= 0?
1617 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! Collection Nr.
1618 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev ! minimum diagn level
1619 : !
1620 : ! !INPUT/OUTPUT PARAMETERS:
1621 : !
1622 : INTEGER, INTENT(INOUT) :: RC ! Return code
1623 : !
1624 : ! !REVISION HISTORY:
1625 : ! 20 Apr 2015 - C. Keller - Initialization
1626 : ! See https://github.com/geoschem/hemco for complete history
1627 : !EOP
1628 : !------------------------------------------------------------------------------
1629 : !BOC
1630 :
1631 : ! Call down to driver routine
1632 : CALL Diagn_UpdateDriver( HcoState, &
1633 : cID = cID, &
1634 : cName = cName, &
1635 : ExtNr = ExtNr, &
1636 : Cat = Cat, &
1637 : Hier = Hier, &
1638 : HcoID = HcoID, &
1639 : AutoFill = AutoFill, &
1640 : Array3D = Array3D, &
1641 : Total = Total, &
1642 : PosOnly = PosOnly, &
1643 : COL = COL, &
1644 : MinDiagnLev = MinDiagnLev, &
1645 0 : RC = RC )
1646 :
1647 0 : END SUBROUTINE Diagn_UpdateDp3d
1648 : !EOC
1649 : !------------------------------------------------------------------------------
1650 : ! Harmonized Emissions Component (HEMCO) !
1651 : !------------------------------------------------------------------------------
1652 : !BOP
1653 : !
1654 : ! !ROUTINE: Diagn_UpdateDriver
1655 : !
1656 : ! !DESCRIPTION: Subroutine Diagn\_UpdateDriver updates the content of a
1657 : ! diagnostics container. The container to be updated is determined
1658 : ! from the passed variables. If a valid (i.e. positive) container
1659 : ! ID is provided, this container is used. Otherwise, if a valid
1660 : ! HEMCO species ID (HcoID) is provided, all containers with the same
1661 : ! combination of HcoID, extension number (ExtNr), emission category
1662 : ! (Cat) and hierarchy (Hier) are updated. If no valid HcoID and no
1663 : ! valid cID is given, the container name has to be provided. The passed
1664 : ! data array (Scalar, Array2D, or Array3D) needs to match the
1665 : ! spatial dimension of the given container. For 2D diagnostics, a 3D
1666 : ! array can be passed, in which case the level index specified
1667 : ! during initialization (`LevIdx`) is used. If LevIdx is set to -1,
1668 : ! the column sum is used (default).
1669 : !\\
1670 : !\\
1671 : ! If no matching container is found, the subroutine leaves with no
1672 : ! error. This allows automatic diagnostics generation, e.g. of
1673 : ! intermediate emission fields created in HCO\_CALC\_Mod.F90.
1674 : !\\
1675 : !\\
1676 : ! The optional input argument `MinDiagnLev` determines how `deep`
1677 : ! this routine will search for diagnostics with matching HcoID, ExtNr,
1678 : ! etc. For example, if a HcoID, an ExtNr, and a category is provided,
1679 : ! HEMCO by default will only update diagnostics containers with exactly
1680 : ! the same HcoID, ExtNr, and category - but not diagnostics of `lower
1681 : ! level`, e.g. with the same HcoID and ExtNr but no assigned category.
1682 : ! This behavior can be changed by explicitly setting MinDiagnLev to the
1683 : ! minimum diagnostics level. In the given example, setting MinDiagnLev
1684 : ! to 1 would also update level 1 and level 2 diagnostics of the same
1685 : ! HcoID (e.g. diagnostics with the same HcoID and no assigned ExtNr and
1686 : ! category; as well as diagnostics with the same HcoID and ExtNr and no
1687 : ! assigned category).
1688 : !\\
1689 : !\\
1690 : ! Notes:
1691 : ! \begin{itemize}
1692 : ! \item For a given time step, the same diagnostics container can be
1693 : ! updated multiple times. The field average is always defined as
1694 : ! temporal average, e.g. multiple updates on the same time step
1695 : ! will not increase the averaging weight of that time step.
1696 : !
1697 : ! \item If the passed array is empty (i.e. not associated), it is
1698 : ! treated as empty values (i.e. zeros).
1699 : !
1700 : ! \item The collection number can be set to -1 to scan trough all
1701 : ! existing diagnostic collections.
1702 : ! \end{itemize}
1703 : !
1704 : ! !INTERFACE:
1705 : !
1706 0 : SUBROUTINE Diagn_UpdateDriver( HcoState, cID, cName, &
1707 : ExtNr, Cat, Hier, HcoID, &
1708 0 : AutoFill, Scalar, Array2D, Array3D, &
1709 0 : Total, Scalar_SP, Array2D_SP, Array3D_SP, &
1710 0 : Total_SP, Scalar_HP, Array2D_HP, Array3D_HP, &
1711 : Total_HP, PosOnly, COL, MinDiagnLev, &
1712 : RC )
1713 : !
1714 : ! !USES:
1715 : !
1716 : USE HCO_Arr_Mod, ONLY : HCO_ArrAssert
1717 : !
1718 : ! !INPUT PARAMETERS:
1719 : !
1720 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
1721 : INTEGER, INTENT(IN ), OPTIONAL :: cID ! container ID
1722 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cName ! Dgn name
1723 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr ! Extension #
1724 : INTEGER, INTENT(IN ), OPTIONAL :: Cat ! Category
1725 : INTEGER, INTENT(IN ), OPTIONAL :: Hier ! Hierarchy
1726 : INTEGER, INTENT(IN ), OPTIONAL :: HcoID ! HEMCO species ID
1727 : INTEGER, INTENT(IN ), OPTIONAL :: AutoFill ! 1=yes; 0=no;
1728 : ! -1=either
1729 : REAL(dp), INTENT(IN ), OPTIONAL :: Scalar ! 1D scalar
1730 : REAL(dp), INTENT(IN ), OPTIONAL, TARGET :: Array2D (:,:) ! 2D array
1731 : REAL(dp), INTENT(IN ), OPTIONAL, TARGET :: Array3D (:,:,:) ! 3D array
1732 : REAL(dp), INTENT(IN ), OPTIONAL :: Total ! Total
1733 : REAL(sp), INTENT(IN ), OPTIONAL :: Scalar_SP ! 1D scalar
1734 : REAL(sp), INTENT(IN ), OPTIONAL, TARGET :: Array2D_SP(:,:) ! 2D array
1735 : REAL(sp), INTENT(IN ), OPTIONAL, TARGET :: Array3D_SP(:,:,:) ! 3D array
1736 : REAL(sp), INTENT(IN ), OPTIONAL :: Total_SP ! Total
1737 : REAL(hp), INTENT(IN ), OPTIONAL :: Scalar_HP ! 1D scalar
1738 : REAL(hp), INTENT(IN ), OPTIONAL, TARGET :: Array2D_HP(:,:) ! 2D array
1739 : REAL(hp), INTENT(IN ), OPTIONAL, TARGET :: Array3D_HP(:,:,:) ! 3D array
1740 : REAL(hp), INTENT(IN ), OPTIONAL :: Total_HP ! Total
1741 : LOGICAL, INTENT(IN ), OPTIONAL :: PosOnly ! Use only vals
1742 : ! >= 0?
1743 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! Collection Nr.
1744 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev ! Collection Nr.
1745 : !
1746 : ! !INPUT/OUTPUT PARAMETERS:
1747 : !
1748 : INTEGER, INTENT(INOUT) :: RC ! Return code
1749 : !
1750 : ! !REVISION HISTORY:
1751 : ! 19 Dec 2013 - C. Keller - Initialization
1752 : ! See https://github.com/geoschem/hemco for complete history
1753 : !EOP
1754 : !------------------------------------------------------------------------------
1755 : !BOC
1756 : !
1757 : ! !LOCAL VARIABLES:
1758 : !
1759 : ! Pointers
1760 : TYPE(DiagnCollection), POINTER :: ThisColl
1761 : TYPE(DiagnCont), POINTER :: ThisDiagn
1762 0 : REAL(sp), POINTER :: Arr2D (:,:)
1763 0 : REAL(sp), POINTER :: Tmp2D (:,:)
1764 0 : REAL(sp), POINTER :: Arr3D (:,:,:)
1765 : REAL(sp) :: TmpScalar
1766 :
1767 : ! Scalars
1768 : CHARACTER(LEN=255) :: LOC, MSG
1769 : REAL(hp) :: Fact
1770 : REAL(hp) :: Tmp
1771 : CHARACTER(LEN=63) :: DgnName
1772 : INTEGER :: I, J, L, PS, AS
1773 : INTEGER :: DgncID, DgnExtNr, DgnCat
1774 : INTEGER :: iHier, iExt, iCat
1775 : INTEGER :: DgnHier, DgnHcoID
1776 : INTEGER :: ThisUpdateID
1777 : INTEGER :: AutoFlag
1778 : INTEGER :: CNT
1779 : INTEGER :: MnDgnLev, OrigDgnLev, ThisDgnLev
1780 : LOGICAL :: Found, OnlyPos, VertSum, IsAssoc, IsNewTS
1781 : LOGICAL :: InUse, SearchAll
1782 :
1783 : !======================================================================
1784 : ! Diagn_UpdateDriver begins here!
1785 : !======================================================================
1786 :
1787 : ! Init
1788 0 : LOC = 'Diagn_UpdateDriver (hco_diagn_mod.F90)'
1789 0 : RC = HCO_SUCCESS
1790 0 : ThisColl => NULL()
1791 0 : ThisDiagn => NULL()
1792 0 : Arr2D => NULL()
1793 0 : Tmp2D => NULL()
1794 0 : Arr3D => NULL()
1795 :
1796 : ! Get collection number.
1797 : CALL DiagnCollection_DefineID( HcoState%Diagn, PS, RC, COL=COL, DEF=-1, &
1798 0 : OKIfAll=.TRUE., InUse=InUse, ThisColl=ThisColl, HcoState=HcoState )
1799 0 : IF ( RC /= HCO_SUCCESS ) THEN
1800 0 : CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC )
1801 0 : RETURN
1802 : ENDIF
1803 :
1804 : ! Check if we need to scan through all collections. This is only the
1805 : ! case if PS is set to -1
1806 0 : IF ( PS == -1 ) THEN
1807 : SearchAll = .TRUE.
1808 : ELSE
1809 0 : SearchAll = .FALSE.
1810 : ENDIF
1811 :
1812 : ! Nothing to do if this collection is empty
1813 0 : IF ( .NOT. SearchAll .AND. .NOT. InUse ) THEN
1814 : RETURN
1815 : ENDIF
1816 :
1817 : !----------------------------------------------------------------------
1818 : ! Make sure all attributes are defined
1819 : !----------------------------------------------------------------------
1820 0 : DgnName = ''
1821 0 : DgncID = -1
1822 0 : DgnExtNr = -1
1823 0 : DgnCat = -1
1824 0 : DgnHier = -1
1825 0 : DgnHcoID = -1
1826 0 : OnlyPos = .FALSE.
1827 0 : AutoFlag = -1
1828 0 : IF ( PRESENT(cName ) ) DgnName = ADJUSTL(cName)
1829 0 : IF ( PRESENT(cID ) ) DgncID = cID
1830 0 : IF ( PRESENT(ExtNr ) ) DgnExtNr = ExtNr
1831 0 : IF ( PRESENT(Cat ) ) DgnCat = Cat
1832 0 : IF ( PRESENT(Hier ) ) DgnHier = Hier
1833 0 : IF ( PRESENT(HcoID ) ) DgnHcoID = HcoID
1834 0 : IF ( PRESENT(PosOnly ) ) OnlyPos = PosOnly
1835 0 : IF ( PRESENT(AutoFill) ) AutoFlag = AutoFill
1836 :
1837 : ! Get the update time ID.
1838 0 : CALL HcoClock_Get( HcoState%Clock, nSteps=ThisUpdateID, RC=RC )
1839 0 : IF ( RC /= HCO_SUCCESS ) THEN
1840 0 : CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC )
1841 0 : RETURN
1842 : ENDIF
1843 :
1844 : ! Count # of containers that are updated
1845 0 : CNT = 0
1846 :
1847 : !-----------------------------------------------------------------
1848 : ! Diagnostics levels to be used. By default, use only diagnostics
1849 : ! at the provided level. For instance, if a hierarchy number is
1850 : ! given do not update diagnostics with the same species and
1851 : ! extension number but a hierarchy number of -1. If a diagnostics
1852 : ! level is given, update all diagnostics up to this diagnostics
1853 : ! level.
1854 : !-----------------------------------------------------------------
1855 :
1856 : ! Get original diagnostics level
1857 0 : OrigDgnLev = 999
1858 0 : IF ( DgnHcoID > -1 ) THEN
1859 0 : OrigDgnLev = 1
1860 0 : IF ( DgnExtNr > -1 ) THEN
1861 0 : OrigDgnLev = 2
1862 0 : IF ( DgnCat > -1 ) THEN
1863 0 : OrigDgnLev = 3
1864 0 : IF ( DgnHier > -1 ) THEN
1865 0 : OrigDgnLev = 4
1866 : ENDIF
1867 : ENDIF
1868 : ENDIF
1869 : ENDIF
1870 :
1871 : ! Set diagnostics level
1872 0 : IF ( PRESENT(MinDiagnLev) ) THEN
1873 0 : MnDgnLev = MinDiagnLev
1874 : ELSE
1875 0 : MnDgnLev = OrigDgnLev
1876 : ENDIF
1877 :
1878 :
1879 : !-----------------------------------------------------------------
1880 : ! Loop over collections
1881 : !-----------------------------------------------------------------
1882 0 : DO WHILE ( ASSOCIATED(ThisColl) )
1883 :
1884 : ! Reset Diagnostics
1885 0 : ThisDiagn => NULL()
1886 :
1887 : ! Reset diagnostics level to use
1888 0 : ThisDgnLev = OrigDgnLev
1889 :
1890 : !-----------------------------------------------------------------
1891 : ! Do for every container in the diagnostics list that matches the
1892 : ! specified arguments (ID, ExtNr, etc.). This can be more than one
1893 : ! container (ckeller, 09/25/2014).
1894 : !-----------------------------------------------------------------
1895 : DO
1896 :
1897 : ! Set ExtNr, Cat, Hier based on current diagnostics level.
1898 0 : iExt = -1
1899 0 : iCat = -1
1900 0 : iHier = -1
1901 0 : IF ( ThisDgnLev > 1 ) iExt = DgnExtNr
1902 0 : IF ( ThisDgnLev > 2 ) iCat = DgnCat
1903 0 : IF ( ThisDgnLev > 3 ) iHier = DgnHier
1904 :
1905 : ! Search for diagnostics that matches the given arguments.
1906 : ! If ThisDiagn is empty (first call), the search will start
1907 : ! at the first diagnostics container. Otherwise, the search
1908 : ! will resume from this diagnostics container.
1909 : CALL DiagnCont_Find( HcoState%Diagn, &
1910 : DgncID, iExt, iCat, iHier, &
1911 : DgnHcoID, DgnName, AutoFlag, Found, &
1912 0 : ThisDiagn, RESUME=.TRUE., COL=ThisColl%CollectionID )
1913 :
1914 : ! Exit while loop if no diagnostics found
1915 : !IF ( .NOT. Found ) EXIT
1916 : ! Now also check lower level diagnostics is specified so
1917 0 : IF ( .NOT. Found ) THEN
1918 0 : IF ( ThisDgnLev > MnDgnLev ) THEN
1919 0 : ThisDgnLev = ThisDgnLev - 1
1920 0 : ThisDiagn => NULL()
1921 0 : CYCLE
1922 : ELSE
1923 : EXIT
1924 : ENDIF
1925 : ENDIF
1926 :
1927 : ! If container holds just a pointer to external data, don't do
1928 : ! anything!
1929 0 : IF ( ThisDiagn%DtaIsPtr ) THEN
1930 : MSG = 'You try to update a container that holds a ' // &
1931 : 'pointer to data - this should never happen! ' // &
1932 0 : TRIM(ThisDiagn%cName)
1933 0 : CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
1934 0 : CYCLE
1935 : ENDIF
1936 :
1937 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
1938 0 : WRITE(MSG,*) 'ThisDiagn%cName: ', trim(ThisDiagn%cName)
1939 0 : CALL HCO_MSG(HcoState%Config%Err, MSG)
1940 0 : WRITE(MSG,*) 'ThisDiagn%AvgFlag: ', ThisDiagn%AvgFlag
1941 0 : CALL HCO_MSG(HcoState%Config%Err, MSG)
1942 0 : WRITE(MSG,*) 'ThisDiagn%SpaceDim: ', ThisDiagn%SpaceDim
1943 0 : CALL HCO_MSG(HcoState%Config%Err, MSG)
1944 : ENDIF
1945 :
1946 : ! Increase counter
1947 0 : CNT = CNT + 1
1948 :
1949 : !----------------------------------------------------------------------
1950 : ! Check if this is a new time step for this diagnostics.
1951 : !----------------------------------------------------------------------
1952 0 : IsNewTS = .TRUE.
1953 0 : IF ( ThisDiagn%LastUpdateID == ThisUpdateID ) IsNewTS = .FALSE.
1954 :
1955 : !----------------------------------------------------------------------
1956 : ! If data is in output format, set counter to zero. This will make
1957 : ! sure that the new data is not added to the existing data.
1958 : !----------------------------------------------------------------------
1959 0 : IF ( ThisDiagn%IsOutFormat ) THEN
1960 0 : ThisDiagn%Counter = 0
1961 : ENDIF
1962 :
1963 : !----------------------------------------------------------------------
1964 : ! Determine scale factor to be applied to data. Diagnostics are
1965 : ! stored in kg/m2, hence need to multiply HEMCO emissions, which
1966 : ! are in kg/m2/s, by emission time step. Don't do anything for
1967 : ! data with non-standard units (e.g. unitless factors) or pointers.
1968 : ! Note: conversion to final output units is done when writing out
1969 : ! the diagnostics.
1970 : !----------------------------------------------------------------------
1971 0 : IF ( ThisDiagn%AvgFlag > 0 ) THEN
1972 : Fact = 1.0_hp
1973 : ELSE
1974 0 : Fact = ThisColl%TS
1975 : ENDIF
1976 :
1977 : !----------------------------------------------------------------------
1978 : ! Fill shadow arrays. Cast any input data to single precision, as this
1979 : ! is the default diagnostics precision.
1980 : !----------------------------------------------------------------------
1981 :
1982 : ! Only need to do this on first container. Afterwards, arrays are
1983 : ! already set!
1984 0 : IF ( CNT == 1 ) THEN
1985 :
1986 : ! 3D array
1987 0 : IF ( PRESENT(Array3D_SP) ) THEN
1988 0 : Arr3D => Array3D_SP
1989 0 : ELSEIF ( PRESENT(Array3D_HP) ) THEN
1990 0 : ALLOCATE( Arr3D(ThisColl%NX,ThisColl%NY,ThisColl%NZ),STAT=AS)
1991 : IF ( AS /= 0 ) THEN
1992 : CALL HCO_ERROR( &
1993 0 : 'Allocation error Arr3D', RC, THISLOC=LOC )
1994 0 : RETURN
1995 : ENDIF
1996 0 : Arr3D = Array3D_HP
1997 0 : ELSEIF( PRESENT(Array3D) ) THEN
1998 0 : ALLOCATE( Arr3D(ThisColl%NX,ThisColl%NY,ThisColl%NZ),STAT=AS)
1999 : IF ( AS /= 0 ) THEN
2000 : CALL HCO_ERROR( &
2001 0 : 'Allocation error Arr3D', RC, THISLOC=LOC )
2002 0 : RETURN
2003 : ENDIF
2004 0 : Arr3D = Array3D
2005 : ENDIF
2006 :
2007 : ! 2D array
2008 0 : IF ( PRESENT(Array2D_SP) ) THEN
2009 0 : Arr2D => Array2D_SP
2010 0 : ELSEIF ( PRESENT(Array2D_HP) ) THEN
2011 0 : ALLOCATE( Arr2D(ThisColl%NX,ThisColl%NY),STAT=AS)
2012 : IF ( AS /= 0 ) THEN
2013 : CALL HCO_ERROR( &
2014 0 : 'Allocation error Arr2D', RC, THISLOC=LOC )
2015 0 : RETURN
2016 : ENDIF
2017 0 : Arr2D = Array2D_HP
2018 0 : ELSEIF( PRESENT(Array2D) ) THEN
2019 0 : ALLOCATE( Arr2D(ThisColl%NX,ThisColl%NY),STAT=AS)
2020 : IF ( AS /= 0 ) THEN
2021 : CALL HCO_ERROR( &
2022 0 : 'Allocation error Arr2D', RC, THISLOC=LOC )
2023 0 : RETURN
2024 : ENDIF
2025 0 : Arr2D = Array2D
2026 : ENDIF
2027 :
2028 : ! Scalar
2029 0 : IF ( PRESENT(Scalar_SP) ) THEN
2030 0 : TmpScalar = Scalar_SP
2031 0 : ELSEIF ( PRESENT(Scalar) ) THEN
2032 0 : TmpScalar = Scalar
2033 : ENDIF
2034 :
2035 : ENDIF ! Counter = 1
2036 :
2037 : !----------------------------------------------------------------------
2038 : ! To add 3D array
2039 : !----------------------------------------------------------------------
2040 0 : IF ( ThisDiagn%SpaceDim == 3 ) THEN
2041 :
2042 : ! Make sure dimensions agree and diagnostics array is allocated
2043 0 : IF ( PRESENT(Array3D_SP) .OR. PRESENT(Array3D) .OR. PRESENT(Array3D_HP) ) THEN
2044 :
2045 : ! By default, write into single precision array
2046 : CALL HCO_ArrAssert( ThisDiagn%Arr3D, ThisColl%NX, &
2047 0 : ThisColl%NY, ThisColl%NZ, RC )
2048 0 : IF ( RC /= HCO_SUCCESS ) THEN
2049 0 : CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC )
2050 0 : RETURN
2051 : ENDIF
2052 :
2053 : ! Pass array to diagnostics: reset to zero if counter
2054 : ! is zero, add to it otherwise.
2055 : ! Never reset containers with cumulative sums!
2056 0 : IF ( ThisDiagn%Counter == 0 .AND. &
2057 0 : ThisDiagn%AvgFlag /= AvgFlagCumulSum ) ThisDiagn%Arr3D%Val = 0.0_sp
2058 :
2059 : ! Always reset containers with instantaneous values if it's a new
2060 : ! time step.
2061 0 : IF ( ThisDiagn%AvgFlag == AvgFlagInst .AND. IsNewTS ) ThisDiagn%Arr3D%Val = 0.0_sp
2062 :
2063 : ! Only if associated ...
2064 0 : IF ( ASSOCIATED(Arr3D) ) THEN
2065 0 : IF ( OnlyPos ) THEN
2066 0 : WHERE ( Arr3D >= 0.0_sp )
2067 0 : ThisDiagn%Arr3D%Val = ThisDiagn%Arr3D%Val + ( Arr3D * Fact )
2068 : END WHERE
2069 : ELSE
2070 0 : ThisDiagn%Arr3D%Val = ThisDiagn%Arr3D%Val + ( Arr3D * Fact )
2071 : ENDIF
2072 : ENDIF
2073 : ENDIF
2074 :
2075 : !----------------------------------------------------------------------
2076 : ! To add 2D array
2077 : !----------------------------------------------------------------------
2078 0 : ELSEIF ( ThisDiagn%SpaceDim == 2 ) THEN
2079 :
2080 : IF ( PRESENT(Array3D_SP) .OR. PRESENT(Array3D) .OR. PRESENT(Array3D_HP) .OR. &
2081 0 : PRESENT(Array2D_SP) .OR. PRESENT(Array2D) .OR. PRESENT(Array2D_HP) ) THEN
2082 :
2083 : ! Make sure dimensions agree and diagnostics array is allocated
2084 : CALL HCO_ArrAssert( ThisDiagn%Arr2D, ThisColl%NX, &
2085 0 : ThisColl%NY, RC )
2086 0 : IF ( RC /= HCO_SUCCESS ) THEN
2087 0 : CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC )
2088 0 : RETURN
2089 : ENDIF
2090 :
2091 : ! Pass array to diagnostics: ignore existing data if counter
2092 : ! is zero, add to it otherwise.
2093 : ! Never reset containers with cumulative sums!
2094 0 : IF ( ThisDiagn%Counter == 0 .AND. &
2095 0 : ThisDiagn%AvgFlag /= AvgFlagCumulSum ) ThisDiagn%Arr2D%Val = 0.0_sp
2096 :
2097 : ! Always reset containers with instantaneous values if it's a new time step
2098 0 : IF ( ThisDiagn%AvgFlag == AvgFlagInst .AND. IsNewTS ) ThisDiagn%Arr2D%Val = 0.0_sp
2099 :
2100 : ! Assume that we don't have to take the vertical sum
2101 0 : VertSum = .FALSE.
2102 :
2103 : ! Assume data pointer is associated
2104 0 : IsAssoc = .TRUE.
2105 :
2106 : ! Convert 3D array to 2D if necessary - only use first level!!
2107 0 : IF ( PRESENT(Array2D) .OR. PRESENT(Array2D_SP) .OR. PRESENT(Array2D_HP) ) THEN
2108 0 : IF ( .NOT. ASSOCIATED(Arr2D) ) THEN
2109 : IsAssoc = .FALSE.
2110 : ELSE
2111 0 : Tmp2D => Arr2D
2112 : ENDIF
2113 0 : ELSEIF ( PRESENT(Array3D) .OR. PRESENT(Array3D_SP) .OR. PRESENT(Array3D_HP) ) THEN
2114 0 : IF ( .NOT. ASSOCIATED(Arr3D) ) THEN
2115 : IsAssoc = .FALSE.
2116 : ELSE
2117 0 : IF ( ThisDiagn%LevIdx == -1 ) THEN
2118 : VertSum = .TRUE.
2119 : ELSE
2120 0 : Tmp2D => Arr3D(:,:,ThisDiagn%LevIdx)
2121 : ENDIF
2122 : ENDIF
2123 : ELSE
2124 0 : MSG = 'No array passed for updating ' // TRIM(ThisDiagn%cName)
2125 0 : CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
2126 0 : RETURN
2127 : ENDIF
2128 :
2129 : ! Do only if data pointer associated ...
2130 : IF ( IsAssoc ) THEN
2131 :
2132 : ! only positive values
2133 0 : IF ( OnlyPos ) THEN
2134 :
2135 : ! need to do vertical summation
2136 0 : IF ( VertSum ) THEN
2137 0 : DO J=1,ThisColl%NY
2138 0 : DO I=1,ThisColl%NX
2139 0 : TMP = 0.0_hp
2140 0 : DO L=1,ThisColl%NZ
2141 0 : IF ( Arr3D(I,J,L) >= 0.0_sp ) &
2142 0 : TMP = TMP + ( Arr3D(I,J,L) * Fact )
2143 : ENDDO
2144 0 : ThisDiagn%Arr2D%Val(I,J) = &
2145 0 : ThisDiagn%Arr2D%Val(I,J) + TMP
2146 : ENDDO
2147 : ENDDO
2148 :
2149 : ! no vertical summation
2150 : ELSE
2151 0 : WHERE ( Tmp2D >= 0.0_sp )
2152 0 : ThisDiagn%Arr2D%Val = ThisDiagn%Arr2D%Val + ( Tmp2D * Fact )
2153 : END WHERE
2154 : ENDIF
2155 :
2156 : ! all values
2157 : ELSE
2158 :
2159 : ! need to do vertical summation
2160 0 : IF ( VertSum ) THEN
2161 0 : DO J=1,ThisColl%NY
2162 0 : DO I=1,ThisColl%NX
2163 0 : TMP = SUM(Arr3D(I,J,:)) * Fact
2164 0 : ThisDiagn%Arr2D%Val(I,J) = &
2165 0 : ThisDiagn%Arr2D%Val(I,J) + TMP
2166 : ENDDO
2167 : ENDDO
2168 :
2169 : ! no vertical summation
2170 : ELSE
2171 0 : ThisDiagn%Arr2D%Val = ThisDiagn%Arr2D%Val + ( Tmp2D * Fact )
2172 : ENDIF
2173 : ENDIF
2174 : ENDIF ! pointer is associated
2175 : ENDIF ! Array present
2176 :
2177 : !----------------------------------------------------------------------
2178 : ! To add scalar (1D)
2179 : !----------------------------------------------------------------------
2180 0 : ELSEIF ( ThisDiagn%SpaceDim == 1 ) THEN
2181 :
2182 : ! Make sure dimensions agree and diagnostics array is allocated
2183 0 : IF ( PRESENT(Scalar_SP) .OR. PRESENT(Scalar) .OR. PRESENT(Scalar_HP) ) THEN
2184 :
2185 : ! Pass array to diagnostics: ignore existing data if counter
2186 : ! is zero, add to it otherwise.
2187 : ! Never reset containers with cumulative sums!
2188 0 : IF ( ThisDiagn%Counter == 0 .AND. &
2189 0 : ThisDiagn%AvgFlag /= AvgFlagCumulSum ) ThisDiagn%Scalar = 0.0_sp
2190 :
2191 : ! Always reset containers with instantaneous values if it's a new time step
2192 0 : IF ( ThisDiagn%AvgFlag == AvgFlagInst .AND. IsNewTS ) ThisDiagn%Scalar = 0.0_sp
2193 :
2194 : ! Update scalar value
2195 0 : IF ( OnlyPos ) THEN
2196 0 : IF ( TmpScalar >= 0.0_sp ) &
2197 0 : ThisDiagn%Scalar = ThisDiagn%Scalar + ( TmpScalar * Fact )
2198 : ELSE
2199 0 : ThisDiagn%Scalar = ThisDiagn%Scalar + ( TmpScalar * Fact )
2200 : ENDIF
2201 : ENDIF
2202 : ENDIF
2203 :
2204 : !----------------------------------------------------------------------
2205 : ! Eventually update total
2206 : !----------------------------------------------------------------------
2207 0 : IF ( PRESENT(Total) ) THEN
2208 0 : ThisDiagn%Total = ThisDiagn%Total + Total
2209 : ENDIF
2210 0 : IF ( PRESENT(Total_SP) ) THEN
2211 0 : ThisDiagn%Total = ThisDiagn%Total + Total_SP
2212 : ENDIF
2213 0 : IF ( PRESENT(Total_HP) ) THEN
2214 0 : ThisDiagn%Total = ThisDiagn%Total + Total_HP
2215 : ENDIF
2216 :
2217 : !----------------------------------------------------------------------
2218 : ! Update counter ==> Do only if last update time is not equal to
2219 : ! current one! This allows the same diagnostics to be updated
2220 : ! multiple time on the same time step without increasing the
2221 : ! time step counter.
2222 : !----------------------------------------------------------------------
2223 0 : IF ( IsNewTS ) THEN
2224 0 : ThisDiagn%Counter = ThisDiagn%Counter + 1
2225 0 : ThisDiagn%LastUpdateID = ThisUpdateID
2226 : ENDIF
2227 :
2228 : !----------------------------------------------------------------------
2229 : ! Data is not in output format and hasn't been called yet by Diagn_Get.
2230 : !----------------------------------------------------------------------
2231 0 : ThisDiagn%IsOutFormat = .FALSE.
2232 0 : ThisDiagn%nnGetCalls = 0
2233 :
2234 : ! Verbose mode
2235 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
2236 0 : WRITE(MSG,'(a,a,a,I3,a)') 'Successfully updated diagnostics: ', &
2237 0 : TRIM(ThisDiagn%cName), ' (counter:', ThisDiagn%Counter, ')'
2238 0 : CALL HCO_MSG ( HcoState%Config%Err, MSG )
2239 : ENDIF
2240 : ENDDO ! loop over containers in collection
2241 :
2242 : ! Advance to next collection
2243 0 : IF ( SearchAll ) THEN
2244 0 : ThisColl => ThisColl%NextCollection
2245 : ELSE
2246 0 : ThisColl => NULL()
2247 : ENDIF
2248 :
2249 : ENDDO ! loop over collections
2250 :
2251 : ! Cleanup
2252 0 : IF (PRESENT(Array3D_SP) ) THEN
2253 0 : Arr3D => NULL()
2254 0 : ELSEIF (PRESENT(Array3D_HP) ) THEN
2255 0 : IF ( ASSOCIATED(Arr3D) ) DEALLOCATE(Arr3D)
2256 0 : ELSEIF (PRESENT(Array3D) ) THEN
2257 0 : IF ( ASSOCIATED(Arr3D) ) DEALLOCATE(Arr3D)
2258 : ENDIF
2259 0 : IF (PRESENT(Array2D_SP) ) THEN
2260 0 : Arr2D => NULL()
2261 0 : ELSEIF (PRESENT(Array2D_HP) ) THEN
2262 0 : IF ( ASSOCIATED(Arr2D) ) DEALLOCATE(Arr2D)
2263 0 : ELSEIF (PRESENT(Array2D) ) THEN
2264 0 : IF ( ASSOCIATED(Arr2D) ) DEALLOCATE(Arr2D)
2265 : ENDIF
2266 :
2267 : ! Return
2268 0 : Tmp2D => NULL()
2269 0 : ThisDiagn => NULL()
2270 0 : ThisColl => NULL()
2271 0 : RC = HCO_SUCCESS
2272 :
2273 0 : END SUBROUTINE Diagn_UpdateDriver
2274 : !EOC
2275 : !------------------------------------------------------------------------------
2276 : ! Harmonized Emissions Component (HEMCO) !
2277 : !------------------------------------------------------------------------------
2278 : !BOP
2279 : !
2280 : ! !ROUTINE: Diagn_Get
2281 : !
2282 : ! !DESCRIPTION: Subroutine Diagn\_Get returns a diagnostics container from
2283 : ! the diagnostics list, with the data converted to the output unit specified
2284 : ! during initialization. Only diagnostics that contain data, i.e. with an
2285 : ! update counter higher than zero, are returned. If EndOfIntvOnly is set to
2286 : ! TRUE, only containers at the end of their time averaging interval are
2287 : ! returned. The current HEMCO time will be used to determine which containers
2288 : ! are at the end of their interval. The IsOutFormat flag of the container is
2289 : ! set to true, making sure that the currently saved data will be erased during
2290 : ! the next update (Diagn\_Update).
2291 : !\\
2292 : !\\
2293 : ! If DgnCont is already associated, the search continues from the container
2294 : ! next to DgnCont. If DgnCont is empty (null), the search starts from the
2295 : ! first container of the diagnostics list ListDiagn. If the optional attribute
2296 : ! cName or cID is provided, this particular container is searched (through the
2297 : ! entire diagnostics list), but is only returned if it is at the end of it's
2298 : ! interval or if EndOfIntvOnly is disabled.
2299 : !\\
2300 : !\\
2301 : ! The optional argument InclManual denotes whether or not containers with
2302 : ! a manual update frequency shall be considered. This argument is only valid
2303 : ! if EndOfIntvOnly is set to FALSE.
2304 : !\\
2305 : !\\
2306 : ! The return flag FLAG is set to HCO\_SUCCESS if a container is found, and to
2307 : ! HCO\_FAIL otherwise.
2308 : !\\
2309 : !\\
2310 : ! !INTERFACE:
2311 : !
2312 0 : SUBROUTINE Diagn_Get( HcoState, &
2313 : EndOfIntvOnly, DgnCont, &
2314 : FLAG, RC, cName, &
2315 : cID, AutoFill, COL, &
2316 : SkipZeroCount )
2317 : !
2318 : ! !USES:
2319 : !
2320 : USE HCO_STATE_MOD, ONLY : HCO_State
2321 : !
2322 : ! !INPUT PARAMETERS:
2323 : !
2324 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
2325 : LOGICAL, INTENT(IN ) :: EndOfIntvOnly ! End of
2326 : ! interval
2327 : ! only?
2328 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cName ! container name
2329 : INTEGER, INTENT(IN ), OPTIONAL :: cID ! container ID
2330 : INTEGER, INTENT(IN ), OPTIONAL :: AutoFill ! 0=no; 1=yes;
2331 : ! -1=either
2332 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! Collection Nr.
2333 : LOGICAL, INTENT(IN ), OPTIONAL :: SkipZeroCount ! Skip if counter
2334 : ! is zero
2335 : !
2336 : ! !OUTPUT PARAMETERS:
2337 : !
2338 :
2339 : TYPE(DiagnCont), POINTER :: DgnCont ! Return
2340 : ! container
2341 : !
2342 : ! !INPUT/OUTPUT PARAMETERS:
2343 : !
2344 : INTEGER, INTENT(INOUT) :: FLAG ! Return flag
2345 : INTEGER, INTENT(INOUT) :: RC ! Return code
2346 : !
2347 : ! !REVISION HISTORY:
2348 : ! 19 Dec 2013 - C. Keller: Initialization
2349 : ! See https://github.com/geoschem/hemco for complete history
2350 : !EOP
2351 : !------------------------------------------------------------------------------
2352 : !BOC
2353 : !
2354 : ! !LOCAL VARIABLES:
2355 : !
2356 : TYPE(DiagnCollection), POINTER :: ThisColl
2357 : INTEGER :: PS, AF
2358 : LOGICAL :: TimeToWrite
2359 : LOGICAL :: FOUND, CF
2360 : LOGICAL :: SKIPZERO
2361 : CHARACTER(LEN=255) :: LOC
2362 :
2363 : !======================================================================
2364 : ! Diagn_Get begins here!
2365 : !======================================================================
2366 : ! Init
2367 0 : LOC = 'Diagn_Get (HCO_DIAGN_MOD.F90)'
2368 0 : FLAG = HCO_FAIL
2369 0 : RC = HCO_SUCCESS
2370 0 : CF = .FALSE.
2371 0 : ThisColl => NULL()
2372 :
2373 : ! Get collection number
2374 : CALL DiagnCollection_DefineID( HcoState%Diagn, PS, RC, COL=COL, &
2375 0 : ThisColl=ThisColl, HcoState=HcoState )
2376 0 : IF ( RC /= HCO_SUCCESS ) THEN
2377 0 : CALL HCO_ERROR( 'ERROR 22', RC, THISLOC=LOC )
2378 0 : RETURN
2379 : ENDIF
2380 :
2381 : ! Set AutoFill flag
2382 0 : AF = -1
2383 0 : IF ( PRESENT(AutoFill ) ) AF = AutoFill
2384 :
2385 : ! Check if diagnostics with counter = 0 shall be skipped
2386 0 : SKIPZERO = .FALSE.
2387 0 : IF ( PRESENT(SkipZeroCount) ) SKIPZERO = SkipZeroCount
2388 :
2389 0 : IF ( EndOfIntvOnly ) THEN
2390 0 : TimeToWrite = DiagnCollection_IsTimeToWrite( HcoState, PS )
2391 0 : IF ( .NOT. TimeToWrite ) THEN
2392 0 : DgnCont => NULL()
2393 0 : RETURN
2394 : ENDIF
2395 : ENDIF
2396 :
2397 : ! If container name is given, search for diagnostics with
2398 : ! the given name.
2399 0 : IF ( PRESENT( cName ) ) THEN
2400 : CALL DiagnCont_Find( HcoState%Diagn, &
2401 : -1, -1, -1, -1, -1, cName, &
2402 0 : AF, FOUND, DgnCont, COL=PS )
2403 :
2404 0 : IF ( .NOT. FOUND ) THEN
2405 :
2406 0 : DgnCont => NULL()
2407 : ELSE
2408 :
2409 : ! Don't consider container if counter is zero.
2410 0 : IF ( SKIPZERO .AND. DgnCont%Counter == 0 ) THEN
2411 0 : DgnCont => NULL()
2412 : ENDIF
2413 : ENDIF
2414 : CF = .TRUE.
2415 :
2416 : ENDIF
2417 :
2418 : ! If container id is given, search for diagnostics with
2419 : ! the given container ID.
2420 0 : IF ( PRESENT( cID ) .AND. .NOT. CF ) THEN
2421 : CALL DiagnCont_Find( HcoState%Diagn, &
2422 : cID, -1, -1, -1, -1, '', &
2423 0 : AF, FOUND, DgnCont, COL=PS )
2424 0 : IF ( .NOT. FOUND ) THEN
2425 0 : DgnCont => NULL()
2426 : ELSE
2427 : ! Don't consider container if counter is zero.
2428 0 : IF ( SKIPZERO .AND. DgnCont%Counter == 0 ) THEN
2429 0 : DgnCont => NULL()
2430 : ENDIF
2431 : ENDIF
2432 : CF = .TRUE.
2433 : ENDIF
2434 :
2435 : ! If no container selected yet, point to next container in
2436 : ! list (or to head of list if DgnCont is not yet associated).
2437 : ! Number of updates since last output must be larger than zero!
2438 0 : IF ( .NOT. CF ) THEN
2439 :
2440 0 : IF ( .NOT. ASSOCIATED( DgnCont ) ) THEN
2441 0 : DgnCont => ThisColl%DiagnList
2442 : ELSE
2443 0 : DgnCont => DgnCont%NextCont
2444 : ENDIF
2445 :
2446 0 : DO WHILE ( ASSOCIATED ( DgnCont ) )
2447 : ! Skip zero counters
2448 0 : IF ( SKIPZERO .AND. DgnCont%Counter <= 0 ) THEN
2449 0 : DgnCont => DgnCont%NextCont
2450 : CYCLE
2451 : ENDIF
2452 :
2453 : ! Exit if we reach this loop here
2454 0 : EXIT
2455 : ENDDO
2456 : ENDIF
2457 :
2458 : ! Before returning container, make sure its data is ready for output.
2459 0 : IF ( ASSOCIATED (DgnCont ) ) THEN
2460 0 : CALL DiagnCont_PrepareOutput ( HcoState, DgnCont, RC )
2461 0 : IF ( RC /= HCO_SUCCESS ) THEN
2462 0 : CALL HCO_ERROR( 'ERROR 23', RC, THISLOC=LOC )
2463 0 : RETURN
2464 : ENDIF
2465 0 : FLAG = HCO_SUCCESS
2466 :
2467 : ! Increase number of times this container has been called by
2468 : ! Diagn_Get
2469 0 : DgnCont%nnGetCalls = DgnCont%nnGetCalls + 1
2470 :
2471 : ENDIF
2472 :
2473 : ! Cleanup
2474 0 : ThisColl => NULL()
2475 :
2476 : END SUBROUTINE Diagn_Get
2477 : !EOC
2478 : !------------------------------------------------------------------------------
2479 : ! Harmonized Emissions Component (HEMCO) !
2480 : !------------------------------------------------------------------------------
2481 : !BOP
2482 : !
2483 : ! !ROUTINE: Diagn_TotalGet
2484 : !
2485 : ! !DESCRIPTION: Subroutine Diagn\_TotalGet returns the total of a given
2486 : ! diagnostics container.
2487 : !\\
2488 : !\\
2489 : ! !INTERFACE:
2490 : !
2491 0 : SUBROUTINE Diagn_TotalGet( HcoState, Diagn, cName, cID, COL, &
2492 : FOUND, Total, Reset, RC )
2493 : !
2494 : ! !INPUT PARAMETERS::
2495 : !
2496 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
2497 : TYPE(DiagnBundle),POINTER :: Diagn ! Diagn bundle obj
2498 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cName ! container name
2499 : INTEGER, INTENT(IN ), OPTIONAL :: cID ! container ID
2500 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! Collection Nr.
2501 : LOGICAL, INTENT(IN ), OPTIONAL :: Reset ! Reset total?
2502 : !
2503 : ! !OUTPUT PARAMETERS:
2504 : !
2505 : LOGICAL, INTENT( OUT), OPTIONAL :: FOUND ! Container found
2506 : REAL(sp), INTENT( OUT) :: Total ! Container total
2507 : !
2508 : ! !INPUT/OUTPUT PARAMETERS:
2509 : !
2510 : INTEGER, INTENT(INOUT) :: RC ! Return code
2511 : !
2512 : ! !REVISION HISTORY:
2513 : ! 15 Mar 2015 - C. Keller: Initialization
2514 : ! See https://github.com/geoschem/hemco for complete history
2515 : !EOP
2516 : !------------------------------------------------------------------------------
2517 : !BOC
2518 : !
2519 : ! !LOCAL VARIABLES:
2520 : !
2521 : TYPE(DiagnCont), POINTER :: DgnCont
2522 : INTEGER :: PS
2523 : LOGICAL :: FND
2524 : CHARACTER(LEN=255) :: LOC
2525 :
2526 : !======================================================================
2527 : ! Diagn_TotalGet begins here!
2528 : !======================================================================
2529 :
2530 : ! Init
2531 0 : LOC = 'Diagn_TotalGet (HCO_DIAGN_MOD.F90)'
2532 0 : RC = HCO_FAIL
2533 0 : Total = 0.0_sp
2534 0 : DgnCont => NULL()
2535 0 : FND = .FALSE.
2536 0 : IF ( PRESENT(FOUND) ) THEN
2537 0 : FOUND = .FALSE.
2538 : ENDIF
2539 :
2540 : ! Get collection number
2541 0 : CALL DiagnCollection_DefineID( Diagn, PS, RC, COL=COL )
2542 0 : IF ( RC /= HCO_SUCCESS ) THEN
2543 0 : CALL HCO_ERROR( 'ERROR 24', RC, THISLOC=LOC )
2544 0 : RETURN
2545 : ENDIF
2546 :
2547 : ! If container name is given, search for diagnostics with
2548 : ! the given name.
2549 0 : IF ( PRESENT( cName ) ) THEN
2550 : CALL DiagnCont_Find( Diagn, -1, -1, -1, -1, -1, cName, &
2551 0 : -1, FND, DgnCont, COL=PS )
2552 : ENDIF
2553 :
2554 : ! If container id is given, search for diagnostics with
2555 : ! the given container ID.
2556 0 : IF ( PRESENT( cID ) .AND. .NOT. FND ) THEN
2557 : CALL DiagnCont_Find( Diagn, cID, -1, -1, -1, -1, '', &
2558 0 : -1, FND, DgnCont, COL=PS )
2559 : ENDIF
2560 :
2561 : ! Pass total to output
2562 0 : IF ( FND .AND. ASSOCIATED ( DgnCont ) ) THEN
2563 0 : Total = DgnCont%Total
2564 :
2565 : ! Eventually reset
2566 0 : IF ( PRESENT(Reset) ) THEN
2567 0 : IF ( Reset ) THEN
2568 0 : DgnCont%Total = 0.0_sp
2569 : ENDIF
2570 : ENDIF
2571 :
2572 : ! Eventually update FOUND argument
2573 0 : IF ( PRESENT(FOUND) ) THEN
2574 0 : FOUND = .TRUE.
2575 : ENDIF
2576 : ENDIF
2577 :
2578 : ! Return w/ success
2579 0 : RC = HCO_SUCCESS
2580 :
2581 : END SUBROUTINE Diagn_TotalGet
2582 : !EOC
2583 : !------------------------------------------------------------------------------
2584 : ! Harmonized Emissions Component (HEMCO) !
2585 : !------------------------------------------------------------------------------
2586 : !BOP
2587 : !
2588 : ! !ROUTINE: DiagnList_Cleanup
2589 : !
2590 : ! !DESCRIPTION: Subroutine DiagnList\_Cleanup cleans up all the diagnostics
2591 : ! containers of the given diagnostics list.
2592 : !\\
2593 : ! !INTERFACE:
2594 : !
2595 0 : SUBROUTINE DiagnList_Cleanup ( DiagnList )
2596 : !
2597 : ! !INPUT PARAMETERS:
2598 : !
2599 : TYPE(DiagnCont), POINTER :: DiagnList ! List to be removed
2600 : !
2601 : ! !REVISION HISTORY:
2602 : ! 19 Dec 2013 - C. Keller - Initialization
2603 : ! See https://github.com/geoschem/hemco for complete history
2604 : !EOP
2605 : !------------------------------------------------------------------------------
2606 : !BOC
2607 : !
2608 : ! !LOCAL VARIABLES:
2609 : !
2610 : ! Pointers
2611 : TYPE(DiagnCont), POINTER :: TmpCont
2612 : TYPE(DiagnCont), POINTER :: NxtCont
2613 :
2614 : !======================================================================
2615 : ! Diagn_Cleanup begins here!
2616 : !======================================================================
2617 :
2618 : ! Walk through entire list and remove all containers
2619 0 : NxtCont => NULL()
2620 0 : TmpCont => DiagnList
2621 0 : DO WHILE ( ASSOCIATED( TmpCont ) )
2622 :
2623 : ! Detach from list
2624 0 : NxtCont => TmpCont%NextCont
2625 :
2626 : ! Clean up this container
2627 0 : CALL DiagnCont_Cleanup( TmpCont )
2628 0 : IF ( ASSOCIATED( TmpCont ) ) DEALLOCATE ( TmpCont )
2629 :
2630 : ! Advance
2631 0 : TmpCont => NxtCont
2632 : ENDDO
2633 :
2634 : ! Nullify DiagnList pointer
2635 0 : DiagnList => NULL()
2636 :
2637 0 : END SUBROUTINE DiagnList_Cleanup
2638 : !EOC
2639 : !------------------------------------------------------------------------------
2640 : ! Harmonized Emissions Component (HEMCO) !
2641 : !------------------------------------------------------------------------------
2642 : !BOP
2643 : !
2644 : ! !ROUTINE: Diagn_AutoFillLevelDefined
2645 : !
2646 : ! !DESCRIPTION: Function Diagn\_AutoFillLevelDefined returns .TRUE. if there
2647 : ! is at least one AutoFill diagnostics container defined for the given level
2648 : ! (1=Species level, 2=ExtNr level, 3=Category level, 4=Hierarchy level).
2649 : !\\
2650 : !\\
2651 : ! !INTERFACE:
2652 : !
2653 0 : FUNCTION Diagn_AutoFillLevelDefined( Diagn, Level, COL ) RESULT ( IsDefined )
2654 : !
2655 : ! !INPUT PARAMETERS:
2656 : !
2657 : TYPE(DiagnBundle),POINTER :: Diagn ! Diagn bundle obj
2658 : INTEGER, INTENT(IN) :: Level ! Level of interest
2659 : INTEGER, INTENT(IN), OPTIONAL :: COL ! Collection Nr.
2660 : !
2661 : ! !RETURN VALUE:
2662 : !
2663 : LOGICAL :: IsDefined ! Return argument
2664 : !
2665 : ! !REVISION HISTORY:
2666 : ! 19 Dec 2013 - C. Keller: Initialization
2667 : ! See https://github.com/geoschem/hemco for complete history
2668 : !EOP
2669 : !------------------------------------------------------------------------------
2670 : !BOC
2671 : !
2672 : ! !LOCAL VARIABLES:
2673 : !
2674 : TYPE(DiagnCollection), POINTER :: ThisColl
2675 : INTEGER :: I, RC, PS
2676 : LOGICAL :: InUse
2677 : CHARACTER(LEN=255) :: LOC
2678 :
2679 : !======================================================================
2680 : ! Diagn_AutoFillLevelDefined begins here!
2681 : !======================================================================
2682 :
2683 : ! Initialize
2684 0 : LOC = 'Diagn_AutoFillLevelDefined (HCO_DIAGN_MOD.F90)'
2685 0 : IsDefined = .FALSE.
2686 0 : ThisColl => NULL()
2687 :
2688 : ! Get collection number
2689 : CALL DiagnCollection_DefineID( Diagn, PS, RC, COL=COL, DEF=-1, &
2690 0 : OKIfAll=.TRUE., InUse=InUse, ThisColl=ThisColl )
2691 0 : IF ( RC /= HCO_SUCCESS ) THEN
2692 0 : CALL HCO_ERROR( 'ERROR 25', RC, THISLOC=LOC )
2693 0 : RETURN
2694 : ENDIF
2695 :
2696 : ! Nothing to do if collection is not in use
2697 0 : IF ( .NOT. InUse ) RETURN
2698 :
2699 : ! Do for every collection to be searched
2700 0 : DO WHILE ( ASSOCIATED(ThisColl) )
2701 :
2702 : ! Check if autofill level is defined for this collection.
2703 : ! If so, can leave here
2704 0 : IsDefined = ThisColl%AF_LevelDefined( Level )
2705 0 : IF ( IsDefined ) EXIT
2706 :
2707 : ! Eventually go to next collection
2708 0 : IF ( PS == -1 ) THEN
2709 0 : ThisColl => ThisColl%NextCollection
2710 : ELSE
2711 0 : ThisColl => NULL()
2712 : ENDIF
2713 : ENDDO
2714 :
2715 : ! Cleanup
2716 0 : ThisColl => NULL()
2717 :
2718 0 : END FUNCTION Diagn_AutoFillLevelDefined
2719 : !EOC
2720 : !------------------------------------------------------------------------------
2721 : ! Harmonized Emissions Component (HEMCO) !
2722 : !------------------------------------------------------------------------------
2723 : !BOP
2724 : !
2725 : ! !ROUTINE: DiagnCollection_Get
2726 : !
2727 : ! !DESCRIPTION: Subroutine DiagnCollection\_Get returns variables assigned to
2728 : ! a given diagnostics collection.
2729 : !\\
2730 : !\\
2731 : ! !INTERFACE:
2732 : !
2733 0 : SUBROUTINE DiagnCollection_Get( Diagn, COL, &
2734 : InUse, Prefix, &
2735 : nnDiagn, DeltaYMD, &
2736 : LastYMD, DeltaHMS, LastHMS, &
2737 : OutTimeStamp, RC )
2738 : !
2739 : ! !INPUT ARGUMENTS:
2740 : !
2741 : INTEGER, INTENT(IN), OPTIONAL :: COL ! Collection Nr.
2742 : !
2743 : ! !OUTPUT PARAMETERS:
2744 : !
2745 : TYPE(DiagnBundle),POINTER :: Diagn
2746 : LOGICAL, INTENT(OUT), OPTIONAL :: InUse
2747 : CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: Prefix
2748 : INTEGER, INTENT(OUT), OPTIONAL :: nnDiagn
2749 : INTEGER, INTENT(OUT), OPTIONAL :: DeltaYMD
2750 : INTEGER, INTENT(OUT), OPTIONAL :: LastYMD
2751 : INTEGER, INTENT(OUT), OPTIONAL :: DeltaHMS
2752 : INTEGER, INTENT(OUT), OPTIONAL :: LastHMS
2753 : INTEGER, INTENT(OUT), OPTIONAL :: OutTimeStamp
2754 : !
2755 : ! !INPUT/OUTPUT PARAMETERS:
2756 : !
2757 : INTEGER, INTENT(INOUT) :: RC
2758 : !
2759 : ! !REVISION HISTORY:
2760 : ! 19 Dec 2013 - C. Keller: Initialization
2761 : ! See https://github.com/geoschem/hemco for complete history
2762 : !EOP
2763 : !------------------------------------------------------------------------------
2764 : !BOC
2765 : !
2766 : ! LOCAL VARIABLES:
2767 : !
2768 : TYPE(DiagnCollection), POINTER :: ThisColl
2769 : INTEGER :: PS
2770 : LOGICAL :: FOUND
2771 : CHARACTER(LEN=255) :: LOC
2772 :
2773 : !======================================================================
2774 : ! DiagnCollection_Get begins here!
2775 : !======================================================================
2776 :
2777 : ! Init
2778 0 : LOC = 'DiagnCollection_Get (HCO_DIAGN_MOD.F90)'
2779 0 : ThisColl => NULL()
2780 0 : IF ( PRESENT(Prefix ) ) Prefix = ''
2781 0 : IF ( PRESENT(InUse ) ) InUse = .FALSE.
2782 0 : IF ( PRESENT(nnDiagn ) ) nnDiagn = 0
2783 0 : IF ( PRESENT(DeltaYMD ) ) DeltaYMD = 0
2784 0 : IF ( PRESENT(LastYMD ) ) LastYMD = -1
2785 0 : IF ( PRESENT(DeltaHMS ) ) DeltaHMS = 0
2786 0 : IF ( PRESENT(LastHMS ) ) LastHMS = -1
2787 0 : IF ( PRESENT(OutTimeStamp) ) OutTimeStamp = -1
2788 :
2789 : ! Get collection number
2790 0 : CALL DiagnCollection_DefineID( Diagn, PS, RC, COL=COL, InUse=FOUND, ThisColl=ThisColl )
2791 0 : IF ( RC /= HCO_SUCCESS ) THEN
2792 0 : CALL HCO_ERROR( 'ERROR 26', RC, THISLOC=LOC )
2793 0 : RETURN
2794 : ENDIF
2795 :
2796 0 : IF ( PRESENT(InUse) ) THEN
2797 0 : InUse = FOUND
2798 : ENDIF
2799 :
2800 : ! Get variables from collection
2801 0 : IF ( FOUND ) THEN
2802 0 : IF ( PRESENT(Prefix ) ) Prefix = ThisColl%PREFIX
2803 0 : IF ( PRESENT(nnDiagn ) ) nnDiagn = ThisColl%nnDiagn
2804 0 : IF ( PRESENT(DeltaYMD ) ) DeltaYMD = ThisColl%DeltaYMD
2805 0 : IF ( PRESENT(LastYMD ) ) LastYMD = ThisColl%LastYMD
2806 0 : IF ( PRESENT(DeltaHMS ) ) DeltaHMS = ThisColl%DeltaHMS
2807 0 : IF ( PRESENT(LastHMS ) ) LastHMS = ThisColl%LastHMS
2808 0 : IF ( PRESENT(OutTimeStamp ) ) OutTimeStamp = ThisColl%OutTimestamp
2809 : ENDIF
2810 :
2811 : ! Cleanup
2812 0 : ThisColl => NULL()
2813 :
2814 : ! Return w/ success
2815 0 : RC = HCO_SUCCESS
2816 :
2817 0 : END SUBROUTINE DiagnCollection_Get
2818 : !EOC
2819 : !------------------------------------------------------------------------------
2820 : ! Harmonized Emissions Component (HEMCO) !
2821 : !------------------------------------------------------------------------------
2822 : !BOP
2823 : !
2824 : ! !ROUTINE: DiagnCollection_Set
2825 : !
2826 : ! !DESCRIPTION: Subroutine DiagnCollection\_Set sets variables assigned to
2827 : ! a given diagnostics collection.
2828 : !\\
2829 : !\\
2830 : ! !INTERFACE:
2831 : !
2832 0 : SUBROUTINE DiagnCollection_Set( Diagn, COL, InUse, LastYMD, LastHMS, RC )
2833 : !
2834 : ! !INPUT ARGUMENTS:
2835 : !
2836 : TYPE(DiagnBundle),POINTER :: Diagn ! Diagn bundle
2837 : INTEGER, INTENT(IN), OPTIONAL :: COL ! Collection Nr.
2838 : !
2839 : ! !OUTPUT PARAMETERS:
2840 : !
2841 : LOGICAL, INTENT(OUT), OPTIONAL :: InUse
2842 : INTEGER, INTENT(IN ), OPTIONAL :: LastYMD
2843 : INTEGER, INTENT(IN ), OPTIONAL :: LastHMS
2844 : !
2845 : ! !INPUT/OUTPUT PARAMETERS:
2846 : !
2847 : INTEGER, INTENT(INOUT) :: RC
2848 : !
2849 : ! !REVISION HISTORY:
2850 : ! 19 Dec 2013 - C. Keller: Initialization
2851 : ! See https://github.com/geoschem/hemco for complete history
2852 : !EOP
2853 : !------------------------------------------------------------------------------
2854 : !BOC
2855 : !
2856 : ! LOCAL VARIABLES:
2857 : !
2858 : TYPE(DiagnCollection), POINTER :: ThisColl
2859 : INTEGER :: PS
2860 : LOGICAL :: FOUND
2861 : CHARACTER(LEN=255) :: LOC
2862 :
2863 : !======================================================================
2864 : ! DiagnCollection_Set begins here!
2865 : !======================================================================
2866 :
2867 : ! Init
2868 0 : LOC = 'DiagnCollection_Set (HCO_DIAGN_MOD.F90)'
2869 0 : ThisColl => NULL()
2870 0 : IF ( PRESENT(InUse ) ) InUse = .FALSE.
2871 :
2872 : ! Get collection number
2873 0 : CALL DiagnCollection_DefineID( Diagn, PS, RC, COL=COL, InUse=FOUND, ThisColl=ThisColl )
2874 0 : IF ( RC /= HCO_SUCCESS ) THEN
2875 0 : CALL HCO_ERROR( 'ERROR 27', RC, THISLOC=LOC )
2876 0 : RETURN
2877 : ENDIF
2878 :
2879 0 : IF ( PRESENT(InUse) ) THEN
2880 0 : InUse = FOUND
2881 : ENDIF
2882 :
2883 : ! Get variables from collection
2884 0 : IF ( FOUND ) THEN
2885 0 : IF ( PRESENT(LastYMD ) ) ThisColl%LastYMD = LastYMD
2886 0 : IF ( PRESENT(LastHMS ) ) ThisColl%LastHMS = LastHMS
2887 : ENDIF
2888 :
2889 : ! Cleanup
2890 0 : ThisColl => NULL()
2891 :
2892 : ! Return w/ success
2893 0 : RC = HCO_SUCCESS
2894 :
2895 : END SUBROUTINE DiagnCollection_Set
2896 : !EOC
2897 : !------------------------------------------------------------------------------
2898 : ! Harmonized Emissions Component (HEMCO) !
2899 : !------------------------------------------------------------------------------
2900 : !BOP
2901 : !
2902 : ! !ROUTINE: DiagnCont_Init
2903 : !
2904 : ! !DESCRIPTION: Subroutine DiagnCont\_Init initializes a new (blank)
2905 : ! diagnostics container DgnCont.
2906 : !\\
2907 : !\\
2908 : ! !INTERFACE:
2909 : !
2910 0 : SUBROUTINE DiagnCont_Init( OutCont )
2911 : !
2912 : ! !OUTPUT PARAMETERS:
2913 : !
2914 : TYPE(DiagnCont), POINTER :: OutCont ! Created container
2915 : !
2916 : ! !REVISION HISTORY:
2917 : ! 19 Dec 2013 - C. Keller: Initialization
2918 : ! See https://github.com/geoschem/hemco for complete history
2919 : !EOP
2920 : !------------------------------------------------------------------------------
2921 : !BOC
2922 : !
2923 : ! !LOCAL VARIABLES:
2924 : !
2925 : ! Pointers
2926 : TYPE(DiagnCont), POINTER :: DgnCont => NULL()
2927 :
2928 : !======================================================================
2929 : ! DiagnCont_Init begins here!
2930 : !======================================================================
2931 :
2932 : ! Allocate the new container
2933 0 : ALLOCATE( DgnCont )
2934 :
2935 : ! Initialize ponters and scalar value
2936 0 : DgnCont%NextCont => NULL()
2937 0 : DgnCont%Arr2D => NULL()
2938 0 : DgnCont%Arr3D => NULL()
2939 0 : DgnCont%DtaIsPtr = .FALSE.
2940 0 : DgnCont%Scalar = 0.0_sp
2941 0 : DgnCont%Total = 0.0_sp
2942 0 : DgnCont%LevIdx = -1
2943 0 : DgnCont%AutoFill = 0
2944 0 : DgnCont%SpaceDim = 2
2945 :
2946 : ! Default values for unit conversion factors
2947 0 : DgnCont%AreaScal = 1.0_hp
2948 0 : DgnCont%ScaleFact = 1.0_hp
2949 0 : DgnCont%AreaFlag = 2
2950 0 : DgnCont%Counter = 0
2951 0 : DgnCont%TimeAvg = -1
2952 0 : DgnCont%AvgFlag = -1
2953 0 : DgnCont%AvgName = 'mean'
2954 :
2955 : ! Set last update time to -1 to start with
2956 0 : DgnCont%LastUpdateID = -1
2957 :
2958 : ! By default, data is not in output format
2959 0 : DgnCont%IsOutFormat = .FALSE.
2960 0 : DgnCont%nnGetCalls = 0
2961 :
2962 : ! Default container ID and collection
2963 0 : DgnCont%cID = -1
2964 0 : DgnCont%CollectionID = -1
2965 :
2966 : ! Initialize other varaibles
2967 0 : DgnCont%HcoID = -1
2968 0 : DgnCont%ExtNr = -1
2969 0 : DgnCont%Cat = -1
2970 0 : DgnCont%Hier = -1
2971 :
2972 : ! Pass to output container
2973 0 : OutCont => DgnCont
2974 :
2975 0 : END SUBROUTINE DiagnCont_Init
2976 : !EOC
2977 : !------------------------------------------------------------------------------
2978 : ! Harmonized Emissions Component (HEMCO) !
2979 : !------------------------------------------------------------------------------
2980 : !BOP
2981 : !
2982 : ! !ROUTINE: DiagnCont_Cleanup
2983 : !
2984 : ! !DESCRIPTION: Subroutine DiagnCont\_Cleanup cleans up diagnostics
2985 : ! container DgnCont.
2986 : !\\
2987 : !\\
2988 : ! !INTERFACE:
2989 : !
2990 0 : SUBROUTINE DiagnCont_Cleanup( DgnCont )
2991 : !
2992 : ! !USES:
2993 : !
2994 : USE HCO_ARR_Mod, ONLY : HCO_ArrCleanup
2995 : !
2996 : ! !INPUT/OUTPUT PARAMETERS:
2997 : !
2998 : TYPE(DiagnCont), POINTER :: DgnCont ! Container to be cleaned
2999 : !
3000 : ! !REVISION HISTORY:
3001 : ! 19 Dec 2013 - C. Keller: Initialization
3002 : ! See https://github.com/geoschem/hemco for complete history
3003 : !EOP
3004 : !------------------------------------------------------------------------------
3005 : !BOC
3006 :
3007 : LOGICAL :: DeepClean
3008 :
3009 : !======================================================================
3010 : ! DiagnCont_Cleanup begins here!
3011 : !======================================================================
3012 :
3013 : ! Only if associated...
3014 0 : IF ( ASSOCIATED( DgnCont ) ) THEN
3015 0 : IF ( DgnCont%DtaIsPtr ) THEN
3016 0 : DeepClean = .FALSE.
3017 : ELSE
3018 0 : DeepClean = .TRUE.
3019 : ENDIF
3020 0 : CALL HCO_ArrCleanup( DgnCont%Arr2D, DeepClean )
3021 0 : CALL HCO_ArrCleanup( DgnCont%Arr3D, DeepClean )
3022 0 : DgnCont%NextCont => NULL()
3023 0 : DEALLOCATE ( DgnCont )
3024 : ENDIF
3025 :
3026 0 : END SUBROUTINE DiagnCont_Cleanup
3027 : !EOC
3028 : !------------------------------------------------------------------------------
3029 : ! Harmonized Emissions Component (HEMCO) !
3030 : !------------------------------------------------------------------------------
3031 : !BOP
3032 : !
3033 : ! !ROUTINE: DiagnCont_PrepareOutput
3034 : !
3035 : ! !DESCRIPTION: Subroutine DiagnCont\_PrepareOutput converts the data of
3036 : ! the given diagnostics container to proper output units.
3037 : !\\
3038 : !\\
3039 : ! !INTERFACE:
3040 : !
3041 0 : SUBROUTINE DiagnCont_PrepareOutput( HcoState, DgnCont, RC )
3042 : !
3043 : ! !USES:
3044 : !
3045 : USE HCO_State_Mod, ONLY : HCO_State
3046 : USE HCO_Arr_Mod, ONLY : HCO_ArrAssert
3047 : !
3048 : ! !INPUT PARAMETERS:
3049 : !
3050 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
3051 : !
3052 : ! !INPUT/OUTPUT PARAMETERS:
3053 : !
3054 : TYPE(DiagnCont), POINTER :: DgnCont ! diagnostics container
3055 : INTEGER, INTENT(INOUT) :: RC ! Return code
3056 : !
3057 : ! !REVISION HISTORY:
3058 : ! 19 Dec 2013 - C. Keller: Initialization
3059 : ! See https://github.com/geoschem/hemco for complete history
3060 : !EOP
3061 : !------------------------------------------------------------------------------
3062 : !BOC
3063 : !
3064 : ! !LOCAL VARIABLES:
3065 : !
3066 : TYPE(DiagnCollection), POINTER :: ThisColl
3067 : LOGICAL :: FOUND
3068 : INTEGER :: I, J, YYYY, MM
3069 : REAL(hp) :: norm1, mult1, DPY, totscal
3070 : CHARACTER(LEN=255) :: MSG, LOC
3071 : INTEGER :: DPM(12) = (/ 31, 28, 31, 30, 31, 30, &
3072 : 31, 31, 30, 31, 30, 31 /)
3073 :
3074 : !======================================================================
3075 : ! DiagnCont_PrepareOutput begins here!
3076 : !======================================================================
3077 :
3078 : ! Init
3079 0 : RC = HCO_SUCCESS
3080 0 : LOC = 'DiagnCont_PrepareOutput (hco_diagn_mod.F90) '
3081 0 : ThisColl => NULL()
3082 :
3083 : !-----------------------------------------------------------------------
3084 : ! Don't do anything for pointer data and/or if data is already in
3085 : ! output format
3086 : !-----------------------------------------------------------------------
3087 0 : IF ( DgnCont%IsOutFormat ) RETURN
3088 0 : IF ( DgnCont%DtaIsPtr ) RETURN
3089 :
3090 : !-----------------------------------------------------------------------
3091 : ! Get pointer to this collection
3092 : !-----------------------------------------------------------------------
3093 : CALL DiagnCollection_Find( HcoState%Diagn, DgnCont%CollectionID, &
3094 0 : FOUND, RC, ThisColl=ThisColl )
3095 0 : IF ( RC /= HCO_SUCCESS ) THEN
3096 0 : CALL HCO_ERROR( 'ERROR 28', RC, THISLOC=LOC )
3097 0 : RETURN
3098 : ENDIF
3099 :
3100 : ! This should never happen
3101 0 : IF ( .NOT. FOUND .OR. .NOT. ASSOCIATED(ThisColl) ) THEN
3102 0 : WRITE(MSG,*) 'Diagnostics ', TRIM(DgnCont%cName), ' has invalid ', &
3103 0 : 'collection ID of ', DgnCont%CollectionID
3104 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3105 0 : RETURN
3106 : ENDIF
3107 :
3108 : !-----------------------------------------------------------------------
3109 : ! Return zero array if counter is still zero
3110 : !-----------------------------------------------------------------------
3111 0 : IF ( DgnCont%Counter == 0 ) THEN
3112 :
3113 : ! Make sure array is defined and zero
3114 0 : IF ( DgnCont%SpaceDim == 2 ) THEN
3115 : CALL HCO_ArrAssert( DgnCont%Arr2D, ThisColl%NX, &
3116 0 : ThisColl%NY, RC )
3117 0 : IF ( RC /= HCO_SUCCESS ) THEN
3118 0 : CALL HCO_ERROR( 'ERROR 29', RC, THISLOC=LOC )
3119 0 : RETURN
3120 : ENDIF
3121 :
3122 : ! Make sure it's zero
3123 0 : DgnCont%Arr2D%Val = 0.0_sp
3124 :
3125 0 : ELSEIF ( DgnCont%SpaceDim == 3 ) THEN
3126 : CALL HCO_ArrAssert( DgnCont%Arr3D, ThisColl%NX, &
3127 0 : ThisColl%NY, ThisColl%NZ, RC )
3128 0 : IF ( RC /= HCO_SUCCESS ) THEN
3129 0 : CALL HCO_ERROR( 'ERROR 30', RC, THISLOC=LOC )
3130 0 : RETURN
3131 : ENDIF
3132 :
3133 : ! Make sure it's zero
3134 0 : DgnCont%Arr3D%Val = 0.0_sp
3135 : ENDIF
3136 :
3137 : ! Prompt warning
3138 : MSG = 'Diagnostics counter is zero - return empty array: ' // &
3139 0 : TRIM(DgnCont%cName)
3140 0 : CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
3141 0 : RETURN
3142 : ENDIF
3143 :
3144 : !-----------------------------------------------------------------------
3145 : ! Output data is calculated as:
3146 : ! out = saved / norm1 * mult1 * * AreaScal
3147 : ! The normalization factor norm1 and multiplication factor mult1
3148 : ! are used to average to the desired time interval, i.e. per
3149 : ! second, per day, etc.
3150 : ! Since all diagnostics are internally stored in units of [kg/m2]
3151 : ! first convert to [kg/m2/s] and then multiply by the desired time
3152 : ! averaging interval (e.g. seconds/hour to get kg/m2/s). Factors
3153 : ! AreaScal convert area to desired units, as determined during
3154 : ! initialization of the diagnostics.
3155 : !-----------------------------------------------------------------------
3156 :
3157 : ! If the averaging is forced to the sum:
3158 0 : IF ( DgnCont%AvgFlag == AvgFlagSum .OR. DgnCont%AvgFlag == AvgFlagCumulSum ) THEN
3159 : norm1 = 1.0_hp
3160 : mult1 = 1.0_dp
3161 :
3162 : ! If the averaging is forced to the arithmetic mean:
3163 0 : ELSEIF ( DgnCont%AvgFlag == AvgFlagMean ) THEN
3164 0 : norm1 = REAL(DgnCont%Counter,kind=hp)
3165 0 : mult1 = 1.0_dp
3166 :
3167 : ! If there is no time averaging interval defined
3168 0 : ELSEIF ( DgnCont%TimeAvg < 0 ) THEN
3169 : norm1 = 1.0_hp
3170 : mult1 = 1.0_dp
3171 :
3172 : ! For other, time averaging intervals
3173 : ELSE
3174 :
3175 : ! Get current month and year
3176 0 : CALL HcoClock_Get( HcoState%Clock, cYYYY=YYYY, cMM=MM, RC=RC )
3177 0 : IF ( RC /= HCO_SUCCESS ) THEN
3178 0 : CALL HCO_ERROR( 'ERROR 31', RC, THISLOC=LOC )
3179 0 : RETURN
3180 : ENDIF
3181 :
3182 : ! Days per year
3183 0 : IF ( (MOD(YYYY,4) == 0) .AND. (MOD(YYYY,400) /= 0) ) THEN
3184 0 : DPY = 366.0_hp
3185 0 : DPM(2) = 29
3186 : ELSE
3187 : DPY = 365.0_hp
3188 : ENDIF
3189 :
3190 : ! Seconds since last reset
3191 0 : norm1 = REAL(DgnCont%Counter,kind=hp) * ThisColl%TS
3192 :
3193 : ! Factors depends on averaging time
3194 0 : IF ( DgnCont%TimeAvg == 1 ) THEN
3195 : mult1 = 1.0_hp ! seconds / second
3196 :
3197 0 : ELSEIF ( DgnCont%TimeAvg == 2 ) THEN
3198 : mult1 = 3600.0_hp ! seconds / hour
3199 :
3200 0 : ELSEIF ( DgnCont%TimeAvg == 3 ) THEN
3201 : mult1 = 86400.0_hp ! seconds / day
3202 :
3203 0 : ELSEIF ( DgnCont%TimeAvg == 4 ) THEN
3204 0 : mult1 = 86400.0_hp * DPM(MM) ! seconds / month
3205 :
3206 0 : ELSEIF ( DgnCont%TimeAvg == 5 ) THEN
3207 0 : mult1 = 86400.0_hp * DPY ! seconds / year
3208 :
3209 : ! We shouldn't get here!
3210 : ELSE
3211 0 : WRITE(MSG,*) 'Illegal time averaging of ', DgnCont%TimeAvg, &
3212 0 : ' for diagnostics ', TRIM(DgnCont%cName)
3213 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3214 0 : RETURN
3215 : ENDIF
3216 :
3217 : ENDIF
3218 :
3219 : ! Error trap
3220 0 : IF ( norm1 <= 0.0_hp ) THEN
3221 0 : MSG = 'Illegal normalization factor: ' // TRIM(DgnCont%cName)
3222 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3223 0 : RETURN
3224 : ENDIF
3225 :
3226 : ! totscal is the combined scale factor
3227 : totscal = mult1 &
3228 : / norm1 &
3229 : * DgnCont%AreaScal &
3230 0 : * DgnCont%ScaleFact
3231 :
3232 : ! For 3D:
3233 0 : IF ( DgnCont%SpaceDim == 3 ) THEN
3234 0 : DO J = 1, ThisColl%NY
3235 0 : DO I = 1, ThisColl%NX
3236 :
3237 : ! Multiply by area if output unit is not per area
3238 0 : IF ( DgnCont%AreaFlag == 0 ) THEN
3239 0 : IF( ASSOCIATED(DgnCont%Arr3D) ) THEN
3240 0 : DgnCont%Arr3D%Val(I,J,:) = DgnCont%Arr3D%Val(I,J,:) &
3241 0 : * ThisColl%AREA_M2(I,J)
3242 : ENDIF
3243 : ENDIF
3244 :
3245 : ! Apply scale factors
3246 0 : IF ( ASSOCIATED(DgnCont%Arr3D) ) THEN
3247 0 : DgnCont%Arr3D%Val(I,J,:) = DgnCont%Arr3D%Val(I,J,:) &
3248 0 : * totscal
3249 : ENDIF
3250 : ENDDO !I
3251 : ENDDO !J
3252 :
3253 : ! For 2D:
3254 0 : ELSEIF ( DgnCont%SpaceDim == 2 ) THEN
3255 0 : DO J = 1, ThisColl%NY
3256 0 : DO I = 1, ThisColl%NX
3257 :
3258 : ! Multiply by area if output unit is not per area
3259 0 : IF ( DgnCont%AreaFlag == 0 ) THEN
3260 0 : IF ( ASSOCIATED(DgnCont%Arr2D) ) THEN
3261 0 : DgnCont%Arr2D%Val(I,J) = DgnCont%Arr2D%Val(I,J) &
3262 0 : * ThisColl%AREA_M2(I,J)
3263 : ENDIF
3264 : ENDIF
3265 :
3266 : ! Apply scale factors
3267 0 : IF ( ASSOCIATED(DgnCont%Arr2D) ) THEN
3268 0 : DgnCont%Arr2D%Val(I,J) = DgnCont%Arr2D%Val(I,J) &
3269 0 : * totscal
3270 : ENDIF
3271 :
3272 : ENDDO !I
3273 : ENDDO !J
3274 :
3275 : ! For 1D:
3276 : ELSE
3277 0 : DgnCont%Scalar = DgnCont%Scalar * totscal
3278 :
3279 : ENDIF
3280 :
3281 : ! Data is now in output format
3282 0 : DgnCont%IsOutFormat = .TRUE.
3283 :
3284 : ! Cleanup
3285 0 : ThisColl => NULL()
3286 :
3287 : ! Return w/ success
3288 0 : RC = HCO_SUCCESS
3289 :
3290 : END SUBROUTINE DiagnCont_PrepareOutput
3291 : !EOC
3292 : !------------------------------------------------------------------------------
3293 : ! Harmonized Emissions Component (HEMCO) !
3294 : !------------------------------------------------------------------------------
3295 : !BOP
3296 : !
3297 : ! !ROUTINE: DiagnCont_Find
3298 : !
3299 : ! !DESCRIPTION: Subroutine DiagnCont\_Find searches for a diagnostics
3300 : ! container in ListDiagn. If a valid container ID (>0) is given, the
3301 : ! container with this ID is searched. Otherwise, if a valid HEMCO
3302 : ! specied ID (>0) is given, the container with the same combination
3303 : ! of HcoID, extension number (ExtNr), and emission category (Cat) and
3304 : ! hierarchy (Hier), is searched. If no valid HcoID and no valid cID is
3305 : ! provided, the container with the given container name is searched.
3306 : !\\
3307 : !\\
3308 : ! If the optional resume flag is set to TRUE, search will resume after
3309 : ! OutCnt. If OutCnt is not associated or resume flag is FALSE, search
3310 : ! starts at the beginning of the diagnostics list.
3311 : !\\
3312 : !\\
3313 : ! This subroutine does return the diagnostics as is, i.e. in the internal
3314 : ! units. It should NOT be used to access the content of a diagnostics but is
3315 : ! rather intended to be used in the background, e.g. to check if a
3316 : ! diagnostics exists at all. To get the values of a diagnostics, use routine
3317 : ! Diagn\_Get.
3318 : !
3319 : ! !INTERFACE:
3320 : !
3321 0 : SUBROUTINE DiagnCont_Find ( Diagn, cID, ExtNr, Cat, Hier, HcoID, &
3322 : cName, AutoFill, FOUND, OutCnt, Resume, COL )
3323 : !
3324 : ! !INPUT PARAMETERS:
3325 : !
3326 : TYPE(DiagnBundle), POINTEr :: Diagn ! diagn bundle
3327 : INTEGER, INTENT(IN) :: cID ! wanted cont. ID
3328 : INTEGER, INTENT(IN) :: ExtNr ! wanted ExtNr
3329 : INTEGER, INTENT(IN) :: Cat ! wanted category
3330 : INTEGER, INTENT(IN) :: Hier ! wanted hierarchy
3331 : INTEGER, INTENT(IN) :: HcoID ! wanted spec. ID
3332 : CHARACTER(LEN=*), INTENT(IN) :: cName ! wanted name
3333 : INTEGER, INTENT(IN) :: AutoFill ! 0=no; 1=yes; -1=either
3334 : LOGICAL, OPTIONAL, INTENT(IN) :: Resume ! Resume at OutCnt?
3335 : INTEGER, OPTIONAL, INTENT(IN) :: COL ! Collection number
3336 : !
3337 : ! !OUTPUT PARAMETERS:
3338 : !
3339 : LOGICAL, INTENT(OUT) :: FOUND ! container found?
3340 : !
3341 : ! !INPUT/OUTPUT PARAMETERS:
3342 : !
3343 : TYPE(DiagnCont), POINTER :: OutCnt ! data container
3344 : !
3345 : ! !REVISION HISTORY:
3346 : ! 19 Dec 2013 - C. Keller: Initialization
3347 : ! See https://github.com/geoschem/hemco for complete history
3348 : !EOP
3349 : !------------------------------------------------------------------------------
3350 : !BOC
3351 : !
3352 : ! !LOCAL VARIABLES:
3353 : !
3354 : INTEGER :: RC, PS
3355 : TYPE(DiagnCont), POINTER :: CurrCnt
3356 : TYPE(DiagnCollection), POINTER :: ThisColl
3357 : LOGICAL :: IsMatch, InUse, Rsm
3358 : CHARACTER(LEN=255) :: LOC
3359 :
3360 : !======================================================================
3361 : ! DiagnCont_Find begins here!
3362 : !======================================================================
3363 :
3364 : ! Initialize
3365 0 : LOC = 'DiagnCont_Find (HCO_DIAGN_MOD.F90)'
3366 0 : FOUND = .FALSE.
3367 0 : CurrCnt => NULL()
3368 0 : ThisColl => NULL()
3369 :
3370 : ! Get collection number
3371 : CALL DiagnCollection_DefineID( Diagn, PS, RC, COL=COL, Def=-1, &
3372 0 : InUse=InUse, OkIfAll=.TRUE., ThisColl=ThisColl )
3373 :
3374 0 : IF ( RC /= HCO_SUCCESS ) THEN
3375 0 : CALL HCO_ERROR( 'ERROR 32', RC, THISLOC=LOC )
3376 0 : RETURN
3377 : ENDIF
3378 :
3379 : ! Leave if collection not in use
3380 0 : IF ( .NOT. InUse ) RETURN
3381 :
3382 : ! Resume from OutCnt
3383 0 : IF ( PRESENT(Resume) ) THEN
3384 0 : RSM = Resume
3385 : ELSE
3386 : RSM = .FALSE.
3387 : ENDIF
3388 :
3389 : ! Make CurrCnt point to first element of the diagnostics list or to
3390 : ! the container after OutCnt if resume flag is activated.
3391 0 : IF ( RSM .AND. ASSOCIATED(OutCnt) ) THEN
3392 0 : CurrCnt => OutCnt%NextCont
3393 : ELSE
3394 0 : CurrCnt => ThisColl%DiagnList
3395 : ENDIF
3396 :
3397 : ! Error trap
3398 0 : IF ( .NOT. ASSOCIATED(CurrCnt) ) THEN
3399 0 : OutCnt => NULL()
3400 0 : RETURN
3401 : ENDIF
3402 :
3403 : ! Loop over all collections
3404 0 : DO
3405 :
3406 : ! Now reset OutCnt. Will be defined again when diagnostics is found.
3407 0 : OutCnt => NULL()
3408 :
3409 : ! Loop over list until container found
3410 0 : DO WHILE ( ASSOCIATED ( CurrCnt ) )
3411 :
3412 : ! Check if this is the container of interest. If a valid
3413 : ! container ID is given, use this attribute. Otherwise, check
3414 : ! for correct match of ExtNr, HcoID, Cat, and Hier attributes
3415 : ! if a valid HcoID is given. Otherwise, use the container name.
3416 0 : IsMatch = .FALSE.
3417 :
3418 : ! Check AutoFill flag.
3419 0 : IF ( CurrCnt%AutoFill /= AutoFill .AND. AutoFill >= 0 ) THEN
3420 0 : CurrCnt => CurrCnt%NextCont
3421 0 : CYCLE
3422 : ENDIF
3423 :
3424 : ! For valid container ID:
3425 0 : IF ( cID > 0 ) THEN
3426 0 : IF ( CurrCnt%cID == cID ) IsMatch = .TRUE.
3427 :
3428 : ! For valid HcoID, check for correct match of HcoID, ExtNr,
3429 : ! category, and hierarchy.
3430 0 : ELSEIF ( HcoID > 0 ) THEN
3431 : IF ( CurrCnt%HcoID == HcoID .AND. &
3432 : CurrCnt%ExtNr == ExtNr .AND. &
3433 0 : CurrCnt%Hier == Hier .AND. &
3434 : CurrCnt%Cat == Cat ) IsMatch = .TRUE.
3435 :
3436 : ! Use container name otherwise:
3437 : ELSE
3438 0 : IF ( TRIM(CurrCnt%cName) == TRIM(cName) ) IsMatch = .TRUE.
3439 : ENDIF
3440 :
3441 : IF ( IsMatch ) THEN
3442 0 : OutCnt => CurrCnt
3443 0 : FOUND = .TRUE.
3444 0 : EXIT
3445 : ENDIF
3446 :
3447 : ! Advance to next field otherwise
3448 0 : CurrCnt => CurrCnt%NextCont
3449 : ENDDO
3450 :
3451 : ! Leave loop over all collections if container was found
3452 0 : IF ( FOUND ) EXIT
3453 :
3454 : ! Advance to next collection
3455 0 : IF ( PS == -1 ) THEN
3456 :
3457 : ! Point to next collection
3458 0 : ThisColl => ThisColl%NextCollection
3459 :
3460 : ! Leave if collection is empty
3461 0 : IF ( .NOT. ASSOCIATED(ThisColl) ) EXIT
3462 :
3463 : ! Make working pointer point to first container in this collection,
3464 : ! then resume list search
3465 0 : CurrCnt => ThisColl%DiagnList
3466 : CYCLE
3467 : ENDIF
3468 :
3469 : ! Leave collection loop if we get here
3470 0 : EXIT
3471 : ENDDO ! Loop over all collections
3472 :
3473 : ! Cleanup
3474 0 : CurrCnt => NULL()
3475 0 : ThisColl => NULL()
3476 :
3477 : END SUBROUTINE DiagnCont_Find
3478 : !EOC
3479 : !------------------------------------------------------------------------------
3480 : ! Harmonized Emissions Component (HEMCO) !
3481 : !------------------------------------------------------------------------------
3482 : !BOP
3483 : !
3484 : ! !ROUTINE: DiagnCont_Link_2D
3485 : !
3486 : ! !DESCRIPTION: Subroutine DiagnCont\_Link\_2D links the data of container
3487 : ! DgnCont to the 2D array Tgt2D. This will disable all time averaging,
3488 : ! unit conversion, etc., i.e. the data will be returned as is.
3489 : !\\
3490 : !\\
3491 : ! !INTERFACE:
3492 : !
3493 0 : SUBROUTINE DiagnCont_Link_2D( DgnCont, ThisColl, Trgt2D, RC, HcoState )
3494 : !
3495 : ! !USES:
3496 : !
3497 : USE HCO_State_Mod, ONLY : HCO_State
3498 : !
3499 : ! !INPUT ARGUMENTS:
3500 : !
3501 : TYPE(HCO_STATE), POINTER, OPTIONAL :: HcoState ! HEMCO state obj
3502 : REAL(sp), INTENT(IN ), TARGET :: Trgt2D(:,:) ! 2D target data
3503 : TYPE(DiagnCollection), POINTER :: ThisColl ! Collection
3504 : !
3505 : ! !INPUT/OUTPUT PARAMETERS:
3506 : !
3507 : TYPE(DiagnCont), POINTER :: DgnCont ! diagnostics container
3508 : INTEGER, INTENT(INOUT) :: RC ! Return code
3509 : !
3510 : ! !REVISION HISTORY:
3511 : ! 19 Dec 2013 - C. Keller: Initialization
3512 : ! See https://github.com/geoschem/hemco for complete history
3513 : !EOP
3514 : !------------------------------------------------------------------------------
3515 : !BOC
3516 : !
3517 : ! !LOCAL VARIABLES:
3518 : !
3519 : CHARACTER(LEN=255) :: MSG, LOC
3520 :
3521 : !======================================================================
3522 : ! DiagnCont_Link_2D begins here!
3523 : !======================================================================
3524 :
3525 : ! Init
3526 0 : LOC = 'DiagnCont_Link_2D (hco_diagn_mod.F90)'
3527 :
3528 : ! Check if dimensions match. Also, containers with pointers must not
3529 : ! be set to AutoFill
3530 0 : IF ( DgnCont%AutoFill == 1 ) THEN
3531 : MSG = 'Target diagnostics has AutoFill flag of 1 - reset to 0: ' &
3532 0 : // TRIM(DgnCont%cName)
3533 0 : IF ( PRESENT(HcoState) ) THEN
3534 0 : CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
3535 : ELSE
3536 0 : WRITE(*,*) 'HEMCO WARNING: ', TRIM(MSG)
3537 : ENDIF
3538 0 : DgnCont%AutoFill = 0
3539 : ENDIF
3540 0 : IF ( DgnCont%SpaceDim /= 2 ) THEN
3541 0 : MSG = 'Diagnostics is not 2D: ' // TRIM(DgnCont%cName)
3542 0 : IF ( PRESENT(HcoState) ) THEN
3543 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3544 : ELSE
3545 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3546 : ENDIF
3547 0 : RETURN
3548 : ENDIF
3549 :
3550 0 : IF ( SIZE(Trgt2D,1) /= ThisColl%NX .OR. &
3551 : SIZE(Trgt2D,2) /= ThisColl%NY ) THEN
3552 0 : MSG = 'Incorrect target array size: ' // TRIM(DgnCont%cName)
3553 0 : IF ( PRESENT(HcoState) ) THEN
3554 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3555 : ELSE
3556 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3557 : ENDIF
3558 0 : RETURN
3559 : ENDIF
3560 :
3561 : ! Define 2D array pointer
3562 0 : CALL HCO_ArrInit( DgnCont%Arr2D, 0, 0, RC )
3563 0 : IF ( RC /= HCO_SUCCESS ) THEN
3564 0 : CALL HCO_ERROR( 'ERROR 33', RC, THISLOC=LOC )
3565 0 : RETURN
3566 : ENDIF
3567 :
3568 : ! Point to data
3569 0 : DgnCont%Arr2D%Val => Trgt2D
3570 :
3571 : ! Update pointer switch. This will make sure that data is not modified.
3572 : ! Also set counter to non-zero to make sure that diagnostics will be
3573 : ! correctly written.
3574 0 : DgnCont%DtaIsPtr = .TRUE.
3575 0 : DgnCont%Counter = 1
3576 :
3577 : ! Return
3578 0 : RC = HCO_SUCCESS
3579 :
3580 : END SUBROUTINE DiagnCont_Link_2D
3581 : !EOC
3582 : !------------------------------------------------------------------------------
3583 : ! Harmonized Emissions Component (HEMCO) !
3584 : !------------------------------------------------------------------------------
3585 : !BOP
3586 : !
3587 : ! !ROUTINE: DiagnCont_Link_3D
3588 : !
3589 : ! !DESCRIPTION: Subroutine DiagnCont\_Link\_3D links the data of container
3590 : ! DgnCont to the 3D array Tgt3D. This will disable all time averaging,
3591 : ! unit conversion, etc., i.e. the data will be returned as is.
3592 : !\\
3593 : !\\
3594 : ! !INTERFACE:
3595 : !
3596 0 : SUBROUTINE DiagnCont_Link_3D( DgnCont, ThisColl, Trgt3D, RC, HcoState )
3597 : !
3598 : ! !USES:
3599 : !
3600 : USE HCO_State_Mod, ONLY : HCO_State
3601 : !
3602 : ! !INPUT PARAEMTERS:
3603 : !
3604 : TYPE(HCO_STATE), POINTER, OPTIONAL :: HcoState ! HEMCO state obj
3605 : REAL(sp), INTENT(IN ), TARGET :: Trgt3D(:,:,:) ! 3D target data
3606 : TYPE(DiagnCollection), POINTER :: ThisColl ! Collection
3607 : !
3608 : ! !INPUT/OUTPUT PARAMETERS:
3609 : !
3610 : TYPE(DiagnCont), POINTER :: DgnCont ! diagnostics
3611 : ! container
3612 : INTEGER, INTENT(INOUT) :: RC ! Return code
3613 : !
3614 : ! !REVISION HISTORY:
3615 : ! 19 Dec 2013 - C. Keller: Initialization
3616 : ! See https://github.com/geoschem/hemco for complete history
3617 : !EOP
3618 : !------------------------------------------------------------------------------
3619 : !BOC
3620 : !
3621 : ! !LOCAL ARGUMENTS:
3622 : !
3623 : CHARACTER(LEN=255) :: MSG, LOC
3624 :
3625 : !======================================================================
3626 : ! DiagnCont_Link_3D begins here!
3627 : !======================================================================
3628 :
3629 : ! Init
3630 0 : LOC = 'DiagnCont_Link_3D (hco_diagn_mod.F90)'
3631 :
3632 : ! Check if dimensions match. Also, containers with pointers must not
3633 : ! be set to AutoFill
3634 0 : IF ( DgnCont%AutoFill == 1 ) THEN
3635 0 : MSG = 'Cannot link AutoFill container: ' // TRIM(DgnCont%cName)
3636 0 : IF ( PRESENT(HcoState) ) THEN
3637 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3638 : ELSE
3639 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3640 : ENDIF
3641 0 : RETURN
3642 : ENDIF
3643 : IF ( DgnCont%AutoFill == 1 ) THEN
3644 : MSG = 'Target diagnostics has autofill flag of 1 - reset to 0: ' &
3645 : // TRIM(DgnCont%cName)
3646 : IF ( PRESENT(HcoState) ) THEN
3647 : CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
3648 : ELSE
3649 : WRITE(*,*) 'HEMCO WARNING: ', TRIM(MSG)
3650 : ENDIF
3651 : DgnCont%AutoFill = 0
3652 : ENDIF
3653 0 : IF ( DgnCont%SpaceDim /= 3 ) THEN
3654 0 : MSG = 'Diagnostics is not 3D: ' // TRIM(DgnCont%cName)
3655 0 : IF ( PRESENT(HcoState) ) THEN
3656 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3657 : ELSE
3658 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3659 : ENDIF
3660 0 : RETURN
3661 : ENDIF
3662 :
3663 : ! Check array size
3664 : IF ( SIZE(Trgt3D,1) /= ThisColl%NX .OR. &
3665 0 : SIZE(Trgt3D,2) /= ThisColl%NY .OR. &
3666 : SIZE(Trgt3D,3) /= ThisColl%NZ ) THEN
3667 0 : MSG = 'Incorrect target array size: ' // TRIM(DgnCont%cName)
3668 0 : IF ( PRESENT(HcoState) ) THEN
3669 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3670 : ELSE
3671 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3672 : ENDIF
3673 0 : RETURN
3674 : ENDIF
3675 :
3676 : ! Define 3D array pointer
3677 0 : CALL HCO_ArrInit( DgnCont%Arr3D, 0, 0, 0, RC )
3678 0 : IF ( RC /= HCO_SUCCESS ) THEN
3679 0 : CALL HCO_ERROR( 'ERROR 34', RC, THISLOC=LOC )
3680 0 : RETURN
3681 : ENDIF
3682 :
3683 : ! Point to data
3684 0 : DgnCont%Arr3D%Val => Trgt3D
3685 :
3686 : ! Update pointer switch. This will make sure that data is not modified.
3687 : ! Also set counter to non-zero to make sure that diagnostics will be
3688 : ! correctly written.
3689 0 : DgnCont%DtaIsPtr = .TRUE.
3690 0 : DgnCont%Counter = 1
3691 0 : DgnCont%IsOutFormat = .TRUE.
3692 :
3693 : ! Return
3694 0 : RC = HCO_SUCCESS
3695 :
3696 : END SUBROUTINE DiagnCont_Link_3D
3697 : !EOC
3698 : !------------------------------------------------------------------------------
3699 : ! Harmonized Emissions Component (HEMCO) !
3700 : !------------------------------------------------------------------------------
3701 : !BOP
3702 : !
3703 : ! !ROUTINE: Diagn_Print
3704 : !
3705 : ! !DESCRIPTION: Subroutine Diagn\_Print displays the content of the
3706 : ! passed diagnostics container.
3707 : !\\
3708 : !\\
3709 : ! !INTERFACE:
3710 : !
3711 0 : SUBROUTINE Diagn_Print ( HcoState, Dgn, VerbNr )
3712 : !
3713 : ! !USES:
3714 : !
3715 : USE HCO_STATE_MOD, ONLY : HCO_STATE
3716 : !
3717 : ! !INPUT ARGUMENTS:
3718 : !
3719 : TYPE(HCO_STATE), POINTER :: HcoState
3720 : TYPE(DiagnCont), POINTER :: Dgn
3721 : INTEGER, INTENT(IN) :: VerbNr
3722 : !
3723 : ! !REVISION HISTORY:
3724 : ! 01 Aug 2014 - C. Keller - Initial version
3725 : ! See https://github.com/geoschem/hemco for complete history
3726 : !EOP
3727 : !------------------------------------------------------------------------------
3728 : !BOC
3729 : !
3730 : ! !ARGUMENTS:
3731 : !
3732 : TYPE(DiagnCollection), POINTER :: ThisColl
3733 : CHARACTER(LEN=255) :: MSG, LOC
3734 : INTEGER :: RC, PS, nx, ny, nz
3735 : REAL(sp) :: sm
3736 :
3737 : ! ================================================================
3738 : ! Diagn_Print begins here
3739 : ! ================================================================
3740 :
3741 : ! Initialize
3742 0 : LOC = 'Diagn_Print (HCO_DIAGN_MOD.F90)'
3743 0 : ThisColl => NULL()
3744 :
3745 : ! Get collection number
3746 : CALL DiagnCollection_DefineID( HcoState%Diagn, PS, RC, &
3747 0 : COL=Dgn%CollectionID, ThisColl=ThisColl, HcoState=HcoState )
3748 0 : IF ( RC /= HCO_SUCCESS ) THEN
3749 0 : CALL HCO_ERROR( 'ERROR 35', RC, THISLOC=LOC )
3750 0 : RETURN
3751 : ENDIF
3752 :
3753 0 : sm = 0.0_sp
3754 0 : nx = 0
3755 0 : ny = 0
3756 0 : nz = 0
3757 0 : IF ( Dgn%SpaceDim<=2 ) THEN
3758 0 : IF ( ASSOCIATED(Dgn%Arr2D) ) THEN
3759 0 : nx = SIZE(Dgn%Arr2D%Val,1)
3760 0 : ny = SIZE(Dgn%Arr2D%Val,2)
3761 0 : sm = SUM(Dgn%Arr2D%Val)
3762 : ENDIF
3763 : ELSE
3764 0 : IF ( ASSOCIATED(Dgn%Arr3D) ) THEN
3765 0 : nx = SIZE(Dgn%Arr3D%Val,1)
3766 0 : ny = SIZE(Dgn%Arr3D%Val,2)
3767 0 : nz = SIZE(Dgn%Arr3D%Val,3)
3768 0 : sm = SUM(Dgn%Arr3D%Val)
3769 : ENDIF
3770 : ENDIF
3771 :
3772 : ! Always print name
3773 0 : MSG = 'Container ' // TRIM(Dgn%cName)
3774 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
3775 :
3776 : ! Eventually add details
3777 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
3778 :
3779 : ! General information
3780 0 : WRITE(MSG,*) ' --> Collection : ', Dgn%CollectionID
3781 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3782 0 : WRITE(MSG,*) ' --> Diagn ID : ', Dgn%cID
3783 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3784 0 : WRITE(MSG,*) ' --> Extension Nr : ', Dgn%ExtNr
3785 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3786 0 : WRITE(MSG,*) ' --> Category : ', Dgn%Cat
3787 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3788 0 : WRITE(MSG,*) ' --> Hierarchy : ', Dgn%Hier
3789 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3790 0 : WRITE(MSG,*) ' --> HEMCO species ID : ', Dgn%HcoID
3791 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3792 0 : WRITE(MSG,*) ' --> Autofill? ', Dgn%AutoFill
3793 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3794 0 : WRITE(MSG,*) ' --> Space dimension : ', Dgn%SpaceDim
3795 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3796 0 : WRITE(MSG,*) ' --> Used level index : ', Dgn%LevIdx
3797 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3798 0 : WRITE(MSG,*) ' --> Output unit : ', TRIM(Dgn%OutUnit)
3799 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3800 0 : WRITE(MSG,*) ' --> Uniform scaling : ', Dgn%ScaleFact
3801 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3802 0 : WRITE(MSG,*) ' --> Current array sum : ', sm
3803 0 : CALL HCO_MSG( HcoState%Config%Err, MSG)
3804 : ENDIF
3805 :
3806 : ! Cleanup
3807 0 : ThisColl => NULL()
3808 :
3809 : END SUBROUTINE Diagn_Print
3810 : !EOC
3811 : !------------------------------------------------------------------------------
3812 : ! Harmonized Emissions Component (HEMCO) !
3813 : !------------------------------------------------------------------------------
3814 : !BOP
3815 : !
3816 : ! !ROUTINE: DiagnCollection_Create
3817 : !
3818 : ! !DESCRIPTION: Subroutine DiagnCollection\_Create creates a new diagnostics
3819 : ! collection at position COL. The class arguments are set as specified by the
3820 : ! input arguments.
3821 : !\\
3822 : !\\
3823 : ! If the given position is already occupied, the routine returns an error if
3824 : ! the input argument do not match with the corresponding arguments of the
3825 : ! diagnostics class at that position.
3826 : !\\
3827 : !\\
3828 : ! !INTERFACE:
3829 : !
3830 0 : SUBROUTINE DiagnCollection_Create ( Diagn, NX, NY, NZ, &
3831 : TS, AM2, PREFIX, &
3832 : deltaYMD, deltaHMS, OutTimeStamp, &
3833 : RC, COL, HcoState )
3834 : !
3835 : ! !USES:
3836 : !
3837 : USE HCO_STATE_MOD, ONLY : HCO_STATE
3838 : !
3839 : ! !INPUT ARGUMENTS:
3840 : !
3841 : TYPE(DiagnBundle), POINTER :: Diagn ! Diagn bundle
3842 : INTEGER, INTENT(IN) :: NX ! # of lons
3843 : INTEGER, INTENT(IN) :: NY ! # of lats
3844 : INTEGER, INTENT(IN) :: NZ ! # of levels
3845 : REAL(sp), INTENT(IN) :: TS ! timestep [s]
3846 : REAL(hp), POINTER :: AM2(:,:) ! grid box areas [m2]
3847 : CHARACTER(LEN=*), INTENT(IN) :: PREFIX ! Output prefix
3848 : INTEGER, INTENT(IN), OPTIONAL :: deltaYMD ! Output frequency
3849 : INTEGER, INTENT(IN), OPTIONAL :: deltaHMS ! Output frequency
3850 : INTEGER, INTENT(IN), OPTIONAL :: OutTimeStamp ! Output time stamp
3851 : TYPE(HCO_State), POINTER, OPTIONAL :: HcoState ! HEMCO state obj
3852 : !
3853 : ! !OUTPUT ARGUMENTS:
3854 : !
3855 : INTEGER, INTENT( OUT) :: COL ! Collection Nr.
3856 : !
3857 : ! !INPUT/OUTPUT ARGUMENTS:
3858 : !
3859 : INTEGER, INTENT(INOUT) :: RC ! Return code
3860 : !
3861 : ! !REVISION HISTORY:
3862 : ! 08 Jan 2015 - C. Keller - Initial version
3863 : ! See https://github.com/geoschem/hemco for complete history
3864 : !EOP
3865 : !------------------------------------------------------------------------------
3866 : !BOC
3867 : !
3868 : ! !ARGUMENTS:
3869 : !
3870 : TYPE(DiagnCollection), POINTER :: NewCollection
3871 : INTEGER :: PS
3872 : CHARACTER(LEN=255) :: MSG
3873 : CHARACTER(LEN=255) :: LOC = 'DiagnCollection_Create (hco_diagn_mod.F90)'
3874 :
3875 : ! ================================================================
3876 : ! DiagnCollection_Create begins here
3877 : ! ================================================================
3878 :
3879 : ! Allocate new collection
3880 0 : ALLOCATE(NewCollection)
3881 :
3882 : ! Pass arguments
3883 0 : NewCollection%NX = NX
3884 0 : NewCollection%NY = NY
3885 0 : NewCollection%NZ = NZ
3886 0 : NewCollection%TS = TS
3887 0 : NewCollection%AREA_M2 => AM2
3888 :
3889 : ! Set prefix
3890 0 : NewCollection%PREFIX = TRIM(PREFIX)
3891 :
3892 : ! Add to collections list. Put at the beginning
3893 0 : NewCollection%NextCollection => Diagn%Collections
3894 0 : Diagn%Collections => NewCollection
3895 :
3896 : ! Define this collection ID
3897 0 : Diagn%nnCollections = Diagn%nnCollections + 1
3898 0 : NewCollection%CollectionID = Diagn%nnCollections
3899 0 : COL = NewCollection%CollectionID
3900 :
3901 : ! New output frequency
3902 0 : IF ( PRESENT(DeltaYMD ) ) NewCollection%DeltaYMD = DeltaYMD
3903 0 : IF ( PRESENT(DeltaHMS ) ) NewCollection%DeltaHMS = DeltaHMS
3904 :
3905 : ! Determine output time stamp
3906 0 : IF ( PRESENT(OutTimeStamp) ) THEN
3907 : ! Make sure it's one of the valid values
3908 : IF ( OutTimeStamp == HcoDiagnStart .OR. &
3909 0 : OutTimeStamp == HcoDiagnMid .OR. &
3910 : OutTimeStamp == HcoDiagnEnd ) THEN
3911 0 : NewCollection%OutTimeStamp = OutTimeStamp
3912 : ELSE
3913 0 : WRITE(MSG,*) 'Error when creating diagnostics collection ', &
3914 0 : TRIM(NewCollection%PREFIX), ' the specified output time ', &
3915 0 : 'stamp of ', OutTimeStamp, ' is invalid, must be one of: ', &
3916 0 : HcoDiagnStart, HcoDiagnMid, HcoDiagnEnd
3917 0 : IF ( PRESENT(HcoState) ) THEN
3918 0 : CALL HCO_ERROR(MSG,RC,THISLOC=LOC)
3919 : ELSE
3920 0 : CALL HCO_ERROR(MSG,RC,THISLOC=LOC)
3921 : ENDIF
3922 0 : RETURN
3923 : ENDIF
3924 : ELSE
3925 0 : NewCollection%OutTimeStamp = HcoDiagnEnd
3926 : ENDIF
3927 :
3928 : ! verbose
3929 0 : IF ( PRESENT(HcoState) ) THEN
3930 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
3931 0 : MSG = 'Created diagnostics collection: '
3932 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
3933 0 : WRITE(MSG,'(a21,i2)') ' - Collection ID : ', COL
3934 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
3935 0 : WRITE(MSG,'(a21,a)' ) ' - PREFIX : ', TRIM(NewCollection%PREFIX)
3936 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
3937 0 : WRITE(MSG,'(a21,i8,a1,i6)' ) ' - Output interval: ', NewCollection%DeltaYMD, &
3938 0 : ' ', NewCollection%DeltaHMS
3939 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
3940 : ENDIF
3941 : ENDIF
3942 :
3943 : ! Return w/ success
3944 0 : RC = HCO_SUCCESS
3945 :
3946 : END SUBROUTINE DiagnCollection_Create
3947 : !EOC
3948 : !------------------------------------------------------------------------------
3949 : ! Harmonized Emissions Component (HEMCO) !
3950 : !------------------------------------------------------------------------------
3951 : !BOP
3952 : !
3953 : ! !ROUTINE: DiagnCollection_Cleanup
3954 : !
3955 : ! !DESCRIPTION: Subroutine DiagnCollection\_Cleanup cleans up the diagnostics
3956 : ! collection for collection COL.
3957 : !\\
3958 : !\\
3959 : ! !INTERFACE:
3960 : !
3961 0 : SUBROUTINE DiagnCollection_Cleanup ( Diagn )
3962 : !
3963 : ! !INPUT ARGUMENTS:
3964 : !
3965 : TYPE(DiagnBundle), POINTER :: Diagn
3966 : !
3967 : ! !REVISION HISTORY:
3968 : ! 08 Jan 2015 - C. Keller - Initial version
3969 : ! See https://github.com/geoschem/hemco for complete history
3970 : !EOP
3971 : !------------------------------------------------------------------------------
3972 : !BOC
3973 : !
3974 : ! !LOCAL VARIABLES:
3975 : !
3976 : TYPE(DiagnCollection), POINTER :: ThisColl => NULL()
3977 : TYPE(DiagnCollection), POINTER :: NextColl => NULL()
3978 :
3979 : ! ================================================================
3980 : ! DiagnCollection_Cleanup begins here
3981 : ! ================================================================
3982 :
3983 : ! Do for every collection in list
3984 0 : ThisColl => Diagn%Collections
3985 0 : NextColl => NULL()
3986 :
3987 0 : DO WHILE ( ASSOCIATED(ThisColl) )
3988 :
3989 : ! Cleanup
3990 0 : CALL DiagnList_Cleanup( ThisColl%DiagnList )
3991 0 : ThisColl%nnDiagn = 0
3992 0 : ThisColl%AREA_M2 => NULL()
3993 :
3994 : ! Advance
3995 0 : NextColl => ThisColl%NextCollection
3996 0 : ThisColl%NextCollection => NULL()
3997 :
3998 : ! Free the memory given to ThisColl to avoid memory leaks
3999 0 : DEALLOCATE( ThisColl )
4000 :
4001 : ! Point to the next collection in the list for the next iteration
4002 0 : ThisColl => NextColl
4003 :
4004 : ENDDO
4005 :
4006 0 : END SUBROUTINE DiagnCollection_Cleanup
4007 : !EOC
4008 : !------------------------------------------------------------------------------
4009 : ! Harmonized Emissions Component (HEMCO) !
4010 : !------------------------------------------------------------------------------
4011 : !BOP
4012 : !
4013 : ! !ROUTINE: DiagnCollection_DefineID
4014 : !
4015 : ! !DESCRIPTION: Subroutine DiagnCollection\_DefineID is a helper routine to
4016 : ! return the collection ID.
4017 : !\\
4018 : !\\
4019 : ! !INTERFACE:
4020 : !
4021 0 : SUBROUTINE DiagnCollection_DefineID ( Diagn, PS, RC, COL, DEF, OkIfAll, &
4022 : InUse, ThisColl, HcoState )
4023 : !
4024 : ! !USES:
4025 : !
4026 : USE HCO_STATE_MOD, ONLY : HCO_STATE
4027 : !
4028 : ! !INPUT ARGUMENTS:
4029 : !
4030 : INTEGER, INTENT(IN ), OPTIONAL :: COL ! desired collection number
4031 : INTEGER, INTENT(IN ), OPTIONAL :: DEF ! default collection number
4032 : LOGICAL, INTENT(IN ), OPTIONAL :: OkIfAll ! Ok if all (PS=-1)
4033 : !
4034 : ! !INPUT/OUTPUT ARGUMENTS:
4035 : !
4036 : TYPE(DiagnBundle), POINTER :: Diagn ! Diagn bundle obj
4037 : TYPE(HCO_STATE), POINTER, OPTIONAL :: HcoState ! HEMCO state obj
4038 : INTEGER, INTENT(INOUT) :: PS ! Assigned collection number
4039 : INTEGER, INTENT(INOUT) :: RC ! Return code
4040 : LOGICAL, INTENT( OUT), OPTIONAL :: InUse ! Is this in use?
4041 : !
4042 : ! !OUTPUT ARGUMENTS:
4043 : !
4044 : TYPE(DiagnCollection), POINTER, OPTIONAL :: ThisColl ! Pointer to collection
4045 : !
4046 : ! !REVISION HISTORY:
4047 : ! 01 Apr 2015 - C. Keller - Initial version
4048 : ! See https://github.com/geoschem/hemco for complete history
4049 : !EOP
4050 : !------------------------------------------------------------------------------
4051 : !BOC
4052 : !
4053 : ! !ARGUMENTS:
4054 : !
4055 : LOGICAL :: AllOk, FOUND
4056 : CHARACTER(LEN=255) :: MSG
4057 : CHARACTER(LEN=255), PARAMETER :: LOC = 'DiagnCollection_DefineID (hco_diagn_mod.F90)'
4058 :
4059 : ! ================================================================
4060 : ! DiagnCollection_DefineID begins here
4061 : ! ================================================================
4062 :
4063 : ! Init
4064 0 : IF ( PRESENT(ThisColl) ) ThisColl => NULL()
4065 0 : IF ( PRESENT(InUse ) ) InUse = .FALSE.
4066 :
4067 : ! Check if it's negative
4068 0 : AllOk = .FALSE.
4069 0 : IF ( PRESENT(OkIfAll) ) AllOK = OkIfAll
4070 :
4071 : ! Get collection position
4072 0 : IF ( PRESENT(DEF) ) THEN
4073 0 : PS = DEF
4074 : ELSE
4075 0 : PS = Diagn%HcoDiagnIDDefault
4076 : ENDIF
4077 0 : IF ( PRESENT(COL) ) PS = COL
4078 :
4079 : ! Check if all collections are selected (-1)
4080 0 : IF ( PS == -1 ) THEN
4081 0 : IF ( AllOK ) THEN
4082 0 : IF ( PRESENT(InUse) ) InUse = .TRUE.
4083 0 : IF ( PRESENT(ThisColl) ) ThisColl => Diagn%Collections
4084 0 : RC = HCO_SUCCESS
4085 0 : RETURN
4086 : ELSE
4087 0 : WRITE(MSG,*) 'Not allowed to select all collections ', PS
4088 0 : IF ( PRESENT(HcoState) ) THEN
4089 0 : CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
4090 : ELSE
4091 0 : CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
4092 : ENDIF
4093 0 : RETURN
4094 : ENDIF
4095 :
4096 : ! If individual collection is selected
4097 : ELSE
4098 :
4099 : ! Try to find collection
4100 0 : CALL DiagnCollection_Find( Diagn, PS, FOUND, RC, ThisColl=ThisColl )
4101 0 : IF ( RC /= HCO_SUCCESS ) THEN
4102 0 : CALL HCO_ERROR( 'ERROR 36', RC, THISLOC=LOC )
4103 0 : RETURN
4104 : ENDIF
4105 :
4106 : ! Eventually fill argumnet
4107 0 : IF ( PRESENT(InUse) ) THEN
4108 0 : InUse = FOUND
4109 :
4110 0 : ELSEIF ( .NOT. FOUND ) THEN
4111 0 : WRITE(MSG,*) 'Diagnostics collection not defined: ', PS
4112 0 : IF ( PRESENT(HcoState) ) THEN
4113 0 : CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
4114 : ELSE
4115 0 : CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
4116 : ENDIF
4117 : ENDIF
4118 : ENDIF
4119 :
4120 : ! Return w/ success
4121 0 : RC = HCO_SUCCESS
4122 :
4123 : END SUBROUTINE DiagnCollection_DefineID
4124 : !EOC
4125 : !------------------------------------------------------------------------------
4126 : ! Harmonized Emissions Component (HEMCO) !
4127 : !------------------------------------------------------------------------------
4128 : !BOP
4129 : !
4130 : ! !ROUTINE: DiagnCollection_Find
4131 : !
4132 : ! !DESCRIPTION: Subroutine DiagnCollection\_Find searches the collection
4133 : ! linked list for the collection with the given collection ID.
4134 : !\\
4135 : !\\
4136 : ! !INTERFACE:
4137 : !
4138 0 : SUBROUTINE DiagnCollection_Find ( Diagn, PS, FOUND, RC, ThisColl )
4139 : !
4140 : ! !INPUT PARAMETERS:
4141 : !
4142 : INTEGER, INTENT(IN ) :: PS ! desired collection number
4143 : !
4144 : ! !INPUT/OUTPUT PARAMETERS:
4145 : !
4146 : TYPE(DiagnBundle), POINTER :: Diagn ! Diagn bundle obj
4147 : LOGICAL, INTENT( OUT) :: FOUND ! Collection exists?
4148 : INTEGER, INTENT(INOUT) :: RC ! Return code
4149 : TYPE(DiagnCollection), POINTER, OPTIONAL :: ThisColl ! Pointer to collection
4150 : !
4151 : ! !REVISION HISTORY:
4152 : ! 01 Apr 2015 - C. Keller - Initial version
4153 : ! See https://github.com/geoschem/hemco for complete history
4154 : !EOP
4155 : !------------------------------------------------------------------------------
4156 : !BOC
4157 : !
4158 : ! !ARGUMENTS:
4159 : !
4160 : TYPE(DiagnCollection), POINTER :: TmpColl
4161 : CHARACTER(LEN=255), PARAMETER :: LOC = 'DiagnCollection_Find (hco_diagn_mod.F90)'
4162 :
4163 : ! ================================================================
4164 : ! DiagnCollection_Find begins here
4165 : ! ================================================================
4166 :
4167 : ! Init
4168 0 : TmpColl => NULL()
4169 :
4170 : ! Check if it's negative
4171 0 : FOUND = .FALSE.
4172 :
4173 : ! Loop over all collections
4174 0 : TmpColl => Diagn%Collections
4175 0 : DO WHILE ( ASSOCIATED(TmpColl) )
4176 :
4177 : ! Check if this is the collection of interest
4178 0 : IF ( TmpColl%CollectionID == PS ) THEN
4179 0 : FOUND = .TRUE.
4180 0 : EXIT
4181 : ENDIF
4182 :
4183 : ! Advance in list
4184 0 : TmpColl => TmpColl%NextCollection
4185 : ENDDO
4186 :
4187 : ! Eventually pass to output argument
4188 0 : IF ( PRESENT(ThisColl) ) ThisColl => TmpColl
4189 :
4190 : ! Cleanup
4191 0 : TmpColl => NULL()
4192 :
4193 : ! Return w/ success
4194 0 : RC = HCO_SUCCESS
4195 :
4196 0 : END SUBROUTINE DiagnCollection_Find
4197 : !EOC
4198 : !------------------------------------------------------------------------------
4199 : ! Harmonized Emissions Component (HEMCO) !
4200 : !------------------------------------------------------------------------------
4201 : !BOP
4202 : !
4203 : ! !IROUTINE: DiagnCollection_GetDefaultDelta returns the default diagnostics
4204 : ! output intervals based on the 'DiagnFreq' entry of the HEMCO configuration
4205 : ! file. This can be one of the following character values: 'Hourly', 'Daily',
4206 : ! 'Monthly', 'Annually', 'Always', or 'End'; or two integer explicitly denoting
4207 : ! the year-month-day and hour-minute-second interval, respectively (format
4208 : ! 00000000 000000). For example, setting DiagnFreq to '00000000 010000' would
4209 : ! be the same as setting it to 'Hourly'.
4210 : !\\
4211 : !\\
4212 : ! !INTERFACE:
4213 : !
4214 0 : SUBROUTINE DiagnCollection_GetDefaultDelta ( HcoState, &
4215 : deltaYMD, deltaHMS, RC )
4216 : !
4217 : ! !USES:
4218 : !
4219 : USE HCO_STATE_MOD, ONLY : HCO_State
4220 : USE HCO_ExtList_Mod, ONLY : GetExtOpt
4221 : USE HCO_ExtList_Mod, ONLY : CoreNr
4222 : !
4223 : ! !INPUT PARAMETERS:
4224 : !
4225 : TYPE(HCO_STATE), POINTER :: HcoState ! HEMCO state obj
4226 : !
4227 : ! !OUTPUT PARAMETERS:
4228 : !
4229 : INTEGER, INTENT( OUT) :: deltaYMD ! delta YYYYMMDD
4230 : INTEGER, INTENT( OUT) :: deltaHMS ! delta HHMMSS
4231 : !
4232 : ! !INPUT/OUTPUT PARAMETERS:
4233 : !
4234 : INTEGER, INTENT(INOUT) :: RC ! Return code
4235 : !
4236 : ! !REVISION HISTORY:
4237 : ! 06 Aug 2015 - C. Keller - Initial version
4238 : ! See https://github.com/geoschem/hemco for complete history
4239 : !EOP
4240 : !------------------------------------------------------------------------------
4241 : !BOC
4242 : !
4243 : ! !LOCAL VARIABLES:
4244 : !
4245 : LOGICAL :: FOUND, SET
4246 : CHARACTER(LEN=255) :: MSG, WriteFreq
4247 : CHARACTER(LEN=255) :: LOC = 'DiagnCollection_GetDefaultDelta (hco_diagn_mod.F90)'
4248 :
4249 : !=================================================================
4250 : ! DiagnCollection_GetDefaultDelta begins here!
4251 : !=================================================================
4252 :
4253 : ! Try to get name of diagnostics file
4254 :
4255 : ! Output frequency. Try to read from configuration file.
4256 : CALL GetExtOpt ( HcoState%Config, CoreNr, 'DiagnFreq', &
4257 0 : OptValChar=WriteFreq, FOUND=FOUND, RC=RC )
4258 :
4259 0 : IF ( RC /= HCO_SUCCESS ) THEN
4260 0 : CALL HCO_ERROR( 'ERROR 37', RC, THISLOC=LOC )
4261 0 : RETURN
4262 : ENDIF
4263 :
4264 : ! Determine output frequency from given output frequency
4265 0 : IF ( FOUND ) THEN
4266 :
4267 : ! Frequency set?
4268 0 : SET = .FALSE.
4269 :
4270 0 : IF ( TRIM(WriteFreq) == 'Hourly' ) THEN
4271 0 : DeltaYMD = 0
4272 0 : DeltaHMS = 10000
4273 : SET = .TRUE.
4274 0 : ELSEIF ( TRIM(WriteFreq) == 'Daily' ) THEN
4275 0 : DeltaYMD = 1
4276 0 : DeltaHMS = 0
4277 : SET = .TRUE.
4278 0 : ELSEIF ( TRIM(WriteFreq) == 'Monthly' ) THEN
4279 0 : DeltaYMD = 100
4280 0 : DeltaHMS = 0
4281 : SET = .TRUE.
4282 0 : ELSEIF ( TRIM(WriteFreq) == 'Annually' ) THEN
4283 0 : DeltaYMD = 10000
4284 0 : DeltaHMS = 0
4285 : SET = .TRUE.
4286 0 : ELSEIF ( TRIM(WriteFreq) == 'Always' ) THEN
4287 0 : DeltaYMD = 0
4288 0 : DeltaHMS = 1
4289 : SET = .TRUE.
4290 0 : ELSEIF ( TRIM(WriteFreq) == 'End' ) THEN
4291 0 : DeltaYMD = 99999999
4292 0 : DeltaHMS = 999999
4293 : SET = .TRUE.
4294 :
4295 : ! If none of the above works, assume that string explicitly gives integer
4296 : ! intervals (YYYYMMDD HHMMSS)
4297 : ELSE
4298 0 : IF ( LEN(TRIM(WriteFreq)) == 15 ) THEN
4299 0 : READ(WriteFreq(1 :8 ), * ) DeltaYMD
4300 0 : READ(WriteFreq(10:15), * ) DeltaHMS
4301 0 : IF ( DeltaYMD >= 0 .AND. DeltaHMS >= 0 ) SET=.TRUE.
4302 : ENDIF
4303 : ENDIF
4304 :
4305 : ! Error check
4306 : IF ( .NOT. SET ) THEN
4307 : MSG = 'Cannot define output frequency from string ' // &
4308 : TRIM(WriteFreq) // '. The output frequency must be one of ' // &
4309 : '`Hourly`, `Daily`, `Monthly`, `Annually`, `Always`, `End`,' // &
4310 0 : ' or the explicit YYYYMMDD HHMMSS interval (15 characters).'
4311 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC)
4312 0 : RETURN
4313 : ENDIF
4314 :
4315 : ! If output frequency is not explicitly given, set to a default of 1 day.
4316 : ELSE
4317 0 : DeltaYMD = 1 ! = 00000001 ==> 1 day
4318 0 : DeltaHMS = 0 ! = 000000
4319 : ENDIF
4320 :
4321 : ! Force to 'Always' in ESMF environment to make sure that
4322 : ! diagnostics are passed to MAPL HISTORY every time.
4323 : #if defined ( ESMF_ )
4324 : DeltaYMD = 0 ! = 00000000
4325 : DeltaHMS = 1 ! = 000001 ==> 1 second!
4326 : #endif
4327 :
4328 : ! Return w/ success
4329 0 : RC = HCO_SUCCESS
4330 :
4331 : END SUBROUTINE DiagnCollection_GetDefaultDelta
4332 : !EOC
4333 : !------------------------------------------------------------------------------
4334 : ! Harmonized Emissions Component (HEMCO) !
4335 : !------------------------------------------------------------------------------
4336 : !BOP
4337 : !
4338 : ! !IROUTINE: Function DiagnCollection_IsTimeToWrite returns true if it is time
4339 : ! to write the provided diagnostics collection (identified by the collection
4340 : ! number) to output. Whether it is time to write the diagnostics is based upon
4341 : ! the current simulation time, the diagnostics output frequency, and the time
4342 : ! span since the last output datetime.
4343 : !\\
4344 : !\\
4345 : ! !INTERFACE:
4346 : !
4347 0 : FUNCTION DiagnCollection_IsTimeToWrite( HcoState, PS ) &
4348 : RESULT ( TimeToWrite )
4349 : !
4350 : ! !USES:
4351 : !
4352 : USE HCO_STATE_MOD, ONLY : HCO_State
4353 : !
4354 : ! !INPUT PARAMETERS:
4355 : !
4356 : INTEGER, INTENT(IN ) :: PS ! Diagnostics collection
4357 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
4358 : !
4359 : ! !OUTPUT PARAMETERS:
4360 : !
4361 : LOGICAL :: TimeToWrite ! Is it time to write?
4362 : !
4363 : ! !REVISION HISTORY:
4364 : ! 06 Aug 2015 - C. Keller - Initial version
4365 : ! See https://github.com/geoschem/hemco for complete history
4366 : !EOP
4367 : !------------------------------------------------------------------------------
4368 : !BOC
4369 : !
4370 : ! !LOCAL VARIABLES:
4371 : !
4372 : INTEGER :: YYYY, MM, DD, h, m, s
4373 : INTEGER :: lh, lm, ls
4374 : INTEGER :: delta
4375 : INTEGER :: dymd, lymd, dhms, lhms
4376 : INTEGER :: RC
4377 : LOGICAL :: IsLast
4378 : CHARACTER(LEN=255) :: LOC = 'DiagnCollection_IsTimeToWrite (hco_diagn_mod.F90)'
4379 :
4380 : !=================================================================
4381 : ! DiagnCollection_IsTimeToWrite begins here!
4382 : !=================================================================
4383 :
4384 : ! Init
4385 0 : TimeToWrite = .FALSE.
4386 :
4387 : ! Get collection time interval
4388 : CALL DiagnCollection_Get( HcoState%Diagn, PS, DeltaYMD=dymd, &
4389 0 : LastYMD=lymd, DeltaHMS=dhms, LastHMS=lhms, RC=RC )
4390 0 : IF ( RC /= HCO_SUCCESS ) THEN
4391 0 : CALL HCO_ERROR( 'ERROR 38', RC, THISLOC=LOC )
4392 0 : RETURN
4393 : ENDIF
4394 :
4395 : ! Get current simulation date
4396 : CALL HcoClock_Get( HcoState%Clock, IsLast=IsLast, &
4397 0 : sYYYY=YYYY,sMM=MM,sDD=DD,sH=h,sM=m,sS=s,RC=RC)
4398 0 : IF ( RC /= HCO_SUCCESS ) THEN
4399 0 : CALL HCO_ERROR( 'ERROR 39', RC, THISLOC=LOC )
4400 0 : RETURN
4401 : ENDIF
4402 :
4403 : ! Check for last time step
4404 0 : IF ( IsLast .AND. dymd == 99999999 .AND. dhms == 999999 ) THEN
4405 0 : TimeToWrite = .TRUE.
4406 : ENDIF
4407 :
4408 : ! Check if we need to write this collection now
4409 0 : IF ( .NOT. TimeToWrite .AND. dhms > 0 .AND. lhms >= 0 ) THEN
4410 : ! lh is the last hour of writeout
4411 0 : lh = FLOOR( MOD(lhms*1.d0, 1000000.0d0 ) / 1.0d4 )
4412 0 : IF ( h == 0 .AND. lh > 0 ) h = 24
4413 0 : delta = ( h * 10000 + m * 100 + s ) - lhms
4414 0 : IF ( delta >= dhms ) TimeToWrite = .TRUE.
4415 : ENDIF
4416 :
4417 0 : IF ( .NOT. TimeToWrite .AND. dymd > 0 .AND. lymd >= 0 ) THEN
4418 0 : delta = ( YYYY * 10000 + MM * 100 + DD ) - lymd
4419 0 : IF ( delta >= dymd ) TimeToWrite = .TRUE.
4420 : ENDIF
4421 :
4422 : END FUNCTION DiagnCollection_IsTimeToWrite
4423 : !EOC
4424 : !------------------------------------------------------------------------------
4425 : ! Harmonized Emissions Component (HEMCO) !
4426 : !------------------------------------------------------------------------------
4427 : !BOP
4428 : !
4429 : ! !IROUTINE: Function DiagnCollection_LastTimesSet returns true if there
4430 : ! exists a valid entry for the last datetime that collection PS has been
4431 : ! written to disk. This is primarily important to check if the last
4432 : ! output date needs be initialized (to non-default values).
4433 : !\\
4434 : !\\
4435 : ! !INTERFACE:
4436 : !
4437 0 : FUNCTION DiagnCollection_LastTimesSet( Diagn, PS ) Result ( LastTimesSet )
4438 : !
4439 : ! !USES:
4440 : !
4441 : !
4442 : ! !INPUT PARAMETERS:
4443 : !
4444 : TYPE(DiagnBundle), POINTER :: Diagn
4445 : INTEGER, INTENT(IN ) :: PS ! Diagnostics collection
4446 : !
4447 : ! !OUTPUT PARAMETERS:
4448 : !
4449 : LOGICAL :: LastTimesSet ! Are last times defined or not?
4450 : !
4451 : ! !REVISION HISTORY:
4452 : ! 09 Sep 2015 - C. Keller - Initial version
4453 : ! See https://github.com/geoschem/hemco for complete history
4454 : !EOP
4455 : !------------------------------------------------------------------------------
4456 : !BOC
4457 : !
4458 : ! !LOCAL VARIABLES:
4459 : !
4460 : INTEGER :: lymd, lhms
4461 : INTEGER :: RC
4462 : CHARACTER(LEN=255) :: LOC = 'DiagnCollection_LastTimesSet (hco_diagn_mod.F90)'
4463 :
4464 : !=================================================================
4465 : ! DiagnCollection_LastTimesSet begins here!
4466 : !=================================================================
4467 :
4468 : ! Init
4469 0 : LastTimesSet = .FALSE.
4470 :
4471 0 : CALL DiagnCollection_Get( Diagn, PS, LastYMD=lymd, LastHMS=lhms, RC=RC )
4472 0 : IF ( RC /= HCO_SUCCESS ) THEN
4473 0 : CALL HCO_ERROR( 'ERROR 40', RC, THISLOC=LOC )
4474 0 : RETURN
4475 : ENDIF
4476 :
4477 : ! Last time stamp is defined if either of the values is greater equal zero.
4478 0 : IF ( lymd >= 0 .OR. lhms >= 0 ) LastTimesSet = .TRUE.
4479 :
4480 : END FUNCTION DiagnCollection_LastTimesSet
4481 : !EOC
4482 : !------------------------------------------------------------------------------
4483 : ! Harmonized Emissions Component (HEMCO) !
4484 : !------------------------------------------------------------------------------
4485 : !BOP
4486 : !
4487 : ! !DESCRIPTION: Opens a diagnostic configuration file. This is where you
4488 : ! tell HEMCO which diagnostics you would like to send directly to netCDF
4489 : ! output.
4490 : !\\
4491 : !\\
4492 : ! !INTERFACE:
4493 : !
4494 0 : SUBROUTINE DiagnFileOpen( HcoConfig, LUN, RC, IsDryRun )
4495 : !
4496 : ! !USES:
4497 : !
4498 : USE HCO_inquireMod, ONLY : findFreeLUN
4499 : USE HCO_ExtList_Mod, ONLY : CoreNr, GetExtOpt
4500 : !
4501 : ! !INPUT PARAMETERS:
4502 : !
4503 : LOGICAL, INTENT(IN ), OPTIONAL :: IsDryRun ! Is it a dry run?
4504 : !
4505 : ! !INPUT/OUTPUT PARAMETERS:
4506 : !
4507 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO config obj
4508 : INTEGER, INTENT(INOUT) :: RC ! Failure or success
4509 : !
4510 : ! !OUTPUT PARAMETERS:
4511 : !
4512 : INTEGER, INTENT( OUT) :: LUN ! File LUN
4513 : !
4514 : ! !REVISION HISTORY:
4515 : ! 10 Apr 2015 - C. Keller - Initial version
4516 : ! See https://github.com/geoschem/hemco for complete history
4517 : !EOP
4518 : !------------------------------------------------------------------------------
4519 : !BOC
4520 : !
4521 : ! !LOCAL VARIABLES:
4522 : !
4523 : ! Scalars
4524 : INTEGER :: IOS
4525 : LOGICAL :: EXISTS, FOUND, DoDryRun
4526 :
4527 : ! Strings
4528 : CHARACTER(LEN=255) :: MSG, DiagnFile, FileMsg
4529 : CHARACTER(LEN=255) :: LOC = 'DiagnFileOpen (hco_diagn_mod.F90)'
4530 :
4531 : !=======================================================================
4532 : ! DiagnFileOpen begins here!
4533 : !=======================================================================
4534 :
4535 : ! Initialize
4536 0 : RC = HCO_SUCCESS
4537 0 : LUN = -1
4538 :
4539 : ! Determine if we need to do a dry-run simulation
4540 0 : IF ( PRESENT( IsDryRun ) ) THEN
4541 0 : DoDryRun = IsDryRun
4542 : ELSE
4543 : DoDryRun = .FALSE.
4544 : ENDIF
4545 :
4546 : ! Try to get name of HEMCO diagnostics file
4547 : CALL GetExtOpt( HcoConfig, CoreNr, 'DiagnFile', &
4548 0 : OptValChar=DiagnFile, FOUND=FOUND, RC=RC )
4549 :
4550 : ! Trap potential errors
4551 0 : IF ( RC /= HCO_SUCCESS ) THEN
4552 0 : MSG = 'Could not find "DiagnFile" in configuration file!'
4553 0 : CALL HCO_Error( MSG, RC, LOC )
4554 0 : RETURN
4555 : ENDIF
4556 :
4557 : ! If a "DiagnFile" entry is found in the configuration file ...
4558 0 : IF ( FOUND ) THEN
4559 :
4560 : ! Test if the diagnostics file exists
4561 0 : INQUIRE( FILE=TRIM(DiagnFile), EXIST=EXISTS )
4562 :
4563 : !====================================================================
4564 : ! For dry-runs, print file status and then return
4565 : !====================================================================
4566 0 : IF ( DoDryRun ) THEN
4567 :
4568 : ! Test if the file exists and define an output string
4569 0 : IF ( Exists ) THEN
4570 0 : FileMsg = 'HEMCO (INIT): Opening'
4571 : ELSE
4572 0 : FileMsg = 'HEMCO (INIT): REQUIRED FILE NOT FOUND'
4573 : ENDIF
4574 :
4575 : ! Write message to stdout and then return
4576 0 : IF ( HcoConfig%amIRoot ) THEN
4577 0 : WRITE( 6, 300 ) TRIM( FileMsg ), TRIM( DiagnFile )
4578 : 300 FORMAT( a, ' ./', a )
4579 : ENDIF
4580 0 : RETURN
4581 : ENDIF
4582 :
4583 : !====================================================================
4584 : ! For regular simulations, continue to open the diagnostic file.
4585 : !====================================================================
4586 :
4587 : ! Find free LUN
4588 0 : LUN = findFreeLUN()
4589 :
4590 : ! If the diagnostics file doesn't exist, then exit
4591 0 : IF ( .NOT. EXISTS ) THEN
4592 0 : MSG = 'Cannot read file - it does not exist: ' // TRIM(DiagnFile)
4593 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
4594 0 : RETURN
4595 : ENDIF
4596 :
4597 : ! Open configuration file
4598 0 : OPEN ( LUN, FILE=TRIM( DiagnFile ), STATUS='OLD', IOSTAT=IOS )
4599 0 : IF ( IOS /= 0 ) THEN
4600 0 : MSG = 'Error opening ' // TRIM(DiagnFile)
4601 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
4602 0 : RETURN
4603 : ENDIF
4604 :
4605 : ENDIF !FOUND
4606 :
4607 : ! Return w/ success
4608 0 : RC = HCO_SUCCESS
4609 :
4610 : END SUBROUTINE DiagnFileOpen
4611 : !EOC
4612 : !------------------------------------------------------------------------------
4613 : ! Harmonized Emissions Component (HEMCO) !
4614 : !------------------------------------------------------------------------------
4615 : !BOP
4616 : !
4617 : ! !IROUTINE: DiagnFileGetNext returns the diagnostics entries of the next
4618 : ! line of the diagnostics list file.
4619 : !
4620 : ! !DESCRIPTION: Gets information from the next line of the diagnostic
4621 : ! configuration file.
4622 : !\\
4623 : !\\
4624 : ! !INTERFACE:
4625 : !
4626 0 : SUBROUTINE DiagnFileGetNext( HcoConfig, LUN, cName, &
4627 : SpcName, ExtNr, Cat, Hier, &
4628 : SpaceDim, OutUnit, EOF, RC, &
4629 : lName, UnitName )
4630 : !
4631 : ! !USES:
4632 : !
4633 : USE HCO_CharTools_Mod
4634 : USE HCO_CHARPAK_Mod, ONLY : STRREPL, STRSPLIT
4635 : !
4636 : ! !INPUT PARAMETERS:
4637 : !
4638 : INTEGER, INTENT(IN ) :: LUN ! file LUN
4639 : !
4640 : ! !INPUT/OUTPUT PARAMETERS:
4641 : !
4642 : TYPE(ConfigObj), POINTER :: HcoConfig
4643 : LOGICAL, INTENT(INOUT) :: EOF
4644 : INTEGER, INTENT(INOUT) :: RC ! Failure or success
4645 : !
4646 : ! !OUTPUT PARAMETERS:
4647 : !
4648 : CHARACTER(LEN=*), INTENT( OUT) :: cName
4649 : CHARACTER(LEN=*), INTENT( OUT) :: SpcName
4650 : INTEGER, INTENT( OUT) :: ExtNr
4651 : INTEGER, INTENT( OUT) :: Cat
4652 : INTEGER, INTENT( OUT) :: Hier
4653 : INTEGER, INTENT( OUT) :: SpaceDim
4654 : CHARACTER(LEN=*), INTENT( OUT) :: OutUnit
4655 : CHARACTER(LEN=*), INTENT( OUT), OPTIONAL :: lName
4656 : CHARACTER(LEN=*), INTENT( OUT), OPTIONAL :: UnitName
4657 : !
4658 : ! !REVISION HISTORY:
4659 : ! 10 Apr 2015 - C. Keller - Initial version
4660 : ! See https://github.com/geoschem/hemco for complete history
4661 : !EOP
4662 : !------------------------------------------------------------------------------
4663 : !BOC
4664 : !
4665 : ! !LOCAL VARIABLES:
4666 : !
4667 : INTEGER :: N
4668 : CHARACTER(LEN=255) :: LINE
4669 : CHARACTER(LEN=255) :: MSG
4670 : CHARACTER(LEN=255) :: SUBSTR(255)
4671 : CHARACTER(LEN=255) :: LOC = 'DiagnFileGetNext (hco_diagn_mod.F90)'
4672 :
4673 : !=================================================================
4674 : ! DiagnFileGetNext begins here!
4675 : !=================================================================
4676 :
4677 : ! Init
4678 0 : cName = ''
4679 0 : SpcName = ''
4680 0 : OutUnit = ''
4681 0 : ExtNr = -1
4682 0 : Cat = -1
4683 0 : Hier = -1
4684 0 : SpaceDim = -1
4685 :
4686 : ! Get next line
4687 0 : CALL GetNextLine( LUN, LINE, EOF, RC )
4688 0 : IF ( RC /= HCO_SUCCESS ) THEN
4689 0 : CALL HCO_ERROR( 'ERROR 41', RC, THISLOC=LOC )
4690 0 : RETURN
4691 : ENDIF
4692 :
4693 : ! Leave here if end of file
4694 0 : IF ( .NOT. EOF ) THEN
4695 :
4696 : ! Parse diagnostics information from line
4697 0 : CALL STRREPL( LINE, HCO_TAB, HCO_SPC )
4698 :
4699 : ! Split into substrings
4700 0 : CALL STRSPLIT( LINE, HCO_SPC, SUBSTR, N )
4701 :
4702 : ! There must be at least 7 entries
4703 0 : IF ( N < 7 ) THEN
4704 0 : MSG = 'Diagnostics entries must have 7 elements: '// TRIM(LINE)
4705 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
4706 0 : RETURN
4707 : ENDIF
4708 :
4709 : ! Extract diagnostics properties
4710 0 : cName = TRIM(SUBSTR(1))
4711 0 : SpcName = TRIM(SUBSTR(2))
4712 :
4713 : ! Extension number, category, hierarchy, space dimension
4714 0 : READ( SUBSTR(3), * ) ExtNr
4715 0 : READ( SUBSTR(4), * ) Cat
4716 0 : READ( SUBSTR(5), * ) Hier
4717 0 : READ( SUBSTR(6), * ) SpaceDim
4718 :
4719 : ! Read output unit
4720 0 : OutUnit = TRIM(SUBSTR(7))
4721 :
4722 : ! Eventually get long name
4723 0 : IF ( PRESENT(lname) ) THEN
4724 0 : IF ( N > 7 ) THEN
4725 0 : lName = TRIM(SUBSTR(8))
4726 : ELSE
4727 0 : lName = TRIM(cName)
4728 : ENDIF
4729 : ENDIF
4730 :
4731 : ! Eventually get unit name
4732 0 : IF ( PRESENT(UnitName) ) THEN
4733 0 : IF ( N > 8 ) THEN
4734 0 : UnitName = TRIM(SUBSTR(9))
4735 : ELSE
4736 0 : UnitName = TRIM(OutUnit)
4737 : ENDIF
4738 : ENDIF
4739 :
4740 : ENDIF !EOF
4741 :
4742 : ! Return w/ success
4743 0 : RC = HCO_SUCCESS
4744 :
4745 0 : END SUBROUTINE DiagnFileGetNext
4746 : !EOC
4747 : !------------------------------------------------------------------------------
4748 : ! Harmonized Emissions Component (HEMCO) !
4749 : !------------------------------------------------------------------------------
4750 : !BOP
4751 : !
4752 : ! !IROUTINE: DiagnFileClose
4753 : !
4754 : ! !DESCRIPTION: Closes the diagnostic configuration file.
4755 : !\\
4756 : !\\
4757 : ! !INTERFACE:
4758 : !
4759 0 : SUBROUTINE DiagnFileClose ( LUN )
4760 : !
4761 : ! !INPUT/OUTPUT PARAMETERS:
4762 : !
4763 : INTEGER, INTENT(INOUT) :: LUN ! File LUN
4764 : !
4765 : ! !REVISION HISTORY:
4766 : ! 10 Apr 2015 - C. Keller - Initial version
4767 : ! See https://github.com/geoschem/hemco for complete history
4768 : !EOP
4769 : !------------------------------------------------------------------------------
4770 : !BOC
4771 0 : CLOSE ( LUN )
4772 :
4773 0 : END SUBROUTINE DiagnFileClose
4774 : !EOC
4775 : !------------------------------------------------------------------------------
4776 : ! Harmonized Emissions Component (HEMCO) !
4777 : !------------------------------------------------------------------------------
4778 : !BOP
4779 : !
4780 : ! !IROUTINE: DiagnBundle_Init
4781 : !
4782 : ! !DESCRIPTION: Creates an empty diagnostics bundle
4783 : !\\
4784 : !\\
4785 : ! !INTERFACE:
4786 : !
4787 0 : SUBROUTINE DiagnBundle_Init ( Diagn )
4788 : !
4789 : ! !INPUT/OUTPUT PARAMETERS:
4790 : !
4791 : TYPE(DiagnBundle), POINTER :: Diagn
4792 : !
4793 : ! !REVISION HISTORY:
4794 : ! 17 Feb 2016 - C. Keller - Initial version
4795 : ! See https://github.com/geoschem/hemco for complete history
4796 : !EOP
4797 : !------------------------------------------------------------------------------
4798 : !BOC
4799 :
4800 0 : IF ( .NOT. ASSOCIATED(Diagn) ) THEN
4801 0 : ALLOCATE(Diagn)
4802 0 : Diagn%Collections => NULL()
4803 0 : Diagn%HcoDiagnIDDefault = -999
4804 0 : Diagn%HcoDiagnIDRestart = -999
4805 0 : Diagn%HcoDiagnIDManual = -999
4806 : #ifdef ADJOINT
4807 : Diagn%HcoDiagnIDAdjoint = -999
4808 : #endif
4809 0 : Diagn%nnCollections = 0
4810 : ENDIF
4811 :
4812 0 : END SUBROUTINE DiagnBundle_Init
4813 : !EOC
4814 : !------------------------------------------------------------------------------
4815 : ! Harmonized Emissions Component (HEMCO) !
4816 : !------------------------------------------------------------------------------
4817 : !BOP
4818 : !
4819 : ! !IROUTINE: DiagnBundle_Cleanup
4820 : !
4821 : ! !DESCRIPTION: Cleans up a diagnostics bundle
4822 : !\\
4823 : !\\
4824 : ! !INTERFACE:
4825 : !
4826 0 : SUBROUTINE DiagnBundle_Cleanup ( Diagn )
4827 : !
4828 : ! !INPUT/OUTPUT PARAMETERS:
4829 : !
4830 : TYPE(DiagnBundle), POINTER :: Diagn
4831 : !
4832 : ! !REVISION HISTORY:
4833 : ! 17 Feb 2016 - C. Keller - Initial version
4834 : ! See https://github.com/geoschem/hemco for complete history
4835 : !EOP
4836 : !------------------------------------------------------------------------------
4837 : !BOC
4838 :
4839 0 : IF ( ASSOCIATED(Diagn) ) THEN
4840 0 : CALL DiagnCollection_Cleanup ( Diagn )
4841 0 : DEALLOCATE(Diagn)
4842 : Diagn => NULL()
4843 : ENDIF
4844 :
4845 0 : END SUBROUTINE DiagnBundle_Cleanup
4846 : !EOC
4847 : END MODULE HCO_Diagn_Mod
|
