Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_config_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCO\_Config\_Mod contains routines related
9 : ! to the HEMCO configuration file. It reads the content of the
10 : ! configuration file, checks which entires therein are actually used
11 : ! for this simulation run, and stores these information. This occurs
12 : ! in two calls: Config\_ReadFile and SetReadList. Config\_ReadFile
13 : ! writes the entire content of the configuration file into buffer
14 : ! except for the input data associated with a disabled extension.
15 : ! SetReadList does many more logical checks and adds all data used
16 : ! by HEMCO to ReadList. Scale factors not used by any of the base
17 : ! emissions and base emission fields (e.g. scale factors that won't
18 : ! be used ) are removed in this step.
19 : !\\
20 : !\\
21 : ! All data fields are saved in individual data containers, which are
22 : ! organized in the ConfigList. Hence, ConfigList is a collection of
23 : ! all HEMCO data containers, with every container representing an
24 : ! entry of the configuration file. Each data container has its unique
25 : ! container ID for identification. All HEMCO lists (ConfigList,
26 : ! ReadList, EmisList) access the same containers.
27 : !\\
28 : !\\
29 : ! The configuration file provides all source file information of the
30 : ! emission fields and scale factors to be used. It must be read at the
31 : ! beginning of a simulation run.
32 : !\\
33 : !\\
34 : ! As of HEMCO v2.0, the ConfigList linked list sits within the HEMCO
35 : ! configuration object (HcoConfig). HcoConfig must be passed to all
36 : ! routines. This allows the parallel usage of multiple invocations
37 : ! of HEMCO that use different input data. HcoConfig is initialized
38 : ! upon reading the HEMCO configuration file (within subroutine
39 : ! Config\_ReadFile).
40 : !\\
41 : !\\
42 : ! !INTERFACE:
43 : !
44 : MODULE HCO_Config_Mod
45 : !
46 : ! !USES:
47 : !
48 : USE HCO_ERROR_MOD
49 : USE HCO_DIAGN_MOD
50 : USE HCO_CHARTOOLS_MOD
51 : USE HCO_TYPES_MOD
52 : USE HCO_STATE_MOD, ONLY : HCO_State
53 :
54 : IMPLICIT NONE
55 : PRIVATE
56 : !
57 : ! !PUBLIC MEMBER FUNCTIONS:
58 : !
59 : PUBLIC :: SetReadList
60 : PUBLIC :: Config_ReadFile
61 : PUBLIC :: Config_GetnSpecies
62 : PUBLIC :: Config_GetSpecNames
63 : PUBLIC :: ConfigInit
64 : !
65 : ! !PRIVATE MEMBER FUNCTIONS:
66 : !
67 : PRIVATE :: ReadSettings
68 : PRIVATE :: ExtSwitch2Buffer
69 : PRIVATE :: ConfigList_AddCont
70 : PRIVATE :: Config_ReadCont
71 : PRIVATE :: RegisterPrepare
72 : PRIVATE :: Get_targetID
73 : PRIVATE :: Calc_Coverage
74 : PRIVATE :: Register_Base
75 : PRIVATE :: Register_Scal
76 : PRIVATE :: ReadAndSplit_Line
77 : PRIVATE :: Config_GetSpecAttr
78 : PRIVATE :: BracketCheck
79 : PRIVATE :: AddZeroScal
80 : PRIVATE :: AddShadowFields
81 : PRIVATE :: ParseEmisL
82 : PRIVATE :: CheckForDuplicateName
83 : PRIVATE :: Hco_GetTagInfo
84 : !
85 : ! !REVISION HISTORY:
86 : ! 18 Jun 2013 - C. Keller - Initialization
87 : ! See https://github.com/geoschem/hemco for complete history
88 : !EOP
89 : !------------------------------------------------------------------------------
90 : !BOC
91 : !
92 : ! !MODULE TYPES/ARGUMENTS:
93 : !
94 :
95 : !----------------------------------------------------------------
96 : ! MODULE ROUTINES follow below
97 : !----------------------------------------------------------------
98 :
99 : CONTAINS
100 : !EOC
101 : !------------------------------------------------------------------------------
102 : ! Harmonized Emissions Component (HEMCO) !
103 : !------------------------------------------------------------------------------
104 : !BOP
105 : !
106 : ! !IROUTINE: Config_Readfile
107 : !
108 : ! !DESCRIPTION: Subroutine CONFIG\_READFILE reads the HEMCO configuration file,
109 : ! archives all HEMCO options and settings (including traceback/error setup),
110 : ! and creates a data container for every (used) emission field in the config.
111 : ! file. All containers become linked through the ConfigList linked list.
112 : ! Note that lists EmisList and ReadList (created lateron) will point to the
113 : ! same containers, but will order the containers in a manner that is most
114 : ! efficient for the respective purpose.
115 : ! Argument HcoConfig represents the HEMCO configuration object. It contains
116 : ! pointers to the HEMCO traceback and error information as well as a pointer
117 : ! to ConfigList. If undefined, HcoConfig becomes initialized as part of this
118 : ! routine.
119 : !\\
120 : !\\
121 : ! !INTERFACE:
122 : !
123 0 : SUBROUTINE Config_ReadFile( am_I_Root, HcoConfig, ConfigFile, Phase, &
124 : RC, IsNest, IsDryRun )
125 : !
126 : ! !USES:
127 : !
128 : USE HCO_inquireMod, ONLY : findFreeLUN
129 : USE HCO_CharPak_Mod, ONLY : STRREPL
130 : USE HCO_EXTLIST_MOD, ONLY : AddExt, CoreNr, ExtNrInUse
131 : !
132 : ! !INPUT PARAMETERS:
133 : !
134 : LOGICAL, INTENT(IN) :: am_I_Root ! root CPU?
135 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO config obj
136 : CHARACTER(LEN=*), INTENT(IN) :: ConfigFile ! Full file name
137 : INTEGER, INTENT(IN) :: Phase ! 0: all
138 : ! 1: Settings and switches only
139 : ! 2: fields only
140 : LOGICAL, INTENT(IN), OPTIONAL :: IsNest ! Nested call?
141 : LOGICAL, INTENT(IN), OPTIONAL :: IsDryRun ! Dry-run?
142 : !
143 : ! !INPUT/OUTPUT PARAMETERS:
144 : !
145 : INTEGER, INTENT(INOUT) :: RC ! Success?
146 : !
147 : ! !REVISION HISTORY:
148 : ! 17 Sep 2012 - C. Keller - Initialization
149 : ! See https://github.com/geoschem/hemco for complete history
150 : !EOP
151 : !------------------------------------------------------------------------------
152 : !BOC
153 : !
154 : ! !LOCAL VARIABLES:
155 : !
156 : ! Scalars
157 : LOGICAL :: EOF
158 : LOGICAL :: EXISTS, NEST, DoDryRUn
159 : INTEGER :: NN
160 : INTEGER :: IU_HCO, IOS
161 :
162 : ! Strings
163 : CHARACTER(LEN=255) :: loc, fileMsg
164 : CHARACTER(LEN=512) :: msg
165 : CHARACTER(LEN=2047) :: CFDIR
166 : CHARACTER(LEN=2047) :: LINE
167 :
168 : !======================================================================
169 : ! Config_ReadFile begins here
170 : !======================================================================
171 :
172 : ! Enter
173 0 : RC = HCO_SUCCESS
174 0 : msg = ''
175 0 : loc = 'Config_ReadFile (hco_config_mod.F90)'
176 :
177 : ! Initialize config object if not already initialized
178 0 : IF ( .NOT. ASSOCIATED(HcoConfig) ) THEN
179 0 : CALL ConfigInit( HcoConfig, RC )
180 0 : HcoConfig%ConfigFileName = TRIM(ConfigFile)
181 : ENDIF
182 :
183 : ! Initialize
184 0 : HcoConfig%amIRoot = am_I_Root
185 :
186 : ! Leave here if configuration file is already read
187 0 : IF ( HcoConfig%ConfigFileRead ) THEN
188 0 : RETURN
189 : ENDIF
190 :
191 : ! Nested call?
192 0 : IF ( PRESENT( IsNest ) ) THEN
193 0 : NEST = IsNest
194 : ELSE
195 : NEST = .FALSE.
196 : ENDIF
197 :
198 : ! Is this a dry-run simulation?
199 0 : IF ( PRESENT( IsDryRun) ) THEN
200 0 : DoDryRun= IsDryRun
201 : ELSE
202 : DoDryRun = .FALSE.
203 : ENDIF
204 :
205 : ! Prompt to standard output (only on the root core
206 0 : IF ( HcoConfig%amIRoot ) THEN
207 :
208 0 : IF ( DoDryRun ) THEN
209 :
210 : !-----------------------------------------------------------------
211 : ! For dry-run simulations: state if the configuration file
212 : ! is found on disk, or not. Only write this message once.
213 : !-----------------------------------------------------------------
214 :
215 : ! Test if the file exists
216 0 : INQUIRE( FILE=TRIM( ConfigFile ), EXIST=Exists )
217 :
218 : ! Test if the file exists and define an output string
219 0 : IF ( Exists ) THEN
220 0 : FileMsg = 'HEMCO (INIT): Opening '
221 : ELSE
222 0 : FileMsg = 'HEMCO (INIT): REQUIRED FILE NOT FOUND '
223 : ENDIF
224 :
225 : ! Write message to stdout
226 0 : WRITE( 6, 300 ) TRIM( FileMsg ), TRIM( ConfigFile )
227 : 300 FORMAT( a, ' ./', a )
228 :
229 : ELSE
230 :
231 : !-----------------------------------------------------------------
232 : ! For regular simulations, write a message containing
233 : ! the configuration file as well as the Phase value.
234 : !-----------------------------------------------------------------
235 0 : WRITE(6,*) ' '
236 0 : IF ( Phase == 1 ) THEN
237 0 : WRITE( 6, 310 ) TRIM(ConfigFile)
238 : 310 FORMAT( 'Reading settings & switches of HEMCO configuration file: ', a )
239 :
240 0 : ELSEIF ( Phase == 2 ) THEN
241 0 : WRITE( 6, 320 ) TRIM(ConfigFile)
242 : 320 FORMAT( 'Reading fields of HEMCO configuration file: ', a )
243 :
244 : ELSE
245 0 : WRITE( 6, 330 ) TRIM(ConfigFile)
246 : 330 FORMAT( 'Reading entire HEMCO configuration file: ', a )
247 : ENDIF
248 : ENDIF
249 : ENDIF
250 :
251 : ! Extract configuration file directory. This is the directory containing
252 : ! the configuration file. Any tokens $CFDIR in the given configuration
253 : ! file will be replaced with the configuration file directory
254 0 : CALL HCO_GetBase( ConfigFile, CFDIR, RC )
255 0 : IF ( RC /= HCO_SUCCESS ) THEN
256 0 : msg = 'Could not replace $CFDIR token in: ' // TRIM( ConfigFile )
257 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
258 0 : RETURN
259 : ENDIF
260 :
261 : ! Find free LUN
262 0 : IU_HCO = findFreeLUN()
263 :
264 0 : INQUIRE( FILE=TRIM(ConfigFile), EXIST=EXISTS )
265 0 : IF ( .NOT. EXISTS ) THEN
266 0 : IF ( HcoConfig%amIRoot ) THEN
267 0 : WRITE(*,*) 'Cannot read file - it does not exist: ', TRIM(ConfigFile)
268 : ENDIF
269 0 : RC = HCO_FAIL
270 0 : RETURN
271 : ENDIF
272 :
273 : ! Open configuration file
274 0 : OPEN ( IU_HCO, FILE=TRIM( ConfigFile ), STATUS='OLD', IOSTAT=IOS )
275 0 : IF ( IOS /= 0 ) THEN
276 0 : IF ( HcoConfig%amIRoot ) THEN
277 0 : WRITE(*,*) 'Error reading ', TRIM(ConfigFile)
278 : ENDIF
279 0 : RC = HCO_FAIL
280 0 : RETURN
281 : ENDIF
282 :
283 : ! Register HEMCO core as extension Nr. CoreNr (default). The
284 : ! core module is used by all HEMCO simulations, and the overall
285 : ! HEMCO settings are stored as options of this extension.
286 : ! Note: cannot use HCO_GetOpt('Wildcard') for species here because
287 : ! this is linked to the core extension...
288 0 : IF ( .NOT. ExtNrInUse( HcoConfig%ExtList, CoreNr ) ) THEN
289 0 : CALL AddExt( HcoConfig, 'CORE', CoreNr, .TRUE., 'all', RC )
290 0 : IF ( RC /= HCO_SUCCESS ) THEN
291 0 : msg = 'Error adding CORE extension'
292 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
293 0 : RC = HCO_FAIL
294 0 : RETURN
295 : ENDIF
296 : ENDIF
297 :
298 : ! NN counts how many sections have ben read already
299 0 : NN = 0
300 :
301 : ! Loop until EOF
302 : DO
303 :
304 : ! Read a line from the file, exit if EOF
305 0 : CALL HCO_ReadLine ( IU_HCO, LINE, EOF, RC )
306 0 : IF ( RC /= HCO_SUCCESS ) THEN
307 0 : msg = 'Error in HEMCO_Config.rc @ line: ' // TRIM( Line )
308 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
309 0 : RETURN
310 : ENDIF
311 0 : IF ( EOF ) EXIT
312 :
313 : ! Replace tab characters in LINE (if any) w/ spaces
314 0 : CALL STRREPL( LINE, HCO_TAB, HCO_SPC )
315 :
316 : ! Read settings if this is beginning of settings section
317 : ! This reads all settings into buffer and initializes the
318 : ! HEMCO traceback/error options.
319 0 : IF ( INDEX ( LINE, 'BEGIN SECTION SETTINGS' ) > 0 ) THEN
320 :
321 0 : IF ( PHASE < 2 ) THEN
322 0 : CALL ReadSettings( HcoConfig, IU_HCO, EOF, RC )
323 0 : IF ( RC /= HCO_SUCCESS ) THEN
324 0 : msg = 'Error in HEMCO_Config.rc @ section ' // TRIM( line )
325 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
326 0 : RETURN
327 : ENDIF
328 0 : IF ( EOF ) EXIT
329 :
330 : ! Increase counter
331 0 : NN = NN + 1
332 :
333 : ! Can we leave here?
334 0 : IF ( PHASE == 1 .AND. NN == 2 ) EXIT
335 : ENDIF
336 :
337 : ! Read extension switches. This registers all enabled extensions.
338 : ! This must include the core extension.
339 0 : ELSEIF ( INDEX ( LINE, 'BEGIN SECTION EXTENSION SWITCHES' ) > 0 ) THEN
340 :
341 0 : IF ( PHASE < 2 ) THEN
342 0 : CALL ExtSwitch2Buffer( HcoConfig, IU_HCO, EOF, RC )
343 0 : IF ( RC /= HCO_SUCCESS ) THEN
344 0 : msg = 'Error in HEMCO_Config,rc @ section: ' // TRIM( line )
345 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
346 0 : RETURN
347 : ENDIF
348 0 : IF ( EOF ) EXIT
349 :
350 : ! Increase counter
351 0 : NN = NN + 1
352 :
353 : ! Can we leave here?
354 0 : IF ( PHASE == 1 .AND. NN == 2 ) EXIT
355 : ENDIF
356 :
357 : ! Read base emissions. This creates a new data container for each
358 : ! base emission field.
359 0 : ELSEIF ( INDEX ( LINE, 'BEGIN SECTION BASE EMISSIONS' ) > 0 ) THEN
360 :
361 : ! Read data and write into container
362 : ! For dry-run simulations, print name of any
363 : ! nested configuration files (e.g. for standalone)
364 0 : IF ( PHASE == 0 .OR. PHASE == 2 ) THEN
365 : CALL Config_ReadCont( HcoConfig, IU_HCO, CFDIR, &
366 : HCO_DCTTYPE_BASE, EOF, RC, &
367 0 : IsDryRun=IsDryRun )
368 0 : IF ( RC /= HCO_SUCCESS ) THEN
369 0 : msg = 'Error in HEMCO_Config.rc @ section: ' // TRIM( Line )
370 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
371 0 : RETURN
372 : ENDIF
373 0 : IF ( EOF ) EXIT
374 :
375 : ! Increase counter
376 0 : NN = NN + 1
377 : ENDIF
378 :
379 : ! Read scale factors. This creates a new data container for each
380 : ! scale factor.
381 0 : ELSE IF ( INDEX ( LINE, 'BEGIN SECTION SCALE FACTORS' ) > 0 ) THEN
382 :
383 : CALL Config_ReadCont( HcoConfig, IU_HCO, CFDIR, &
384 0 : HCO_DCTTYPE_SCAL, EOF, RC )
385 0 : IF ( RC /= HCO_SUCCESS ) THEN
386 0 : msg= 'Error in HEMCO_Config.rc @ section: ' // TRIM( Line )
387 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
388 0 : RETURN
389 : ENDIF
390 0 : IF ( EOF ) EXIT
391 :
392 : ! Read masks. This creates a new data container for each mask
393 0 : ELSE IF ( INDEX ( LINE, 'BEGIN SECTION MASKS' ) > 0 ) THEN
394 :
395 0 : IF ( PHASE == 0 .OR. PHASE == 2 ) THEN
396 : CALL Config_ReadCont( HcoConfig, IU_HCO, CFDIR, &
397 0 : HCO_DCTTYPE_MASK, EOF, RC )
398 0 : IF ( RC /= HCO_SUCCESS ) THEN
399 0 : msg = 'Error in HEMCO_Config.rc @ line: ' // TRIM( Line )
400 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
401 0 : RETURN
402 : ENDIF
403 0 : IF ( EOF ) EXIT
404 :
405 : ! Increase counter
406 0 : NN = NN + 1
407 : ENDIF
408 :
409 : ENDIF
410 : ENDDO
411 :
412 : ! Check if we caught all sections. Do that only for phase 1.
413 : ! Sections SETTINGS and extension switches are needed.
414 0 : IF ( PHASE == 1 .AND. NN /= 2 .AND. .NOT. NEST ) THEN
415 0 : WRITE(*,*) 'Expected 2 sections, found/read ', NN
416 0 : WRITE(*,*) 'Should read SETTINGS and EXTENSION SWITCHES'
417 0 : RC = HCO_FAIL
418 0 : RETURN
419 : ENDIF
420 :
421 : ! Close file
422 0 : CLOSE( UNIT=IU_HCO, IOSTAT=IOS )
423 0 : IF ( IOS /= 0 ) THEN
424 0 : msg = 'Error closing ' // TRIM(ConfigFile)
425 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
426 0 : RC = HCO_FAIL
427 0 : RETURN
428 : ENDIF
429 :
430 : ! Configuration file is now read
431 0 : IF ( .NOT. NEST ) THEN
432 0 : IF ( PHASE == 0 .OR. PHASE == 2 ) THEN
433 0 : HcoConfig%ConfigFileRead = .TRUE.
434 : ENDIF
435 : ENDIF
436 :
437 : ! Leave w/ success
438 0 : RC = HCO_SUCCESS
439 :
440 : END SUBROUTINE Config_ReadFile
441 : !EOC
442 : !------------------------------------------------------------------------------
443 : ! Harmonized Emissions Component (HEMCO) !
444 : !------------------------------------------------------------------------------
445 : !BOP
446 : !
447 : ! !IROUTINE: SetReadList
448 : !
449 : ! !DESCRIPTION: Subroutine SetReadList writes data to the data reading
450 : ! lists (ReadList). This routine assumes that the configuration file has
451 : ! been read beforehand (via Config\_ReadFile).
452 : !\\
453 : !\\
454 : ! !INTERFACE:
455 : !
456 0 : SUBROUTINE SetReadList( HcoState, RC )
457 : !
458 : ! !USES:
459 : !
460 : USE HCO_DATACONT_Mod, ONLY : cIDList_Create
461 : USE HCO_READLIST_Mod, ONLY : ReadList_Init, ReadList_Print
462 : !
463 : ! !INPUT PARAMETERS:
464 : !
465 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state
466 : !
467 : ! !INPUT/OUTPUT PARAMETERS:
468 : !
469 : INTEGER, INTENT(INOUT) :: RC ! Error stat
470 : !
471 : ! !REVISION HISTORY:
472 : ! 18 Jun 2013 - C. Keller: Initialization
473 : ! See https://github.com/geoschem/hemco for complete history
474 : !EOP
475 : !------------------------------------------------------------------------------
476 : !BOC
477 :
478 : CHARACTER(LEN=255) :: loc
479 : CHARACTER(LEN=512) :: msg
480 :
481 : !======================================================================
482 : ! SetReadList begins here
483 : !======================================================================
484 0 : msg = ''
485 0 : loc = 'SetReadList (HCO_CONFIG_MOD.F90)'
486 :
487 : ! Init
488 0 : CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
489 0 : IF ( RC /= HCO_SUCCESS ) THEN
490 0 : msg = 'Error encountered in routine "HCO_Enter"!'
491 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
492 0 : RETURN
493 : ENDIF
494 :
495 : ! Return w/ error if configuration file hasn't been read yet!
496 0 : IF ( .NOT. ASSOCIATED(HcoState%Config) ) THEN
497 0 : msg = 'HEMCO configuration object in HEMCO state is empty!'
498 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
499 0 : RETURN
500 : ENDIF
501 0 : IF ( .NOT. HcoState%Config%ConfigFileRead ) THEN
502 0 : msg = 'HEMCO configuration file not read!'
503 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
504 0 : RETURN
505 : ENDIF
506 :
507 : ! Only if not yet done so...
508 0 : IF ( .NOT. HcoState%SetReadListCalled ) THEN
509 :
510 : ! Initialize ReadList
511 0 : CALL ReadList_Init ( HcoState%ReadLists, RC )
512 0 : IF ( RC /= HCO_SUCCESS ) THEN
513 0 : PRINT *,'Error in ReadList_Init called from HEMCO SetReadList'
514 0 : RETURN
515 : ENDIF
516 :
517 : ! Prepare data in buffer. This call identifies all base fields
518 : ! that have to be read by this CPU. It also kicks out base
519 : ! fields for emissions with an invalid species ID (if any) or
520 : ! if there are other base fields with higher priority.
521 0 : CALL RegisterPrepare ( HcoState, RC )
522 0 : IF ( RC /= HCO_SUCCESS ) THEN
523 0 : PRINT *,'Error in RegisterPrepare called from HEMCO SetReadList'
524 0 : RETURN
525 : ENDIF
526 :
527 : ! Register base emissions. In this step, we also redefine the
528 : ! list UnqScalIDs to make sure that only those scale factors
529 : ! will be registered that are effectively used in the next step.
530 0 : CALL Register_Base( HcoState, RC )
531 0 : IF ( RC /= HCO_SUCCESS ) THEN
532 0 : PRINT *,'Error in Register_Base called from HEMCO SetReadList'
533 0 : RETURN
534 : ENDIF
535 :
536 : ! Register scale factors based upon UnqScalIDs.
537 0 : CALL Register_Scal( HcoState, RC )
538 0 : IF ( RC /= HCO_SUCCESS ) THEN
539 0 : PRINT *,'Error in Register_Scal called from HEMCO SetReadList'
540 0 : RETURN
541 : ENDIF
542 :
543 : ! Create cIDList which allows quick access to all data containers
544 : ! based on their container IDs cID
545 0 : CALL cIDList_Create ( HcoState, HcoState%Config%ConfigList, RC )
546 0 : IF ( RC /= HCO_SUCCESS ) THEN
547 0 : PRINT *,'Error in cIDList_Create called from HEMCO SetReadlist'
548 0 : RETURN
549 : ENDIF
550 :
551 : ! Don't need internal lists anymore.
552 0 : CALL ScalID_Cleanup ( HcoState%Config%ScalIDList )
553 0 : CALL SpecName_Cleanup( HcoState%Config%SpecNameList )
554 :
555 : ENDIF ! SetReadListCalled
556 :
557 : ! SetReadList has now been called
558 0 : HcoState%SetReadListCalled = .TRUE.
559 :
560 : ! Debug
561 0 : IF ( HCO_IsVerb( HcoState%Config%Err, 1 ) ) THEN
562 0 : CALL ReadList_Print( HcoState, HcoState%ReadLists, 1 )
563 : ENDIF
564 :
565 : ! Leave w/ success
566 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
567 :
568 : END SUBROUTINE SetReadList
569 : !EOC
570 : !------------------------------------------------------------------------------
571 : ! Harmonized Emissions Component (HEMCO) !
572 : !------------------------------------------------------------------------------
573 : !BOP
574 : !
575 : ! !IROUTINE: Config_ReadCont
576 : !
577 : ! !DESCRIPTION: Subroutine CONFIG\_READCONT reads the given line into a
578 : ! list container. Depending on the specified data type, the line is
579 : ! assumed to hold base emissions, scale factors, or mask information.
580 : !\\
581 : !\\
582 : ! !INTERFACE:
583 : !
584 0 : SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, &
585 : DctType, EOF, RC, IsDryRun )
586 : !
587 : ! !USES:
588 : !
589 : USE HCO_CHARPAK_MOD, ONLY : StrSplit
590 : USE HCO_EXTLIST_MOD, ONLY : ExtNrInUse, HCO_GetOpt
591 : USE HCO_TIDX_Mod, ONLY : HCO_ExtractTime
592 : USE HCO_FILEDATA_Mod, ONLY : FileData_Init
593 : USE HCO_DATACONT_Mod, ONLY : CatMax, ZeroScalID
594 : !
595 : ! !INPUT PARAMETERS:
596 : !
597 : TYPE(ConfigObj), POINTER :: HcoConfig ! Config object
598 : INTEGER, INTENT(IN ) :: IU_HCO ! Logfile LUN
599 : CHARACTER(LEN=*), INTENT(IN ) :: CFDIR ! Configuration file directory
600 : INTEGER, INTENT(IN ) :: DctType ! 1=base; 2=scale; 3=mask
601 : LOGICAL, OPTIONAL :: IsDryRun ! Is this a HEMCO dry-run?
602 : !
603 : ! !INPUT/OUTPUT PARAMETERS:
604 : !
605 : LOGICAL, INTENT(INOUT) :: EOF ! end of file encountered?
606 : !
607 : ! !OUTPUT PARAMETERS:
608 : !
609 : INTEGER, INTENT( OUT) :: RC ! error code
610 : !
611 : ! !REVISION HISTORY:
612 : ! 03 Jan 2014 - C. Keller - Initial version
613 : ! See https://github.com/geoschem/hemco for complete history
614 : !EOP
615 : !------------------------------------------------------------------------------
616 : !BOC
617 : !
618 : ! !LOCAL VARIABLES:
619 : !
620 : ! Scalars
621 : INTEGER :: I, N, nEdges
622 : INTEGER :: nScl
623 : INTEGER :: STAT
624 : INTEGER :: Int1
625 : INTEGER :: Int2
626 : INTEGER :: Int3
627 : INTEGER :: Int4
628 : INTEGER :: nCat
629 : INTEGER :: Cats(CatMax)
630 : INTEGER :: STRLEN
631 : INTEGER :: levScal1
632 : INTEGER :: levScal2
633 : INTEGER :: nTags
634 : LOGICAL :: SKIP
635 : LOGICAL :: Found
636 : CHARACTER(LEN= 63) :: cName
637 : CHARACTER(LEN=255) :: srcFile
638 : CHARACTER(LEN= 50) :: srcVar
639 : CHARACTER(LEN= 31) :: srcTime
640 : CHARACTER(LEN= 31) :: TmCycle
641 : CHARACTER(LEN= 1) :: WildCard
642 : CHARACTER(LEN= 1) :: Separator
643 : CHARACTER(LEN= 31) :: srcDim
644 : CHARACTER(LEN= 31) :: srcUnit
645 : CHARACTER(LEN= 31) :: SpcName
646 : CHARACTER(LEN=255) :: Char1
647 : CHARACTER(LEN=255) :: Char2
648 : CHARACTER(LEN=255) :: loc
649 : CHARACTER(LEN=255) :: LINE
650 : CHARACTER(LEN=255) :: tagId
651 : CHARACTER(LEN=255) :: tagName
652 : CHARACTER(LEN=255) :: tagcName
653 : CHARACTER(LEN=255) :: ItemPrefix
654 : CHARACTER(LEN=512) :: msg
655 :
656 : ! Arrays
657 : INTEGER :: SplitInts(255)
658 : CHARACTER(LEN=255) :: SubStrs(255)
659 :
660 : ! Pointers
661 : TYPE(ListCont), POINTER :: Lct
662 : TYPE(ListCont), POINTER :: Tmp
663 : TYPE(FileData), POINTER :: Dta
664 :
665 : !=================================================================
666 : ! Config_ReadCont begins here!
667 : !=================================================================
668 :
669 : ! Enter
670 0 : loc = 'Config_ReadCont (hco_config_mod.F90)'
671 :
672 : ! Initialize
673 0 : SKIP = .FALSE.
674 0 : nCat = -1
675 0 : Lct => NULL()
676 0 : Tmp => NULL()
677 0 : Dta => NULL()
678 :
679 : ! Get tokens
680 0 : WildCard = HCO_GetOpt( HcoConfig%ExtList, 'Wildcard' )
681 0 : Separator = HCO_GetOpt( HcoConfig%ExtList, 'Separator' )
682 :
683 : ! Repeat until end of the given section is found
684 : DO
685 :
686 : ! Zero loop variables for safety's sake (bmy, 07 Mar 2022)
687 0 : srcFile = ''
688 0 : srcVar = ''
689 0 : srcTime = ''
690 0 : tmCycle = ''
691 0 : srcDim = ''
692 0 : srcUnit = ''
693 0 : spcName = ''
694 0 : char1 = ''
695 0 : char2 = ''
696 0 : int1 = 0
697 0 : int2 = 0
698 0 : int3 = 0
699 :
700 : !==============================================================
701 : ! Read line and get desired character strings
702 : ! Since base emissions, scale factors and masks have different
703 : ! configuration file input parameter, need to use a different
704 : ! call for the three data types.
705 : !==============================================================
706 0 : IF ( DctType == HCO_DCTTYPE_BASE ) THEN
707 : CALL ReadAndSplit_Line ( HcoConfig, IU_HCO, cName, 2, &
708 : srcFile, 3, srcVar, 4, &
709 : srcTime, 5, TmCycle, 6, &
710 : srcDim, 7, srcUnit, 8, &
711 : SpcName, 9, Char1, 10, &
712 : Char2, 11, &
713 : Int1, -1, Int2, 12, &
714 : Int3, 1, STAT, &
715 0 : OutLine=LINE )
716 :
717 0 : ELSEIF ( DctType == HCO_DCTTYPE_SCAL ) THEN
718 : CALL ReadAndSplit_Line ( HcoConfig, IU_HCO, cName, 2, &
719 : srcFile, 3, srcVar, 4, &
720 : srcTime, 5, TmCycle, 6, &
721 : srcDim, 7, srcUnit, 8, &
722 : SpcName, -1, Char1, -1, &
723 : Char2, -1, &
724 : Int1, 1, Int2, 9, &
725 : Int3, 10, STAT, &
726 0 : optcl=10 , OutLine=LINE )
727 :
728 0 : ELSEIF ( DctType == HCO_DCTTYPE_MASK ) THEN
729 : CALL ReadAndSplit_Line ( HcoConfig, IU_HCO, cName, 2, &
730 : srcFile, 3, srcVar, 4, &
731 : srcTime, 5, TmCycle, 6, &
732 : srcDim, 7, srcUnit, 8, &
733 : SpcName, -1, Char1, 10, &
734 : Char2, 11, &
735 : Int1, 1, Int2, 9, &
736 : Int3, -1, STAT, &
737 0 : optcl=11, OutLine=LINE )
738 : ENDIF
739 :
740 : !--------------------------------------------------------------
741 : ! Error checks
742 : !--------------------------------------------------------------
743 :
744 : ! Check for end of file
745 0 : IF ( STAT < 0 ) THEN
746 0 : EOF = .TRUE.
747 0 : EXIT
748 : ENDIF
749 :
750 : ! Skip this entry if commented line
751 0 : IF ( STAT == 1 ) THEN
752 : CYCLE
753 : ENDIF
754 :
755 : ! Leave routine here if end of section encountered
756 0 : IF ( STAT == 10 ) THEN
757 : EXIT
758 : ENDIF
759 :
760 : ! Error if not enough entries found
761 0 : IF ( STAT == 100 ) THEN
762 0 : msg = 'STAT == 100; not enough entries found!'
763 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
764 0 : RETURN
765 : ENDIF
766 :
767 : ! -------------------------------------------------------------
768 : ! Check for emission shortcuts. Fields can be bracketed into
769 : ! 'collections'.
770 : ! -------------------------------------------------------------
771 0 : CALL BracketCheck( HcoConfig, STAT, LINE, SKIP, RC )
772 0 : IF ( RC /= HCO_SUCCESS ) THEN
773 0 : msg = 'Bracket error in HEMCO_Config.rc @ line ' // TRIM( line )
774 0 : CALL HCO_ERROR( msg, RC, thisLoc=loc )
775 0 : RETURN
776 : ENDIF
777 :
778 : ! Skip if needed
779 0 : IF ( SKIP ) CYCLE
780 :
781 : ! Can advance to next line if this was a bracket line: nothing
782 : ! else to do with this line.
783 0 : IF ( STAT == 5 .OR. STAT == 6 ) CYCLE
784 :
785 : ! Read include file. Configuration files can be 'nested', e.g.
786 : ! configuration files can be included into the 'main' configuration
787 : ! file. These files must be listed as '>>>include FileName', where
788 : ! FileName is the actual path of the file.
789 0 : IF ( STAT == 1000 ) THEN
790 :
791 : ! Call the parser. This is to make sure that any $ROOT statements
792 : ! will be evaluated properly. The configuration file must not
793 : ! contain any data tokens ($YR, $MM, etc.).
794 0 : CALL HCO_CharParse ( HcoConfig, LINE, 0, 0, 0, 0, 0, RC )
795 0 : IF ( RC /= HCO_SUCCESS ) THEN
796 0 : msg = 'Parse error in HEMCO_Config.rc @ line: ' // TRIM( line )
797 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
798 0 : RETURN
799 : ENDIF
800 :
801 : CALL Config_ReadFile( HcoConfig%amIRoot, HcoConfig, LINE, 0, RC, &
802 0 : IsNest=.TRUE., IsDryRun=IsDryRun )
803 0 : IF ( RC /= HCO_SUCCESS ) THEN
804 0 : msg = 'Error reading HEMCO_Config.rc @ line: ' // TRIM( line )
805 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
806 0 : RETURN
807 : ENDIF
808 :
809 : ! All done with this line
810 : CYCLE
811 : ENDIF
812 :
813 : ! Output status should be 0 if none of the statuses above applies
814 0 : IF ( STAT /= 0 ) THEN
815 0 : msg = 'STAT /= 0; indicates I/O error!'
816 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
817 0 : RETURN
818 : ENDIF
819 :
820 : ! For base fields, check if this extension number is indeed in
821 : ! use. Otherwise, we can ignore this line completely! The
822 : ! extension switches are read and evaluated prior to the
823 : ! extension data!
824 0 : IF ( DctType == HCO_DCTTYPE_BASE .AND. &
825 : .NOT. ExtNrInUse( HcoConfig%ExtList, Int3 ) ) CYCLE
826 :
827 : !==============================================================
828 : ! Create and fill list container and add to ConfigList
829 : !==============================================================
830 :
831 : ! Test if wildcard is present
832 0 : IF ( INDEX( srcVar, '?' ) > 0 ) THEN
833 :
834 : ! Split the name to get wildcard and string prior to wildcard
835 0 : CALL StrSplit( srcVar, '?', SubStrs, N )
836 0 : tagId = SubStrs(N-1)
837 0 : ItemPrefix = SubStrs(1)
838 :
839 : ! Get number of tags for this wildcard
840 0 : CALL Hco_GetTagInfo( tagId, HcoConfig, Found, RC, nTags=nTags )
841 :
842 : ! Add each tagged name as a separate item in the collection
843 0 : DO N = 1, nTags
844 : ! Construct the item name
845 0 : tagcName = ''
846 :
847 : ! Get tag, if any
848 : CALL Hco_GetTagInfo( tagId, HcoConfig, Found, RC, N=N, &
849 0 : tagName=tagName )
850 0 : IF ( RC /= HCO_SUCCESS ) THEN
851 : msg = 'Error retrieving tag name for' // &
852 0 : ' wildcard ' // TRIM(tagId)
853 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
854 0 : RETURN
855 : ENDIF
856 :
857 : ! Append the tag name to the output name
858 0 : srcVar = TRIM( ItemPrefix ) // TRIM( tagName )
859 0 : tagcName = TRIM( cName ) // TRIM( tagName )
860 : ! Do not overwrite species name for now. Use HEMCO wildcard
861 : ! to read all external model species.
862 : !spcName = TRIM( tagName )
863 :
864 : ! -------------------------------------------------------------
865 : ! Fill data container
866 : ! -------------------------------------------------------------
867 :
868 : ! Add blank list container (ListCont object) to ConfigList.
869 : ! The container is placed at the beginning of the list.
870 0 : CALL ConfigList_AddCont ( Lct, HcoConfig%ConfigList )
871 :
872 : ! Check if name exists already
873 0 : CALL CheckForDuplicateName( HcoConfig, tagcName, RC )
874 0 : IF ( RC /= HCO_SUCCESS ) THEN
875 0 : msg = 'Duplicate container name: ' // TRIM( tagcName )
876 0 : CALL HCO_ERROR( msg, RC, thisLoc=loc )
877 0 : RETURN
878 : ENDIF
879 :
880 : ! Attributes used by all data types: data type number and
881 : ! container name.
882 0 : Lct%Dct%DctType = DctType
883 0 : Lct%Dct%cName = ADJUSTL( tagcName )
884 :
885 : ! Set species name, extension number, emission category,
886 : ! hierarchy
887 0 : Lct%Dct%SpcName = ADJUSTL( SpcName )
888 0 : Lct%Dct%Hier = Int2
889 0 : Lct%Dct%ExtNr = Int3
890 :
891 : ! Extract category from character 2. This can be up to
892 : ! CatMax integers, or empty.
893 0 : CALL HCO_CharSplit( Char2, Separator, Wildcard, Cats, nCat, RC )
894 0 : IF ( RC /= HCO_SUCCESS ) THEN
895 0 : msg = 'Could not extract category at line: ' // TRIM( char2 )
896 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
897 0 : RETURN
898 : ENDIF
899 0 : IF ( nCat == 0 ) THEN
900 0 : Lct%Dct%Cat = -999
901 : ELSE
902 0 : Lct%Dct%Cat = Cats(1)
903 : ENDIF
904 :
905 : ! Set scale factor IDs into Scal_cID. These values will be
906 : ! replaced lateron with the container IDs (in register_base)!
907 : CALL HCO_CharSplit( Char1, Separator, Wildcard, &
908 0 : SplitInts, nScl, RC )
909 0 : IF ( RC /= HCO_SUCCESS ) THEN
910 : msg = 'Could not get scale factor ID''s in line: ' // &
911 0 : TRIM( char1 )
912 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
913 0 : RETURN
914 : ENDIF
915 0 : IF ( nScl > 0 ) THEN
916 0 : ALLOCATE ( Lct%Dct%Scal_cID(nScl) )
917 0 : Lct%Dct%Scal_cID(1:nScl) = SplitInts(1:nScl)
918 0 : Lct%Dct%nScalID = nScl
919 : ENDIF
920 :
921 : ! Register species name. A list of all species names can be
922 : ! returned to the atmospheric model to match HEMCO species
923 : ! with model species (see Config\_GetSpecNames).
924 0 : CALL SpecName_Register ( HcoConfig, ADJUSTL(SpcName), RC )
925 0 : IF ( RC /= HCO_SUCCESS ) THEN
926 0 : msg = 'Could not register species name: ' // TRIM(SpcName)
927 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
928 0 : RETURN
929 : ENDIF
930 :
931 : ! -------------------------------------------------------------
932 : ! Create and fill file data object. Use previous file data
933 : ! object if filename is undefined. Do not yet update the
934 : ! DoShare and DtaHome flags of the data file object and data
935 : ! container, respectively, since we still don't know which
936 : ! data containers will be effectively used for emission
937 : ! calculation (containers may be dropped lateron because the
938 : ! emission category / hierarchy is too low, species is not
939 : ! used, etc.). The DoShare and DtaHome flags will be set the
940 : ! first time that data is read (in hco_readlist_mod.F90).
941 : ! Here, we only set the DtaHome flag to -1000 instead of the
942 : ! default value of -999 to be able to identify data objects
943 : ! used by multiple containers.
944 : ! -------------------------------------------------------------
945 0 : IF ( TRIM( srcFile ) == '-' ) THEN
946 :
947 : ! The current entry of the configuration file specifies that
948 : ! we will get data from the file listed immediately above it.
949 : ! Thus we have to reuse a previously-defined FileData object
950 : ! (aka Dta). Stop if Dta is not initialized.
951 0 : IF ( .not. ASSOCIATED( Dta ) ) THEN
952 0 : MSG = 'Cannot use previous data container: '//TRIM(tagcName)
953 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
954 0 : RETURN
955 : ENDIF
956 :
957 : ! Reuse the file metadata specified in PrevDta for
958 : ! this entry of the HEMCO configuration file.
959 0 : Lct%Dct%DtaHome = Lct%Dct%DtaHome - 1
960 :
961 : ELSE
962 :
963 : ! The current entry of the configuration file specifies that
964 : ! we will read data from a file. We thus need to initialize
965 : ! a new FileData object to keep track of the file metadata.
966 : !
967 : ! >>> NOTE: This seems to cause a memory leak! <<<
968 : ! >>> We will look into this at a later date. <<<
969 0 : CALL FileData_Init( Dta )
970 :
971 : ! Set source file name. Check if the read file name starts
972 : ! with the configuration file token '$CFDIR', in which case
973 : ! we replace this value with the passed CFDIR value.
974 0 : STRLEN = LEN( srcFile )
975 : IF ( STRLEN > 6 ) THEN
976 0 : IF ( srcFile(1:6) == '$CFDIR' ) THEN
977 0 : srcFile = TRIM( CFDIR ) // TRIM( srcFile(7:STRLEN) )
978 : ENDIF
979 : ENDIF
980 0 : Dta%ncFile = srcFile
981 :
982 : ! Set source variable and original data unit.
983 0 : Dta%ncPara = ADJUSTL( srcVar )
984 0 : Dta%OrigUnit = ADJUSTL( srcUnit )
985 :
986 : ! If the parameter ncPara is not defined, attempt to read data
987 : ! directly from configuration file instead of netCDF.
988 : ! These data are always assumed to be in local time. Gridded
989 : ! data read from netCDF is always in UTC, except for weekdaily
990 : ! data that is treated in local time. The corresponding
991 : ! IsLocTime flag is updated when reading the data (see
992 : ! hcoio_dataread_mod.F90).
993 0 : IF ( TRIM( Dta%ncPara ) == '-' ) THEN
994 0 : Dta%ncRead = .FALSE.
995 0 : Dta%IsLocTime = .TRUE.
996 : ENDIF
997 :
998 : ! Extract information from time stamp character and pass values
999 : ! to the corresponding container variables. If no time string is
1000 : ! defined, keep default values (-1 for all of them)
1001 0 : IF ( TRIM(srcTime) /= '-' ) THEN
1002 0 : CALL HCO_ExtractTime( HcoConfig, srcTime, Dta, RC )
1003 0 : IF ( RC /= HCO_SUCCESS ) THEN
1004 0 : msg = 'Could not extract time cycle information!'
1005 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1006 0 : RETURN
1007 : ENDIF
1008 : ENDIF
1009 :
1010 : #if defined(ESMF_)
1011 : ! In an ESMF environment, the source data will be imported
1012 : ! through ExtData by name, hence need to set ncFile equal to
1013 : ! container name!
1014 : IF ( Dta%ncRead ) THEN
1015 : Dta%ncFile = ADJUSTL( tagcName )
1016 : ENDIF
1017 : #endif
1018 :
1019 : ! Update the properties of the data container
1020 : ! NOTE: This routine abstracts the big IF/ELSE block that
1021 : ! processes the time cycle information (bmy, 07 Mar 2022)
1022 : CALL UpdateDtaProperties( &
1023 : dctType = dctType, &
1024 : int3 = int3, &
1025 : char1 = TRIM( char1 ), &
1026 : char2 = char2(1:1), &
1027 : tagCName = TRIM( tagCName ), &
1028 : tmCycle = TRIM( tmCycle ), &
1029 : separator = TRIM( separator ), &
1030 : srcDim = TRIM( srcDim ), &
1031 : wildCard = TRIM( wildCard ), &
1032 : HcoConfig = HcoConfig, &
1033 : Lct = Lct, &
1034 : Dta = Dta, &
1035 0 : RC = RC )
1036 :
1037 : ! Trap potential errors
1038 0 : IF ( RC /= HCO_Success ) THEN
1039 0 : MSG = 'Error encountered in routine "UpdateDtaProperties"'
1040 0 : CALL HCO_Error( MSG, RC, thisLoc=loc )
1041 0 : RETURN
1042 : ENDIF
1043 :
1044 : ENDIF
1045 :
1046 : ! Connect this FileData object to the HcoState%HcoConfigList.
1047 0 : Lct%Dct%Dta => Dta
1048 :
1049 : ! Free list container for next cycle
1050 0 : Lct => NULL()
1051 :
1052 : ENDDO
1053 :
1054 : ! If no wildcard is present in variable name
1055 : ELSE
1056 :
1057 : ! -------------------------------------------------------------
1058 : ! Fill data container
1059 : ! -------------------------------------------------------------
1060 :
1061 : ! Add blank list container (ListCont object) to ConfigList.
1062 : ! The container is placed at the beginning of the list.
1063 0 : CALL ConfigList_AddCont ( Lct, HcoConfig%ConfigList )
1064 :
1065 : ! Check if name exists already
1066 0 : CALL CheckForDuplicateName( HcoConfig, cName, RC )
1067 0 : IF ( RC /= HCO_SUCCESS ) THEN
1068 0 : msg = 'Duplicate name: ' // TRIM( cName )
1069 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1070 0 : RETURN
1071 : ENDIF
1072 :
1073 : ! Attributes used by all data types: data type number and
1074 : ! container name.
1075 0 : Lct%Dct%DctType = DctType
1076 0 : Lct%Dct%cName = ADJUSTL(cName)
1077 :
1078 : ! Base container specific attributes
1079 0 : IF ( DctType == HCO_DCTTYPE_BASE ) THEN
1080 :
1081 : ! Set species name, extension number, emission category,
1082 : ! hierarchy
1083 0 : Lct%Dct%SpcName = ADJUSTL( SpcName )
1084 0 : Lct%Dct%Hier = Int2
1085 0 : Lct%Dct%ExtNr = Int3
1086 :
1087 : ! Extract category from character 2. This can be up to
1088 : ! CatMax integers, or empty.
1089 0 : CALL HCO_CharSplit( Char2, Separator, Wildcard, Cats, nCat, RC )
1090 0 : IF ( RC /= HCO_SUCCESS ) THEN
1091 0 : msg = 'Could not extract category from: ' // TRIM( char2 )
1092 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1093 0 : RETURN
1094 : ENDIF
1095 0 : IF ( nCat == 0 ) THEN
1096 0 : Lct%Dct%Cat = -999
1097 : ELSE
1098 0 : Lct%Dct%Cat = Cats(1)
1099 : ENDIF
1100 :
1101 : ! Set scale factor IDs into Scal_cID. These values will be
1102 : ! replaced lateron with the container IDs (in register_base)!
1103 : CALL HCO_CharSplit( Char1, Separator, Wildcard, &
1104 0 : SplitInts, nScl, RC )
1105 0 : IF ( RC /= HCO_SUCCESS ) THEN
1106 0 : msg = 'Could not get scale factor IDs from: ' // TRIM( char1 )
1107 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1108 0 : RETURN
1109 : ENDIF
1110 0 : IF ( nScl > 0 ) THEN
1111 0 : ALLOCATE ( Lct%Dct%Scal_cID(nScl) )
1112 0 : Lct%Dct%Scal_cID(1:nScl) = SplitInts(1:nScl)
1113 0 : Lct%Dct%nScalID = nScl
1114 : ENDIF
1115 :
1116 : ! Register species name. A list of all species names can be
1117 : ! returned to the atmospheric model to match HEMCO species
1118 : ! with model species (see Config\_GetSpecNames).
1119 0 : CALL SpecName_Register ( HcoConfig, ADJUSTL(SpcName), RC )
1120 0 : IF ( RC /= HCO_SUCCESS ) THEN
1121 0 : msg = 'Could not register species: ' // TRIM( SpcName )
1122 0 : CALL HCO_ERROR( msg, RC, thisLoc=loc )
1123 0 : RETURN
1124 : ENDIF
1125 :
1126 : ! Scale factor & mask specific attributes
1127 0 : ELSE IF ( DctType == HCO_DCTTYPE_SCAL .OR. &
1128 : DctType == HCO_DCTTYPE_MASK ) THEN
1129 :
1130 : ! Set scale factor ID and data operator
1131 0 : Lct%Dct%ScalID = Int1
1132 0 : Lct%Dct%Oper = Int2
1133 :
1134 : ! Make sure that negative scale factors are always read
1135 0 : IF ( Lct%Dct%ScalID < 0 ) THEN
1136 0 : CALL ScalID2List( HcoConfig%ScalIDList, Lct%Dct%ScalID, RC )
1137 0 : IF ( RC /= HCO_SUCCESS ) THEN
1138 : msg = 'Could not make sure that negative scale ' // &
1139 0 : 'are always read!'
1140 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1141 0 : RETURN
1142 : ENDIF
1143 : ENDIF
1144 :
1145 : ELSE
1146 0 : msg = 'Invalid data type!'
1147 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1148 0 : RETURN
1149 : ENDIF
1150 :
1151 : ! -------------------------------------------------------------
1152 : ! Create and fill file data object. Use previous file data
1153 : ! object if filename is undefined. Do not yet update the
1154 : ! DoShare and DtaHome flags of the data file object and data
1155 : ! container, respectively, since we still don't know which
1156 : ! data containers will be effectively used for emission
1157 : ! calculation (containers may be dropped lateron because the
1158 : ! emission category / hierarchy is too low, species is not
1159 : ! used, etc.). The DoShare and DtaHome flags will be set the
1160 : ! first time that data is read (in hco_readlist_mod.F90).
1161 : ! Here, we only set the DtaHome flag to -1000 instead of the
1162 : ! default value of -999 to be able to identify data objects
1163 : ! used by multiple containers.
1164 : ! -------------------------------------------------------------
1165 0 : IF ( TRIM( srcFile ) == '-' ) THEN
1166 :
1167 : ! The current entry of the configuration file specifies that
1168 : ! we will get data from the file listed immediately above it.
1169 : ! Thus we have to reuse a previously-defined FileData object
1170 : ! (aka Dta). Stop if Dta is not initialized.
1171 0 : IF ( .NOT. ASSOCIATED(Dta) ) THEN
1172 0 : MSG = 'Cannot use previous data container: '//TRIM(cName)
1173 0 : CALL HCO_Error( msg, RC, thisLoc=loc)
1174 0 : RETURN
1175 : ENDIF
1176 :
1177 : ! Reuse the file metadata specified in Dta for
1178 : ! this entry of the HEMCO configuration file.
1179 0 : Lct%Dct%DtaHome = Lct%Dct%DtaHome - 1
1180 :
1181 : ELSE
1182 :
1183 : ! The current entry of the configuration file specifies that
1184 : ! we will read data from a file. We thus need to initialize
1185 : ! a new FileData object to keep track of the file metadata.
1186 : !
1187 : ! >>> NOTE: This seems to cause a memory leak; <<<
1188 : ! >>> We will look into this at a later date <<<
1189 0 : CALL FileData_Init( Dta )
1190 :
1191 : ! Set source file name. Check if the read file name starts
1192 : ! with the configuration file token '$CFDIR', in which case
1193 : ! we replace this value with the passed CFDIR value.
1194 0 : STRLEN = LEN( srcFile )
1195 : IF ( STRLEN > 6 ) THEN
1196 0 : IF ( srcFile(1:6) == '$CFDIR' ) THEN
1197 0 : srcFile = TRIM( CFDIR ) // TRIM( srcFile(7:STRLEN) )
1198 : ENDIF
1199 : ENDIF
1200 0 : Dta%ncFile = srcFile
1201 :
1202 : ! Set source variable and original data unit.
1203 0 : Dta%ncPara = ADJUSTL( srcVar )
1204 0 : Dta%OrigUnit = ADJUSTL( srcUnit )
1205 :
1206 : ! If the parameter ncPara is not defined, attempt to read data
1207 : ! directly from configuration file instead of netCDF.
1208 : ! These data are always assumed to be in local time. Gridded
1209 : ! data read from netCDF is always in UTC, except for weekdaily
1210 : ! data that is treated in local time. The corresponding
1211 : ! IsLocTime flag is updated when reading the data (see
1212 : ! hcoio_dataread_mod.F90).
1213 0 : IF ( TRIM( Dta%ncPara ) == '-' ) THEN
1214 0 : Dta%ncRead = .FALSE.
1215 0 : Dta%IsLocTime = .TRUE.
1216 : ENDIF
1217 :
1218 : ! Extract information from time stamp character and pass values
1219 : ! to the corresponding container variables. If no time string is
1220 : ! defined, keep default values (-1 for all of them)
1221 0 : IF ( TRIM(srcTime) /= '-' ) THEN
1222 0 : CALL HCO_ExtractTime( HcoConfig, srcTime, Dta, RC )
1223 0 : IF ( RC /= HCO_SUCCESS ) THEN
1224 0 : msg = 'Could not extract time information!'
1225 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1226 0 : RETURN
1227 : ENDIF
1228 : ENDIF
1229 :
1230 : #if defined(ESMF_)
1231 : ! In an ESMF environment, the source data will be imported
1232 : ! through ExtData by name, hence need to set ncFile equal to
1233 : ! container name!
1234 : IF ( Dta%ncRead ) THEN
1235 : Dta%ncFile = ADJUSTL( cName )
1236 : ENDIF
1237 : #endif
1238 :
1239 : ! Update the properties of the data container
1240 : ! NOTE: This routine abstracts the big IF/ELSE block that
1241 : ! processes the time cycle information (bmy, 07 Mar 2022)
1242 : CALL UpdateDtaProperties( &
1243 : dctType = dctType, &
1244 : int3 = int3, &
1245 : char1 = TRIM( char1 ), &
1246 : char2 = char2(1:1), &
1247 : tagCName = TRIM( tagCName ), &
1248 : tmCycle = TRIM( tmCycle ), &
1249 : separator = TRIM( separator ), &
1250 : srcDim = TRIM( srcDim ), &
1251 : wildCard = TRIM( wildCard ), &
1252 : HcoConfig = HcoConfig, &
1253 : Lct = Lct, &
1254 : Dta = Dta, &
1255 0 : RC = RC )
1256 :
1257 : ! Trap potential errors
1258 0 : IF ( RC /= HCO_Success ) THEN
1259 0 : MSG = 'Error encountered in routine "UpdateDtaProperties"'
1260 0 : CALL HCO_Error( MSG, RC, thisLoc=loc )
1261 0 : RETURN
1262 : ENDIF
1263 :
1264 : ENDIF
1265 :
1266 : ! Connect FileData object to the HcoState%HcoConfigList
1267 0 : Lct%Dct%Dta => Dta
1268 :
1269 : ! If a base emission field covers multiple emission categories,
1270 : ! create a 'shadow' container for each additional category.
1271 : ! These shadow container have the same information as the main
1272 : ! container except that a scale factor of zero will be applied in
1273 : ! addition. This makes sure that the inventory cancels out other
1274 : ! inventories with lower hierarchy for every specified category,
1275 : ! while emission totals are not changed. All emissions of a base
1276 : ! field with multiple categories is written into the category
1277 : ! listed first.
1278 0 : IF ( nCat > 1 ) THEN
1279 :
1280 : ! nCat cannot exceed CatMax
1281 0 : IF ( nCat > CatMax ) THEN
1282 0 : MSG = 'Exceeded maximum number of categories!'
1283 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1284 0 : RETURN
1285 : ENDIF
1286 :
1287 0 : CALL AddShadowFields( HcoConfig, Lct, Cats, nCat, RC )
1288 0 : IF ( RC /= HCO_SUCCESS ) THEN
1289 0 : msg = 'Could not create shadow emission container!'
1290 0 : CALL HCO_ERROR( msg, RC, thisLoc=loc )
1291 0 : RETURN
1292 : ENDIF
1293 :
1294 : ! Reset nCat
1295 0 : nCat = -1
1296 : ENDIF
1297 :
1298 : ! Free list container for next cycle
1299 0 : Lct => NULL()
1300 :
1301 : ENDIF
1302 :
1303 : ENDDO
1304 :
1305 : ! Leave w/ success
1306 0 : Dta => NULL()
1307 0 : RC = HCO_SUCCESS
1308 :
1309 : END SUBROUTINE Config_ReadCont
1310 : !EOC
1311 : !------------------------------------------------------------------------------
1312 : ! Harmonized Emissions Component (HEMCO) !
1313 : !------------------------------------------------------------------------------
1314 : !BOP
1315 : !
1316 : ! !IROUTINE: BracketCheck
1317 : !
1318 : ! !DESCRIPTION: Subroutine BracketCheck checks if base emission data is within
1319 : ! a bracket and if that field shall be ignored or not. Brackets can be used to
1320 : ! lump entires of the HEMCO configuration file into collections that can be
1321 : ! collectively enabled or disabled. The first entry of a collection is marked
1322 : ! adding an 'opening bracket' to the HEMCO configuration file (on the line
1323 : ! above the entry). Opening brackets must start with three opening brackets,
1324 : ! e.g.: '(((TEST'. Similarly, the end of a collection is marked by placing a
1325 : ! closing bracket after the last entry of the collection: '))))TEST'.
1326 : ! Brackets can be enabled / disabled in the EXTENSION SWITCH section of the
1327 : ! HEMCO configuration file:
1328 : ! \# ExtNr ExtName on/off Species
1329 : ! 0 Base : on *
1330 : ! --> TEST : true
1331 : !\\
1332 : !\\
1333 : ! It is also possible to use 'opposite' brackets, e.g. to use a collection
1334 : ! only if the given setting is *disabled*. This can be achieved by precede
1335 : ! the collection word with '.not.', e.g. '(((.not.TEST' and '))).not.TEST'.
1336 : ! Similarly, multiple collections can be combined to be evaluated together,
1337 : ! e.g. NAME1.or.NAME2.
1338 : !\\
1339 : !\\
1340 : ! !INTERFACE:
1341 : !
1342 0 : SUBROUTINE BracketCheck( HcoConfig, STAT, LINE, SKIP, RC )
1343 : !
1344 : ! !USES:
1345 : !
1346 : USE HCO_EXTLIST_MOD, ONLY : GetExtOpt, GetExtNr
1347 : !
1348 : ! !INPUT PARAMETERS:
1349 : !
1350 : INTEGER, INTENT(IN) :: STAT !
1351 : CHARACTER(LEN=*), INTENT(IN) :: LINE !
1352 : !
1353 : ! !INPUT/OUTPUT PARAMETERS:
1354 : !
1355 : TYPE(ConfigObj), POINTER :: HcoConfig ! Config object
1356 : LOGICAL, INTENT(INOUT) :: SKIP ! Skip
1357 : INTEGER, INTENT(INOUT) :: RC ! Success/failure
1358 : !
1359 : ! !REVISION HISTORY:
1360 : ! 15 Feb 2015 - C. Keller - Initial version.
1361 : ! See https://github.com/geoschem/hemco for complete history
1362 : !EOP
1363 : !------------------------------------------------------------------------------
1364 : !BOC
1365 : !
1366 : ! !LOCAL VARIABLES:
1367 : !
1368 : ! Maximum number of nested brackets
1369 : INTEGER, PARAMETER :: MAXBRACKNEST = 5
1370 : INTEGER :: IDX, STRLEN, ExtNr
1371 : LOGICAL :: FOUND
1372 : LOGICAL :: UseBracket, UseThis
1373 : LOGICAL :: verb
1374 : LOGICAL :: REV
1375 : INTEGER, SAVE :: NEST = 0
1376 : INTEGER, SAVE :: SKIPLEVEL = 0
1377 : CHARACTER(LEN=255), SAVE :: AllBrackets(MAXBRACKNEST) = ''
1378 : CHARACTER(LEN=255) :: TmpBracket, CheckBracket, ThisBracket
1379 : CHARACTER(LEN=512) :: msg
1380 :
1381 : CHARACTER(LEN=255), PARAMETER :: LOC = 'BracketCheck (hco_config_mod.F90)'
1382 :
1383 : !======================================================================
1384 : ! BracketCheck begins here
1385 : !======================================================================
1386 :
1387 : ! Init
1388 0 : verb = HCO_IsVerb( HcoConfig%Err, 1 )
1389 :
1390 : ! Get name of this bracket
1391 0 : IF ( STAT == 5 .OR. STAT == 6 ) THEN
1392 0 : STRLEN = LEN(LINE)
1393 0 : IF ( STRLEN < 4 ) THEN
1394 0 : msg = 'Illegal bracket length: ' // TRIM(line)
1395 0 : CALL HCO_ERROR ( msg, RC, thisLoc=loc )
1396 0 : RETURN
1397 : ELSE
1398 0 : TmpBracket = TRIM(LINE(4:STRLEN))
1399 : ENDIF
1400 : ENDIF
1401 :
1402 : ! Open a bracket. Save out the bracket name in the list of all
1403 : ! opened brackets. This is primarily to ensure that every opening
1404 : ! brackets is properly closed. Only register it as skipping bracket
1405 : ! if needed.
1406 0 : IF ( STAT == 5 ) THEN
1407 :
1408 : ! Archive bracket name
1409 0 : NEST = NEST + 1
1410 0 : IF ( NEST > MAXBRACKNEST ) THEN
1411 0 : MSG = 'Too many nested brackets'
1412 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
1413 0 : RETURN
1414 : ENDIF
1415 0 : AllBrackets(NEST) = TmpBracket
1416 :
1417 : ! Check if this bracket content shall be skipped. Always skip
1418 : ! if this is a nested bracket in an already skipped bracket.
1419 0 : IF ( .NOT. SKIP ) THEN
1420 :
1421 : ! Check for 'inverse' bracket. These start with '.not.'
1422 0 : CheckBracket = TmpBracket
1423 0 : REV = .FALSE.
1424 0 : IF ( STRLEN > 5 ) THEN
1425 0 : IF ( TmpBracket(1:5) == '.not.' ) THEN
1426 0 : STRLEN = LEN(TmpBracket)
1427 0 : CheckBracket = TmpBracket(6:STRLEN)
1428 0 : REV = .TRUE.
1429 : ENDIF
1430 : ENDIF
1431 :
1432 : ! Check if the evaluation of CheckBracket returns true, i.e.
1433 : ! if any of the elements of CheckBracket is enabled. These
1434 : ! can be multiple settings separated by '.or.'.
1435 : ! By default, don't use the content of the bracket
1436 0 : UseBracket = .FALSE.
1437 :
1438 : ! Make sure variable ThisBracket is initialized. Needed in the
1439 : ! DO loop below
1440 0 : ThisBracket = ''
1441 :
1442 : ! Pack the following into a DO loop to check for multiple
1443 : ! flags separated by '.or.'.
1444 : DO
1445 :
1446 : ! Leave do loop if ThisBracket is equal to CheckBracket.
1447 : ! In this case, the entire bracket has already been
1448 : ! evaluated.
1449 0 : IF ( TRIM(CheckBracket) == TRIM(ThisBracket) ) EXIT
1450 :
1451 : ! Evaluate bracket for '.or.':
1452 0 : IDX = INDEX(TRIM(CheckBracket),'.or.')
1453 :
1454 : ! If '.or.' is a substring of the whole bracket, get
1455 : ! substring up to the first '.or.' and write it into variable
1456 : ! ThisBracket, which will be evaluated below. The tail
1457 : ! (everything after the first '.or.') is written into
1458 : ! CheckBracket.
1459 0 : IF ( IDX > 0 ) THEN
1460 0 : ThisBracket = CheckBracket(1:(IDX-1))
1461 0 : STRLEN = LEN(CheckBracket)
1462 0 : CheckBracket = CheckBracket((IDX+4):STRLEN)
1463 :
1464 : ! If there is no '.or.' in the bracket, simply evaluate the
1465 : ! whole bracket.
1466 : ELSE
1467 0 : ThisBracket = CheckBracket
1468 : ENDIF
1469 :
1470 : ! Check if this bracket has been registered as being used.
1471 : ! Scan all extensions, including the core one.
1472 : CALL GetExtOpt( HcoConfig, -999, TRIM(ThisBracket), &
1473 0 : OptValBool=UseThis, FOUND=FOUND, RC=RC )
1474 0 : IF ( RC /= HCO_SUCCESS ) THEN
1475 0 : msg = 'Error when checking '// TRIM( thisBracket ) // '!'
1476 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1477 0 : RETURN
1478 : ENDIF
1479 :
1480 : ! If bracket name was found in options, update the UseBracket
1481 : ! variable accordingly.
1482 0 : IF ( FOUND ) THEN
1483 0 : UseBracket = UseThis
1484 :
1485 : ! If bracket name was not found, check if this is an extension
1486 : ! name
1487 : ELSE
1488 0 : ExtNr = GetExtNr( HcoConfig%ExtList, TRIM(ThisBracket) )
1489 0 : IF ( ExtNr > 0 ) THEN
1490 0 : UseBracket = .TRUE.
1491 : ENDIF
1492 :
1493 : ENDIF
1494 :
1495 : ! As soon as UseBracket is true, we don't need to evaluate
1496 : ! further
1497 0 : IF ( UseBracket ) EXIT
1498 :
1499 : ENDDO
1500 :
1501 : ! We need to skip the content of this bracket?
1502 0 : SKIP = .NOT. UseBracket
1503 :
1504 : ! Eventually reverse the skip flag
1505 0 : IF ( REV ) THEN
1506 0 : SKIP = .NOT. SKIP
1507 : ENDIF
1508 :
1509 : ! If bracket is skipped, adjust skip level accordingly.
1510 : ! This is so that we know when it's time to flip back to
1511 : ! a bracket that is being used (if brackets are nested).
1512 0 : IF ( SKIP ) THEN
1513 0 : SKIPLEVEL = NEST
1514 : ENDIF
1515 : ENDIF
1516 :
1517 : ! Verbose mode
1518 0 : IF ( verb ) THEN
1519 0 : MSG = 'Opened shortcut bracket: '//TRIM(TmpBracket)
1520 0 : CALL HCO_MSG( HcoConfig%Err, msg )
1521 0 : WRITE(MSG,*) ' - Skip content of this bracket: ', SKIP
1522 0 : CALL HCO_MSG( HcoConfig%Err, msg )
1523 : ENDIF
1524 : ENDIF
1525 :
1526 : ! Close a bracket
1527 0 : IF ( STAT == 6 ) THEN
1528 :
1529 : ! This must be the latest opened bracket
1530 0 : IF ( TRIM(TmpBracket) /= TRIM(AllBrackets(NEST)) ) THEN
1531 : MSG = 'Closing bracket does not match opening bracket: '// &
1532 0 : TRIM(TmpBracket)//', expected: '//TRIM(AllBrackets(NEST))
1533 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
1534 0 : RETURN
1535 : ENDIF
1536 :
1537 : ! If that was the latest opened bracket that was disabled
1538 0 : IF ( SKIPLEVEL == NEST ) THEN
1539 0 : SKIP = .FALSE.
1540 : ENDIF
1541 :
1542 : ! Update nesting level
1543 0 : AllBrackets(NEST) = ''
1544 0 : NEST = NEST - 1
1545 :
1546 : ! Verbose mode
1547 0 : IF ( verb ) THEN
1548 0 : MSG = 'Closed shortcut bracket: '//TRIM(TmpBracket)
1549 0 : CALL HCO_MSG( HcoConfig%Err, msg )
1550 0 : WRITE(MSG,*) ' - Skip following lines: ', SKIP
1551 0 : CALL HCO_MSG( HcoConfig%Err, msg )
1552 : ENDIF
1553 : ENDIF
1554 :
1555 : ! Return w/ success
1556 0 : RC = HCO_SUCCESS
1557 :
1558 : END SUBROUTINE BracketCheck
1559 : !EOC
1560 : !------------------------------------------------------------------------------
1561 : ! Harmonized Emissions Component (HEMCO) !
1562 : !------------------------------------------------------------------------------
1563 : !BOP
1564 : !
1565 : ! !IROUTINE: AddShadowFields
1566 : !
1567 : ! !DESCRIPTION: Subroutine AddShadowFields adds a shadow container for every
1568 : ! additional category of a base emission field. These container contain the
1569 : ! same container as the 'mother' container, but an additional scale factor
1570 : ! of zero will be applied to them. This makes sure that no additional emissions
1571 : ! are created by the virtue of the shadow container.
1572 : !\\
1573 : !\\
1574 : ! !INTERFACE:
1575 : !
1576 0 : SUBROUTINE AddShadowFields( HcoConfig, Lct, Cats, nCat, RC )
1577 : !
1578 : ! !USES:
1579 : !
1580 : USE HCO_DATACONT_MOD, ONLY : CatMax, ZeroScalID
1581 : !
1582 : ! !INPUT PARAMETERS:
1583 : !
1584 : TYPE(ConfigObj), POINTER :: HcoConfig ! Config object
1585 : TYPE(ListCont), POINTER :: Lct ! List container of interest
1586 : INTEGER, INTENT(IN) :: Cats(CatMax) ! Category numbers
1587 : INTEGER, INTENT(IN) :: nCat ! number of categories
1588 : !
1589 : ! !INPUT/OUTPUT PARAMETERS:
1590 : !
1591 : INTEGER, INTENT(INOUT) :: RC ! Success/failure
1592 : !
1593 : ! !REVISION HISTORY:
1594 : ! 15 Feb 2015 - C. Keller - Initial version.
1595 : ! See https://github.com/geoschem/hemco for complete history
1596 : !EOP
1597 : !------------------------------------------------------------------------------
1598 : !BOC
1599 : !
1600 : ! !LOCAL VARIABLES:
1601 : !
1602 : LOGICAL :: verb
1603 : INTEGER :: I, N
1604 : TYPE(ListCont), POINTER :: Shd
1605 : CHARACTER(LEN=512) :: msg
1606 : CHARACTER(LEN=5) :: C5
1607 :
1608 : CHARACTER(LEN=255), PARAMETER :: LOC = 'AddShadowFields (hco_config_mod.F90)'
1609 :
1610 : !======================================================================
1611 : ! AddShadowFields begins here
1612 : !======================================================================
1613 :
1614 : ! Nothing to do if ncat is only 1
1615 0 : IF ( nCat <= 1 ) THEN
1616 0 : RC = HCO_SUCCESS
1617 0 : RETURN
1618 : ENDIF
1619 :
1620 : ! Init
1621 0 : verb = HCO_IsVerb( HcoConfig%Err, 1 )
1622 0 : Shd => NULL()
1623 :
1624 :
1625 : ! ! Get number of currently used scale factors
1626 : ! N = 0
1627 : ! DO I = 1, SclMax
1628 : ! IF ( Lct%Dct%Scal_cID(I) < 0 ) EXIT
1629 : ! N = N + 1
1630 : ! ENDDO
1631 : !
1632 : ! ! There has to be space for scale factor zero.
1633 : ! IF ( N >= SclMax ) THEN
1634 : ! MSG = 'Cannot add shadow scale factor (zeros) - : ' // &
1635 : ! 'All scale factors already used: ' // TRIM(Lct%Dct%cName)
1636 : ! CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
1637 : ! RETURN
1638 : ! ENDIF
1639 :
1640 : ! Get number of scale factor IDs. Will add one more scale factor of
1641 : ! zero to this list.
1642 0 : N = Lct%Dct%nScalID
1643 :
1644 : ! Create 'shadow' container for every additional category.
1645 : ! Add scale factor zero to it, so that emissions will all be zero.
1646 0 : DO I = 2, nCat
1647 :
1648 : ! Create new data container (ListCont object)
1649 0 : CALL ConfigList_AddCont ( Shd, HcoConfig%ConfigList )
1650 :
1651 : ! Character of category
1652 0 : Write(C5,'(I5.5)') Cats(I)
1653 :
1654 : ! Shadow variables. Append category name to name
1655 0 : Shd%Dct%DctType = Lct%Dct%DctType
1656 0 : Shd%Dct%cName = TRIM(Lct%Dct%cName) // '_Cat' // TRIM(C5)
1657 0 : Shd%Dct%SpcName = Lct%Dct%SpcName
1658 0 : Shd%Dct%Hier = Lct%Dct%Hier
1659 0 : Shd%Dct%ExtNr = Lct%Dct%ExtNr
1660 0 : Shd%Dct%Cat = Cats(I)
1661 :
1662 : ! Pass scale factors, add scale factor of zero to it
1663 0 : ALLOCATE ( Shd%Dct%Scal_cID(N+1) )
1664 0 : IF ( N > 0 ) THEN
1665 0 : Shd%Dct%Scal_cID(1:N) = Lct%Dct%Scal_cID(1:N)
1666 : ENDIF
1667 0 : Shd%Dct%Scal_cID(N+1) = ZeroScalID
1668 0 : Shd%Dct%nScalID = N + 1
1669 :
1670 : ! Connect to data from main container. Make sure the new container
1671 : ! is not identified as the home container (only points to the file
1672 : ! data container of another data container.
1673 0 : Shd%Dct%DtaHome = Shd%Dct%DtaHome - 1
1674 0 : Shd%Dct%Dta => Lct%Dct%Dta
1675 :
1676 : ! verbose mode
1677 0 : IF ( verb ) THEN
1678 0 : MSG = 'Created shadow base emission field: ' // TRIM(Shd%Dct%cName)
1679 0 : CALL HCO_MSG( HcoConfig%Err, msg )
1680 : ENDIF
1681 :
1682 : ! Cleanup
1683 0 : Shd => NULL()
1684 : ENDDO !I
1685 :
1686 : ! Add zero scale factor container
1687 0 : CALL AddZeroScal( HcoConfig, RC )
1688 0 : IF ( RC /= HCO_SUCCESS ) THEN
1689 0 : msg = 'Call to AddZeroScal could not add zero scale factor container!'
1690 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1691 0 : RETURN
1692 : ENDIF
1693 :
1694 : ! Return w/ success
1695 0 : RC = HCO_SUCCESS
1696 :
1697 : END SUBROUTINE AddShadowFields
1698 : !EOC
1699 : !------------------------------------------------------------------------------
1700 : ! Harmonized Emissions Component (HEMCO) !
1701 : !------------------------------------------------------------------------------
1702 : !BOP
1703 : !
1704 : ! !IROUTINE: AddZeroScal
1705 : !
1706 : ! !DESCRIPTION: Subroutine AddZeroScal adds a scale factor of zero to the
1707 : ! configuration container list. This scale factor is an internal scale factor
1708 : ! used in combination with the 'shadow' containers. Its scale factor ID is
1709 : ! defined in Hco\_DataCont\_Mod and must not be used otherwise, e.g. there
1710 : ! must not be another scale factor in the HEMCO configuration file with the
1711 : ! same scale factor ID. Otherwise, HEMCO will create an error lateron.
1712 : !\\
1713 : !\\
1714 : ! !INTERFACE:
1715 : !
1716 0 : SUBROUTINE AddZeroScal( HcoConfig, RC )
1717 : !
1718 : ! !USES:
1719 : !
1720 : USE HCO_DATACONT_MOD, ONLY : ZeroScalID
1721 : USE HCO_DATACONT_MOD, ONLY : ListCont_Find
1722 : USE HCO_FILEDATA_MOD, ONLY : FileData_Init
1723 : !
1724 : ! !INPUT PARAMETERS:
1725 : !
1726 : TYPE(ConfigObj), POINTER :: HcoConfig ! Config object
1727 : !
1728 : ! !INPUT/OUTPUT PARAMETERS:
1729 : !
1730 : INTEGER, INTENT(INOUT) :: RC ! Success/failure
1731 : !
1732 : ! !REVISION HISTORY:
1733 : ! 15 Feb 2015 - C. Keller - Initial version.
1734 : ! See https://github.com/geoschem/hemco for complete history
1735 : !EOP
1736 : !------------------------------------------------------------------------------
1737 : !BOC
1738 : !
1739 : ! !LOCAL VARIABLES:
1740 : !
1741 : TYPE(ListCont), POINTER :: Lct
1742 : TYPE(FileData), POINTER :: Dta
1743 : CHARACTER(LEN=255) :: MSG
1744 :
1745 : LOGICAL :: FOUND
1746 : CHARACTER(LEN=255), PARAMETER :: LOC = 'AddZeroScal (hco_config_mod.F90)'
1747 :
1748 : !======================================================================
1749 : ! AddZeroScal begins here
1750 : !======================================================================
1751 :
1752 : ! Initialize
1753 0 : Lct => NULL()
1754 0 : Dta => NULL()
1755 :
1756 : ! Check if this container already exists
1757 0 : CALL ListCont_Find ( HcoConfig%ConfigList, 'DUMMYSCALE_ZERO', FOUND )
1758 :
1759 : ! Only do on first call
1760 0 : IF ( .NOT. FOUND ) THEN
1761 :
1762 : ! Add new container to configuration list and set data container
1763 : ! attributes.
1764 0 : CALL ConfigList_AddCont ( Lct, HcoConfig%ConfigList )
1765 0 : Lct%Dct%DctType = HCO_DCTTYPE_SCAL
1766 0 : Lct%Dct%cName = 'DUMMYSCALE_ZERO'
1767 0 : Lct%Dct%ScalID = ZeroScalID
1768 0 : Lct%Dct%Oper = 1
1769 :
1770 : ! Create new file data container and fill it with values.
1771 0 : CALL FileData_Init ( Dta )
1772 0 : Dta%ncFile = '0.0'
1773 0 : Dta%ncPara = '-'
1774 0 : Dta%OrigUnit = 'unitless'
1775 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
1776 0 : Dta%SpaceDim = 2
1777 0 : Dta%ncRead = .FALSE.
1778 0 : Dta%IsLocTime = .TRUE.
1779 :
1780 : ! Connect data container
1781 0 : Lct%Dct%Dta => Dta
1782 :
1783 : ! verbose mode
1784 0 : IF ( HCO_IsVerb( HcoConfig%Err, 2 ) ) THEN
1785 0 : MSG = 'Created a fake scale factor with zeros'
1786 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
1787 : MSG = 'This field will be used to artificially expand ' // &
1788 0 : 'over multiple emission categories'
1789 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
1790 : ENDIF
1791 :
1792 : ! Cleanup
1793 0 : Lct => NULL()
1794 0 : Dta => NULL()
1795 : ENDIF
1796 :
1797 : ! Return w/ success
1798 0 : RC = HCO_SUCCESS
1799 :
1800 0 : END SUBROUTINE AddZeroScal
1801 : !EOC
1802 : !------------------------------------------------------------------------------
1803 : ! Harmonized Emissions Component (HEMCO) !
1804 : !------------------------------------------------------------------------------
1805 : !BOP
1806 : !
1807 : ! !IROUTINE: ExtSwitch2Buffer
1808 : !
1809 : ! !DESCRIPTION: Subroutine ExtSwitch2Buffer reads the HEMCO extension
1810 : ! switches and registers all enabled extensions.
1811 : !\\
1812 : !\\
1813 : ! !INTERFACE:
1814 : !
1815 0 : SUBROUTINE ExtSwitch2Buffer( HcoConfig, IU_HCO, EOF, RC )
1816 : !
1817 : ! !USES:
1818 : !
1819 : USE HCO_CHARPAK_Mod, ONLY : STRREPL, STRSPLIT, TRANLC
1820 : USE HCO_EXTLIST_MOD, ONLY : AddExt, AddExtOpt, HCO_GetOpt
1821 : USE HCO_EXTLIST_MOD, ONLY : GetExtNr
1822 : !
1823 : ! !INPUT PARAMETERS:
1824 : !
1825 : TYPE(ConfigObj), POINTER :: HcoConfig ! Config object
1826 : INTEGER, INTENT(IN) :: IU_HCO ! HEMCO configfile LUN
1827 : !
1828 : ! !INPUT/OUTPUT PARAMETERS:
1829 : !
1830 : LOGICAL, INTENT(INOUT) :: EOF ! End of file?
1831 : INTEGER, INTENT(INOUT) :: RC ! Success/failure
1832 : !
1833 : ! !REVISION HISTORY:
1834 : ! 17 Sep 2013 - C. Keller - Initialization (update)
1835 : ! See https://github.com/geoschem/hemco for complete history
1836 : !EOP
1837 : !------------------------------------------------------------------------------
1838 : !BOC
1839 : !
1840 : ! !LOCAL VARIABLES:
1841 : !
1842 : INTEGER :: I, N, Idx, ExtNr
1843 : LOGICAL :: Enabled, NewExt
1844 : CHARACTER(LEN=255) :: loc
1845 : CHARACTER(LEN=512) :: msg
1846 : CHARACTER(LEN=1023) :: OPTS
1847 : CHARACTER(LEN=2047) :: LINE
1848 : CHARACTER(LEN=2047) :: SUBSTR(255), SPECS(255)
1849 :
1850 : !======================================================================
1851 : ! ExtSwitch2Buffer begins here
1852 : !======================================================================
1853 :
1854 : ! Enter
1855 0 : RC = HCO_SUCCESS
1856 0 : msg = ''
1857 0 : loc = 'ExtSwitch2Buffer (hco_config_mod.F90)'
1858 0 : ExtNr = -1
1859 :
1860 : ! Do until exit
1861 : DO
1862 :
1863 : ! Read line
1864 0 : CALL HCO_ReadLine ( IU_HCO, LINE, EOF, RC )
1865 0 : IF ( RC /= HCO_SUCCESS ) THEN
1866 0 : msg = 'Error in HEMCO_Config.rc @ line: ' // TRIM( line )
1867 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1868 0 : RETURN
1869 : ENDIF
1870 :
1871 : ! Return if EOF
1872 0 : IF ( EOF ) RETURN
1873 :
1874 : ! Exit here if end of section encountered. Place this before the
1875 : ! test for comment to allow for "### END SECTION" tags (bmy, 4/21/15)
1876 0 : IF ( INDEX ( LINE, 'END SECTION' ) > 0 ) RETURN
1877 :
1878 : ! Jump to next line if line is commented out
1879 0 : IF ( LINE(1:1) == HCO_CMT ) CYCLE
1880 :
1881 : ! Check if these are options
1882 0 : IF ( INDEX(LINE,'-->') > 0 ) THEN
1883 : ! Only add if extension is defined!
1884 0 : IF ( ExtNr >= 0 .AND. Enabled ) THEN
1885 : CALL AddExtOpt( HcoConfig, TRIM(LINE), &
1886 0 : ExtNr, RC, IgnoreIfExist=.TRUE. )
1887 0 : IF ( RC /= HCO_SUCCESS ) THEN
1888 0 : msg = 'Error in HEMCO_Config.rc @ line: ' // TRIM( line )
1889 0 : CALL HCO_ERROR( msg, RC, thisLoc=loc )
1890 0 : RETURN
1891 : ENDIF
1892 : ENDIF
1893 : CYCLE
1894 : ENDIF
1895 :
1896 : ! ---------------------------------------------------------------------
1897 : ! If the line is not an extension option, treat it as an extension
1898 : ! definition (e.g. 108 MEGAN : on ISOP/ACET/PRPE/C2H4/ALD2)
1899 : ! ---------------------------------------------------------------------
1900 :
1901 : ! Split character string
1902 0 : CALL STRREPL ( LINE, HCO_TAB, HCO_TAB )
1903 0 : CALL STRSPLIT( LINE, HCO_SPC, SUBSTR, N )
1904 :
1905 : ! Jump to next line if this line is empty
1906 0 : IF ( N <= 1 ) CYCLE
1907 :
1908 : ! Check if extension already exists, e.g. if this is a nested HEMCO configuration
1909 : ! file and the same extension has already been defined. In that case, use the
1910 : ! on/off toggle that has already been defined.
1911 0 : ExtNr = GetExtNr( HcoConfig%ExtList, TRIM(SUBSTR(2)) )
1912 :
1913 : ! Three possibilities:
1914 : ! - ExtNr is -999 --> extension does not yet exist
1915 : ! - ExtNr is a positive number --> extension exists and is enabled
1916 : ! - ExtNr is -1 --> extension exists and is disabled
1917 0 : IF ( ExtNr == -999 ) THEN
1918 : NewExt = .TRUE.
1919 0 : ELSEIF ( ExtNr >= 0 ) THEN
1920 0 : NewExt = .FALSE.
1921 0 : Enabled = .TRUE.
1922 : ELSE
1923 0 : NewExt = .FALSE.
1924 0 : Enabled = .FALSE.
1925 : ENDIF
1926 :
1927 : ! The following needs to be done for new extensions only
1928 : IF ( NewExt ) THEN
1929 :
1930 : ! Check for on-switch. This is either the
1931 : ! 3rd or the 4th substring, depending on the
1932 : ! location of the colon sign!
1933 0 : IF ( TRIM(SUBSTR(3)) /= ':' ) THEN
1934 : idx = 3
1935 : ELSE
1936 : idx = 4
1937 : ENDIF
1938 0 : CALL TRANLC( TRIM(SUBSTR(idx)) )
1939 0 : IF ( TRIM(SUBSTR(idx)) == 'on' ) THEN
1940 0 : Enabled = .TRUE.
1941 : ELSE
1942 0 : Enabled = .FALSE.
1943 : ENDIF
1944 :
1945 : ! Register extension name, number and species
1946 : ! idx is the position of the species names
1947 0 : idx = idx+1
1948 0 : READ( SUBSTR(1), * ) ExtNr
1949 : CALL AddExt ( HcoConfig, TRIM(SUBSTR(2)), &
1950 0 : ExtNr, Enabled, SUBSTR(idx), RC )
1951 0 : IF ( RC /= HCO_SUCCESS ) THEN
1952 0 : CALL HCO_ERROR( 'ERROR 32', RC, THISLOC=LOC )
1953 0 : RETURN
1954 : ENDIF
1955 :
1956 : ! Register species (specNames)
1957 0 : IF ( Enabled ) THEN
1958 :
1959 : CALL STRSPLIT( SUBSTR(idx), &
1960 0 : HCO_GetOpt(HcoConfig%ExtList,'Separator'), SPECS, N )
1961 0 : IF ( N < 1 ) THEN
1962 0 : CALL HCO_ERROR ( 'No species defined', RC, THISLOC=LOC )
1963 0 : RETURN
1964 : ENDIF
1965 0 : DO I = 1, N
1966 0 : CALL SpecName_Register ( HcoConfig, SPECS(I), RC )
1967 0 : IF ( RC /= HCO_SUCCESS ) THEN
1968 0 : msg = 'Error encountered in "SpecName_Register"!'
1969 0 : CALL HCO_ERROR( msg, RC, thisLoc=LOC )
1970 0 : RETURN
1971 : ENDIF
1972 : ENDDO
1973 : ENDIF
1974 : ENDIF ! NextExt
1975 : ENDDO
1976 :
1977 : ! Leave w/ success
1978 : RC = HCO_SUCCESS
1979 :
1980 : END SUBROUTINE ExtSwitch2Buffer
1981 : !EOC
1982 : !------------------------------------------------------------------------------
1983 : ! Harmonized Emissions Component (HEMCO) !
1984 : !------------------------------------------------------------------------------
1985 : !BOP
1986 : !
1987 : ! !ROUTINE: ReadSettings
1988 : !
1989 : ! !DESCRIPTION: Subroutine ReadSettings reads the HEMCO settings,
1990 : ! stores them as HEMCO core extension options, and also evaluates
1991 : ! some of the values (e.g. to initialize the HEMCO error module).
1992 : !\\
1993 : !\\
1994 : ! !INTERFACE:
1995 : !
1996 0 : SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC )
1997 : !
1998 : ! !USES:
1999 : !
2000 : USE HCO_EXTLIST_MOD, ONLY : AddExtOpt, GetExtOpt, CoreNr
2001 : USE HCO_EXTLIST_MOD, ONLY : HCO_SetDefaultToken
2002 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
2003 : USE HCO_CHARPAK_MOD, ONLY : STRREPL, STRSPLIT, TRANLC
2004 : !
2005 : ! !INPUT PARAMETERS:
2006 : !
2007 : TYPE(ConfigObj), POINTER :: HcoConfig ! Config obj
2008 : INTEGER, INTENT(IN) :: IU_HCO ! HEMCO configfile LUN
2009 : !
2010 : ! !INPUT/OUTPUT PARAMETERS:
2011 : !
2012 : LOGICAL, INTENT(INOUT) :: EOF ! End of file?
2013 : INTEGER, INTENT(INOUT) :: RC ! Success/failure
2014 : !
2015 : ! !REVISION HISTORY:
2016 : ! 17 Sep 2013 - C. Keller - Initialization (update)
2017 : ! See https://github.com/geoschem/hemco for complete history
2018 : !EOP
2019 : !------------------------------------------------------------------------------
2020 : !BOC
2021 : !
2022 : ! !LOCAL VARIABLES:
2023 : !
2024 : ! Scalars
2025 : LOGICAL :: FOUND
2026 : INTEGER :: I, N, POS
2027 : INTEGER :: verb
2028 : INTEGER :: warn
2029 :
2030 : ! Strings
2031 : CHARACTER(LEN=255) :: Line
2032 : CHARACTER(LEN=255) :: loc
2033 : CHARACTER(LEN=255) :: LogFile
2034 : CHARACTER(LEN=255) :: DiagnPrefix
2035 : CHARACTER(LEN=255) :: MetField
2036 : CHARACTER(LEN=255) :: GridRes
2037 : CHARACTER(LEN=512) :: msg
2038 :
2039 : !======================================================================
2040 : ! ReadSettings begins here
2041 : !======================================================================
2042 :
2043 : ! Enter
2044 0 : Loc = 'ReadSettings (hco_config_mod.F90)'
2045 :
2046 : !-----------------------------------------------------------------------
2047 : ! Read settings and add them as options to core extensions
2048 : !-----------------------------------------------------------------------
2049 :
2050 : ! Do until exit
2051 : DO
2052 :
2053 : ! Read line
2054 0 : CALL HCO_ReadLine ( IU_HCO, LINE, EOF, RC )
2055 0 : IF ( RC /= HCO_SUCCESS ) THEN
2056 0 : msg = 'Error in HEMCO_Config.rc @ line: ' // TRIM( Line )
2057 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2058 0 : RETURN
2059 : ENDIF
2060 :
2061 : ! Return if EOF
2062 0 : IF ( EOF ) EXIT
2063 :
2064 : ! Exit here if end of section encountered
2065 0 : IF ( INDEX ( LINE, 'END SECTION' ) > 0 ) EXIT
2066 :
2067 : ! Jump to next line if line is commented out
2068 0 : IF ( LINE(1:1) == HCO_CMT ) CYCLE
2069 :
2070 : ! Ignore empty lines
2071 0 : IF ( TRIM(LINE) == '' ) CYCLE
2072 :
2073 : ! Add this option to HEMCO core
2074 : CALL AddExtOpt ( HcoConfig, TRIM(LINE), &
2075 0 : CoreNr, RC, IgnoreIfExist=.TRUE. )
2076 0 : IF ( RC /= HCO_SUCCESS ) THEN
2077 0 : msg = 'Error in HEMCO_Config.rc @ line: ' // TRIM( Line )
2078 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2079 0 : RETURN
2080 : ENDIF
2081 :
2082 : ENDDO
2083 :
2084 : #ifndef MODEL_GEOS
2085 : #ifndef MODEL_WRF
2086 : #ifndef MODEL_CESM
2087 : #ifndef ESMF_
2088 : !=======================================================================
2089 : ! Look for met field and grid resolution. When running the HEMCO
2090 : ! standalone these will need to be read from the configuration file.
2091 : ! Otherwise, HEMCO will inherit the met field and grid resolution
2092 : ! of the parent model (GC-Classic, GCHP, etc.)
2093 : !
2094 : ! NOTE: Only do this check if not using GEOS-Chem in an external ESM!
2095 : !=======================================================================
2096 :
2097 : ! Look for met field
2098 : CALL GetExtOpt( HcoConfig, CoreNr, 'MET', &
2099 : OptValChar=MetField, FOUND=FOUND, RC=RC )
2100 : IF ( FOUND ) THEN
2101 : HcoConfig%MetField = TRIM( MetField )
2102 : ENDIF
2103 :
2104 : ! Look for grid resolution
2105 : ! Make sure resolution string is in the proper FlexGrid format
2106 : CALL GetExtOpt( HcoConfig, CoreNr, 'RES', &
2107 : OptValChar=GridRes, FOUND=FOUND, RC=RC )
2108 : IF ( FOUND ) THEN
2109 : SELECT CASE( TRIM( GridRes ) )
2110 : CASE( '4x5' )
2111 : GridRes = '4.0x5.0'
2112 : CASE( '2x25', '2x2.5' )
2113 : GridRes = '2.0x2.5'
2114 : CASE( '05x0625', '0.5x0.625' )
2115 : GridRes = '0.5x0.625'
2116 : CASE( '025x03125', '0.25x0.3125' )
2117 : GridRes = '0.25x0.3125'
2118 : CASE DEFAULT
2119 : Msg = 'Improperly formatted grid resolution: ' // TRIM( GridRes )
2120 : CALL HCO_Error( Msg, RC, Loc )
2121 : RETURN
2122 : END SELECT
2123 : HcoConfig%GridRes = TRIM( GridRes )
2124 : ENDIF
2125 : #endif
2126 : #endif
2127 : #endif
2128 : #endif
2129 :
2130 : !-----------------------------------------------------------------------
2131 : ! Initialize error object if needed.
2132 : ! Extract values to initialize error module and set some further
2133 : ! HEMCO variables. Only the first time the settings are read (settings
2134 : ! can be read multiple times if nested HEMCO configuration files are
2135 : ! used)
2136 : !-----------------------------------------------------------------------
2137 0 : IF ( .NOT. ASSOCIATED(HcoConfig%Err) ) THEN
2138 :
2139 : ! Verbose mode?
2140 : CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', &
2141 0 : OptValInt=verb, FOUND=FOUND, RC=RC )
2142 0 : IF ( RC /= HCO_SUCCESS ) THEN
2143 0 : msg = 'Error looking for "Verbose" HEMCO_Config.rc!'
2144 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2145 0 : RETURN
2146 : ENDIF
2147 0 : IF ( .NOT. FOUND ) THEN
2148 0 : verb = 3
2149 0 : WRITE(*,*) 'Setting `Verbose` not found in HEMCO logfile - use 3'
2150 : ENDIF
2151 :
2152 : ! Logfile to write into
2153 : CALL GetExtOpt( HcoConfig, CoreNr, 'Logfile', &
2154 0 : OptValChar=Logfile, FOUND=FOUND, RC=RC )
2155 0 : IF ( RC /= HCO_SUCCESS ) THEN
2156 0 : msg = 'Error looking for "Logfile" in HEMCO_Config.rc!'
2157 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2158 0 : RETURN
2159 : ENDIF
2160 0 : IF ( .NOT. FOUND ) THEN
2161 0 : LogFile = 'HEMCO.log'
2162 0 : WRITE(*,*) 'Setting `Logfile` not found in HEMCO logfile - use `HEMCO.log`'
2163 : ENDIF
2164 :
2165 : ! Prompt warnings to logfile?
2166 : CALL GetExtOpt( HcoConfig, CoreNr, 'Warnings', &
2167 0 : OptValInt=warn, FOUND=FOUND, RC=RC )
2168 0 : IF ( RC /= HCO_SUCCESS ) THEN
2169 0 : msg = 'Error looking for "Warnings" in HEMCO_Config.rc!'
2170 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2171 0 : RETURN
2172 : ENDIF
2173 0 : IF ( .NOT. FOUND ) THEN
2174 0 : warn = 3
2175 0 : WRITE(*,*) 'Setting `Warnings` not found in HEMCO logfile - use 3'
2176 : ENDIF
2177 :
2178 : ! Initialize (standard) HEMCO tokens
2179 0 : CALL HCO_SetDefaultToken( HcoConfig, RC )
2180 0 : IF ( RC /= HCO_SUCCESS ) THEN
2181 0 : msg = 'Error encountered in routine "HCO_SetDefaultToken"!'
2182 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2183 0 : RETURN
2184 : ENDIF
2185 :
2186 : ! If LogFile is equal to wildcard character, set LogFile to asterik
2187 : ! character. This will ensure that all output is written to standard
2188 : ! output!
2189 0 : IF ( TRIM(LogFile) == HCO_GetOpt(HcoConfig%ExtList,'Wildcard') ) &
2190 0 : LogFile = '*'
2191 :
2192 : ! We should now have everything to define the HEMCO error settings
2193 : CALL HCO_ERROR_SET( HcoConfig%amIRoot, HcoConfig%Err, LogFile, &
2194 0 : verb, warn, RC )
2195 0 : IF ( RC /= HCO_SUCCESS ) THEN
2196 0 : msg = 'Error encountered in routine "Hco_Error_Set"!'
2197 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2198 0 : RETURN
2199 : ENDIF
2200 :
2201 : ENDIF
2202 :
2203 : ! Leave w/ success
2204 0 : RC = HCO_SUCCESS
2205 :
2206 : END SUBROUTINE ReadSettings
2207 : !EOC
2208 : !------------------------------------------------------------------------------
2209 : ! Harmonized Emissions Component (HEMCO) !
2210 : !------------------------------------------------------------------------------
2211 : !BOP
2212 : !
2213 : ! !IROUTINE: RegisterPrepare
2214 : !
2215 : ! !DESCRIPTION: Subroutine RegisterPrepare extracts the spatial
2216 : ! coverages of all mask fields as well as the HEMCO species IDs of
2217 : ! all base emissions.
2218 : !\\
2219 : !\\
2220 : ! The species IDs are determined by matching the species name read
2221 : ! from the configuration file (in ConfigList) and the species names
2222 : ! defined in the HEMCO state object HcoState.
2223 : !\\
2224 : !\\
2225 : ! Mask coverages are defined based upon the passed horizontal grid
2226 : ! extensions on this CPU (xrng and yrng).
2227 : !\\
2228 : !\\
2229 : ! !INTERFACE:
2230 : !
2231 0 : SUBROUTINE RegisterPrepare( HcoState, RC )
2232 : !
2233 : ! !USES:
2234 : !
2235 : USE HCO_EXTLIST_MOD, ONLY : ExtNrInUse
2236 : USE HCO_STATE_Mod, ONLY : HCO_GetHcoID
2237 : USE HCO_DATACONT_MOD, ONLY : ListCont_NextCont
2238 : !
2239 : ! !INPUT PARAMETERS:
2240 : !
2241 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj.
2242 : !
2243 : ! !OUTPUT PARAMETERS:
2244 : !
2245 : INTEGER, INTENT(INOUT) :: RC
2246 : !
2247 : ! !REVISION HISTORY:
2248 : ! 18 Sep 2013 - C. Keller - Initial version (update)
2249 : ! See https://github.com/geoschem/hemco for complete history
2250 : !EOP
2251 : !------------------------------------------------------------------------------
2252 : !BOC
2253 : !
2254 : ! !LOCAL VARIABLES:
2255 : !
2256 : TYPE(ListCont), POINTER :: Lct
2257 : INTEGER :: ThisCover, ThisHcoID, FLAG
2258 : INTEGER :: lon1, lon2, lat1, lat2
2259 : INTEGER :: cpux1, cpux2, cpuy1, cpuy2
2260 : CHARACTER(LEN=255) :: loc
2261 : CHARACTER(LEN=512) :: msg
2262 :
2263 : !=================================================================
2264 : ! RegisterPrepare begins here!
2265 : !=================================================================
2266 0 : loc = 'RegisterPrepare (HCO_CONFIG_MOD.F90)'
2267 :
2268 : ! Enter
2269 0 : CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
2270 0 : IF ( RC /= HCO_SUCCESS ) THEN
2271 0 : msg = 'Error encountered in routine "HCO_Enter"!'
2272 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2273 0 : RETURN
2274 : ENDIF
2275 :
2276 : ! Initialize
2277 0 : Lct => NULL()
2278 :
2279 : ! Grid boundaries on this CPU. Will be needed to calculate
2280 : ! coverages.
2281 : ! NOTE: Use midpoints here because only those become defined in
2282 : ! the ESMF environment (xedge and yedge are not used anywhere
2283 : ! else in ESMF!).
2284 0 : cpux1 = FLOOR(MINVAL(HcoState%Grid%XMID%Val))
2285 0 : cpux2 = FLOOR(MAXVAL(HcoState%Grid%XMID%Val))
2286 0 : cpuy1 = CEILING(MINVAL(HcoState%Grid%YMID%Val))
2287 0 : cpuy2 = CEILING(MAXVAL(HcoState%Grid%YMID%Val))
2288 :
2289 : ! Make sure values are within -180.0 to 180.0
2290 0 : IF ( cpux1 >= 180 ) cpux1 = cpux1 - 360
2291 0 : IF ( cpux2 >= 180 ) cpux2 = cpux2 - 360
2292 :
2293 : ! verbose
2294 0 : IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN
2295 0 : WRITE(MSG,*) 'Start to prepare fields for registering!'
2296 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2297 0 : WRITE(MSG,*) 'This CPU x-range: ', cpux1, cpux2
2298 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2299 0 : WRITE(MSG,*) 'This CPU y-range: ', cpuy1, cpuy2
2300 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2301 : ENDIF
2302 :
2303 : ! Get next (first) line of ConfigList
2304 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2305 :
2306 : ! Loop over all lines
2307 0 : DO WHILE ( FLAG == HCO_SUCCESS )
2308 :
2309 : ! Check if data container defined
2310 0 : IF ( .NOT. ASSOCIATED(Lct%Dct) ) THEN
2311 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2312 0 : CYCLE
2313 : ENDIF
2314 :
2315 : ! verbose
2316 0 : IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN
2317 0 : WRITE(MSG,*) 'Prepare ', TRIM(Lct%Dct%cName)
2318 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2319 : ENDIF
2320 :
2321 : ! For base fields or data fields used in one of the HEMCO
2322 : ! extensions:
2323 0 : IF ( Lct%Dct%DctType == HCO_DCTTYPE_BASE ) THEN
2324 :
2325 : ! Only do for entries that will be used!
2326 0 : IF ( ExtNrInUse( HcoState%Config%ExtList, Lct%Dct%ExtNr ) ) THEN
2327 :
2328 : ! Extract HEMCO species ID. This will return -1 for
2329 : ! undefined species and 0 for wildcard character.
2330 0 : ThisHcoID = HCO_GetHcoID( Lct%Dct%SpcName, HcoState )
2331 0 : Lct%Dct%HcoID = ThisHcoID
2332 :
2333 : ! verbose
2334 0 : IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN
2335 0 : WRITE(MSG,*) 'Assigned HEMCO species ID: ', Lct%Dct%HcoID
2336 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2337 : ENDIF
2338 :
2339 : ! Else: assign default value. These containers will be
2340 : ! removed in the next step!
2341 : ELSE
2342 0 : Lct%Dct%HcoID = -999
2343 : ENDIF
2344 :
2345 : ! Calculate coverage for masks
2346 0 : ELSE IF ( Lct%Dct%DctType == HCO_DCTTYPE_MASK .AND. &
2347 : Lct%Dct%Dta%Cover == -999 ) THEN
2348 :
2349 : ! The mask coverage calculation (which only has three values)
2350 : ! is used to simplify I/O and CPU operations in code below.
2351 : !
2352 : ! However, there are two distinct bugs related to this:
2353 : !
2354 : ! (1)
2355 : ! There appear to be some issues with full masks coverages
2356 : ! when working in an MPI environment. Specifically, masks
2357 : ! can be seen as fully covering a given CPU even though in
2358 : ! reality it may only cover parts of it. Thus, in ESMF mode
2359 : ! always set coverage to zero or partial (ckeller, 3/17/16).
2360 : !
2361 : ! This appears to be related to masking for two inventories
2362 : ! with overlapping temporal coverage. For example, if inventory
2363 : ! A is 2013-2015, and B is 2010-2018 with higher hierarchy,
2364 : ! but not the same mask (maybe A covers regions that B does not).
2365 : ! If both masks are set to ThisCover == 1 (full coverage), because
2366 : ! a certain CPU might be overlapped by lon1/lat1/lon2/lat2 even
2367 : ! though the actual netCDF shape of the mask is different,
2368 : ! then a simulation running 2013-2015 will see inventory B on that CPU
2369 : ! decide it has full coverage (only through lon1/..), and skip
2370 : ! inventory A altogether, resulting in missing emissions.
2371 : ! This behavior is in the line
2372 : ! IF ( (tmpLct%Dct%Hier > Hier) .AND. (tmpCov==1) ) THEN below.
2373 : !
2374 : ! (2)
2375 : ! Another artifact caused by MPI environments:
2376 : ! where lon1/lat1/... is set too small, resulting in certain CPUs not
2377 : ! having overlap (defined by cpux/y) with lon1/lat1/..., and thus
2378 : ! skipping the base inventory as a bug. This behavior is in the line
2379 : ! IF ( (mskLct%Dct%DctType == HCO_DCTTYPE_MASK ) .AND. &
2380 : ! (mskLct%Dct%Dta%Cover == 0 ) ) THEN
2381 : !
2382 : ! Because the code only distinguishes between full/partial and zero
2383 : ! coverage, and skips reading the base field if coverage is zero,
2384 : ! this may cause issues with MPI environments in WRF and CESM where
2385 : ! the mask lon1/lat1/lon2/lat2 boundaries are set too small compared
2386 : ! to the mask, and result in the base field being skipped over small
2387 : ! CPU decompositions where it should not have been. The above fix
2388 : ! does not fix the issue where ThisCover == 0, which is the root
2389 : ! cause in WRF and CESM. Thus, always set to partial coverage
2390 : ! (hplin, 8/19/22)
2391 : !
2392 : ! Thus, the following fix needs to be applied for ESMF environments,
2393 : ! skipping a lot of the calculations below.
2394 : #if defined ( ESMF_ ) || defined( MODEL_WRF ) || defined( MODEL_CESM )
2395 0 : ThisCover = -1
2396 : #else
2397 : ! Get mask edges
2398 : lon1 = Lct%Dct%Dta%ncYrs(1)
2399 : lat1 = Lct%Dct%Dta%ncYrs(2)
2400 : lon2 = Lct%Dct%Dta%ncMts(1)
2401 : lat2 = Lct%Dct%Dta%ncMts(2)
2402 :
2403 : ThisCover = CALC_COVERAGE( lon1, lon2, &
2404 : lat1, lat2, &
2405 : cpux1, cpux2, &
2406 : cpuy1, cpuy2 )
2407 : #endif
2408 :
2409 : ! Update container information
2410 0 : Lct%Dct%Dta%Cover = ThisCover
2411 0 : Lct%Dct%Dta%ncYrs(:) = -999
2412 0 : Lct%Dct%Dta%ncMts(:) = -999
2413 :
2414 0 : IF ( HCO_IsVerb(HcoSTate%Config%Err,3) ) THEN
2415 0 : WRITE(MSG,*) 'Coverage: ', Lct%Dct%Dta%Cover
2416 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2417 : ENDIF
2418 : ENDIF
2419 :
2420 : ! Advance to next line
2421 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2422 : ENDDO
2423 :
2424 : ! Cleanup
2425 0 : Lct => NULL()
2426 :
2427 : ! Return w/ success
2428 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
2429 :
2430 : END SUBROUTINE RegisterPrepare
2431 : !EOC
2432 : !------------------------------------------------------------------------------
2433 : ! Harmonized Emissions Component (HEMCO) !
2434 : !------------------------------------------------------------------------------
2435 : !BOP
2436 : !
2437 : ! !IROUTINE: Register_Base
2438 : !
2439 : ! !DESCRIPTION: Subroutine Register\_Base registers all base emission
2440 : ! data and writes out all associated scale factor IDs.
2441 : !\\
2442 : !\\
2443 : ! !INTERFACE:
2444 : !
2445 0 : SUBROUTINE Register_Base( HcoState, RC )
2446 : !
2447 : ! !USES:
2448 : !
2449 : USE HCO_READLIST_Mod, ONLY : ReadList_Set
2450 : USE HCO_DATACONT_Mod, ONLY : DataCont_Cleanup
2451 : USE HCO_DATACONT_MOD, ONLY : ListCont_NextCont
2452 : !
2453 : ! !INPUT/OUTPUT PARAMETERS:
2454 : !
2455 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
2456 : !
2457 : ! !INPUT/OUTPUT PARAMETERS:
2458 : !
2459 : INTEGER, INTENT(INOUT) :: RC ! Success or failure
2460 : !
2461 : ! !REVISION HISTORY:
2462 : ! 18 Jun 2013 - C. Keller: Initialization
2463 : ! See https://github.com/geoschem/hemco for complete history
2464 : !EOP
2465 : !------------------------------------------------------------------------------
2466 : !BOC
2467 : !
2468 : ! !LOCAL VARIABLES:
2469 : !
2470 : ! Pointers
2471 : TYPE(ListCont), POINTER :: Lct
2472 :
2473 : ! Scalars
2474 : INTEGER :: N, cID, HcoID
2475 : INTEGER :: targetID, FLAG
2476 : LOGICAL :: Ignore, Add
2477 : CHARACTER(LEN=255) :: LOC
2478 : CHARACTER(LEN=512) :: msg
2479 :
2480 : !======================================================================
2481 : ! Register_Base begins here
2482 : !======================================================================
2483 0 : loc = 'Register_Base (HCO_CONFIG_MOD.F90)'
2484 :
2485 : ! Enter
2486 0 : CALL HCO_ENTER ( HcoState%Config%Err, loc, RC )
2487 0 : IF ( RC /= HCO_SUCCESS ) THEN
2488 0 : msg = 'Error encountered in routine "HCO_Enter"!'
2489 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2490 0 : RETURN
2491 : ENDIF
2492 :
2493 : ! Initialize
2494 0 : Lct => NULL()
2495 :
2496 : ! Point to next (first) line in ConfigList
2497 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2498 :
2499 : ! Loop over temporary arrays
2500 0 : DO WHILE ( FLAG == HCO_SUCCESS )
2501 :
2502 : ! Reset ignore flag
2503 0 : Ignore = .FALSE.
2504 :
2505 : ! Skip entry if data container not defined
2506 0 : IF ( .NOT. ASSOCIATED(Lct%Dct) ) THEN
2507 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2508 0 : CYCLE
2509 : ENDIF
2510 :
2511 : ! Skip entry if it's not a base field
2512 0 : IF ( (Lct%Dct%DctType /= HCO_DCTTYPE_BASE) ) THEN
2513 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2514 0 : CYCLE
2515 : ENDIF
2516 :
2517 : ! If this base field is not used (either because it belongs to
2518 : ! an extension that is not enabled or because its HEMCO or
2519 : ! model species ID is undefined), we don't need this container
2520 : ! any more. Hence remove it.
2521 : ! Note: Routine RegisterPrepare assigns negative HcoID's to all
2522 : ! base fields with invalid ExtNr's, so it is ok to check only
2523 : ! for HcoID here. If data is used in one of the HEMCO extensions
2524 : ! and has a species flag of '*' (= always read), its species ID
2525 : ! becomes set to 0 in RegisterPrepare.
2526 0 : HcoID = Lct%Dct%HcoID
2527 0 : IF ( HcoID < 0 ) THEN
2528 : Ignore = .TRUE.
2529 0 : ELSE IF ( HcoID > 0 ) THEN
2530 0 : IF ( HcoState%Spc(HcoID)%ModID < 0 ) Ignore = .TRUE.
2531 : ENDIF
2532 :
2533 : IF ( Ignore ) THEN
2534 0 : IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN
2535 : WRITE(MSG,*) &
2536 0 : 'Register_Base: Ignore (and remove) base field ', &
2537 0 : TRIM(Lct%Dct%cName)
2538 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='-')
2539 : ENDIF
2540 :
2541 : ! Remove data container from list.
2542 0 : CALL DataCont_Cleanup ( Lct%Dct )
2543 0 : Lct%Dct => NULL()
2544 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2545 0 : CYCLE
2546 : ENDIF
2547 :
2548 : ! Verbose mode
2549 0 : IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN
2550 0 : WRITE(MSG,*) 'Register_Base: Checking ', TRIM(Lct%Dct%cName)
2551 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='-')
2552 : ENDIF
2553 :
2554 : ! -------------------------------------------------------------
2555 : ! Extract vector of scale factor container IDs to be applied
2556 : ! to this base field (vector Scal_cID). For now, this container
2557 : ! contains the scale factor IDs, hence need to convert to
2558 : ! container IDs. Beforehand, add scale factor IDs to internal
2559 : ! list of used scale factors (UnqScalIDs).
2560 0 : CALL ScalID_Register ( Lct%Dct, HcoState%Config, RC )
2561 0 : IF ( RC /= HCO_SUCCESS ) THEN
2562 0 : PRINT *,'Error in ScaleID_Register called from Register_Base'
2563 0 : RETURN
2564 : ENDIF
2565 :
2566 : ! Get target ID of this container. The targetID corresponds
2567 : ! to the container ID cID into which emissions data of the
2568 : ! current container (Lct) will be added to. Typically,
2569 : ! targetID is equal to cID, i.e. a container holds the data
2570 : ! array corresponding to its source data information. In
2571 : ! cases where multiple base emissions have same properties,
2572 : ! however, we can merge these fields prior to emission
2573 : ! calculation to save some calculation operations.
2574 : ! Requirement is that these base emissions have same species
2575 : ! ID, emission category and hierarchy, ext. number, scale
2576 : ! factors, and update frequency.
2577 0 : CALL Get_targetID( HcoState, Lct, targetID, RC)
2578 0 : IF ( RC /= HCO_SUCCESS ) THEN
2579 0 : PRINT *,'Error in Get_targetID called from Register_Base'
2580 0 : RETURN
2581 : ENDIF
2582 :
2583 : ! verbose
2584 0 : IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN
2585 0 : WRITE(MSG,*) 'Container ID : ', Lct%Dct%cID
2586 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2587 0 : WRITE(MSG,*) 'Assigned targetID: ', targetID
2588 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2589 : ENDIF
2590 :
2591 : ! Negative targetID is assigned to base data that doesn't need
2592 : ! to be considered either because it's a regional inventory
2593 : ! with no spatial overlap with the region domain on this CPU,
2594 : ! or because there exist another inventory with higher
2595 : ! priority (and same category) that will overwrite these
2596 : ! emissions data anyway!
2597 0 : IF ( targetID <= 0 ) THEN
2598 0 : CALL DataCont_Cleanup ( Lct%Dct )
2599 0 : Lct%Dct => NULL()
2600 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2601 0 : CYCLE
2602 : ENDIF
2603 :
2604 : ! Pass targetID to container
2605 0 : Lct%Dct%targetID = targetID
2606 :
2607 : ! Register container in ReadList. Containers will be listed
2608 : ! in the reading lists sorted by cID.
2609 0 : CALL ReadList_Set( HcoState, Lct%Dct, RC )
2610 0 : IF ( RC /= HCO_SUCCESS ) THEN
2611 0 : msg = 'Error encountered in routine "ReadList_Set"!'
2612 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2613 0 : RETURN
2614 : ENDIF
2615 :
2616 : ! Print some information if verbose mode is on
2617 0 : IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN
2618 0 : WRITE(MSG,*) 'Base field registered: ', TRIM(Lct%Dct%cName)
2619 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2620 : ENDIF
2621 :
2622 : ! Advance to next line
2623 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2624 : ENDDO
2625 :
2626 : ! Cleanup
2627 0 : Lct => NULL()
2628 :
2629 : ! Return w/ success
2630 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
2631 :
2632 : END SUBROUTINE Register_Base
2633 : !EOC
2634 : !------------------------------------------------------------------------------
2635 : ! Harmonized Emissions Component (HEMCO) !
2636 : !------------------------------------------------------------------------------
2637 : !BOP
2638 : !
2639 : ! !IROUTINE: Register_Scal
2640 : !
2641 : ! !DESCRIPTION: Subroutine Register\_Scal registers all scale factors.
2642 : !\\
2643 : !\\
2644 : ! !INTERFACE:
2645 : !
2646 0 : SUBROUTINE Register_Scal( HcoState, RC )
2647 : !
2648 : ! !USES:
2649 : !
2650 : USE HCO_ReadList_Mod, ONLY : ReadList_Set
2651 : USE HCO_DATACONT_MOD, ONLY : ListCont_NextCont
2652 :
2653 : !
2654 : ! !INPUT PARAMETERS:
2655 : !
2656 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
2657 : !
2658 : ! !INPUT/OUTPUT PARAMETERS:
2659 : !
2660 : INTEGER, INTENT(INOUT) :: RC ! Success or failure
2661 : !
2662 : ! !REVISION HISTORY:
2663 : ! 18 Jun 2013 - C. Keller - Initialization
2664 : ! See https://github.com/geoschem/hemco for complete history
2665 : !EOP
2666 : !------------------------------------------------------------------------------
2667 : !BOC
2668 : !
2669 : ! !LOCAL VARIABLES:
2670 : !
2671 : ! Pointers
2672 : TYPE(ListCont), POINTER :: Lct
2673 : TYPE(ScalIDCont), POINTER :: TmpScalIDCont
2674 :
2675 : ! Scalars
2676 : INTEGER :: cID, FLAG
2677 : CHARACTER(LEN=255) :: LOC
2678 : CHARACTER(LEN=512) :: msg
2679 : CHARACTER(LEN= 5) :: strID
2680 : INTEGER :: ThisScalID
2681 :
2682 : !======================================================================
2683 : ! Register_Scal begins here
2684 : !======================================================================
2685 0 : loc = 'Register_Scal (HCO_CONFIG_MOD.F90)'
2686 :
2687 : ! Enter
2688 0 : CALL HCO_ENTER ( HcoState%Config%Err, loc, RC )
2689 0 : IF ( RC /= HCO_SUCCESS ) THEN
2690 0 : msg = 'Error encountered in routine "HCO_Enter"!'
2691 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2692 0 : RETURN
2693 : ENDIF
2694 :
2695 : ! Loop over all scale factor ids
2696 0 : Lct => NULL()
2697 0 : TmpScalIDCont => HcoState%Config%ScalIDList
2698 0 : DO WHILE ( ASSOCIATED( TmpScalIDCont ) )
2699 :
2700 : ! Extract this scale factor ID
2701 0 : ThisScalID = TmpScalIDCont%ScalID
2702 :
2703 : ! Make ThisLine point to first element of ConfigList
2704 0 : Lct => NULL()
2705 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2706 :
2707 : ! Loop over all lines in input file and find the one with the
2708 : ! correct scale factor ID
2709 0 : DO WHILE ( FLAG == HCO_SUCCESS )
2710 :
2711 : ! Leave if this is the wanted container.
2712 0 : IF ( ASSOCIATED(Lct%Dct)) THEN
2713 0 : IF ( Lct%Dct%ScalID == ThisScalID ) EXIT
2714 : ENDIF
2715 :
2716 : ! Advance to next line otherwise
2717 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2718 : ENDDO
2719 :
2720 : ! Return error if scale factor ID not found
2721 0 : IF ( .NOT. ASSOCIATED(Lct) ) THEN
2722 0 : WRITE ( strID, * ) ThisScalID
2723 0 : msg = 'Container ID not found: ' // strID
2724 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2725 0 : RETURN
2726 : ENDIF
2727 :
2728 : ! Return w/ error if container not scale factor or mask
2729 0 : IF ( Lct%Dct%DctType == HCO_DCTTYPE_BASE ) THEN
2730 0 : WRITE ( strID, * ) ThisScalID
2731 0 : MSG = 'Container ID belongs to base field: ' // strID
2732 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2733 0 : RETURN
2734 : ENDIF
2735 :
2736 : ! Check if this scale factor has a mask field assigned to
2737 : ! it, in which case we have to make sure that the mask field
2738 : ! becomes registered in the scale factor list ScalIDList.
2739 : ! We can do this while evaluating ScalIDList due to the dynamic
2740 : ! structure of the linked list with new containers simply being
2741 : ! added to the end of the list.
2742 0 : IF ( Lct%Dct%nScalID > 0 ) THEN
2743 0 : CALL ScalID_Register ( Lct%Dct, HcoState%Config, RC )
2744 0 : IF ( RC /= HCO_SUCCESS ) THEN
2745 0 : msg = 'Error encountered in routine "ScalID_Register"!'
2746 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2747 0 : RETURN
2748 : ENDIF
2749 : ENDIF
2750 :
2751 : ! Register container in ReadList. Containers will be listed
2752 : ! in the reading lists sorted by cID.
2753 0 : CALL ReadList_Set( HcoState, Lct%Dct, RC )
2754 0 : IF ( RC /= HCO_SUCCESS ) THEN
2755 0 : msg = 'Error encountered in "ReadList_Set"!'
2756 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2757 0 : RETURN
2758 : ENDIF
2759 :
2760 : ! Print some information if verbose mode is on
2761 0 : IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN
2762 0 : WRITE(MSG,*) 'Scale field registered: ', TRIM(Lct%Dct%cName)
2763 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2764 : ENDIF
2765 :
2766 : ! Advance
2767 0 : TmpScalIDCont => TmpScalIDCont%NEXT
2768 :
2769 : ENDDO
2770 :
2771 : ! Cleanup
2772 0 : Lct => NULL()
2773 0 : TmpScalIDCont => NULL()
2774 :
2775 : ! Return w/ success
2776 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
2777 :
2778 : END SUBROUTINE Register_Scal
2779 : !EOC
2780 : !------------------------------------------------------------------------------
2781 : ! Harmonized Emissions Component (HEMCO) !
2782 : !------------------------------------------------------------------------------
2783 : !BOP
2784 : !
2785 : ! !IROUTINE: Get_targetID
2786 : !
2787 : ! !DESCRIPTION: Subroutine Get\_targetID returns the target ID of a
2788 : ! container. The target ID can point to the container ID (cID) of
2789 : ! another base field if multiple emissions shall be added together
2790 : ! prior to emission calculation, e.g. sectoral emissions data with
2791 : ! same species ID, category, hierarchy, extension number, scale factors,
2792 : ! etc.
2793 : !\\
2794 : !\\
2795 : ! Target ID is set to -999 if there exists another inventory over
2796 : ! the full spatial region covered by this CPU for this species but
2797 : ! with higher hierarchy. In this case, we can ignore the current
2798 : ! container from here onwards!
2799 : !\\
2800 : !\\
2801 : ! !INTERFACE:
2802 : !
2803 0 : SUBROUTINE Get_targetID( HcoState, Lct, targetID, RC )
2804 : !
2805 : ! !USES:
2806 : !
2807 : USE HCO_DataCont_Mod, ONLY : ListCont_Find
2808 : USE HCO_DataCont_Mod, ONLY : ListCont_NextCont
2809 : !
2810 : ! !INPUT PARAMETERS:
2811 : !
2812 : TYPE(HCO_State), POINTER :: HcoState
2813 : TYPE(ListCont), POINTER :: Lct
2814 : !
2815 : ! !OUTPUT PARAMETERS:
2816 : !
2817 : INTEGER, INTENT( OUT) :: targetID
2818 : !
2819 : ! !INPUT/OUTPUT PARAMETERS:
2820 : !
2821 : INTEGER, INTENT(INOUT) :: RC
2822 : !
2823 : ! !NOTE: If data from multiple containers are added, the target ID
2824 : ! is always set to the lowest cID of all involved containers, i.e.
2825 : ! data are added to the container with the lowest cID. This makes
2826 : ! sure that data is not accidentally overwritten, e.g. when updating
2827 : ! container contents!
2828 : !
2829 : ! !REVISION HISTORY:
2830 : ! 11 Apr 2013 - C. Keller - Initialization
2831 : ! See https://github.com/geoschem/hemco for complete history
2832 : !EOP
2833 : !------------------------------------------------------------------------------
2834 : !BOC
2835 : !
2836 : ! !LOCAL VARIABLES:
2837 : !
2838 : ! Pointers
2839 : TYPE(ListCont), POINTER :: tmpLct
2840 : TYPE(ListCont), POINTER :: mskLct
2841 :
2842 : ! Scalars
2843 : INTEGER :: HcoID, Cat, Hier, Scal, ExtNr, cID
2844 : INTEGER :: tmpID
2845 : INTEGER :: I, J, FLAG1, tmpCov
2846 : LOGICAL :: found, sameCont
2847 : CHARACTER(LEN=255) :: loc
2848 : CHARACTER(LEN=512) :: msg
2849 : CHARACTER(LEN= 7) :: strID
2850 :
2851 : !======================================================================
2852 : ! Get_targetID begins here
2853 : !======================================================================
2854 0 : loc = 'Get_targetID (HCO_CONFIG_MOD.F90)'
2855 :
2856 : ! Enter
2857 0 : CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
2858 0 : IF ( RC /= HCO_SUCCESS ) THEN
2859 0 : msg = 'Error encountered in routine "HCO_Enter"!'
2860 0 : CALL HCO_ERROR( msg, RC, thisLoc=LOC )
2861 0 : RETURN
2862 : ENDIF
2863 :
2864 : ! Initialize
2865 0 : tmpLct => NULL()
2866 0 : mskLct => NULL()
2867 :
2868 : ! Get Tracer ID, category and hierarchy of entry to be checked
2869 0 : cID = Lct%Dct%cID
2870 0 : ExtNr = Lct%Dct%ExtNr
2871 0 : Cat = Lct%Dct%Cat
2872 0 : Hier = Lct%Dct%Hier
2873 0 : HcoID = Lct%Dct%HcoID
2874 :
2875 : ! By default, set target ID to container ID
2876 0 : targetID = cID
2877 :
2878 : ! If ExtNr is -999, always read this field. ExtNr becomes zero
2879 : ! if the extension number entry in the configuration file is the
2880 : ! wildcard character
2881 0 : IF ( ExtNr == -999 ) THEN
2882 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
2883 0 : RETURN
2884 : ENDIF
2885 :
2886 : ! If species ID is zero, always read this field as is, i.e. don't
2887 : ! skip it and don't add it to another field!
2888 : ! Species ID become zero if the species ID entry in the
2889 : ! configuration file is the wildcard character.
2890 0 : IF ( HcoID == 0 ) THEN
2891 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
2892 0 : RETURN
2893 : ENDIF
2894 :
2895 : ! Check all scale factors of the current container to see if one
2896 : ! of them is a mask that has no valid entries over the domain of
2897 : ! this CPU. In this case we don't have to consider this field at
2898 : ! all!
2899 0 : IF ( Lct%Dct%nScalID > 0 ) THEN
2900 0 : DO I = 1, Lct%Dct%nScalID
2901 :
2902 : ! Check if it's a valid scale factor
2903 0 : IF ( Lct%Dct%Scal_cID(I) < 0 ) CYCLE
2904 :
2905 : ! Find container with this container ID
2906 : ! Note: this should always look up the container ID, but make
2907 : ! check for safety's sake.
2908 0 : tmpID = Lct%Dct%Scal_cID(I)
2909 0 : IF ( .NOT. Lct%Dct%Scal_cID_set ) THEN
2910 : CALL ListCont_Find ( HcoState%Config%ConfigList, &
2911 0 : tmpID, 1, FOUND, mskLct )
2912 : ELSE
2913 : CALL ListCont_Find ( HcoState%Config%ConfigList, &
2914 0 : tmpID, 0, FOUND, mskLct )
2915 : ENDIF
2916 :
2917 : ! Error if scale factor not found
2918 0 : IF ( .NOT. FOUND ) THEN
2919 0 : WRITE ( strID, * ) Lct%Dct%Scal_cID(I)
2920 0 : msg = 'No scale factor with cID: ' // TRIM(strID)
2921 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2922 0 : RETURN
2923 : ENDIF
2924 :
2925 : ! Check if this is a mask with zero coverage over this CPU, in
2926 : ! which case we don't need to consider the base field at all!
2927 0 : IF ( (mskLct%Dct%DctType == HCO_DCTTYPE_MASK ) .AND. &
2928 0 : (mskLct%Dct%Dta%Cover == 0 ) ) THEN
2929 0 : targetID = -999
2930 0 : IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN
2931 : WRITE(MSG,*) 'Data not defined over this CPU, skip ' // &
2932 0 : TRIM(Lct%Dct%cName)
2933 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2934 : ENDIF
2935 :
2936 : ! Return
2937 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
2938 0 : RETURN
2939 : ENDIF
2940 : ENDDO ! I
2941 : ENDIF
2942 :
2943 : ! Now find out if there is another base field for the same species,
2944 : ! emission category and extension number, but higher hierarchy.
2945 : ! Such a field also needs to have full coverage over this CPU,
2946 : ! then we can ignore the current container.
2947 :
2948 : ! Initialize looping pointer
2949 0 : tmpLct => NULL()
2950 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
2951 :
2952 : ! Loop over containers
2953 0 : DO WHILE ( FLAG1 == HCO_SUCCESS )
2954 :
2955 : ! Advance to next container if data container not defined
2956 0 : IF ( .NOT. ASSOCIATED(tmpLct%Dct) ) THEN
2957 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
2958 0 : CYCLE
2959 : ENDIF
2960 :
2961 : ! Advance to next container if this is the current container
2962 0 : IF ( tmpLct%Dct%cID == cID ) THEN
2963 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
2964 0 : CYCLE
2965 : ENDIF
2966 :
2967 : ! Advance to next container if this is not a base field
2968 0 : IF ( tmpLct%Dct%DctType /= HCO_DCTTYPE_BASE ) THEN
2969 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
2970 0 : CYCLE
2971 : ENDIF
2972 :
2973 : ! Advance to next container if not the same extension nr
2974 0 : IF ( tmpLct%Dct%ExtNr /= ExtNr ) THEN
2975 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
2976 0 : CYCLE
2977 : ENDIF
2978 :
2979 : ! Advance to next container if not the same species
2980 0 : IF ( tmpLct%Dct%HcoID /= HcoID ) THEN
2981 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
2982 0 : CYCLE
2983 : ENDIF
2984 :
2985 : ! Advance to next container if not the same category
2986 0 : IF ( tmpLct%Dct%Cat /= Cat ) THEN
2987 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
2988 0 : CYCLE
2989 : ENDIF
2990 :
2991 : ! Advance to next container if lower hierarchy
2992 0 : IF ( tmpLct%Dct%Hier < Hier ) THEN
2993 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
2994 0 : CYCLE
2995 : ENDIF
2996 :
2997 : ! Advance to next container if this container has limited time
2998 : ! coverage. Emissions with limited time coverage may not be used
2999 : ! during all of the simulation time, so it's important to keep the
3000 : ! lower hierarchy emission fields in memory in case that those need
3001 : ! to be used instead (e.g. if EDGAR shall only be used between years
3002 : ! 2005 and 2013, we should keep GEIA in case that we are outside of
3003 : ! that time window).
3004 : IF ( ( tmpLct%Dct%Dta%CycleFlag == HCO_CFLAG_RANGE ) .OR. &
3005 0 : ( tmpLct%Dct%Dta%CycleFlag == HCO_CFLAG_EXACT ) .OR. &
3006 : ( tmpLct%Dct%Dta%CycleFlag == HCO_CFLAG_RANGEAVG ) ) THEN
3007 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3008 0 : CYCLE
3009 : ENDIF
3010 :
3011 : ! Check for coverage of tmpLct. Default = full coverage (1)
3012 0 : tmpCov = 1
3013 :
3014 : ! Check all scale factors of tmpLct to see if this base
3015 : ! field has full coverage over this CPU domain or not.
3016 0 : IF ( tmpLct%Dct%nScalID > 0 ) THEN
3017 0 : DO I = 1, tmpLct%Dct%nScalID
3018 :
3019 : ! Check if it's a valid scale factor
3020 0 : IF ( tmpLct%Dct%Scal_cID(I) < 0 ) CYCLE
3021 :
3022 0 : tmpID = tmpLct%Dct%Scal_cID(I)
3023 0 : IF ( .NOT. tmpLct%Dct%Scal_cID_set ) THEN
3024 : CALL ListCont_Find ( HcoState%Config%ConfigList, &
3025 0 : tmpID, 1, FOUND, mskLct )
3026 : ELSE
3027 : CALL ListCont_Find ( HcoState%Config%ConfigList, &
3028 0 : tmpID, 0, FOUND, mskLct )
3029 : ENDIF
3030 :
3031 : ! Error if container not found
3032 0 : IF ( .NOT. FOUND ) THEN
3033 0 : WRITE(MSG,*) 'No scale factor with ID: ', tmpID
3034 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
3035 0 : RETURN
3036 : ENDIF
3037 :
3038 : ! Write out coverage.
3039 : ! Note: If one mask has only partial coverage, retain that
3040 : ! value! If we encounter a mask with no coverage, set coverage
3041 : ! to zero and leave immediately.
3042 0 : IF ( (mskLct%Dct%DctType == HCO_DCTTYPE_MASK) ) THEN
3043 0 : IF ( mskLct%Dct%Dta%Cover == -1 ) THEN
3044 : tmpCov = -1
3045 0 : ELSEIF ( mskLct%Dct%Dta%Cover == 0 ) THEN
3046 : tmpCov = 0
3047 : EXIT
3048 : ENDIF
3049 : ENDIF
3050 : ENDDO ! I
3051 : ENDIF
3052 :
3053 : ! If tmpLct has no coverage, we can ignore this tmpLct as
3054 : ! it will never overwrite data of currCont
3055 0 : IF ( tmpCov == 0 ) THEN
3056 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3057 0 : CYCLE
3058 : ENDIF
3059 :
3060 : ! If we made it up to here and tmpLct has full coverage, then
3061 : ! tmpLct has the same species ID, category, ext. nr.,
3062 : ! and a higher (or the same) hierarchy as Lct.
3063 :
3064 : ! If hierarchy of tmpLct is higher than Lct and this
3065 : ! container has total coverage over this CPU, it will always
3066 : ! replace all values of Lct. Hence, set targetID to -999
3067 : ! (= ignore container) and return here.
3068 0 : IF ( (tmpLct%Dct%Hier > Hier) .AND. (tmpCov==1) ) THEN
3069 0 : IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN
3070 0 : WRITE(MSG,*) 'Skip container ', TRIM(Lct%Dct%cName), &
3071 0 : ' because of ', TRIM(tmpLct%Dct%cName)
3072 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
3073 : ENDIF
3074 :
3075 : ! Return
3076 0 : targetID = -999
3077 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
3078 0 : RETURN
3079 : ENDIF
3080 :
3081 : ! If currCont and tmpLct have same hierarchy, scale factors,
3082 : ! and update frequencies, we may add the two fields together
3083 : ! in order to make emission calculation more efficient.
3084 : ! Thus, set target ID to the lower of the two container IDs.
3085 : ! This procedure will ensure that emission data are added
3086 : ! when registering/updating containers in the emissions list
3087 : ! (EmisList). Since containers are sorted in ReadList with
3088 : ! increasing cID, pick the lowest cID to make sure that all
3089 : ! fields are properly added.
3090 : ! Note: this option is currently disabled for ESMF applications.
3091 0 : IF ( tmpLct%Dct%Hier == Hier .AND. .NOT. HcoState%Options%isESMF ) THEN
3092 :
3093 : ! temporary flag
3094 0 : sameCont = .TRUE.
3095 :
3096 : ! Check for same scale factors
3097 0 : IF ( tmpLct%Dct%nScalID /= Lct%Dct%nScalID ) THEN
3098 : sameCont = .FALSE.
3099 : ELSE
3100 0 : DO I = 1, tmpLct%Dct%nScalID
3101 0 : IF ( tmpLct%Dct%Scal_cID(I) /= &
3102 0 : Lct%Dct%Scal_cID(I) ) THEN
3103 : sameCont = .FALSE.
3104 : EXIT
3105 : ENDIF
3106 : ENDDO
3107 : ENDIF
3108 :
3109 : ! Check for same update frequencies
3110 0 : IF ( sameCont ) THEN
3111 0 : IF (tmpLct%Dct%Dta%ncYrs(1)/=Lct%Dct%Dta%ncYrs(1)) THEN
3112 : sameCont = .FALSE.
3113 0 : ELSEIF(tmpLct%Dct%Dta%ncYrs(2)/=Lct%Dct%Dta%ncYrs(2)) THEN
3114 : sameCont = .FALSE.
3115 0 : ELSEIF(tmpLct%Dct%Dta%ncMts(1)/=Lct%Dct%Dta%ncMts(1)) THEN
3116 : sameCont = .FALSE.
3117 0 : ELSEIF(tmpLct%Dct%Dta%ncMts(2)/=Lct%Dct%Dta%ncMts(2)) THEN
3118 : sameCont = .FALSE.
3119 0 : ELSEIF(tmpLct%Dct%Dta%ncDys(1)/=Lct%Dct%Dta%ncDys(1)) THEN
3120 : sameCont = .FALSE.
3121 0 : ELSEIF(tmpLct%Dct%Dta%ncDys(2)/=Lct%Dct%Dta%ncDys(2)) THEN
3122 : sameCont = .FALSE.
3123 0 : ELSEIF(tmpLct%Dct%Dta%ncHrs(1)/=Lct%Dct%Dta%ncHrs(1)) THEN
3124 : sameCont = .FALSE.
3125 0 : ELSEIF(tmpLct%Dct%Dta%ncHrs(2)/=Lct%Dct%Dta%ncHrs(2)) THEN
3126 : sameCont = .FALSE.
3127 : ENDIF
3128 : ENDIF
3129 :
3130 : ! Check for same emitted level
3131 : IF ( sameCont ) THEN
3132 : IF ( ( tmpLct%Dct%Dta%SpaceDim /= Lct%Dct%Dta%SpaceDim ) .OR. &
3133 : ( tmpLct%Dct%Dta%Levels /= Lct%Dct%Dta%Levels ) .OR. &
3134 0 : ( tmpLct%Dct%Dta%EmisL1 /= Lct%Dct%Dta%EmisL1 ) .OR. &
3135 : ( tmpLct%Dct%Dta%EmisL2 /= Lct%Dct%Dta%EmisL2 ) ) THEN
3136 : sameCont = .FALSE.
3137 : ENDIF
3138 : ENDIF
3139 :
3140 : ! Finally, check for "same" container names. This checks the
3141 : ! container names ignoring the name 'tags'.
3142 : IF ( sameCont ) THEN
3143 0 : sameCont = Check_ContNames( tmpLct, Lct )
3144 : ENDIF
3145 :
3146 : ! If "same" containers, set target ID to container ID of
3147 : ! tmpLct if this value is lower than current target ID.
3148 0 : IF ( sameCont ) THEN
3149 0 : targetID = MIN( targetID, tmpLct%Dct%cID )
3150 : ENDIF
3151 :
3152 : ENDIF
3153 :
3154 : ! Advance to next line
3155 : ! Don't return here, because it is still possible that there is
3156 : ! another inventory in the list coming up which overwrites this
3157 : ! inventory (or another field emissions shall be added to which
3158 : ! has lower container ID and hence needs to be the target
3159 : ! container!).
3160 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3161 :
3162 : ENDDO !Loop over all entries in ConfigList (tmpLct)
3163 :
3164 : ! Free pointers
3165 0 : tmpLct => NULL()
3166 0 : mskLct => NULL()
3167 :
3168 : ! Leave w/ success
3169 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
3170 :
3171 : END SUBROUTINE Get_targetID
3172 : !EOC
3173 : !------------------------------------------------------------------------------
3174 : ! Harmonized Emissions Component (HEMCO) !
3175 : !------------------------------------------------------------------------------
3176 : !BOP
3177 : !
3178 : ! !IROUTINE: Calc_Coverage
3179 : !
3180 : ! !DESCRIPTION: Function Calc\_Coverage calculates the coverage of
3181 : ! the specified lon/lat box with the area covered by the inventory.
3182 : ! Returns 0 if no overlap, 1 if complete overlap, and -1 for partial
3183 : ! overlap.
3184 : !\\
3185 : !\\
3186 : ! !INTERFACE:
3187 : !
3188 : FUNCTION Calc_Coverage( msk_x1, msk_x2, msk_y1, msk_y2, &
3189 : cpu_x1, cpu_x2, cpu_y1, cpu_y2 ) RESULT ( COVERAGE )
3190 : !
3191 : ! !INPUT PARAMETERS:
3192 : !
3193 : INTEGER, INTENT(IN) :: msk_x1
3194 : INTEGER, INTENT(IN) :: msk_x2
3195 : INTEGER, INTENT(IN) :: msk_y1
3196 : INTEGER, INTENT(IN) :: msk_y2
3197 : INTEGER, INTENT(IN) :: cpu_x1
3198 : INTEGER, INTENT(IN) :: cpu_x2
3199 : INTEGER, INTENT(IN) :: cpu_y1
3200 : INTEGER, INTENT(IN) :: cpu_y2
3201 : !
3202 : ! !RETURN VALUE:
3203 : !
3204 : INTEGER :: COVERAGE
3205 : !
3206 : ! !REVISION HISTORY:
3207 : ! 11 Apr 2013 - C. Keller: Initialization
3208 : ! See https://github.com/geoschem/hemco for complete history
3209 : !EOP
3210 : !------------------------------------------------------------------------------
3211 : !BOC
3212 :
3213 : !======================================================================
3214 : ! CALC_COVERAGE begins here
3215 : !======================================================================
3216 :
3217 : ! Check if specified area does not overlap with inventory
3218 : COVERAGE = 1
3219 : IF ( (msk_x1 > cpu_x2) .OR. (msk_x2 < cpu_x1) .OR. &
3220 : (msk_y1 > cpu_y2) .OR. (msk_y2 < cpu_y1) ) THEN
3221 : COVERAGE = 0
3222 : RETURN
3223 : ENDIF
3224 :
3225 : ! Check for partial coverage
3226 : IF ( (msk_x1 > cpu_x1) .OR. (msk_x2 < cpu_x2) .OR. &
3227 : (msk_y1 > cpu_y1) .OR. (msk_y2 < cpu_y2) ) THEN
3228 : COVERAGE = -1
3229 : ENDIF
3230 :
3231 : END FUNCTION Calc_Coverage
3232 : !EOC
3233 : !------------------------------------------------------------------------------
3234 : ! Harmonized Emissions Component (HEMCO) !
3235 : !------------------------------------------------------------------------------
3236 : !BOP
3237 : !
3238 : ! !IROUTINE: ReadAndSplit_Line
3239 : !
3240 : ! !DESCRIPTION: Subroutine ReadAndSplit\_Line reads a line from the HEMCO
3241 : ! config file and parses the specified columns into the passed integer
3242 : ! and character variables. If the optional argument inLine is provided,
3243 : ! this line will be parsed, otherwise a new line will be read from the config
3244 : ! file. If the optional argument outLine is provided, this variable will hold
3245 : ! the parsed line.
3246 : !\\
3247 : !\\
3248 : ! This routine splits the input line (or the next line of an open file with
3249 : ! ID IU\_HCO), using the HEMCO separator (default: space) as separator. The
3250 : ! resulting elements are then passed to the specified output characters and
3251 : ! integers. For example, to pass the 5th element of a line to variable int1,
3252 : ! set int1cl to 5, etc. An error will be returned (STAT=100) if any of the
3253 : ! output columns exceeds the number of line elements. The optional argument
3254 : ! optcl can be used to denote an optional value, e.g. no error is returned
3255 : ! if the value at position optcl cannot be read. Only one optional value can
3256 : ! be specified.
3257 : !\\
3258 : !\\
3259 : ! !INTERFACE:
3260 : !
3261 0 : SUBROUTINE ReadAndSplit_Line( HcoConfig, IU_HCO, char1, chr1cl, &
3262 : char2, chr2cl, char3, chr3cl, &
3263 : char4, chr4cl, char5, chr5cl, &
3264 : char6, chr6cl, char7, chr7cl, &
3265 : char8, chr8cl, char9, chr9cl, &
3266 : char10, chr10cl, &
3267 : int1, int1cl, int2, int2cl, &
3268 0 : int3, int3cl, STAT, inLine, &
3269 0 : outLine, optcl )
3270 : !
3271 : ! !USES:
3272 : !
3273 : USE HCO_CHARPAK_Mod, ONLY : STRREPL, STRSPLIT
3274 : !
3275 : ! !INPUT PARAMETERS:
3276 : !
3277 : TYPE(ConfigObj), POINTER :: HcoConfig
3278 : INTEGER, INTENT(IN ) :: IU_HCO
3279 : INTEGER, INTENT(IN ) :: chr1cl
3280 : INTEGER, INTENT(IN ) :: chr2cl
3281 : INTEGER, INTENT(IN ) :: chr3cl
3282 : INTEGER, INTENT(IN ) :: chr4cl
3283 : INTEGER, INTENT(IN ) :: chr5cl
3284 : INTEGER, INTENT(IN ) :: chr6cl
3285 : INTEGER, INTENT(IN ) :: chr7cl
3286 : INTEGER, INTENT(IN ) :: chr8cl
3287 : INTEGER, INTENT(IN ) :: chr9cl
3288 : INTEGER, INTENT(IN ) :: chr10cl
3289 : INTEGER, INTENT(IN ) :: int1cl
3290 : INTEGER, INTENT(IN ) :: int2cl
3291 : INTEGER, INTENT(IN ) :: int3cl
3292 : CHARACTER(LEN=255), INTENT(IN ), OPTIONAL :: inLINE
3293 : INTEGER, INTENT(IN ), OPTIONAL :: optcl
3294 : !
3295 : ! !OUTPUT PARAMETERS:
3296 : !
3297 : CHARACTER(LEN=*), INTENT(INOUT) :: char1
3298 : CHARACTER(LEN=*), INTENT(INOUT) :: char2
3299 : CHARACTER(LEN=*), INTENT(INOUT) :: char3
3300 : CHARACTER(LEN=*), INTENT(INOUT) :: char4
3301 : CHARACTER(LEN=*), INTENT(INOUT) :: char5
3302 : CHARACTER(LEN=*), INTENT(INOUT) :: char6
3303 : CHARACTER(LEN=*), INTENT(INOUT) :: char7
3304 : CHARACTER(LEN=*), INTENT(INOUT) :: char8
3305 : CHARACTER(LEN=*), INTENT(INOUT) :: char9
3306 : CHARACTER(LEN=*), INTENT(INOUT) :: char10
3307 : INTEGER, INTENT(INOUT) :: int1
3308 : INTEGER, INTENT(INOUT) :: int2
3309 : INTEGER, INTENT(INOUT) :: int3
3310 : CHARACTER(LEN=255), INTENT( OUT), OPTIONAL :: outLINE
3311 : !
3312 : ! !INPUT/OUTPUT PARAMETERS:
3313 : !
3314 : INTEGER, INTENT(INOUT) :: STAT
3315 : !
3316 : ! !REVISION HISTORY:
3317 : ! 28 Aug 2013 - C. Keller - Initial version
3318 : ! See https://github.com/geoschem/hemco for complete history
3319 : !EOP
3320 : !------------------------------------------------------------------------------
3321 : !BOC
3322 : !
3323 : ! !LOCAL VARIABLES:
3324 : !
3325 : INTEGER :: N, OPT, STRLEN, RC
3326 : CHARACTER(LEN=255) :: LINE
3327 : CHARACTER(LEN=255) :: SUBSTR(255)
3328 : LOGICAL :: EOF
3329 :
3330 : !======================================================================
3331 : ! ReadAndSplit_Line begins here
3332 : !======================================================================
3333 :
3334 : ! Output status
3335 0 : STAT = 0
3336 :
3337 : ! ---------------------------------------------------------------------
3338 : ! Read line and split column
3339 : ! ---------------------------------------------------------------------
3340 0 : IF ( PRESENT(inLINE) ) THEN
3341 0 : LINE = inLINE
3342 : ELSE
3343 : ! Read line
3344 0 : CALL HCO_READLINE( IU_HCO, LINE, EOF, RC )
3345 :
3346 : ! Return w/ error
3347 0 : IF ( RC /= HCO_SUCCESS ) THEN
3348 0 : STAT = 999
3349 0 : RETURN
3350 : ENDIF
3351 :
3352 : ! End of file
3353 0 : IF ( EOF ) THEN
3354 0 : STAT = -999
3355 0 : RETURN
3356 : ENDIF
3357 : ENDIF
3358 :
3359 : ! Check for output line
3360 0 : IF ( PRESENT(outLINE) ) outLINE = LINE
3361 :
3362 : ! Return here with flag = 10 if line starts with 'END SECTION'.
3363 0 : IF ( INDEX ( LINE, 'END SECTION' ) > 0 ) THEN
3364 0 : STAT = 10
3365 0 : RETURN
3366 : ENDIF
3367 :
3368 : ! Return here with flag = 1 if line is commented
3369 0 : IF ( LINE(1:1) == HCO_CMT ) THEN
3370 0 : STAT = 1
3371 0 : RETURN
3372 : ENDIF
3373 :
3374 : ! Get string length
3375 0 : STRLEN = LEN(TRIM(LINE))
3376 :
3377 : ! Return here with flag = 5 is line is opening a (shortcut) bracket.
3378 0 : IF ( STRLEN > 3 ) THEN
3379 0 : IF ( LINE(1:3) == '(((' ) THEN
3380 0 : STAT = 5
3381 0 : RETURN
3382 : ENDIF
3383 :
3384 : ! Return here with flag = 6 is line is opening a (shortcut) bracket.
3385 0 : IF ( LINE(1:3) == ')))' ) THEN
3386 0 : STAT = 6
3387 0 : RETURN
3388 : ENDIF
3389 : ENDIF
3390 :
3391 : ! Return with flag = 1000 if this is a link to an include file.
3392 0 : IF ( STRLEN > 11 ) THEN
3393 0 : IF ( LINE(1:10) == '>>>include' ) THEN
3394 0 : IF ( PRESENT(outLINE) ) outLINE = outLINE(12:STRLEN)
3395 0 : STAT = 1000
3396 0 : RETURN
3397 : ENDIF
3398 : ENDIF
3399 :
3400 : ! Split line into columns
3401 0 : CALL STRREPL ( LINE, HCO_TAB, HCO_SPC )
3402 0 : CALL STRSPLIT( LINE, HCO_SPC, SUBSTR, N )
3403 :
3404 : ! Also ignore empty lines
3405 0 : IF ( N <= 1 ) THEN
3406 0 : STAT = 1
3407 0 : RETURN
3408 : ENDIF
3409 :
3410 : ! Are there any optional lines?
3411 0 : IF ( PRESENT(optcl) ) THEN
3412 0 : OPT = optcl
3413 : ELSE
3414 0 : OPT = -1
3415 : ENDIF
3416 :
3417 : ! ---------------------------------------------------------------------
3418 : ! Read characters as specified and write them into given variables
3419 : ! ---------------------------------------------------------------------
3420 :
3421 0 : CALL READCHAR( LINE, SUBSTR, N, chr1cl, char1, OPT, STAT )
3422 0 : IF ( STAT == 100 ) RETURN
3423 0 : CALL READCHAR( LINE, SUBSTR, N, chr2cl, char2, OPT, STAT )
3424 0 : IF ( STAT == 100 ) RETURN
3425 0 : CALL READCHAR( LINE, SUBSTR, N, chr3cl, char3, OPT, STAT )
3426 0 : IF ( STAT == 100 ) RETURN
3427 0 : CALL READCHAR( LINE, SUBSTR, N, chr4cl, char4, OPT, STAT )
3428 0 : IF ( STAT == 100 ) RETURN
3429 0 : CALL READCHAR( LINE, SUBSTR, N, chr5cl, char5, OPT, STAT )
3430 0 : IF ( STAT == 100 ) RETURN
3431 0 : CALL READCHAR( LINE, SUBSTR, N, chr6cl, char6, OPT, STAT )
3432 0 : IF ( STAT == 100 ) RETURN
3433 0 : CALL READCHAR( LINE, SUBSTR, N, chr7cl, char7, OPT, STAT )
3434 0 : IF ( STAT == 100 ) RETURN
3435 0 : CALL READCHAR( LINE, SUBSTR, N, chr8cl, char8, OPT, STAT )
3436 0 : IF ( STAT == 100 ) RETURN
3437 0 : CALL READCHAR( LINE, SUBSTR, N, chr9cl, char9, OPT, STAT )
3438 0 : IF ( STAT == 100 ) RETURN
3439 0 : CALL READCHAR( LINE, SUBSTR, N, chr10cl, char10, OPT, STAT )
3440 0 : IF ( STAT == 100 ) RETURN
3441 :
3442 : ! ---------------------------------------------------------------------
3443 : ! Read integers as specified and write them into given variables.
3444 : ! Value -999 is returned for wildcard characters.
3445 : ! ---------------------------------------------------------------------
3446 :
3447 0 : CALL READINT( HcoConfig%ExtList, LINE, SUBSTR, N, int1cl, int1, OPT, STAT )
3448 0 : IF ( STAT == 100 ) RETURN
3449 0 : CALL READINT( HcoConfig%ExtList, LINE, SUBSTR, N, int2cl, int2, OPT, STAT )
3450 0 : IF ( STAT == 100 ) RETURN
3451 0 : CALL READINT( HcoConfig%ExtList, LINE, SUBSTR, N, int3cl, int3, OPT, STAT )
3452 0 : IF ( STAT == 100 ) RETURN
3453 :
3454 : END SUBROUTINE ReadAndSplit_Line
3455 : !EOC
3456 : !------------------------------------------------------------------------------
3457 : ! Harmonized Emissions Component (HEMCO) !
3458 : !------------------------------------------------------------------------------
3459 : !BOP
3460 : !
3461 : ! !IROUTINE: READCHAR
3462 : !
3463 : ! !DESCRIPTION: Subroutine READCHAR is a helper routine to read character
3464 : ! values from the HEMCO configuration file.
3465 : !\\
3466 : !\\
3467 : ! !INTERFACE:
3468 : !
3469 0 : SUBROUTINE READCHAR ( LINE, SUBSTR, N, chrcl, charout, OPT, STAT )
3470 : !
3471 : ! !INPUT PARAMETERS:
3472 : !
3473 : CHARACTER(LEN=255), INTENT(IN ) :: LINE
3474 : CHARACTER(LEN=255), INTENT(IN ) :: SUBSTR(255)
3475 : INTEGER, INTENT(IN ) :: N
3476 : INTEGER, INTENT(IN ) :: chrcl
3477 : INTEGER, INTENT(IN ) :: OPT
3478 : !
3479 : ! !INPUT/OUTPUT PARAMETERS:
3480 : !
3481 : CHARACTER(LEN=*), INTENT(INOUT) :: charout
3482 : INTEGER, INTENT(INOUT) :: STAT
3483 : !
3484 : ! !REVISION HISTORY:
3485 : ! 29 Dec 2014 - C. Keller - Initial version
3486 : ! See https://github.com/geoschem/hemco for complete history
3487 : !EOP
3488 : !------------------------------------------------------------------------------
3489 : !BOC
3490 : !
3491 0 : IF ( chrcl > 0 ) THEN
3492 0 : IF ( chrcl > N ) THEN
3493 0 : IF ( chrcl /= OPT ) THEN
3494 0 : WRITE(*,*) 'Not enough elements in: '//TRIM(LINE)
3495 0 : STAT = 100
3496 0 : RETURN
3497 : ELSE
3498 0 : charout = ''
3499 : ENDIF
3500 : ELSE
3501 0 : READ( SUBSTR(chrcl), '(a)' ) charout
3502 : ENDIF
3503 : ENDIF
3504 0 : charout = ADJUSTL(charout)
3505 :
3506 0 : END SUBROUTINE READCHAR
3507 : !EOC
3508 : !------------------------------------------------------------------------------
3509 : ! Harmonized Emissions Component (HEMCO) !
3510 : !------------------------------------------------------------------------------
3511 : !BOP
3512 : !
3513 : ! !IROUTINE: READINT
3514 : !
3515 : ! !DESCRIPTION: Subroutine READINT is a helper routine to read integer
3516 : ! values from the HEMCO configuration file.
3517 : !\\
3518 : !\\
3519 : ! !INTERFACE:
3520 : !
3521 0 : SUBROUTINE READINT ( ExtList, LINE, SUBSTR, N, intcl, intout, OPT, STAT )
3522 : !
3523 : ! !USES:
3524 : !
3525 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
3526 : !
3527 : ! !INPUT PARAMETERS:
3528 : !
3529 : TYPE(Ext), POINTER :: ExtList
3530 : CHARACTER(LEN=255), INTENT(IN ) :: LINE
3531 : CHARACTER(LEN=255), INTENT(IN ) :: SUBSTR(255)
3532 : INTEGER, INTENT(IN ) :: N
3533 : INTEGER, INTENT(IN ) :: intcl
3534 : INTEGER, INTENT(IN ) :: OPT
3535 : !
3536 : ! !INPUT/OUTPUT PARAMETERS:
3537 : !
3538 : INTEGER, INTENT(INOUT) :: intout
3539 : INTEGER, INTENT(INOUT) :: STAT
3540 : !
3541 : ! !REVISION HISTORY:
3542 : ! 29 Dec 2014 - C. Keller - Initial version
3543 : ! See https://github.com/geoschem/hemco for complete history
3544 : !EOP
3545 : !------------------------------------------------------------------------------
3546 : !BOC
3547 : !
3548 0 : IF ( intcl > 0 ) THEN
3549 0 : IF ( intcl > N ) THEN
3550 0 : IF ( intcl /= OPT ) THEN
3551 0 : WRITE(*,*) 'Not enough elements in: '//TRIM(LINE)
3552 0 : STAT = 100
3553 0 : RETURN
3554 : ELSE
3555 0 : intout = -999
3556 : ENDIF
3557 : ELSE
3558 : ! Check for wildcard
3559 0 : IF ( SUBSTR(intcl) == TRIM(HCO_GetOpt(ExtList,'Wildcard')) ) THEN
3560 0 : intout = -999
3561 : ELSE
3562 0 : READ( SUBSTR(intcl), * ) intout
3563 : ENDIF
3564 : ENDIF
3565 : ENDIF
3566 :
3567 : END SUBROUTINE READINT
3568 : !EOC
3569 : !------------------------------------------------------------------------------
3570 : ! Harmonized Emissions Component (HEMCO) !
3571 : !------------------------------------------------------------------------------
3572 : !BOP
3573 : !
3574 : ! !IROUTINE: Get_cID
3575 : !
3576 : ! !DESCRIPTION: Subroutine Get\_cID searches the whole ConfigList for an entry
3577 : ! with the given ScalID and returns the corresponding container ID cID.
3578 : !\\
3579 : !\\
3580 : ! !INTERFACE:
3581 : !
3582 0 : SUBROUTINE Get_cID( ScalID, HcoConfig, cID, RC )
3583 : !
3584 : ! !INPUT PARAMETERS:
3585 : !
3586 : INTEGER, INTENT(IN ) :: scalID
3587 : TYPE(ConfigObj), POINTER :: HcoConfig
3588 : !
3589 : ! !OUTPUT PARAMETERS:
3590 : !
3591 : INTEGER, INTENT( OUT) :: cID
3592 : !
3593 : ! !INPUT/OUTPUTP PARAMETERS:
3594 : !
3595 : INTEGER, INTENT(INOUT) :: RC
3596 : !
3597 : ! !REVISION HISTORY:
3598 : ! 18 Sep 2013 - C. Keller - Initial version
3599 : ! See https://github.com/geoschem/hemco for complete history
3600 : !EOP
3601 : !------------------------------------------------------------------------------
3602 : !BOC
3603 : !
3604 : ! !LOCAL VARIABLES:
3605 : !
3606 : ! Pointers
3607 : TYPE(ListCont), POINTER :: Lct
3608 :
3609 : ! Scalars
3610 : CHARACTER(LEN=255) :: MSG, LOC
3611 : CHARACTER(LEN= 31) :: strID
3612 :
3613 : ! Enter
3614 0 : LOC = 'Get_cID (hco_config_mod.F90)'
3615 0 : cID = -999
3616 :
3617 : ! Loop over all containers
3618 0 : Lct => HcoConfig%ConfigList
3619 0 : DO WHILE ( ASSOCIATED ( Lct ) )
3620 :
3621 : ! Skip if data container not defined
3622 0 : IF ( .NOT. ASSOCIATED(Lct%Dct) ) THEN
3623 0 : Lct => Lct%NextCont
3624 0 : CYCLE
3625 : ENDIF
3626 :
3627 : ! Check if this container has desired scalID
3628 0 : IF ( Lct%Dct%ScalID == ScalID ) THEN
3629 0 : cID = Lct%Dct%cID
3630 0 : EXIT
3631 : ENDIF
3632 :
3633 : ! Move to archived next line
3634 0 : Lct => Lct%NextCont
3635 : ENDDO
3636 :
3637 : ! Free pointer
3638 0 : Lct => NULL()
3639 :
3640 : ! cID must be positive!
3641 0 : IF ( cID <= 0 ) THEN
3642 0 : WRITE ( strID, * ) ScalID
3643 0 : MSG = 'Cannot find ScalID' // TRIM(strID)
3644 0 : PRINT *,'cID negative in HEMCO Get_cID'
3645 0 : PRINT *, TRIM(MSG)
3646 0 : RETURN
3647 : ENDIF
3648 :
3649 : ! Leave w/ success
3650 0 : RC = HCO_SUCCESS
3651 :
3652 : END SUBROUTINE Get_cID
3653 : !EOC
3654 : !------------------------------------------------------------------------------
3655 : ! Harmonized Emissions Component (HEMCO) !
3656 : !------------------------------------------------------------------------------
3657 : !BOP
3658 : !
3659 : ! !IROUTINE: ConfigList_AddCont
3660 : !
3661 : ! !DESCRIPTION: Subroutine ConfigList\_AddCont adds a new (blank) container to
3662 : ! the ConfigList list.
3663 : !\\
3664 : !\\
3665 : ! !INTERFACE:
3666 : !
3667 0 : SUBROUTINE ConfigList_AddCont( Lct, List )
3668 : !
3669 : ! !USES:
3670 : !
3671 : USE HCO_DATACONT_Mod, ONLY : DataCont_Init
3672 : USE HCO_DATACONT_Mod, ONLY : ListCont_Length
3673 : !
3674 : ! !INPUT/OUTPUT PARAMETERS:
3675 : !
3676 : TYPE(ListCont), POINTER :: Lct
3677 : TYPE(ListCont), POINTER :: List
3678 : !
3679 : ! !REVISION HISTORY:
3680 : ! 17 Sep 2013 - C. Keller: Initialization (update)
3681 : ! See https://github.com/geoschem/hemco for complete history
3682 : !EOP
3683 : !------------------------------------------------------------------------------
3684 : !BOC
3685 : !
3686 : ! !LOCAL VARIABLES:
3687 : !
3688 : INTEGER :: cID
3689 :
3690 : !======================================================================
3691 : ! ConfigList_AddCont begins here
3692 : !======================================================================
3693 :
3694 : ! Allocate container and create data structure.
3695 : ! The DataCont_Init call creates a new data container (type DataCont)
3696 : ! All HEMCO lists (ConfigList, ReadList, EmisList) point to this
3697 : ! container!
3698 0 : ALLOCATE ( Lct )
3699 0 : Lct%Dct => NULL()
3700 0 : Lct%NextCont => NULL()
3701 :
3702 : ! Get # of containers in list. Set new container ID (cID) to # of
3703 : ! containers + 1.
3704 0 : cID = ListCont_Length( List )
3705 0 : cID = cID + 1
3706 0 : CALL DataCont_Init ( Lct%Dct, cID )
3707 :
3708 : ! Connect blank container with ConfigList list.
3709 0 : Lct%NextCont => List
3710 0 : List => Lct
3711 :
3712 :
3713 0 : END SUBROUTINE ConfigList_AddCont
3714 : !EOC
3715 : !------------------------------------------------------------------------------
3716 : ! Harmonized Emissions Component (HEMCO) !
3717 : !------------------------------------------------------------------------------
3718 : !BOP
3719 : !
3720 : ! !IROUTINE: ScalID_Register
3721 : !
3722 : ! !DESCRIPTION: Subroutine ScalID\_Register adds the scale factor IDs ScalIDs
3723 : ! to the list of scale factor IDs.
3724 : !\\
3725 : !\\
3726 : ! !INTERFACE:
3727 : !
3728 0 : SUBROUTINE ScalID_Register( Dct, HcoConfig, RC )
3729 : !
3730 : ! !INPUT PARAMETERS:
3731 : !
3732 : TYPE(DataCont), POINTER :: Dct
3733 : TYPE(ConfigObj), POINTER :: HcoConfig
3734 : !
3735 : ! !INPUT/OUTPUT PARAMETERS:
3736 : !
3737 : INTEGER, INTENT(INOUT) :: RC
3738 : !
3739 : ! !REVISION HISTORY:
3740 : ! 10 Jan 2014 - C. Keller: Initialization (update)
3741 : ! See https://github.com/geoschem/hemco for complete history
3742 : !EOP
3743 : !------------------------------------------------------------------------------
3744 : !BOC
3745 : !
3746 : ! !LOCAL VARIABLES:
3747 : !
3748 : ! Scalars
3749 : INTEGER :: N, cID
3750 :
3751 : !======================================================================
3752 : ! ScalID_Register begins here
3753 : !======================================================================
3754 :
3755 : ! Check for every element of ScalIDs, if this scale factor ID is
3756 : ! already a member of ScalIDList. If not, add it.
3757 0 : DO N = 1, Dct%nScalID
3758 0 : IF ( Dct%Scal_cID(N) < 0 ) CYCLE
3759 :
3760 0 : CALL ScalID2List( HcoConfig%ScalIDList, Dct%Scal_cID(N), RC )
3761 0 : IF ( RC /= HCO_SUCCESS ) THEN
3762 0 : PRINT *,'Error in ScaleID2List called from HEMCO ScalID_Register (1)'
3763 0 : RETURN
3764 : ENDIF
3765 :
3766 : ! Replace scale factor ID with container ID.
3767 0 : CALL Get_cID ( Dct%Scal_cID(N), HcoConfig, cID, RC )
3768 0 : IF ( RC /= HCO_SUCCESS ) THEN
3769 0 : PRINT *,'Error in Get_cID called from HEMCO ScalID_Register (1)'
3770 0 : RETURN
3771 : ENDIF
3772 0 : Dct%Scal_cID(N) = cID
3773 :
3774 : ENDDO
3775 :
3776 : ! Also check for level scale factor IDs
3777 0 : IF ( Dct%levScalID1 > 0 ) THEN
3778 0 : CALL ScalID2List( HcoConfig%ScalIDList, Dct%levScalID1, RC )
3779 0 : IF ( RC /= HCO_SUCCESS ) THEN
3780 0 : PRINT *,'Error in ScalID2List called from HEMCO ScalID_Register (2)'
3781 0 : RETURN
3782 : ENDIF
3783 0 : CALL Get_cID ( Dct%levScalID1, HcoConfig, cID, RC )
3784 0 : IF ( RC /= HCO_SUCCESS ) THEN
3785 0 : PRINT *,'Error in Get_cID called from HEMCO ScalID_Register (2)'
3786 0 : RETURN
3787 : ENDIF
3788 0 : Dct%levScalID1 = cID
3789 : ENDIF
3790 0 : IF ( Dct%levScalID2 > 0 ) THEN
3791 0 : CALL ScalID2List( HcoConfig%ScalIDList, Dct%levScalID2, RC )
3792 0 : IF ( RC /= HCO_SUCCESS ) THEN
3793 0 : PRINT *,'Error in ScaleID2List called from HEMCO ScalID_Register (3)'
3794 0 : RETURN
3795 : ENDIF
3796 0 : CALL Get_cID ( Dct%levScalID2, HcoConfig, cID, RC )
3797 0 : IF ( RC /= HCO_SUCCESS ) THEN
3798 0 : PRINT *,'Error in Get_cID called from HEMCO ScalID_Register (3)'
3799 0 : RETURN
3800 : ENDIF
3801 0 : Dct%levScalID2 = cID
3802 : ENDIF
3803 :
3804 : ! Vector Scal_cID of this container now points to cIDs
3805 0 : Dct%Scal_cID_Set = .TRUE.
3806 :
3807 : ! Leave w/ success
3808 0 : RC = HCO_SUCCESS
3809 :
3810 : END SUBROUTINE ScalID_Register
3811 : !EOC
3812 : !------------------------------------------------------------------------------
3813 : ! Harmonized Emissions Component (HEMCO) !
3814 : !------------------------------------------------------------------------------
3815 : !BOP
3816 : !
3817 : ! !IROUTINE: ScalID2List
3818 : !
3819 : ! !DESCRIPTION: Subroutine ScalID2List adds the scale factor IDs ScalIDs
3820 : ! to the list of scale factor IDs.
3821 : !\\
3822 : !\\
3823 : ! !INTERFACE:
3824 : !
3825 0 : SUBROUTINE ScalID2List( ScalIDList, ID, RC )
3826 : !
3827 : ! !INPUT PARAMETERS:
3828 : !
3829 : TYPE(ScalIDCont), POINTER :: ScalIDList
3830 : INTEGER, INTENT(IN ) :: ID
3831 : !
3832 : ! !INPUT/OUTPUT PARAMETERS:
3833 : !
3834 : INTEGER, INTENT(INOUT) :: RC
3835 : !
3836 : ! !REVISION HISTORY:
3837 : ! 10 Jan 2014 - C. Keller: Initialization (update)
3838 : ! See https://github.com/geoschem/hemco for complete history
3839 : !EOP
3840 : !------------------------------------------------------------------------------
3841 : !BOC
3842 : !
3843 : ! !LOCAL VARIABLES:
3844 : !
3845 : ! Pointers
3846 : TYPE(ScalIDCont), POINTER :: NewScalIDCont
3847 : TYPE(ScalIDCont), POINTER :: TmpScalIDCont
3848 : TYPE(ScalIDCont), POINTER :: PrvScalIDCont
3849 :
3850 : ! Scalars
3851 : LOGICAL :: IsInList
3852 :
3853 : !======================================================================
3854 : ! ScalID2List begins here
3855 : !======================================================================
3856 :
3857 : ! Initialize
3858 0 : NewScalIDCont => NULL()
3859 0 : TmpScalIDCont => NULL()
3860 0 : PrvScalIDCont => NULL()
3861 :
3862 : ! Check for every element of ScalIDs, if this scale factor ID is
3863 : ! already a member of ScalIDList. If not, add it.
3864 :
3865 : ! Check if already in list
3866 0 : IsInList = .FALSE.
3867 0 : TmpScalIDCont => ScalIDList
3868 0 : PrvScalIDCont => TmpScalIDCont
3869 0 : DO WHILE ( ASSOCIATED(TmpScalIDCont) )
3870 0 : IF ( TmpScalIDCont%ScalID == ID ) THEN
3871 : IsInList = .TRUE.
3872 : EXIT
3873 : ENDIF
3874 0 : PrvScalIDCont => TmpScalIDCont
3875 0 : TmpScalIDCont => TmpScalIDCont%NEXT
3876 : ENDDO
3877 :
3878 : ! Add new container w/ this scal ID to (end of) list
3879 0 : IF ( .NOT. IsInList ) THEN
3880 0 : ALLOCATE ( NewScalIDCont )
3881 0 : NewScalIDCont%ScalID = ID
3882 0 : NewScalIDCont%NEXT => NULL()
3883 0 : IF ( .NOT. ASSOCIATED(PrvScalIDCont) ) THEN
3884 0 : ScalIDList => NewScalIDCont
3885 : ELSE
3886 0 : PrvScalIDCont%NEXT => NewScalIDCont
3887 : ENDIF
3888 : ! NewScalIDCont%NEXT => ScalIDList
3889 : ! ScalIDList => NewScalIDCont
3890 : ! NewScalIDCont => NULL()
3891 : ENDIF
3892 :
3893 : ! Cleanup
3894 0 : TmpScalIDCont => NULL()
3895 :
3896 : ! Leave w/ success
3897 0 : RC = HCO_SUCCESS
3898 :
3899 0 : END SUBROUTINE ScalID2List
3900 : !EOC
3901 : !------------------------------------------------------------------------------
3902 : ! Harmonized Emissions Component (HEMCO) !
3903 : !------------------------------------------------------------------------------
3904 : !BOP
3905 : !
3906 : ! !IROUTINE: ScalID_Cleanup
3907 : !
3908 : ! !DESCRIPTION: Subroutine ScalID\_Cleanup cleans up the internal ScalID
3909 : ! list.
3910 : !\\
3911 : !\\
3912 : ! !INTERFACE:
3913 : !
3914 0 : SUBROUTINE ScalID_Cleanup( ScalIDList )
3915 : !
3916 : ! !INPUT ARGUMENTS:
3917 : !
3918 : TYPE(ScalIDCont), POINTER :: ScalIDList
3919 : !
3920 : ! !REVISION HISTORY:
3921 : ! 10 Jan 2014 - C. Keller: Initialization (update)
3922 : ! See https://github.com/geoschem/hemco for complete history
3923 : !EOP
3924 : !------------------------------------------------------------------------------
3925 : !BOC
3926 : !
3927 : ! !LOCAL VARIABLES:
3928 : !
3929 : ! Pointers
3930 : TYPE(ScalIDCont), POINTER :: TmpScalIDCont
3931 : TYPE(ScalIDCont), POINTER :: NxtScalIDCont
3932 :
3933 : !======================================================================
3934 : ! ScalID_Cleanup begins here
3935 : !======================================================================
3936 :
3937 : ! Walk through list and remove each element
3938 0 : NxtScalIDCont => NULL()
3939 0 : TmpScalIDCont => ScalIDList
3940 0 : DO WHILE ( ASSOCIATED(TmpScalIDCont) )
3941 :
3942 0 : NxtScalIDCont => TmpScalIDCont%NEXT
3943 0 : TmpScalIDCont%NEXT => NULL()
3944 0 : DEALLOCATE ( TmpScalIDCont )
3945 :
3946 0 : TmpScalIDCont => NxtScalIDCont
3947 : ENDDO
3948 :
3949 : ! Exit
3950 0 : TmpScalIDCont => NULL()
3951 0 : NxtScalIDCont => NULL()
3952 0 : ScalIDList => NULL()
3953 :
3954 0 : END SUBROUTINE ScalID_Cleanup
3955 : !EOC
3956 : !------------------------------------------------------------------------------
3957 : ! Harmonized Emissions Component (HEMCO) !
3958 : !------------------------------------------------------------------------------
3959 : !BOP
3960 : !
3961 : ! !IROUTINE: SpecName_Register
3962 : !
3963 : ! !DESCRIPTION: Subroutine SpecName\_Register adds the species name SpecName
3964 : ! to the list of species names.
3965 : !\\
3966 : !\\
3967 : ! !INTERFACE:
3968 : !
3969 0 : SUBROUTINE SpecName_Register( HcoConfig, SpecName, RC )
3970 : !
3971 : ! !USES:
3972 : !
3973 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
3974 : !
3975 : ! !INPUT PARAMETERS:
3976 : !
3977 : TYPE(ConfigObj), POINTER :: HcoConfig
3978 : CHARACTER(LEN=*), INTENT(IN ) :: SpecName
3979 : !
3980 : ! !INPUT/OUTPUT PARAMETERS:
3981 : !
3982 : INTEGER, INTENT(INOUT) :: RC
3983 : !
3984 : ! !REVISION HISTORY:
3985 : ! 10 Jan 2014 - C. Keller: Initialization (update)
3986 : ! See https://github.com/geoschem/hemco for complete history
3987 : !EOP
3988 : !------------------------------------------------------------------------------
3989 : !BOC
3990 : !
3991 : ! !LOCAL ARGUMENTS:
3992 : !
3993 : TYPE(SpecNameCont), POINTER :: NewSpecNameCont
3994 : TYPE(SpecNameCont), POINTER :: TmpSpecNameCont
3995 : LOGICAL :: IsInList
3996 :
3997 : !======================================================================
3998 : ! SpecName_Register begins here
3999 : !======================================================================
4000 :
4001 : ! Ignore if wildcard character. These fields will always be used!
4002 0 : IF ( TRIM(SpecName) == TRIM(HCO_GetOpt(HcoConfig%ExtList,'Wildcard')) ) THEN
4003 0 : RC = HCO_SUCCESS
4004 0 : RETURN
4005 : ENDIF
4006 :
4007 : ! Initialize
4008 0 : NewSpecNameCont => NULL()
4009 0 : TmpSpecNameCont => NULL()
4010 :
4011 : ! Check if already in list
4012 0 : IsInList = .FALSE.
4013 0 : TmpSpecNameCont => HcoConfig%SpecNameList
4014 0 : DO WHILE ( ASSOCIATED(TmpSpecNameCont) )
4015 0 : IF ( TRIM(TmpSpecNameCont%SpecName) == TRIM(SpecName) ) THEN
4016 0 : IsInList = .TRUE.
4017 0 : EXIT
4018 : ENDIF
4019 0 : TmpSpecNameCont => TmpSpecNameCont%NEXT
4020 : ENDDO
4021 :
4022 : ! Add new container w/ this scal ID to (beginning) of list
4023 : IF ( .NOT. IsInList ) THEN
4024 0 : ALLOCATE ( NewSpecNameCont )
4025 0 : NewSpecNameCont%SpecName = SpecName
4026 0 : NewSpecNameCont%NEXT => HcoConfig%SpecNameList
4027 0 : HcoConfig%SpecNameList => NewSpecNameCont
4028 0 : NewSpecNameCont => NULL()
4029 : ENDIF
4030 :
4031 : ! Cleanup
4032 0 : TmpSpecNameCont => NULL()
4033 :
4034 : ! Leave w/ success
4035 0 : RC = HCO_SUCCESS
4036 :
4037 0 : END SUBROUTINE SpecName_Register
4038 : !EOC
4039 : !------------------------------------------------------------------------------
4040 : ! Harmonized Emissions Component (HEMCO) !
4041 : !------------------------------------------------------------------------------
4042 : !BOP
4043 : !
4044 : ! !IROUTINE: SpecName_Cleanup
4045 : !
4046 : ! !DESCRIPTION: Subroutine SpecName\_Cleanup cleans up the internal SpecName
4047 : ! list.
4048 : !\\
4049 : !\\
4050 : ! !INTERFACE:
4051 : !
4052 0 : SUBROUTINE SpecName_Cleanup ( SpecNameList )
4053 : !
4054 : ! !INPUT/OUTPUT ARGUMENT:
4055 : !
4056 : TYPE(SpecNameCont), POINTER :: SpecNameList
4057 : !
4058 : ! !REVISION HISTORY:
4059 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4060 : ! See https://github.com/geoschem/hemco for complete history
4061 : !EOP
4062 : !------------------------------------------------------------------------------
4063 : !BOC
4064 : !
4065 : ! !LOCAL ARGUMENTS:
4066 : !
4067 : ! Pointers
4068 : TYPE(SpecNameCont), POINTER :: TmpSpecNameCont
4069 : TYPE(SpecNameCont), POINTER :: NxtSpecNameCont
4070 :
4071 : !======================================================================
4072 : ! SpecName_Cleanup begins here
4073 : !======================================================================
4074 :
4075 : ! Initialize
4076 0 : TmpSpecNameCont => NULL()
4077 0 : NxtSpecNameCont => NULL()
4078 :
4079 : ! Walk through list and remove each element
4080 0 : TmpSpecNameCont => SpecNameList
4081 0 : DO WHILE ( ASSOCIATED(TmpSpecNameCont) )
4082 :
4083 0 : NxtSpecNameCont => TmpSpecNameCont%NEXT
4084 0 : TmpSpecNameCont%NEXT => NULL()
4085 0 : DEALLOCATE ( TmpSpecNameCont )
4086 :
4087 0 : TmpSpecNameCont => NxtSpecNameCont
4088 : ENDDO
4089 :
4090 : ! Exit
4091 0 : TmpSpecNameCont => NULL()
4092 0 : NxtSpecNameCont => NULL()
4093 0 : SpecNameList => NULL()
4094 :
4095 0 : END SUBROUTINE SpecName_Cleanup
4096 : !EOC
4097 : !------------------------------------------------------------------------------
4098 : ! Harmonized Emissions Component (HEMCO) !
4099 : !------------------------------------------------------------------------------
4100 : !BOP
4101 : !
4102 : ! !IROUTINE: Config_GetnSpecies
4103 : !
4104 : ! !DESCRIPTION: Function Config\_GetnSpecies is a wrapper function to
4105 : ! get the number of (unique) species names in SpecNameList.
4106 : !\\
4107 : !\\
4108 : ! !INTERFACE:
4109 : !
4110 0 : FUNCTION Config_GetnSpecies( HcoConfig ) RESULT( nSpecies )
4111 : !
4112 : ! !INPUT ARGUMENT:
4113 : !
4114 : TYPE(ConfigObj), POINTER :: HcoConfig
4115 : !
4116 : ! !RETURN VALUE:
4117 : !
4118 : INTEGER :: nSpecies
4119 : !
4120 : ! !REVISION HISTORY:
4121 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4122 : ! See https://github.com/geoschem/hemco for complete history
4123 : !EOP
4124 : !------------------------------------------------------------------------------
4125 : !BOC
4126 : !
4127 : ! !LOCAL VARIABLES:
4128 : !
4129 : INTEGER :: THISRC
4130 :
4131 : !======================================================================
4132 : ! Config_GetnSpecies begins here
4133 : !======================================================================
4134 :
4135 0 : CALL Config_GetSpecAttr( HcoConfig, N=nSpecies, RC = THISRC )
4136 :
4137 0 : END FUNCTION Config_GetnSpecies
4138 : !EOC
4139 : !------------------------------------------------------------------------------
4140 : ! Harmonized Emissions Component (HEMCO) !
4141 : !------------------------------------------------------------------------------
4142 : !BOP
4143 : !
4144 : ! !IROUTINE: Config_GetSpecNames
4145 : !
4146 : ! !DESCRIPTION: Subroutine Config\_GetSpecNames is a wrapper routine to
4147 : ! obtain the list of (unique) species names defined in SpecNameList.
4148 : !\\
4149 : !\\
4150 : ! !INTERFACE:
4151 : !
4152 0 : SUBROUTINE Config_GetSpecNames( HcoConfig, SpecNames, nSpecies, RC )
4153 : !
4154 : ! !INPUT ARGUMENT:
4155 : !
4156 : TYPE(ConfigObj), POINTER :: HcoConfig
4157 : !
4158 : ! !OUTPUT PARAMTERS:
4159 : !
4160 : CHARACTER(LEN=*), POINTER :: SpecNames(:)
4161 : !
4162 : ! !INPUT/OUTPUT PARAMETERS:
4163 : !
4164 : INTEGER, INTENT(INOUT) :: nSpecies
4165 : INTEGER, INTENT(INOUT) :: RC
4166 : !
4167 : ! !REVISION HISTORY:
4168 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4169 : ! See https://github.com/geoschem/hemco for complete history
4170 : !EOP
4171 : !------------------------------------------------------------------------------
4172 : !BOC
4173 : !======================================================================
4174 : ! Config_GetSpecNames begins here
4175 : !======================================================================
4176 :
4177 0 : CALL Config_GetSpecAttr( HcoConfig, N=nSpecies, SpecNames=SpecNames, RC=RC )
4178 :
4179 0 : END SUBROUTINE Config_GetSpecNames
4180 : !EOC
4181 : !------------------------------------------------------------------------------
4182 : ! Harmonized Emissions Component (HEMCO) !
4183 : !------------------------------------------------------------------------------
4184 : !BOP
4185 : !
4186 : ! !IROUTINE: Config_getSpecAttr
4187 : !
4188 : ! !DESCRIPTION: Subroutine Config\_GetSpecAttr returns the number of
4189 : ! species names N and the vector of species names SpecNames.
4190 : ! SpecNames must be of length nnSpecs, i.e. in order to obtain
4191 : ! SpecNames, Config\_getSpecAttr has to be called twice:
4192 : ! N = 0
4193 : ! CALL Config\_getSpecAttr ( N=N, RC=RC )
4194 : ! ALLOCATE(SpecNames(N))
4195 : ! CALL Config\_getSpecAttr ( N=N, SpecNames=SpecNames, RC=RC )
4196 : !\\
4197 : !\\
4198 : ! !INTERFACE:
4199 : !
4200 0 : SUBROUTINE Config_GetSpecAttr( HcoConfig, N, SpecNames, RC )
4201 : !
4202 : ! !INPUT ARGUMENT:
4203 : !
4204 : TYPE(ConfigObj), POINTER :: HcoConfig
4205 : !
4206 : ! !INPUT/OUTPUT PARAMETERS:
4207 : !
4208 : INTEGER, INTENT(INOUT) :: N
4209 : INTEGER, INTENT(INOUT) :: RC
4210 : !
4211 : ! !OUTPUT PARAMETERS:
4212 : !
4213 : CHARACTER(LEN=*), POINTER, OPTIONAL :: SpecNames(:)
4214 : !
4215 : ! !REVISION HISTORY:
4216 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4217 : ! See https://github.com/geoschem/hemco for complete history
4218 : !EOP
4219 : !------------------------------------------------------------------------------
4220 : !BOC
4221 : !
4222 : ! !LOCAL VARIABLES:
4223 : !
4224 : TYPE(SpecNameCont), POINTER :: TmpSpecNameCont
4225 : INTEGER :: AS
4226 : CHARACTER(LEN=255), PARAMETER :: &
4227 : LOC = 'Config_GetSpecAttr (hco_config_mod.F90)'
4228 : CHARACTER(LEN=512) :: errMsg
4229 :
4230 : !======================================================================
4231 : ! Config_GetSpecAttr begins here
4232 : !======================================================================
4233 :
4234 : ! Initialize
4235 0 : TmpSpecNameCont => NULL()
4236 :
4237 : ! Eventually allocate pointer
4238 0 : IF ( PRESENT(SpecNames) ) THEN
4239 0 : IF ( .NOT. ASSOCIATED(SpecNames) ) THEN
4240 0 : IF ( N <= 0 ) THEN
4241 0 : errMsg = 'Cannot allocate SpecNames - N is size 0 or smaller'
4242 0 : CALL HCO_Error( errMsg, RC, thisLoc=LOC )
4243 0 : RETURN
4244 : ENDIF
4245 0 : ALLOCATE(SpecNames(N), STAT=AS )
4246 0 : IF ( AS/= 0 ) THEN
4247 0 : errMsg = 'Could not allocate the SpcNames array!'
4248 0 : CALL HCO_Error( errMsg, RC, thisLoc=LOC )
4249 0 : RETURN
4250 : ENDIF
4251 0 : SpecNames(:) = ''
4252 0 : ELSEIF ( SIZE(SpecNames) /= N ) THEN
4253 0 : errMsg = 'Size(SpecNames) does not match the passed N argument!'
4254 0 : CALL HCO_Error( errMsg, RC, thisLoc=LOC )
4255 0 : RETURN
4256 : ENDIF
4257 : ENDIF
4258 :
4259 : ! Init
4260 0 : N = 0
4261 :
4262 : ! Loop over entire list. Count number of containers and eventually
4263 : ! write out the species names.
4264 0 : TmpSpecNameCont => HcoConfig%SpecNameList
4265 0 : DO WHILE ( ASSOCIATED(TmpSpecNameCont) )
4266 0 : N = N + 1
4267 0 : IF ( PRESENT(SpecNames) ) THEN
4268 0 : SpecNames(N) = TRIM(TmpSpecNameCont%SpecName)
4269 : ENDIF
4270 0 : TmpSpecNameCont => TmpSpecNameCont%NEXT
4271 : ENDDO
4272 :
4273 : ! Cleanup and return w/ success
4274 0 : TmpSpecNameCont => NULL()
4275 :
4276 0 : RC = HCO_SUCCESS
4277 :
4278 0 : END SUBROUTINE Config_GetSpecAttr
4279 : !EOC
4280 : !------------------------------------------------------------------------------
4281 : ! Harmonized Emissions Component (HEMCO) !
4282 : !------------------------------------------------------------------------------
4283 : !BOP
4284 : !
4285 : ! !IROUTINE: Check_ContNames
4286 : !
4287 : ! !DESCRIPTION: Function Check\_Contnames compares the container names of
4288 : ! two containers, ignoring the name 'tags', i.e. ignoring everything that
4289 : ! follows double underscore (\_\_). For example, two containers with names
4290 : ! "EDGAR\_NOX\_\_PNT" and "EDGAR\_NOX\_\_MOB" are considered equal, while
4291 : ! "EDGAR\_NOX\_PNT" and "EDGAR\_NOX\_MOB" are not.
4292 : !\\
4293 : !\\
4294 : ! !INTERFACE:
4295 : !
4296 0 : FUNCTION Check_ContNames( Lct1, Lct2 ) RESULT( SameName )
4297 : !
4298 : ! !INPUT/OUTPUT PARAMETERS:
4299 : !
4300 : TYPE(ListCont), POINTER :: Lct1
4301 : TYPE(ListCont), POINTER :: Lct2
4302 : !
4303 : ! !RETURN VALUE:
4304 : !
4305 : LOGICAL :: SameName
4306 : !
4307 : ! !REVISION HISTORY:
4308 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4309 : ! See https://github.com/geoschem/hemco for complete history
4310 : !EOP
4311 : !------------------------------------------------------------------------------
4312 : !BOC
4313 : !
4314 : ! !LOCAL VARIABLES:
4315 : !
4316 : CHARACTER(LEN=63) :: name1, name2
4317 : INTEGER :: idx
4318 :
4319 : !======================================================================
4320 : ! Check_ContNames begins here!
4321 : !======================================================================
4322 :
4323 0 : SameName = .FALSE.
4324 0 : name1 = 'a'
4325 0 : name2 = 'b'
4326 :
4327 0 : idx = INDEX( TRIM(Lct1%Dct%cName), '__' )
4328 0 : IF ( idx > 0 ) THEN
4329 0 : name1 = Lct1%Dct%cName(1:idx)
4330 : ELSE
4331 0 : name1 = Lct1%Dct%cName
4332 : ENDIF
4333 :
4334 0 : idx = INDEX( TRIM(Lct2%Dct%cName), '__' )
4335 0 : IF ( idx > 0 ) THEN
4336 0 : name2 = Lct2%Dct%cName(1:idx)
4337 : ELSE
4338 0 : name2 = Lct2%Dct%cName
4339 : ENDIF
4340 :
4341 0 : IF ( TRIM(name1) == TRIM(name2) ) THEN
4342 : SameName = .TRUE.
4343 : ELSE
4344 0 : SameName = .FALSE.
4345 : ENDIF
4346 :
4347 0 : END FUNCTION Check_ContNames
4348 : !EOC
4349 : !------------------------------------------------------------------------------
4350 : ! Harmonized Emissions Component (HEMCO) !
4351 : !------------------------------------------------------------------------------
4352 : !BOP
4353 : !
4354 : ! !IROUTINE: ExtractSrcDim
4355 : !
4356 : ! !DESCRIPTION: Subroutine ExtractSrcDim extracts the source dimension
4357 : ! attribute. Specifically, it checks if the field is expected to be 2D
4358 : ! (xy) or 3D. Default 3D data is xyz, but it is also possible to explicitly
4359 : ! define the number of vertical levels to be read, as well as the reading
4360 : ! direction (up or down). For example, 'xy1' will be interpreted as reading
4361 : ! only the first level, and 'xy27' will only read the first 27 levels. To
4362 : ! reverse the vertical axis, use e.g. 'xy-1' to read only the top level,
4363 : ! or 'xy-27' to read the top 27 levels, with the topmost level being put
4364 : ! into the surface level.
4365 : !\\
4366 : !\\
4367 : ! !INTERFACE:
4368 : !
4369 0 : SUBROUTINE ExtractSrcDim( HcoConfig, SrcDim, Dta, Lscal1, Lscal2, RC )
4370 : !
4371 : ! !INPUT PARAMETERS:
4372 : !
4373 : TYPE(ConfigObj), POINTER :: HcoConfig
4374 : CHARACTER(LEN=*), INTENT(IN ) :: SrcDim
4375 : TYPE(FileData), POINTER :: Dta
4376 : !
4377 : ! !OUTPUT PARAMETERS:
4378 : !
4379 : INTEGER, INTENT( OUT) :: Lscal1
4380 : INTEGER, INTENT( OUT) :: Lscal2
4381 : !
4382 : ! !INPUT/OUTPUT PARAMETERS:
4383 : !
4384 : INTEGER, INTENT(INOUT) :: RC
4385 : !
4386 : ! !REVISION HISTORY:
4387 : ! 20 May 2015 - C. Keller - Initial version
4388 : ! See https://github.com/geoschem/hemco for complete history
4389 : !EOP
4390 : !------------------------------------------------------------------------------
4391 : !BOC
4392 : !
4393 : ! !LOCAL VARIABLES:
4394 : !
4395 : INTEGER :: i, idx, idx2
4396 : INTEGER :: strLen
4397 : INTEGER :: EmisUnit
4398 : REAL(hp) :: EmisL
4399 : CHARACTER(LEN=255) :: str1, str2, tmpstr
4400 : CHARACTER(LEN=255) :: MSG
4401 : CHARACTER(LEN=255) :: LOC = 'ExtractSrcDim (hco_config_mod.F90)'
4402 :
4403 : !======================================================================
4404 : ! ExtractSrcDim begins here
4405 : !======================================================================
4406 :
4407 : msg = 'Illegal source dimension ' // TRIM(srcDim) // &
4408 : ' for file ' // TRIM(Dta%ncFile) // &
4409 0 : '. Valid entries are e.g. xy or xyz.'
4410 :
4411 : ! Init output
4412 0 : Lscal1 = -1
4413 0 : Lscal2 = -1
4414 :
4415 : ! See if there is an arbitrary additional dimension. This must be added
4416 : ! at the end of the string and be separated by a '+' sign
4417 0 : idx = INDEX( TRIM(srcDim), '+' )
4418 0 : IF ( idx > 0 ) THEN
4419 0 : str1 = srcDim(1:(idx-1))
4420 0 : str2 = srcDim((idx+1):LEN(srcDim))
4421 : ELSE
4422 0 : str1 = srcDim
4423 0 : str2 = ''
4424 : ENDIF
4425 :
4426 : ! 2D data:
4427 0 : IF ( TRIM(str1) == 'xy' .OR. TRIM(str1) == '-' ) THEN
4428 0 : Dta%SpaceDim = 2
4429 :
4430 : ! All other cases
4431 : ELSE
4432 : ! Character length
4433 0 : strLen = LEN(TRIM(str1))
4434 :
4435 : ! There must be at least 3 characters (e.g. xyz)
4436 0 : IF ( strLen < 3 ) THEN
4437 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
4438 0 : RETURN
4439 : ENDIF
4440 :
4441 : ! First two entries must be xy
4442 0 : IF ( str1(1:2) /= 'xy' ) THEN
4443 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
4444 0 : RETURN
4445 : ENDIF
4446 :
4447 : ! If third entry is 'L', this means we have 2D data that shall be put
4448 : ! into a particular level, e.g. xyL4 will cause the 2D data to be
4449 : ! emitted into level 4.
4450 0 : IF ( str1(3:3) == 'L' .OR. str1(3:3) == 'l' ) THEN
4451 0 : IF ( strLen < 4 ) THEN
4452 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
4453 0 : RETURN
4454 : ENDIF
4455 0 : Dta%SpaceDim = 2
4456 0 : Dta%EmisLmode = 1 ! Dilute emissions vertically
4457 :
4458 : ! Read levels to put emissions into:
4459 0 : i=4
4460 0 : IF ( str1(i:i) == '=' ) i = i + 1
4461 :
4462 : ! Reduce to data to be read
4463 0 : tmpstr = str1(i:strLen)
4464 :
4465 : ! Check if range of levels is provided, i.e. xyL=1:5
4466 0 : idx = INDEX( TRIM(tmpstr), ':' )
4467 :
4468 : ! If multiple levels are provided (e.g. xyL=1:5)
4469 0 : IF ( idx > 0 ) THEN
4470 :
4471 : ! Check for PBL flag. It is possible to emit stuff
4472 : ! from the PBL up to e.g. level 30 (xyL=PBL:30)
4473 : ! The call to ParseEmisL now returns three arguments: the emission
4474 : ! level, the emission unit, and the emission scale factor. Ignore
4475 : ! emission level and unit if scale factor is given.
4476 0 : CALL ParseEmisL( tmpstr(1:(idx-1)), EmisL, EmisUnit, Lscal1 )
4477 0 : Dta%EmisL1 = EmisL
4478 0 : Dta%EmisL1Unit = EmisUnit
4479 0 : CALL ParseEmisL( tmpstr((idx+1):LEN(tmpstr)), EmisL, EmisUnit, Lscal2 )
4480 0 : Dta%EmisL2 = EmisL
4481 0 : Dta%EmisL2Unit = EmisUnit
4482 0 : Dta%EmisLmode = 1
4483 :
4484 : ! If only one value is provided (e.g. xyL5, xyL=5, xyL*)
4485 : ELSE
4486 :
4487 : ! Check if wildcard provided, i.e. xyL*
4488 0 : idx = INDEX( TRIM(tmpstr), '*' )
4489 :
4490 : ! Wildcard tells HEMCO to emit same value to all emission levels
4491 : ! A scale factor should be applied to distribute the emissions
4492 : ! vertically
4493 0 : IF ( idx > 0 ) THEN
4494 :
4495 0 : Dta%EmisL1 = 1.0_hp
4496 0 : Dta%EmisL1Unit = HCO_EMISL_LEV
4497 0 : Dta%EmisL2 = 0.0_hp
4498 0 : Dta%EmisL2Unit = HCO_EMISL_TOP
4499 0 : Dta%EmisLmode = 2 ! Copy data to all levels
4500 :
4501 : ! Emissions are allocated to one level
4502 : ELSE
4503 :
4504 0 : CALL ParseEmisL( tmpstr, EmisL, EmisUnit, Lscal1 )
4505 0 : Dta%EmisL1 = EmisL
4506 0 : Dta%EmisL1Unit = EmisUnit
4507 0 : Lscal2 = Lscal1
4508 0 : Dta%EmisL2 = Dta%EmisL1
4509 0 : Dta%EmisL2Unit = Dta%EmisL1Unit
4510 :
4511 : ENDIF
4512 : ENDIF
4513 : ELSE
4514 :
4515 : ! If we get to here, it's 3D data
4516 0 : Dta%SpaceDim = 3
4517 :
4518 : ! The third entry determines the vertical dimension.
4519 : ! This can be 'z' (standard) or a number to explicitly define
4520 : ! the vertical extension and direction.
4521 0 : IF ( str1(3:3) /= 'z' ) THEN
4522 0 : READ(str1(3:strLen),*) Dta%Levels
4523 : ENDIF
4524 : ENDIF
4525 : ENDIF
4526 :
4527 : ! Eventually set additional dimension name and value
4528 0 : IF ( TRIM(str2) /= '' ) THEN
4529 : MSG = 'Cannot extract arbitrary dimension from ' &
4530 : // TRIM(srcDim) // ' for file ' // TRIM(Dta%ncFile) &
4531 : // ' - arbitrary dimensions must follow a `+` sign ' &
4532 0 : // 'and contain the name/value pair, e.g. xyz+"ens"=3'
4533 0 : idx = INDEX( TRIM(str2), '=' )
4534 0 : IF ( idx <= 0 ) THEN
4535 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
4536 0 : RETURN
4537 : ENDIF
4538 :
4539 : ! Extract dimension name. Eventually remove '"' character at
4540 : ! beginning
4541 0 : IF ( str2(1:1) == '"' .OR. &
4542 : str2(1:1) == '`' ) THEN
4543 0 : Dta%ArbDimName = str2(2:(idx-1))
4544 : ELSE
4545 0 : Dta%ArbDimName = str2(1:(idx-1))
4546 : ENDIF
4547 :
4548 : ! Extract dimension value. Eventually remove trailing '"'
4549 : ! character. The string value itself will be evaluated when
4550 : ! reading the file (in hcoio_dataread_mod.F90).
4551 0 : strlen = LEN(TRIM(str2))
4552 0 : IF ( str2(strlen:strlen) == '"' .OR. &
4553 : str2(strlen:strlen) == '`' ) THEN
4554 0 : Dta%ArbDimVal = str2((idx+1):(strlen-1))
4555 : ELSE
4556 0 : Dta%ArbDimVal = str2((idx+1):(strlen))
4557 : ENDIF
4558 :
4559 : ! Verbose
4560 0 : IF ( HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err,2) ) THEN
4561 0 : WRITE(MSG,*) 'Will use additional dimension on file ', &
4562 0 : TRIM(Dta%ncFile), ': ', TRIM(Dta%ArbDimName), ' = ', &
4563 0 : TRIM(Dta%ArbDimVal)
4564 0 : CALL HCO_Msg( HcoConfig%Err, msg )
4565 : ENDIF
4566 : ENDIF
4567 :
4568 : ! Leave w/ success
4569 0 : RC = HCO_SUCCESS
4570 :
4571 0 : END SUBROUTINE ExtractSrcDim
4572 : !EOC
4573 : !------------------------------------------------------------------------------
4574 : ! Harmonized Emissions Component (HEMCO) !
4575 : !------------------------------------------------------------------------------
4576 : !BOP
4577 : !
4578 : ! !IROUTINE: ConfigInit
4579 : !
4580 : ! !DESCRIPTION: Subroutine ConfigInit is a wrapper routine to initialize the
4581 : ! HEMCO configuration object.
4582 : !\\
4583 : !\\
4584 : ! !INTERFACE:
4585 : !
4586 0 : SUBROUTINE ConfigInit ( HcoConfig, RC, nModelSpecies )
4587 : !
4588 : ! !INPUT PARAMETERS:
4589 : !
4590 : INTEGER, INTENT(IN), OPTIONAL :: nModelSpecies ! # model species
4591 : !
4592 : ! !INPUT/OUTPUT PARAMETERS:
4593 : !
4594 : TYPE(ConfigObj), POINTER :: HcoConfig
4595 : INTEGER, INTENT(INOUT) :: RC ! Success/fail
4596 : !
4597 : ! !REVISION HISTORY:
4598 : ! 16 Feb 2016 - C. Keller: Initialization (update)
4599 : ! See https://github.com/geoschem/hemco for complete history
4600 : !EOP
4601 : !------------------------------------------------------------------------------
4602 : !BOC
4603 : !
4604 : ! !LOCAL VARIABLES:
4605 : !
4606 : INTEGER :: I, AS
4607 : CHARACTER(LEN=255) :: thisLoc
4608 : CHARACTER(LEN=512) :: errMsg
4609 :
4610 : !=====================================================================
4611 : ! ConfigInit begins here!
4612 : !=====================================================================
4613 :
4614 0 : ALLOCATE(HcoConfig)
4615 0 : HcoConfig%ConfigFileName = ''
4616 0 : HcoConfig%ROOT = ''
4617 0 : HcoConfig%ConfigFileRead = .FALSE.
4618 0 : HcoConfig%ConfigList => NULL()
4619 0 : HcoConfig%ScalIDList => NULL()
4620 0 : HcoConfig%SpecNameList => NULL()
4621 0 : HcoConfig%ExtList => NULL()
4622 0 : HcoConfig%Err => NULL()
4623 :
4624 0 : IF ( PRESENT( nModelSpecies ) ) THEN
4625 :
4626 : ! Initialize strings
4627 0 : errMsg = ''
4628 0 : thisLoc = 'ConfigInit (in module hco_config_mod.F90)'
4629 :
4630 : ! Initialize vector w/ species information
4631 0 : HcoConfig%nModelSpc = nModelSpecies
4632 0 : IF ( nModelSpecies > 0 ) THEN
4633 0 : ALLOCATE ( HcoConfig%ModelSpc( nModelSpecies ), STAT=AS )
4634 0 : IF ( AS /= 0 ) THEN
4635 0 : errMsg = 'Could not allocate "ModelSpecies" array!'
4636 0 : CALL HCO_Error( errMsg, RC, thisLoc )
4637 0 : RETURN
4638 : ENDIF
4639 :
4640 : ! Initalize species information. The effective values for species
4641 : ! names, model IDs, etc. are set in the HEMCO-model interface
4642 : ! routine.
4643 0 : DO I = 1, nModelSpecies
4644 0 : HcoConfig%ModelSpc(I)%HcoID = I
4645 0 : HcoConfig%ModelSpc(I)%ModID = -1
4646 0 : HcoConfig%ModelSpc(I)%SpcName = ''
4647 : ENDDO
4648 : ENDIF
4649 :
4650 : ENDIF
4651 :
4652 : END SUBROUTINE ConfigInit
4653 : !EOC
4654 : !------------------------------------------------------------------------------
4655 : ! Harmonized Emissions Component (HEMCO) !
4656 : !------------------------------------------------------------------------------
4657 : !BOP
4658 : !
4659 : ! !IROUTINE: ParseEmisL
4660 : !
4661 : ! !DESCRIPTION: parses the emission level.
4662 : !\\
4663 : !\\
4664 : ! !INTERFACE:
4665 : !
4666 0 : SUBROUTINE ParseEmisL ( str, EmisL, EmisUnit, ScalID )
4667 : !
4668 : ! !INPUT PARAMETERS:
4669 : !
4670 : CHARACTER(LEN=*), INTENT(IN ) :: str
4671 : !
4672 : ! !INPUT/OUTPUT PARAMETERS:
4673 : !
4674 : REAL(hp), INTENT(OUT) :: EmisL
4675 : INTEGER, INTENT(OUT) :: EmisUnit
4676 : INTEGER, INTENT(OUT) :: ScalID
4677 : !
4678 : ! !REVISION HISTORY:
4679 : ! 09 May 2016 - C. Keller: Intial version.
4680 : ! See https://github.com/geoschem/hemco for complete history
4681 : !EOP
4682 : !------------------------------------------------------------------------------
4683 : !BOC
4684 : !
4685 : ! !LOCAL VARIABLES:
4686 : !
4687 : INTEGER :: nchar, idx
4688 :
4689 : !======================================================================
4690 : ! ParseEmisL begins here!
4691 : !======================================================================
4692 :
4693 : ! Init
4694 0 : EmisUnit = HCO_EMISL_LEV
4695 0 : ScalID = -1
4696 :
4697 0 : IF ( TRIM(str) == 'PBL' ) THEN
4698 0 : EmisL = 0.0_hp
4699 0 : EmisUnit = HCO_EMISL_PBL
4700 : ELSE
4701 : ! extract scale factor if string starts with 'SCAL' or 'scal'
4702 0 : nchar = LEN(str)
4703 0 : IF ( nchar > 4 ) THEN
4704 0 : IF ( str(1:4)=='SCAL' .OR. str(1:4)=='scal' ) THEN
4705 0 : READ(str(5:nchar),*) ScalID
4706 0 : EmisUnit = -1
4707 0 : EmisL = -1.0
4708 : ENDIF
4709 : ENDIF
4710 :
4711 : ! check for elevation unit flag (e.g. 1000m)
4712 0 : IF ( ScalID < 0 ) THEN
4713 0 : idx = INDEX(TRIM(str),'m')
4714 0 : IF ( idx > 0 ) THEN
4715 0 : READ(str(1:(idx-1)),*) EmisL
4716 0 : EmisUnit = HCO_EMISL_M
4717 : ELSE
4718 0 : READ(str,*) EmisL
4719 : ENDIF
4720 : ENDIF
4721 : ENDIF
4722 :
4723 0 : END SUBROUTINE ParseEmisL
4724 : !EOC
4725 : !------------------------------------------------------------------------------
4726 : ! Harmonized Emissions Component (HEMCO) !
4727 : !------------------------------------------------------------------------------
4728 : !BOP
4729 : !
4730 : ! !IROUTINE: CheckForDuplicateName
4731 : !
4732 : ! !DESCRIPTION: Subroutine CheckForDuplicateName checks if there is a
4733 : ! container in the container linked list that has the same name as the
4734 : ! name given as input argument.
4735 : !\\
4736 : !\\
4737 : ! !INTERFACE:
4738 : !
4739 0 : Subroutine CheckForDuplicateName( HcoConfig, cName, RC )
4740 : !
4741 : ! !INPUT ARGUMENT:
4742 : !
4743 : TYPE(ConfigObj) , POINTER :: HcoConfig ! HEMCO config obj
4744 : CHARACTER(LEN=*), INTENT(IN) :: cName
4745 : !
4746 : ! !OUTPUT ARGUMENT:
4747 : !
4748 : INTEGER, INTENT(INOUT) :: RC
4749 : !
4750 : ! !REVISION HISTORY:
4751 : ! 20 Jul 2018 - C. Keller: Initial version
4752 : ! See https://github.com/geoschem/hemco for complete history
4753 : !EOP
4754 : !------------------------------------------------------------------------------
4755 : !BOC
4756 : !
4757 : ! !LOCAL VARIABLES:
4758 : !
4759 : TYPE(ListCont), POINTER :: ThisLct => NULL()
4760 : LOGICAL :: Duplicate
4761 : CHARACTER(LEN=255) :: tmpName, thisLoc
4762 : CHARACTER(LEN=512) :: errMsg
4763 :
4764 : !======================================================================
4765 : ! CheckForDuplicateName begins here!
4766 : !======================================================================
4767 :
4768 : ! Init
4769 0 : RC = HCO_SUCCESS
4770 0 : errMsg = ''
4771 0 : thisLoc = 'CheckForDuplicateName (in module hco_config_mod.F90)'
4772 0 : Duplicate = .FALSE.
4773 :
4774 : ! Pass name to clear spaces
4775 0 : tmpName = ADJUSTL(cName)
4776 :
4777 : ! Walk through list and check for duplicate. Exit if found
4778 0 : ThisLct => HcoConfig%ConfigList
4779 0 : DO WHILE ( ASSOCIATED ( ThisLct ) )
4780 :
4781 : ! Skip if data container not defined
4782 0 : IF ( .NOT. ASSOCIATED(ThisLct%Dct) ) THEN
4783 0 : ThisLct => ThisLct%NextCont
4784 0 : CYCLE
4785 : ENDIF
4786 :
4787 : ! Check if this container has desired scalID
4788 0 : IF ( TRIM(ThisLct%Dct%cName) == TRIM(tmpName) ) THEN
4789 0 : Duplicate = .TRUE.
4790 0 : EXIT
4791 : ENDIF
4792 :
4793 : ! Move to next container
4794 0 : ThisLct => ThisLct%NextCont
4795 : ENDDO
4796 :
4797 : IF ( Duplicate ) THEN
4798 0 : errMsg = 'Error: HEMCO field already exists:'//TRIM(cName)
4799 0 : CALL HCO_Error( errMsg, RC, thisLoc )
4800 0 : RETURN
4801 : ENDIF
4802 :
4803 0 : END SUBROUTINE CheckForDuplicateName
4804 : !EOC
4805 : !------------------------------------------------------------------------------
4806 : ! GEOS-Chem Global Chemical Transport Model !
4807 : !------------------------------------------------------------------------------
4808 : !BOP
4809 : !
4810 : ! !IROUTINE: Hco_GetTagInfo
4811 : !
4812 : ! !DESCRIPTION: Subroutine HCO\_GETTAGINFO retrieves basic information about
4813 : ! tags given a wildcard string.
4814 : !\\
4815 : !\\
4816 : ! !INTERFACE:
4817 : !
4818 0 : SUBROUTINE Hco_GetTagInfo( tagID, HcoConfig, Found, &
4819 0 : RC, N, tagName, nTags )
4820 : !
4821 : ! !USES:
4822 : !
4823 : !
4824 : ! !INPUT PARAMETERS:
4825 : !
4826 : CHARACTER(LEN=*), INTENT(IN) :: tagID ! ID of tag (e.g. wildcard)
4827 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO Config object
4828 : INTEGER, OPTIONAL :: N ! index (1 to # tags)
4829 : !
4830 : ! !OUTPUT PARAMETERS:
4831 : !
4832 : LOGICAL, INTENT(OUT) :: Found ! Item found?
4833 : INTEGER, INTENT(OUT) :: RC ! Return code
4834 : CHARACTER(LEN=255), OPTIONAL :: tagName ! tag name for index N
4835 : INTEGER, OPTIONAL :: nTags ! # tags
4836 : !
4837 : ! !REMARKS:
4838 : !
4839 : ! !REVISION HISTORY:
4840 : ! 23 Oct 2018 - M. Sulprizio- Initial version based on routine Get_TagInfo in
4841 : ! GEOS-Chem's Headers/state_diag_mod.F90
4842 : ! See https://github.com/geoschem/hemco for complete history
4843 : !EOP
4844 : !------------------------------------------------------------------------------
4845 : !BOC
4846 : !
4847 : ! !LOCAL VARIABLES:
4848 : !
4849 : ! Scalars
4850 : INTEGER :: D, numTags
4851 : LOGICAL :: isNumTags, isTagName, isN
4852 :
4853 : ! Strings
4854 : CHARACTER(LEN=255) :: thisLoc, Nstr
4855 : CHARACTER(LEN=512) :: errMsg
4856 :
4857 : !=======================================================================
4858 : ! Hco_GetTagInfo begins here
4859 : !=======================================================================
4860 :
4861 : ! Initialize
4862 0 : errMsg = ''
4863 0 : thisLoc = 'Hco_Get_TagInfo (in module hco_config_mod.F90)'
4864 0 : Found = .TRUE.
4865 0 : numTags = 0
4866 :
4867 : ! Optional arguments present?
4868 0 : isN = PRESENT( N )
4869 0 : isTagName = PRESENT( TagName )
4870 0 : isNumTags = PRESENT( nTags )
4871 :
4872 : ! Exit with error if getting tag name but index not specified
4873 0 : IF ( isTagName .AND. .NOT. isN ) THEN
4874 0 : ErrMsg = 'Index must be specified if retrieving an individual tag name'
4875 0 : CALL HCO_Error( errMsg, RC, thisLoc )
4876 0 : RETURN
4877 : ENDIF
4878 :
4879 : !=======================================================================
4880 : ! Get number of tags
4881 : !=======================================================================
4882 0 : SELECT CASE( TRIM( tagId ) )
4883 : CASE( 'ALL' )
4884 0 : numTags = HcoConfig%nModelSpc
4885 : CASE( 'ADV' )
4886 0 : numTags = HcoConfig%nModelAdv
4887 : CASE DEFAULT
4888 0 : FOUND = .FALSE.
4889 : ErrMsg = 'Handling of tagId ' // TRIM(tagId) // &
4890 0 : ' is not implemented for getting number of tags'
4891 0 : CALL HCO_Error( errMsg, RC, thisLoc )
4892 0 : RETURN
4893 : END SELECT
4894 :
4895 : !=======================================================================
4896 : ! Sanity checks -- exit under certain conditions
4897 : !=======================================================================
4898 :
4899 : ! If not getting tag name then set nTags and exit
4900 0 : IF ( .NOT. isTagName ) THEN
4901 0 : nTags = numTags
4902 0 : RETURN
4903 : ENDIF
4904 :
4905 : ! Exit with error if index exceeds number of tags for this wildcard
4906 : IF ( isTagName .AND. .NOT. isN ) THEN
4907 : errMsg = &
4908 : 'Index must be greater than total number of tags for wildcard' &
4909 : // TRIM(tagId)
4910 : CALL HCO_Error( errMsg, RC, thisLoc )
4911 : RETURN
4912 : ENDIF
4913 :
4914 : !=======================================================================
4915 : ! Get mapping index
4916 : !=======================================================================
4917 0 : SELECT CASE( TRIM( tagID ) )
4918 : CASE( 'ALL', 'ADV' )
4919 0 : D = N
4920 : CASE DEFAULT
4921 0 : FOUND = .FALSE.
4922 : errMsg = 'Handling of tagId ' // TRIM( tagId ) // &
4923 0 : ' is not implemented for getting tag name'
4924 0 : CALL HCO_Error( errMsg, RC, thisLoc )
4925 0 : RETURN
4926 : END SELECT
4927 :
4928 : !=======================================================================
4929 : ! Return the tag name
4930 : !=======================================================================
4931 0 : tagName = HcoConfig%ModelSpc(D)%SpcName
4932 :
4933 : END SUBROUTINE Hco_GetTagInfo
4934 : !EOC
4935 : !------------------------------------------------------------------------------
4936 : ! GEOS-Chem Global Chemical Transport Model !
4937 : !------------------------------------------------------------------------------
4938 : !BOP
4939 : !
4940 : ! !IROUTINE: UpdateDtaProperties
4941 : !
4942 : ! !DESCRIPTION: Updates metdata about the current data container that is
4943 : ! being created (e.g. time cycle information, level information, etc.)
4944 : !\\
4945 : !\\
4946 : ! !INTERFACE:
4947 : !
4948 0 : SUBROUTINE UpdateDtaProperties( char1, char2, dctType, int3, &
4949 : separator, srcDim, tagCName, tmCycle, &
4950 : wildCard, HcoConfig, Lct, Dta, &
4951 : RC )
4952 : !
4953 : ! !INPUT PARAMETERS:
4954 : !
4955 : CHARACTER(LEN=*), INTENT(IN) :: char1 !
4956 : CHARACTER(LEN=1), INTENT(IN) :: char2 !
4957 : INTEGER, INTENT(IN) :: dctType ! 1=base; 2=scale; 3=mask
4958 : INTEGER, INTENT(IN) :: int3 !
4959 : CHARACTER(LEN=*), INTENT(IN) :: separator ! Separator character
4960 : CHARACTER(LEN=*), INTENT(IN) :: srcDim ! e.g. "xyz", "xy", etc.
4961 : CHARACTER(LEN=*), INTENT(IN) :: tagCName ! Contaniner name
4962 : CHARACTER(LEN=*), INTENT(IN) :: tmCycle ! Tioe cycle flag setting
4963 : CHARACTER(LEN=*), INTENT(IN) :: wildCard ! Wild card character
4964 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO configuration object
4965 : !
4966 : ! !INPUT/OUTPUT PARAMETERS:
4967 : !
4968 : TYPE(ListCont), POINTER :: Lct ! List container object
4969 : TYPE(FileData), POINTER :: Dta ! Data container object
4970 : !
4971 : ! !OUTPUT PARAMETERS:
4972 : !
4973 : INTEGER, INTENT(OUT) :: RC ! Success or failure
4974 : !
4975 : ! !REMARKS:
4976 : ! Abstracted from routine Config_ReadCont.
4977 : !EOP
4978 : !------------------------------------------------------------------------------
4979 : !BOC
4980 : !
4981 : ! !LOCAL VARIABLES:
4982 : !
4983 : ! Scalars
4984 : INTEGER :: levScal1
4985 : INTEGER :: levScal2
4986 : INTEGER :: nEdges
4987 :
4988 : ! Arrays
4989 : INTEGER :: splitInts(255)
4990 :
4991 : ! Strings
4992 : CHARACTER(LEN=255) :: thisLoc
4993 : CHARACTER(LEN=512) :: errMsg
4994 :
4995 : ! String arrays
4996 : CHARACTER(LEN=255) :: SubStrs(255)
4997 :
4998 : !========================================================================
4999 : ! UpdateDtaProperties begins here!
5000 : !========================================================================
5001 :
5002 : ! Initialize
5003 0 : RC = HCO_SUCCESS
5004 0 : levScal1 = 0
5005 0 : levScal2 = 0
5006 0 : nEdges = 0
5007 0 : splitInts = 0
5008 0 : errMsg = ''
5009 : thisLoc = &
5010 0 : ' -> at UpdateDtaProperties (in module HEMCO/src/Core/hco_config_mod.F90)'
5011 :
5012 : !========================================================================
5013 : ! Set time cycling behaviour. Possible values are:
5014 : ! - "C" : cycling <-- DEFAULT
5015 : ! - "CS" : cycling, skip if not exist
5016 : ! - "CY" : cycling, always use simulation year
5017 : ! - "CYS" : cycling, always use simulation yr, skip if not exist
5018 : ! - "R" : range
5019 : ! - "RA" : range, average outside
5020 : ! - "RF" : range, forced (error if not in range)
5021 : ! - "RFY" : range, forced, always use simulation year
5022 : ! - "RFY3 : range, forced, always use simulation year, 3-hourly
5023 : ! - "RY" : range, always use simulation year
5024 : ! - "E" : exact, read/query once
5025 : ! - "EF" : exact, forced (error if not exist), read/query once
5026 : ! - "EFY" : exact, forced, always use sim year
5027 : ! - "EFYO": exact, forced, always use sim year, read once
5028 : ! - "EC" : exact, read/query continuously (e.g. for ESMF interface)
5029 : ! - "ECF" : exact, forced, read/query continuously
5030 : ! - "EY" : exact, always use simulation year, read/query once
5031 : ! - "A" : average
5032 : ! - "I" : interpolate
5033 : ! - "ID" : interpolate, discontinuous dataset
5034 : !========================================================================
5035 :
5036 : ! Zero logical fields of Dta for safety's sake
5037 0 : Dta%MustFind = .FALSE.
5038 0 : Dta%UseSimYear = .FALSE.
5039 0 : Dta%Discontinuous = .FALSE.
5040 :
5041 : ! Look for time cycle values
5042 0 : SELECT CASE( TRIM( TmCycle ) )
5043 : CASE( "C" )
5044 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
5045 0 : Dta%MustFind = .TRUE.
5046 : CASE( "CS" )
5047 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
5048 0 : Dta%MustFind = .FALSE.
5049 : CASE( "CY" )
5050 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
5051 0 : Dta%MustFind = .TRUE.
5052 0 : Dta%UseSimYear = .TRUE.
5053 : CASE( "CYS" )
5054 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
5055 0 : Dta%MustFind = .FALSE.
5056 0 : Dta%UseSimYear = .TRUE.
5057 : CASE( "R" )
5058 0 : Dta%CycleFlag = HCO_CFLAG_RANGE
5059 : CASE( "RA" )
5060 0 : Dta%CycleFlag = HCO_CFLAG_RANGEAVG
5061 : CASE( "RF" )
5062 0 : Dta%CycleFlag = HCO_CFLAG_RANGE
5063 0 : Dta%MustFind = .TRUE.
5064 : CASE( "RFY" )
5065 0 : Dta%CycleFlag = HCO_CFLAG_RANGE
5066 0 : Dta%MustFind = .TRUE.
5067 0 : Dta%UseSimYear = .TRUE.
5068 : CASE( "RFY3" )
5069 0 : Dta%CycleFlag = HCO_CFLAG_RANGE
5070 0 : Dta%MustFind = .TRUE.
5071 0 : Dta%UseSimYear = .TRUE.
5072 0 : Dta%UpdtFlag = HCO_UFLAG_3HR
5073 : CASE( "RY" )
5074 0 : Dta%CycleFlag = HCO_CFLAG_RANGE
5075 0 : Dta%UseSimYear = .TRUE.
5076 : CASE( "E" )
5077 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5078 0 : Dta%UpdtFlag = HCO_UFLAG_ONCE
5079 : CASE( "EF" )
5080 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5081 0 : Dta%UpdtFlag = HCO_UFLAG_ONCE
5082 0 : Dta%MustFind = .TRUE.
5083 : CASE( "EFY" )
5084 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5085 0 : Dta%MustFind = .TRUE.
5086 0 : Dta%UseSimYear = .TRUE.
5087 : CASE( "EFYO" )
5088 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5089 0 : Dta%UpdtFlag = HCO_UFLAG_ONCE
5090 0 : Dta%MustFind = .TRUE.
5091 0 : Dta%UseSimYear = .TRUE.
5092 : CASE( "EC" )
5093 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5094 : CASE( "ECF" )
5095 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5096 0 : Dta%MustFind = .TRUE.
5097 : CASE( "EY" )
5098 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5099 0 : Dta%UpdtFlag = HCO_UFLAG_ONCE
5100 0 : Dta%UseSimYear = .TRUE.
5101 : CASE( "A" )
5102 0 : Dta%CycleFlag = HCO_CFLAG_AVERG
5103 : CASE( "I" )
5104 0 : Dta%CycleFlag = HCO_CFLAG_INTER
5105 : CASE( "ID" )
5106 0 : Dta%CycleFlag = HCO_CFLAG_INTER
5107 0 : Dta%Discontinuous = .TRUE.
5108 : CASE( "-" )
5109 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
5110 : CASE DEFAULT
5111 : errMsg = 'Invalid time cycling attribute: ' // tmCycle // &
5112 0 : ' - in ' // tagcName
5113 0 : CALL HCO_Error( errMsg, RC, thisLoc )
5114 0 : RETURN
5115 : END SELECT
5116 :
5117 : !========================================================================
5118 : ! Set space dimension. This will determine the dimension of the
5119 : ! data array vector, i.e. 3D or 2D. Different time slices will
5120 : ! be stored as different vector elements.
5121 : ! For 3D data, it is now possible to explicitly set the number
5122 : ! of vertical levels to be used, as well as the 'reading
5123 : ! direction' (up or down). These information is also extracted
5124 : ! from srcDim and will be stored in variable Dta%Levels.
5125 : ! (ckeller, 5/20/15)
5126 : ! ExtractSrcDim now also returns possible scale factors for the
5127 : ! injection level, which will be stored in container variable
5128 : ! levScalID1 (bottom level) and levScalID2 (top level).
5129 : !========================================================================
5130 0 : CALL ExtractSrcDim( HcoConfig, srcDim, Dta, levScal1, levScal2, RC )
5131 0 : IF ( RC /= HCO_SUCCESS ) THEN
5132 0 : errMsg = 'Error encountered in routine "ExtractSrcDim"!'
5133 0 : CALL HCO_Error( errMsg, RC, thisLoc )
5134 0 : RETURN
5135 : ENDIF
5136 :
5137 : ! Set level scale factor index
5138 0 : IF ( levScal1 > 0 ) Lct%Dct%levScalID1 = levScal1
5139 0 : IF ( levScal2 > 0 ) Lct%Dct%levScalID2 = levScal2
5140 :
5141 : !========================================================================
5142 : ! For scale factors: check if a mask is assigned to this scale factor.
5143 : ! In this case, pass mask ID to first slot of Scal_cID vector. This
5144 : ! value will be set to the container ID of the corresponding mask
5145 : ! field later on.
5146 : !========================================================================
5147 0 : IF ( DctType == HCO_DCTTYPE_SCAL .AND. Int3 > 0 ) THEN
5148 0 : ALLOCATE ( Lct%Dct%Scal_cID(1) )
5149 0 : Lct%Dct%Scal_cID(1) = Int3
5150 0 : Lct%Dct%nScalID = 1
5151 : ENDIF
5152 :
5153 : !========================================================================
5154 : ! For masks: extract grid box edges. These will be used later on to
5155 : ! determine if emissions have to be considered by this CPU.
5156 : !========================================================================
5157 0 : IF ( DctType == HCO_DCTTYPE_MASK ) THEN
5158 :
5159 : ! Extract grid box edges. Need to be four values.
5160 : CALL HCO_CharSplit( char1, separator, wildcard, &
5161 0 : splitInts, nEdges, RC )
5162 0 : IF ( RC /= HCO_SUCCESS ) THEN
5163 0 : errMsg = 'Error encountered in routine "HCO_CharSplit"!'
5164 0 : CALL HCO_Error( errMsg, RC, thisLoc )
5165 0 : RETURN
5166 : ENDIF
5167 0 : IF ( nEdges /= 4 ) THEN
5168 : errMsg = 'Cannot properly read mask coverage: ' // &
5169 0 : TRIM( Lct%Dct%cName )
5170 0 : CALL HCO_Error( errMsg, RC, thisLoc )
5171 0 : RETURN
5172 : ENDIF
5173 :
5174 : ! Save temporarily in year and month range. Will be
5175 : ! reset lateron.
5176 0 : Dta%ncYrs(1) = splitInts(1)
5177 0 : Dta%ncYrs(2) = splitInts(2)
5178 0 : Dta%ncMts(1) = splitInts(3)
5179 0 : Dta%ncMts(2) = splitInts(4)
5180 :
5181 : ! Make sure that masks are always being read if specified so.
5182 0 : IF ( char2 == 'y' .OR. char2 == 'Y' ) THEN
5183 0 : CALL ScalID2List( HcoConfig%ScalIDList, Lct%Dct%ScalID, RC )
5184 0 : IF ( RC /= HCO_SUCCESS ) THEN
5185 0 : errMsg = 'Error encountered in routine "ScalID2List"!'
5186 0 : CALL HCO_Error( errMsg, RC, thisLoc )
5187 0 : RETURN
5188 : ENDIF
5189 : ENDIF
5190 : ENDIF
5191 :
5192 0 : END SUBROUTINE UpdateDtaProperties
5193 : !EOC
5194 : END MODULE HCO_Config_Mod
|