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 ) ) THEN
562 0 : CALL ReadList_Print( HcoState, HcoState%ReadLists )
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=100) :: 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 = 10
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 )
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 )
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 ) ) 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, GetExtOpt
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 : LOGICAL :: DoEmis, Found, LTMP
1845 : CHARACTER(LEN=255) :: loc
1846 : CHARACTER(LEN=512) :: msg
1847 : CHARACTER(LEN=1023) :: OPTS
1848 : CHARACTER(LEN=2047) :: LINE
1849 : CHARACTER(LEN=2047) :: SUBSTR(255), SPECS(255)
1850 :
1851 : !======================================================================
1852 : ! ExtSwitch2Buffer begins here
1853 : !======================================================================
1854 :
1855 : ! Enter
1856 0 : RC = HCO_SUCCESS
1857 0 : msg = ''
1858 0 : loc = 'ExtSwitch2Buffer (hco_config_mod.F90)'
1859 0 : ExtNr = -1
1860 :
1861 : ! Initialize
1862 0 : DoEmis= .TRUE.
1863 0 : Found = .FALSE.
1864 :
1865 : ! Do until exit
1866 : DO
1867 :
1868 : ! Read line
1869 0 : CALL HCO_ReadLine ( IU_HCO, LINE, EOF, RC )
1870 0 : IF ( RC /= HCO_SUCCESS ) THEN
1871 0 : msg = 'Error in HEMCO_Config.rc @ line: ' // TRIM( line )
1872 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
1873 0 : RETURN
1874 : ENDIF
1875 :
1876 : ! Return if EOF
1877 0 : IF ( EOF ) RETURN
1878 :
1879 : ! Exit here if end of section encountered. Place this before the
1880 : ! test for comment to allow for "### END SECTION" tags (bmy, 4/21/15)
1881 0 : IF ( INDEX ( LINE, 'END SECTION' ) > 0 ) RETURN
1882 :
1883 : ! Jump to next line if line is commented out
1884 0 : IF ( LINE(1:1) == HCO_CMT ) CYCLE
1885 :
1886 : ! Check if these are options
1887 0 : IF ( INDEX(LINE,'-->') > 0 ) THEN
1888 : ! Only add if extension is defined!
1889 0 : IF ( ExtNr >= 0 .AND. Enabled ) THEN
1890 : CALL AddExtOpt( HcoConfig, TRIM(LINE), &
1891 0 : ExtNr, RC, IgnoreIfExist=.TRUE. )
1892 0 : IF ( RC /= HCO_SUCCESS ) THEN
1893 0 : msg = 'Error in HEMCO_Config.rc @ line: ' // TRIM( line )
1894 0 : CALL HCO_ERROR( msg, RC, thisLoc=loc )
1895 0 : RETURN
1896 : ENDIF
1897 : ENDIF
1898 :
1899 : ! Check if EMISSIONS setting is found. If so, overwrite DoEmis.
1900 0 : IF ( .not. Found ) THEN
1901 : CALL GetExtOpt( HcoConfig, -999, 'EMISSIONS', &
1902 0 : OptValBool=LTMP, FOUND=Found, RC=RC )
1903 0 : IF ( RC /= HCO_SUCCESS ) THEN
1904 0 : msg = 'Error encountered in "GetExtOpt( EMISSIONS )"!'
1905 0 : CALL HCO_Error( msg, RC, ThisLoc=loc )
1906 0 : RETURN
1907 : ENDIF
1908 0 : IF ( Found ) DoEmis = LTMP
1909 : ENDIF
1910 : CYCLE
1911 : ENDIF
1912 :
1913 : ! ---------------------------------------------------------------------
1914 : ! If the line is not an extension option, treat it as an extension
1915 : ! definition (e.g. 108 MEGAN : on ISOP/ACET/PRPE/C2H4/ALD2)
1916 : ! ---------------------------------------------------------------------
1917 :
1918 : ! Split character string
1919 0 : CALL STRREPL ( LINE, HCO_TAB, HCO_TAB )
1920 0 : CALL STRSPLIT( LINE, HCO_SPC, SUBSTR, N )
1921 :
1922 : ! Jump to next line if this line is empty
1923 0 : IF ( N <= 1 ) CYCLE
1924 :
1925 : ! Check if extension already exists, e.g. if this is a nested HEMCO configuration
1926 : ! file and the same extension has already been defined. In that case, use the
1927 : ! on/off toggle that has already been defined.
1928 0 : ExtNr = GetExtNr( HcoConfig%ExtList, TRIM(SUBSTR(2)) )
1929 :
1930 : ! Three possibilities:
1931 : ! - ExtNr is -999 --> extension does not yet exist
1932 : ! - ExtNr is a positive number --> extension exists and is enabled
1933 : ! - ExtNr is -1 --> extension exists and is disabled
1934 0 : IF ( ExtNr == -999 ) THEN
1935 : NewExt = .TRUE.
1936 0 : ELSEIF ( ExtNr >= 0 ) THEN
1937 0 : NewExt = .FALSE.
1938 0 : Enabled = .TRUE.
1939 : ELSE
1940 0 : NewExt = .FALSE.
1941 0 : Enabled = .FALSE.
1942 : ENDIF
1943 :
1944 : ! The following needs to be done for new extensions only
1945 : IF ( NewExt ) THEN
1946 :
1947 : ! Check for on-switch. This is either the
1948 : ! 3rd or the 4th substring, depending on the
1949 : ! location of the colon sign!
1950 0 : IF ( TRIM(SUBSTR(3)) /= ':' ) THEN
1951 : idx = 3
1952 : ELSE
1953 : idx = 4
1954 : ENDIF
1955 0 : CALL TRANLC( TRIM(SUBSTR(idx)) )
1956 0 : IF ( TRIM(SUBSTR(idx)) == 'on' ) THEN
1957 0 : Enabled = .TRUE.
1958 : ELSE
1959 0 : Enabled = .FALSE.
1960 : ENDIF
1961 :
1962 : ! Disable extension if EMISSIONS logical is false
1963 0 : IF ( .not. DoEmis ) THEN
1964 0 : Enabled = .FALSE.
1965 : ENDIF
1966 :
1967 : ! Register extension name, number and species
1968 : ! idx is the position of the species names
1969 0 : idx = idx+1
1970 0 : READ( SUBSTR(1), * ) ExtNr
1971 : CALL AddExt ( HcoConfig, TRIM(SUBSTR(2)), &
1972 0 : ExtNr, Enabled, SUBSTR(idx), RC )
1973 0 : IF ( RC /= HCO_SUCCESS ) THEN
1974 0 : CALL HCO_ERROR( 'ERROR 32', RC, THISLOC=LOC )
1975 0 : RETURN
1976 : ENDIF
1977 :
1978 : ! Register species (specNames)
1979 0 : IF ( Enabled ) THEN
1980 :
1981 : CALL STRSPLIT( SUBSTR(idx), &
1982 0 : HCO_GetOpt(HcoConfig%ExtList,'Separator'), SPECS, N )
1983 0 : IF ( N < 1 ) THEN
1984 0 : CALL HCO_ERROR ( 'No species defined', RC, THISLOC=LOC )
1985 0 : RETURN
1986 : ENDIF
1987 0 : DO I = 1, N
1988 0 : CALL SpecName_Register ( HcoConfig, SPECS(I), RC )
1989 0 : IF ( RC /= HCO_SUCCESS ) THEN
1990 0 : msg = 'Error encountered in "SpecName_Register"!'
1991 0 : CALL HCO_ERROR( msg, RC, thisLoc=LOC )
1992 0 : RETURN
1993 : ENDIF
1994 : ENDDO
1995 : ENDIF
1996 : ENDIF ! NextExt
1997 : ENDDO
1998 :
1999 : ! Leave w/ success
2000 : RC = HCO_SUCCESS
2001 :
2002 : END SUBROUTINE ExtSwitch2Buffer
2003 : !EOC
2004 : !------------------------------------------------------------------------------
2005 : ! Harmonized Emissions Component (HEMCO) !
2006 : !------------------------------------------------------------------------------
2007 : !BOP
2008 : !
2009 : ! !ROUTINE: ReadSettings
2010 : !
2011 : ! !DESCRIPTION: Subroutine ReadSettings reads the HEMCO settings,
2012 : ! stores them as HEMCO core extension options, and also evaluates
2013 : ! some of the values (e.g. to initialize the HEMCO error module).
2014 : !\\
2015 : !\\
2016 : ! !INTERFACE:
2017 : !
2018 0 : SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC )
2019 : !
2020 : ! !USES:
2021 : !
2022 : USE HCO_EXTLIST_MOD, ONLY : AddExtOpt, GetExtOpt, CoreNr
2023 : USE HCO_EXTLIST_MOD, ONLY : HCO_SetDefaultToken
2024 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
2025 : USE HCO_CHARPAK_MOD, ONLY : STRREPL, STRSPLIT, TRANLC
2026 : !
2027 : ! !INPUT PARAMETERS:
2028 : !
2029 : TYPE(ConfigObj), POINTER :: HcoConfig ! Config obj
2030 : INTEGER, INTENT(IN) :: IU_HCO ! HEMCO configfile LUN
2031 : !
2032 : ! !INPUT/OUTPUT PARAMETERS:
2033 : !
2034 : LOGICAL, INTENT(INOUT) :: EOF ! End of file?
2035 : INTEGER, INTENT(INOUT) :: RC ! Success/failure
2036 : !
2037 : ! !REVISION HISTORY:
2038 : ! 17 Sep 2013 - C. Keller - Initialization (update)
2039 : ! See https://github.com/geoschem/hemco for complete history
2040 : !EOP
2041 : !------------------------------------------------------------------------------
2042 : !BOC
2043 : !
2044 : ! !LOCAL VARIABLES:
2045 : !
2046 : ! Scalars
2047 : LOGICAL :: doVerbose, doVerboseOnRoot, found
2048 : INTEGER :: I, N, POS
2049 :
2050 : ! Strings
2051 : CHARACTER(LEN=10) :: onCores
2052 : CHARACTER(LEN=15) :: verboseMsg
2053 : CHARACTER(LEN=255) :: line
2054 : CHARACTER(LEN=255) :: loc
2055 : CHARACTER(LEN=255) :: LogFile
2056 : CHARACTER(LEN=255) :: DiagnPrefix
2057 : CHARACTER(LEN=255) :: MetField
2058 : CHARACTER(LEN=255) :: GridRes
2059 : CHARACTER(LEN=512) :: msg
2060 :
2061 : !======================================================================
2062 : ! ReadSettings begins here
2063 : !======================================================================
2064 :
2065 : ! Enter
2066 0 : Loc = 'ReadSettings (hco_config_mod.F90)'
2067 :
2068 :
2069 : !-----------------------------------------------------------------------
2070 : ! Read settings and add them as options to core extensions
2071 : !-----------------------------------------------------------------------
2072 :
2073 : ! Do until exit
2074 : DO
2075 :
2076 : ! Read line
2077 0 : CALL HCO_ReadLine ( IU_HCO, LINE, EOF, RC )
2078 0 : IF ( RC /= HCO_SUCCESS ) THEN
2079 0 : msg = 'Error in HEMCO_Config.rc @ line: ' // TRIM( Line )
2080 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2081 0 : RETURN
2082 : ENDIF
2083 :
2084 : ! Return if EOF
2085 0 : IF ( EOF ) EXIT
2086 :
2087 : ! Exit here if end of section encountered
2088 0 : IF ( INDEX ( LINE, 'END SECTION' ) > 0 ) EXIT
2089 :
2090 : ! Jump to next line if line is commented out
2091 0 : IF ( LINE(1:1) == HCO_CMT ) CYCLE
2092 :
2093 : ! Ignore empty lines
2094 0 : IF ( TRIM(LINE) == '' ) CYCLE
2095 :
2096 : ! Add this option to HEMCO core
2097 : CALL AddExtOpt ( HcoConfig, TRIM(LINE), &
2098 0 : CoreNr, RC, IgnoreIfExist=.TRUE. )
2099 0 : IF ( RC /= HCO_SUCCESS ) THEN
2100 0 : msg = 'Error in HEMCO_Config.rc @ line: ' // TRIM( Line )
2101 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2102 0 : RETURN
2103 : ENDIF
2104 :
2105 : ENDDO
2106 :
2107 : #ifndef MODEL_GEOS
2108 : #ifndef MODEL_WRF
2109 : #ifndef MODEL_CESM
2110 : #ifndef ESMF_
2111 : !=======================================================================
2112 : ! Look for met field and grid resolution. When running the HEMCO
2113 : ! standalone these will need to be read from the configuration file.
2114 : ! Otherwise, HEMCO will inherit the met field and grid resolution
2115 : ! of the parent model (GC-Classic, GCHP, etc.)
2116 : !
2117 : ! NOTE: Only do this check if not using GEOS-Chem in an external ESM!
2118 : !=======================================================================
2119 :
2120 : ! Look for met field
2121 : CALL GetExtOpt( HcoConfig, CoreNr, 'MET', &
2122 : OptValChar=MetField, FOUND=FOUND, RC=RC )
2123 : IF ( FOUND ) THEN
2124 : HcoConfig%MetField = TRIM( MetField )
2125 : ENDIF
2126 :
2127 : ! Look for grid resolution
2128 : ! Make sure resolution string is in the proper FlexGrid format
2129 : CALL GetExtOpt( HcoConfig, CoreNr, 'RES', &
2130 : OptValChar=GridRes, FOUND=FOUND, RC=RC )
2131 : IF ( FOUND ) THEN
2132 : SELECT CASE( TRIM( GridRes ) )
2133 : CASE( '4x5' )
2134 : GridRes = '4.0x5.0'
2135 : CASE( '2x25', '2x2.5' )
2136 : GridRes = '2.0x2.5'
2137 : CASE( '05x0625', '0.5x0.625' )
2138 : GridRes = '0.5x0.625'
2139 : CASE( '025x03125', '0.25x0.3125' )
2140 : GridRes = '0.25x0.3125'
2141 : CASE DEFAULT
2142 : Msg = 'Improperly formatted grid resolution: ' // TRIM( GridRes )
2143 : CALL HCO_Error( Msg, RC, Loc )
2144 : RETURN
2145 : END SELECT
2146 : HcoConfig%GridRes = TRIM( GridRes )
2147 : ENDIF
2148 : #endif
2149 : #endif
2150 : #endif
2151 : #endif
2152 :
2153 : !-----------------------------------------------------------------------
2154 : ! Initialize error object if needed.
2155 : ! Extract values to initialize error module and set some further
2156 : ! HEMCO variables. Only the first time the settings are read (settings
2157 : ! can be read multiple times if nested HEMCO configuration files are
2158 : ! used)
2159 : !-----------------------------------------------------------------------
2160 0 : IF ( .NOT. ASSOCIATED(HcoConfig%Err) ) THEN
2161 :
2162 : ! Initialize
2163 0 : doVerbose = .FALSE.
2164 0 : doVerboseOnRoot = .FALSE.
2165 0 : onCores = ''
2166 :
2167 : ! First look for Verbose
2168 : CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', &
2169 0 : OptValBool=doVerbose, found=found, RC=RC )
2170 0 : IF ( RC /= HCO_SUCCESS ) THEN
2171 0 : msg = 'Error looking for "Verbose" in HEMCO_Config.rc!'
2172 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2173 0 : RETURN
2174 : ENDIF
2175 :
2176 : ! First look for Verbose (logical). This is now the default
2177 : ! inthe HEMCO_Config.rc file for HEMCO 3.7.0 and later.
2178 : CALL GetExtOpt( HcoConfig, CoreNr, 'VerboseOnCores', &
2179 0 : OptValChar=onCores, found=found, RC=RC )
2180 0 : IF ( RC /= HCO_SUCCESS ) THEN
2181 0 : msg = 'Error looking for "VerboseOnCores in HEMCO_Config.rc!'
2182 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2183 0 : RETURN
2184 : ENDIF
2185 :
2186 : ! Set a flag if Verbose output is to be done on the root core only
2187 : ! (if false, it will be done on all cores)
2188 0 : CALL TranLC( onCores )
2189 0 : doVerboseOnRoot = ( TRIM( onCores ) == "root" )
2190 :
2191 : ! Print status message
2192 0 : IF ( doVerbose ) THEN
2193 0 : msg = NEW_LINE( 'A' ) // 'HEMCO verbose output is ON '
2194 0 : IF ( doVerboseOnRoot ) THEN
2195 0 : msg = TRIM( msg ) // ' (root core only)'
2196 : ELSE
2197 0 : msg = TRIM( msg ) // ' (all cores)'
2198 : ENDIF
2199 : ELSE
2200 0 : msg = NEW_LINE( 'A' ) // 'HEMCO verbose output is OFF'
2201 : ENDIF
2202 0 : IF ( HcoConfig%amIRoot ) CALL HCO_Msg( msg, verb=.TRUE. )
2203 :
2204 : ! Logfile to write into
2205 : CALL GetExtOpt( HcoConfig, CoreNr, 'Logfile', &
2206 0 : OptValChar=Logfile, FOUND=FOUND, RC=RC )
2207 0 : IF ( RC /= HCO_SUCCESS ) THEN
2208 0 : msg = 'Error looking for "Logfile" in HEMCO_Config.rc!'
2209 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2210 0 : RETURN
2211 : ENDIF
2212 0 : IF ( .NOT. FOUND ) THEN
2213 0 : LogFile = 'HEMCO.log'
2214 0 : WRITE(*,*) 'Setting `Logfile` not found in HEMCO logfile - use `HEMCO.log`'
2215 : ENDIF
2216 :
2217 : ! Initialize (standard) HEMCO tokens
2218 0 : CALL HCO_SetDefaultToken( HcoConfig, RC )
2219 0 : IF ( RC /= HCO_SUCCESS ) THEN
2220 0 : msg = 'Error encountered in routine "HCO_SetDefaultToken"!'
2221 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2222 0 : RETURN
2223 : ENDIF
2224 :
2225 : ! If LogFile is equal to wildcard character, set LogFile to asterik
2226 : ! character. This will ensure that all output is written to standard
2227 : ! output!
2228 0 : IF ( TRIM(LogFile) == HCO_GetOpt(HcoConfig%ExtList,'Wildcard') ) &
2229 0 : LogFile = '*'
2230 :
2231 : ! We should now have everything to define the HEMCO error settings
2232 : CALL HCO_ERROR_SET( HcoConfig%amIRoot, HcoConfig%Err, LogFile, &
2233 0 : doVerbose, doVerboseOnRoot, RC )
2234 0 : IF ( RC /= HCO_SUCCESS ) THEN
2235 0 : msg = 'Error encountered in routine "Hco_Error_Set"!'
2236 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2237 0 : RETURN
2238 : ENDIF
2239 :
2240 : ENDIF
2241 :
2242 : ! Leave w/ success
2243 0 : RC = HCO_SUCCESS
2244 :
2245 : END SUBROUTINE ReadSettings
2246 : !EOC
2247 : !------------------------------------------------------------------------------
2248 : ! Harmonized Emissions Component (HEMCO) !
2249 : !------------------------------------------------------------------------------
2250 : !BOP
2251 : !
2252 : ! !IROUTINE: RegisterPrepare
2253 : !
2254 : ! !DESCRIPTION: Subroutine RegisterPrepare extracts the spatial
2255 : ! coverages of all mask fields as well as the HEMCO species IDs of
2256 : ! all base emissions.
2257 : !\\
2258 : !\\
2259 : ! The species IDs are determined by matching the species name read
2260 : ! from the configuration file (in ConfigList) and the species names
2261 : ! defined in the HEMCO state object HcoState.
2262 : !\\
2263 : !\\
2264 : ! Mask coverages are defined based upon the passed horizontal grid
2265 : ! extensions on this CPU (xrng and yrng).
2266 : !\\
2267 : !\\
2268 : ! !INTERFACE:
2269 : !
2270 0 : SUBROUTINE RegisterPrepare( HcoState, RC )
2271 : !
2272 : ! !USES:
2273 : !
2274 : USE HCO_EXTLIST_MOD, ONLY : ExtNrInUse
2275 : USE HCO_STATE_Mod, ONLY : HCO_GetHcoID
2276 : USE HCO_DATACONT_MOD, ONLY : ListCont_NextCont
2277 : !
2278 : ! !INPUT PARAMETERS:
2279 : !
2280 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj.
2281 : !
2282 : ! !OUTPUT PARAMETERS:
2283 : !
2284 : INTEGER, INTENT(INOUT) :: RC
2285 : !
2286 : ! !REVISION HISTORY:
2287 : ! 18 Sep 2013 - C. Keller - Initial version (update)
2288 : ! See https://github.com/geoschem/hemco for complete history
2289 : !EOP
2290 : !------------------------------------------------------------------------------
2291 : !BOC
2292 : !
2293 : ! !LOCAL VARIABLES:
2294 : !
2295 : TYPE(ListCont), POINTER :: Lct
2296 : INTEGER :: ThisCover, ThisHcoID, FLAG
2297 : INTEGER :: lon1, lon2, lat1, lat2
2298 : INTEGER :: cpux1, cpux2, cpuy1, cpuy2
2299 : CHARACTER(LEN=255) :: loc
2300 : CHARACTER(LEN=512) :: msg
2301 :
2302 : !=================================================================
2303 : ! RegisterPrepare begins here!
2304 : !=================================================================
2305 0 : loc = 'RegisterPrepare (HCO_CONFIG_MOD.F90)'
2306 :
2307 : ! Enter
2308 0 : CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
2309 0 : IF ( RC /= HCO_SUCCESS ) THEN
2310 0 : msg = 'Error encountered in routine "HCO_Enter"!'
2311 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2312 0 : RETURN
2313 : ENDIF
2314 :
2315 : ! Initialize
2316 0 : Lct => NULL()
2317 :
2318 : ! Grid boundaries on this CPU. Will be needed to calculate
2319 : ! coverages.
2320 : ! NOTE: Use midpoints here because only those become defined in
2321 : ! the ESMF environment (xedge and yedge are not used anywhere
2322 : ! else in ESMF!).
2323 0 : cpux1 = FLOOR(MINVAL(HcoState%Grid%XMID%Val))
2324 0 : cpux2 = FLOOR(MAXVAL(HcoState%Grid%XMID%Val))
2325 0 : cpuy1 = CEILING(MINVAL(HcoState%Grid%YMID%Val))
2326 0 : cpuy2 = CEILING(MAXVAL(HcoState%Grid%YMID%Val))
2327 :
2328 : ! Make sure values are within -180.0 to 180.0
2329 0 : IF ( cpux1 >= 180 ) cpux1 = cpux1 - 360
2330 0 : IF ( cpux2 >= 180 ) cpux2 = cpux2 - 360
2331 :
2332 : ! verbose
2333 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
2334 0 : WRITE(MSG,*) 'Start to prepare fields for registering!'
2335 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2336 0 : WRITE(MSG,*) 'This CPU x-range: ', cpux1, cpux2
2337 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2338 0 : WRITE(MSG,*) 'This CPU y-range: ', cpuy1, cpuy2
2339 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2340 : ENDIF
2341 :
2342 : ! Get next (first) line of ConfigList
2343 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2344 :
2345 : ! Loop over all lines
2346 0 : DO WHILE ( FLAG == HCO_SUCCESS )
2347 :
2348 : ! Check if data container defined
2349 0 : IF ( .NOT. ASSOCIATED(Lct%Dct) ) THEN
2350 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2351 0 : CYCLE
2352 : ENDIF
2353 :
2354 : ! verbose
2355 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
2356 0 : WRITE(MSG,*) 'Prepare ', TRIM(Lct%Dct%cName)
2357 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2358 : ENDIF
2359 :
2360 : ! For base fields or data fields used in one of the HEMCO
2361 : ! extensions:
2362 0 : IF ( Lct%Dct%DctType == HCO_DCTTYPE_BASE ) THEN
2363 :
2364 : ! Only do for entries that will be used!
2365 0 : IF ( ExtNrInUse( HcoState%Config%ExtList, Lct%Dct%ExtNr ) ) THEN
2366 :
2367 : ! Extract HEMCO species ID. This will return -1 for
2368 : ! undefined species and 0 for wildcard character.
2369 0 : ThisHcoID = HCO_GetHcoID( Lct%Dct%SpcName, HcoState )
2370 0 : Lct%Dct%HcoID = ThisHcoID
2371 :
2372 : ! verbose
2373 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
2374 0 : WRITE(MSG,*) 'Assigned HEMCO species ID: ', Lct%Dct%HcoID
2375 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2376 : ENDIF
2377 :
2378 : ! Else: assign default value. These containers will be
2379 : ! removed in the next step!
2380 : ELSE
2381 0 : Lct%Dct%HcoID = -999
2382 : ENDIF
2383 :
2384 : ! Calculate coverage for masks
2385 0 : ELSE IF ( Lct%Dct%DctType == HCO_DCTTYPE_MASK .AND. &
2386 : Lct%Dct%Dta%Cover == -999 ) THEN
2387 :
2388 : ! The mask coverage calculation (which only has three values)
2389 : ! is used to simplify I/O and CPU operations in code below.
2390 : !
2391 : ! However, there are two distinct bugs related to this:
2392 : !
2393 : ! (1)
2394 : ! There appear to be some issues with full masks coverages
2395 : ! when working in an MPI environment. Specifically, masks
2396 : ! can be seen as fully covering a given CPU even though in
2397 : ! reality it may only cover parts of it. Thus, in ESMF mode
2398 : ! always set coverage to zero or partial (ckeller, 3/17/16).
2399 : !
2400 : ! This appears to be related to masking for two inventories
2401 : ! with overlapping temporal coverage. For example, if inventory
2402 : ! A is 2013-2015, and B is 2010-2018 with higher hierarchy,
2403 : ! but not the same mask (maybe A covers regions that B does not).
2404 : ! If both masks are set to ThisCover == 1 (full coverage), because
2405 : ! a certain CPU might be overlapped by lon1/lat1/lon2/lat2 even
2406 : ! though the actual netCDF shape of the mask is different,
2407 : ! then a simulation running 2013-2015 will see inventory B on that CPU
2408 : ! decide it has full coverage (only through lon1/..), and skip
2409 : ! inventory A altogether, resulting in missing emissions.
2410 : ! This behavior is in the line
2411 : ! IF ( (tmpLct%Dct%Hier > Hier) .AND. (tmpCov==1) ) THEN below.
2412 : !
2413 : ! (2)
2414 : ! Another artifact caused by MPI environments:
2415 : ! where lon1/lat1/... is set too small, resulting in certain CPUs not
2416 : ! having overlap (defined by cpux/y) with lon1/lat1/..., and thus
2417 : ! skipping the base inventory as a bug. This behavior is in the line
2418 : ! IF ( (mskLct%Dct%DctType == HCO_DCTTYPE_MASK ) .AND. &
2419 : ! (mskLct%Dct%Dta%Cover == 0 ) ) THEN
2420 : !
2421 : ! Because the code only distinguishes between full/partial and zero
2422 : ! coverage, and skips reading the base field if coverage is zero,
2423 : ! this may cause issues with MPI environments in WRF and CESM where
2424 : ! the mask lon1/lat1/lon2/lat2 boundaries are set too small compared
2425 : ! to the mask, and result in the base field being skipped over small
2426 : ! CPU decompositions where it should not have been. The above fix
2427 : ! does not fix the issue where ThisCover == 0, which is the root
2428 : ! cause in WRF and CESM. Thus, always set to partial coverage
2429 : ! (hplin, 8/19/22)
2430 : !
2431 : ! Thus, the following fix needs to be applied for ESMF environments,
2432 : ! skipping a lot of the calculations below.
2433 : #if defined ( ESMF_ ) || defined( MODEL_WRF ) || defined( MODEL_CESM )
2434 0 : ThisCover = -1
2435 : #else
2436 : ! Get mask edges
2437 : lon1 = Lct%Dct%Dta%ncYrs(1)
2438 : lat1 = Lct%Dct%Dta%ncYrs(2)
2439 : lon2 = Lct%Dct%Dta%ncMts(1)
2440 : lat2 = Lct%Dct%Dta%ncMts(2)
2441 :
2442 : ! If ncFile is passed as the lon1/lat1/lon2/lat2 instead
2443 : ! of netCDF file name, then set ncRead to false, so that
2444 : ! HEMCO won't try to read a file from disk. Also set the
2445 : ! IsLocTime flag to TRUE. This should fix Github issue
2446 : ! https://github.com/geoschem/HEMCO/issues/153.
2447 : ! -- Bob Yantosca (12 Jul 2022)
2448 : !
2449 : ! Also allow for the .$NC replaceable token, see:
2450 : ! https://github.com/geoschem/HEMCO/issues/204
2451 : ! -- Melissa Sulprizio & Bob Yantosca (11 Apr 2023)
2452 : IF ( INDEX( Lct%Dct%Dta%ncFile, ".nc" ) == 0 ) THEN
2453 : IF ( INDEX( Lct%Dct%Dta%ncFile, ".$NC" ) == 0 ) THEN
2454 : Lct%Dct%Dta%ncRead = .FALSE.
2455 : Lct%Dct%Dta%IsLocTime = .TRUE.
2456 : ENDIF
2457 : ENDIF
2458 :
2459 : ThisCover = CALC_COVERAGE( lon1, lon2, lat1, lat2, &
2460 : cpux1, cpux2, cpuy1, cpuy2 )
2461 : #endif
2462 :
2463 : ! Update container information
2464 0 : Lct%Dct%Dta%Cover = ThisCover
2465 0 : Lct%Dct%Dta%ncYrs(:) = -999
2466 0 : Lct%Dct%Dta%ncMts(:) = -999
2467 :
2468 0 : IF ( HCO_IsVerb(HcoSTate%Config%Err ) ) THEN
2469 0 : WRITE(MSG,*) 'Coverage: ', Lct%Dct%Dta%Cover
2470 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2471 : ENDIF
2472 : ENDIF
2473 :
2474 : ! Advance to next line
2475 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2476 : ENDDO
2477 :
2478 : ! Cleanup
2479 0 : Lct => NULL()
2480 :
2481 : ! Return w/ success
2482 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
2483 :
2484 : END SUBROUTINE RegisterPrepare
2485 : !EOC
2486 : !------------------------------------------------------------------------------
2487 : ! Harmonized Emissions Component (HEMCO) !
2488 : !------------------------------------------------------------------------------
2489 : !BOP
2490 : !
2491 : ! !IROUTINE: Register_Base
2492 : !
2493 : ! !DESCRIPTION: Subroutine Register\_Base registers all base emission
2494 : ! data and writes out all associated scale factor IDs.
2495 : !\\
2496 : !\\
2497 : ! !INTERFACE:
2498 : !
2499 0 : SUBROUTINE Register_Base( HcoState, RC )
2500 : !
2501 : ! !USES:
2502 : !
2503 : USE HCO_READLIST_Mod, ONLY : ReadList_Set
2504 : USE HCO_DATACONT_Mod, ONLY : DataCont_Cleanup
2505 : USE HCO_DATACONT_MOD, ONLY : ListCont_NextCont
2506 : !
2507 : ! !INPUT/OUTPUT PARAMETERS:
2508 : !
2509 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
2510 : !
2511 : ! !INPUT/OUTPUT PARAMETERS:
2512 : !
2513 : INTEGER, INTENT(INOUT) :: RC ! Success or failure
2514 : !
2515 : ! !REVISION HISTORY:
2516 : ! 18 Jun 2013 - C. Keller: Initialization
2517 : ! See https://github.com/geoschem/hemco for complete history
2518 : !EOP
2519 : !------------------------------------------------------------------------------
2520 : !BOC
2521 : !
2522 : ! !LOCAL VARIABLES:
2523 : !
2524 : ! Pointers
2525 : TYPE(ListCont), POINTER :: Lct
2526 :
2527 : ! Scalars
2528 : INTEGER :: N, cID, HcoID
2529 : INTEGER :: targetID, FLAG
2530 : LOGICAL :: Ignore, Add
2531 : CHARACTER(LEN=255) :: LOC
2532 : CHARACTER(LEN=512) :: msg
2533 :
2534 : !======================================================================
2535 : ! Register_Base begins here
2536 : !======================================================================
2537 0 : loc = 'Register_Base (HCO_CONFIG_MOD.F90)'
2538 :
2539 : ! Enter
2540 0 : CALL HCO_ENTER ( HcoState%Config%Err, loc, RC )
2541 0 : IF ( RC /= HCO_SUCCESS ) THEN
2542 0 : msg = 'Error encountered in routine "HCO_Enter"!'
2543 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2544 0 : RETURN
2545 : ENDIF
2546 :
2547 : ! Initialize
2548 0 : Lct => NULL()
2549 :
2550 : ! Point to next (first) line in ConfigList
2551 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2552 :
2553 : ! Loop over temporary arrays
2554 0 : DO WHILE ( FLAG == HCO_SUCCESS )
2555 :
2556 : ! Reset ignore flag
2557 0 : Ignore = .FALSE.
2558 :
2559 : ! Skip entry if data container not defined
2560 0 : IF ( .NOT. ASSOCIATED(Lct%Dct) ) THEN
2561 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2562 0 : CYCLE
2563 : ENDIF
2564 :
2565 : ! Skip entry if it's not a base field
2566 0 : IF ( (Lct%Dct%DctType /= HCO_DCTTYPE_BASE) ) THEN
2567 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2568 0 : CYCLE
2569 : ENDIF
2570 :
2571 : ! If this base field is not used (either because it belongs to
2572 : ! an extension that is not enabled or because its HEMCO or
2573 : ! model species ID is undefined), we don't need this container
2574 : ! any more. Hence remove it.
2575 : ! Note: Routine RegisterPrepare assigns negative HcoID's to all
2576 : ! base fields with invalid ExtNr's, so it is ok to check only
2577 : ! for HcoID here. If data is used in one of the HEMCO extensions
2578 : ! and has a species flag of '*' (= always read), its species ID
2579 : ! becomes set to 0 in RegisterPrepare.
2580 0 : HcoID = Lct%Dct%HcoID
2581 0 : IF ( HcoID < 0 ) THEN
2582 : Ignore = .TRUE.
2583 0 : ELSE IF ( HcoID > 0 ) THEN
2584 0 : IF ( HcoState%Spc(HcoID)%ModID < 0 ) Ignore = .TRUE.
2585 : ENDIF
2586 :
2587 : IF ( Ignore ) THEN
2588 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
2589 : WRITE(MSG,*) &
2590 0 : 'Register_Base: Ignore (and remove) base field ', &
2591 0 : TRIM(Lct%Dct%cName)
2592 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='-')
2593 : ENDIF
2594 :
2595 : ! Remove data container from list.
2596 0 : CALL DataCont_Cleanup ( Lct%Dct )
2597 0 : Lct%Dct => NULL()
2598 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2599 0 : CYCLE
2600 : ENDIF
2601 :
2602 : ! Verbose mode
2603 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
2604 0 : WRITE(MSG,*) 'Register_Base: Checking ', TRIM(Lct%Dct%cName)
2605 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='-')
2606 : ENDIF
2607 :
2608 : ! -------------------------------------------------------------
2609 : ! Extract vector of scale factor container IDs to be applied
2610 : ! to this base field (vector Scal_cID). For now, this container
2611 : ! contains the scale factor IDs, hence need to convert to
2612 : ! container IDs. Beforehand, add scale factor IDs to internal
2613 : ! list of used scale factors (UnqScalIDs).
2614 0 : CALL ScalID_Register ( Lct%Dct, HcoState%Config, RC )
2615 0 : IF ( RC /= HCO_SUCCESS ) THEN
2616 0 : PRINT *,'Error in ScaleID_Register called from Register_Base'
2617 0 : RETURN
2618 : ENDIF
2619 :
2620 : ! Get target ID of this container. The targetID corresponds
2621 : ! to the container ID cID into which emissions data of the
2622 : ! current container (Lct) will be added to. Typically,
2623 : ! targetID is equal to cID, i.e. a container holds the data
2624 : ! array corresponding to its source data information. In
2625 : ! cases where multiple base emissions have same properties,
2626 : ! however, we can merge these fields prior to emission
2627 : ! calculation to save some calculation operations.
2628 : ! Requirement is that these base emissions have same species
2629 : ! ID, emission category and hierarchy, ext. number, scale
2630 : ! factors, and update frequency.
2631 0 : CALL Get_targetID( HcoState, Lct, targetID, RC)
2632 0 : IF ( RC /= HCO_SUCCESS ) THEN
2633 0 : PRINT *,'Error in Get_targetID called from Register_Base'
2634 0 : RETURN
2635 : ENDIF
2636 :
2637 : ! verbose
2638 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
2639 0 : WRITE(MSG,*) 'Container ID : ', Lct%Dct%cID
2640 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2641 0 : WRITE(MSG,*) 'Assigned targetID: ', targetID
2642 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2643 : ENDIF
2644 :
2645 : ! Negative targetID is assigned to base data that doesn't need
2646 : ! to be considered either because it's a regional inventory
2647 : ! with no spatial overlap with the region domain on this CPU,
2648 : ! or because there exist another inventory with higher
2649 : ! priority (and same category) that will overwrite these
2650 : ! emissions data anyway!
2651 0 : IF ( targetID <= 0 ) THEN
2652 0 : CALL DataCont_Cleanup ( Lct%Dct )
2653 0 : Lct%Dct => NULL()
2654 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2655 0 : CYCLE
2656 : ENDIF
2657 :
2658 : ! Pass targetID to container
2659 0 : Lct%Dct%targetID = targetID
2660 :
2661 : ! Register container in ReadList. Containers will be listed
2662 : ! in the reading lists sorted by cID.
2663 0 : CALL ReadList_Set( HcoState, Lct%Dct, RC )
2664 0 : IF ( RC /= HCO_SUCCESS ) THEN
2665 0 : msg = 'Error encountered in routine "ReadList_Set"!'
2666 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2667 0 : RETURN
2668 : ENDIF
2669 :
2670 : ! Print some information if verbose mode is on
2671 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
2672 0 : WRITE(MSG,*) 'Base field registered: ', TRIM(Lct%Dct%cName)
2673 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2674 : ENDIF
2675 :
2676 : ! Advance to next line
2677 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2678 : ENDDO
2679 :
2680 : ! Cleanup
2681 0 : Lct => NULL()
2682 :
2683 : ! Return w/ success
2684 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
2685 :
2686 : END SUBROUTINE Register_Base
2687 : !EOC
2688 : !------------------------------------------------------------------------------
2689 : ! Harmonized Emissions Component (HEMCO) !
2690 : !------------------------------------------------------------------------------
2691 : !BOP
2692 : !
2693 : ! !IROUTINE: Register_Scal
2694 : !
2695 : ! !DESCRIPTION: Subroutine Register\_Scal registers all scale factors.
2696 : !\\
2697 : !\\
2698 : ! !INTERFACE:
2699 : !
2700 0 : SUBROUTINE Register_Scal( HcoState, RC )
2701 : !
2702 : ! !USES:
2703 : !
2704 : USE HCO_ReadList_Mod, ONLY : ReadList_Set
2705 : USE HCO_DATACONT_MOD, ONLY : ListCont_NextCont
2706 :
2707 : !
2708 : ! !INPUT PARAMETERS:
2709 : !
2710 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
2711 : !
2712 : ! !INPUT/OUTPUT PARAMETERS:
2713 : !
2714 : INTEGER, INTENT(INOUT) :: RC ! Success or failure
2715 : !
2716 : ! !REVISION HISTORY:
2717 : ! 18 Jun 2013 - C. Keller - Initialization
2718 : ! See https://github.com/geoschem/hemco for complete history
2719 : !EOP
2720 : !------------------------------------------------------------------------------
2721 : !BOC
2722 : !
2723 : ! !LOCAL VARIABLES:
2724 : !
2725 : ! Pointers
2726 : TYPE(ListCont), POINTER :: Lct
2727 : TYPE(ScalIDCont), POINTER :: TmpScalIDCont
2728 :
2729 : ! Scalars
2730 : INTEGER :: cID, FLAG
2731 : CHARACTER(LEN=255) :: LOC
2732 : CHARACTER(LEN=512) :: msg
2733 : CHARACTER(LEN= 5) :: strID
2734 : INTEGER :: ThisScalID
2735 :
2736 : !======================================================================
2737 : ! Register_Scal begins here
2738 : !======================================================================
2739 0 : loc = 'Register_Scal (HCO_CONFIG_MOD.F90)'
2740 :
2741 : ! Enter
2742 0 : CALL HCO_ENTER ( HcoState%Config%Err, loc, RC )
2743 0 : IF ( RC /= HCO_SUCCESS ) THEN
2744 0 : msg = 'Error encountered in routine "HCO_Enter"!'
2745 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2746 0 : RETURN
2747 : ENDIF
2748 :
2749 : ! Loop over all scale factor ids
2750 0 : Lct => NULL()
2751 0 : TmpScalIDCont => HcoState%Config%ScalIDList
2752 0 : DO WHILE ( ASSOCIATED( TmpScalIDCont ) )
2753 :
2754 : ! Extract this scale factor ID
2755 0 : ThisScalID = TmpScalIDCont%ScalID
2756 :
2757 : ! Make ThisLine point to first element of ConfigList
2758 0 : Lct => NULL()
2759 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2760 :
2761 : ! Loop over all lines in input file and find the one with the
2762 : ! correct scale factor ID
2763 0 : DO WHILE ( FLAG == HCO_SUCCESS )
2764 :
2765 : ! Leave if this is the wanted container.
2766 0 : IF ( ASSOCIATED(Lct%Dct)) THEN
2767 0 : IF ( Lct%Dct%ScalID == ThisScalID ) EXIT
2768 : ENDIF
2769 :
2770 : ! Advance to next line otherwise
2771 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, Lct, FLAG )
2772 : ENDDO
2773 :
2774 : ! Return error if scale factor ID not found
2775 0 : IF ( .NOT. ASSOCIATED(Lct) ) THEN
2776 0 : WRITE ( strID, * ) ThisScalID
2777 0 : msg = 'Container ID not found: ' // strID
2778 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2779 0 : RETURN
2780 : ENDIF
2781 :
2782 : ! Return w/ error if container not scale factor or mask
2783 0 : IF ( Lct%Dct%DctType == HCO_DCTTYPE_BASE ) THEN
2784 0 : WRITE ( strID, * ) ThisScalID
2785 0 : MSG = 'Container ID belongs to base field: ' // strID
2786 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2787 0 : RETURN
2788 : ENDIF
2789 :
2790 : ! Check if this scale factor has a mask field assigned to
2791 : ! it, in which case we have to make sure that the mask field
2792 : ! becomes registered in the scale factor list ScalIDList.
2793 : ! We can do this while evaluating ScalIDList due to the dynamic
2794 : ! structure of the linked list with new containers simply being
2795 : ! added to the end of the list.
2796 0 : IF ( Lct%Dct%nScalID > 0 ) THEN
2797 0 : CALL ScalID_Register ( Lct%Dct, HcoState%Config, RC )
2798 0 : IF ( RC /= HCO_SUCCESS ) THEN
2799 0 : msg = 'Error encountered in routine "ScalID_Register"!'
2800 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2801 0 : RETURN
2802 : ENDIF
2803 : ENDIF
2804 :
2805 : ! Register container in ReadList. Containers will be listed
2806 : ! in the reading lists sorted by cID.
2807 0 : CALL ReadList_Set( HcoState, Lct%Dct, RC )
2808 0 : IF ( RC /= HCO_SUCCESS ) THEN
2809 0 : msg = 'Error encountered in "ReadList_Set"!'
2810 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2811 0 : RETURN
2812 : ENDIF
2813 :
2814 : ! Print some information if verbose mode is on
2815 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
2816 0 : WRITE(MSG,*) 'Scale field registered: ', TRIM(Lct%Dct%cName)
2817 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2818 : ENDIF
2819 :
2820 : ! Advance
2821 0 : TmpScalIDCont => TmpScalIDCont%NEXT
2822 :
2823 : ENDDO
2824 :
2825 : ! Cleanup
2826 0 : Lct => NULL()
2827 0 : TmpScalIDCont => NULL()
2828 :
2829 : ! Return w/ success
2830 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
2831 :
2832 : END SUBROUTINE Register_Scal
2833 : !EOC
2834 : !------------------------------------------------------------------------------
2835 : ! Harmonized Emissions Component (HEMCO) !
2836 : !------------------------------------------------------------------------------
2837 : !BOP
2838 : !
2839 : ! !IROUTINE: Get_targetID
2840 : !
2841 : ! !DESCRIPTION: Subroutine Get\_targetID returns the target ID of a
2842 : ! container. The target ID can point to the container ID (cID) of
2843 : ! another base field if multiple emissions shall be added together
2844 : ! prior to emission calculation, e.g. sectoral emissions data with
2845 : ! same species ID, category, hierarchy, extension number, scale factors,
2846 : ! etc.
2847 : !\\
2848 : !\\
2849 : ! Target ID is set to -999 if there exists another inventory over
2850 : ! the full spatial region covered by this CPU for this species but
2851 : ! with higher hierarchy. In this case, we can ignore the current
2852 : ! container from here onwards!
2853 : !\\
2854 : !\\
2855 : ! !INTERFACE:
2856 : !
2857 0 : SUBROUTINE Get_targetID( HcoState, Lct, targetID, RC )
2858 : !
2859 : ! !USES:
2860 : !
2861 : USE HCO_DataCont_Mod, ONLY : ListCont_Find
2862 : USE HCO_DataCont_Mod, ONLY : ListCont_NextCont
2863 : !
2864 : ! !INPUT PARAMETERS:
2865 : !
2866 : TYPE(HCO_State), POINTER :: HcoState
2867 : TYPE(ListCont), POINTER :: Lct
2868 : !
2869 : ! !OUTPUT PARAMETERS:
2870 : !
2871 : INTEGER, INTENT( OUT) :: targetID
2872 : !
2873 : ! !INPUT/OUTPUT PARAMETERS:
2874 : !
2875 : INTEGER, INTENT(INOUT) :: RC
2876 : !
2877 : ! !NOTE: If data from multiple containers are added, the target ID
2878 : ! is always set to the lowest cID of all involved containers, i.e.
2879 : ! data are added to the container with the lowest cID. This makes
2880 : ! sure that data is not accidentally overwritten, e.g. when updating
2881 : ! container contents!
2882 : !
2883 : ! !REVISION HISTORY:
2884 : ! 11 Apr 2013 - C. Keller - Initialization
2885 : ! See https://github.com/geoschem/hemco for complete history
2886 : !EOP
2887 : !------------------------------------------------------------------------------
2888 : !BOC
2889 : !
2890 : ! !LOCAL VARIABLES:
2891 : !
2892 : ! Pointers
2893 : TYPE(ListCont), POINTER :: tmpLct
2894 : TYPE(ListCont), POINTER :: mskLct
2895 :
2896 : ! Scalars
2897 : INTEGER :: HcoID, Cat, Hier, Scal, ExtNr, cID
2898 : INTEGER :: tmpID
2899 : INTEGER :: I, J, FLAG1, tmpCov
2900 : LOGICAL :: found, sameCont
2901 : CHARACTER(LEN=255) :: loc
2902 : CHARACTER(LEN=512) :: msg
2903 : CHARACTER(LEN= 7) :: strID
2904 :
2905 : !======================================================================
2906 : ! Get_targetID begins here
2907 : !======================================================================
2908 0 : loc = 'Get_targetID (HCO_CONFIG_MOD.F90)'
2909 :
2910 : ! Enter
2911 0 : CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
2912 0 : IF ( RC /= HCO_SUCCESS ) THEN
2913 0 : msg = 'Error encountered in routine "HCO_Enter"!'
2914 0 : CALL HCO_ERROR( msg, RC, thisLoc=LOC )
2915 0 : RETURN
2916 : ENDIF
2917 :
2918 : ! Initialize
2919 0 : tmpLct => NULL()
2920 0 : mskLct => NULL()
2921 :
2922 : ! Get Tracer ID, category and hierarchy of entry to be checked
2923 0 : cID = Lct%Dct%cID
2924 0 : ExtNr = Lct%Dct%ExtNr
2925 0 : Cat = Lct%Dct%Cat
2926 0 : Hier = Lct%Dct%Hier
2927 0 : HcoID = Lct%Dct%HcoID
2928 :
2929 : ! By default, set target ID to container ID
2930 0 : targetID = cID
2931 :
2932 : ! If ExtNr is -999, always read this field. ExtNr becomes zero
2933 : ! if the extension number entry in the configuration file is the
2934 : ! wildcard character
2935 0 : IF ( ExtNr == -999 ) THEN
2936 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
2937 0 : RETURN
2938 : ENDIF
2939 :
2940 : ! If species ID is zero, always read this field as is, i.e. don't
2941 : ! skip it and don't add it to another field!
2942 : ! Species ID become zero if the species ID entry in the
2943 : ! configuration file is the wildcard character.
2944 0 : IF ( HcoID == 0 ) THEN
2945 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
2946 0 : RETURN
2947 : ENDIF
2948 :
2949 : ! Check all scale factors of the current container to see if one
2950 : ! of them is a mask that has no valid entries over the domain of
2951 : ! this CPU. In this case we don't have to consider this field at
2952 : ! all!
2953 0 : IF ( Lct%Dct%nScalID > 0 ) THEN
2954 0 : DO I = 1, Lct%Dct%nScalID
2955 :
2956 : ! Check if it's a valid scale factor
2957 0 : IF ( Lct%Dct%Scal_cID(I) < 0 ) CYCLE
2958 :
2959 : ! Find container with this container ID
2960 : ! Note: this should always look up the container ID, but make
2961 : ! check for safety's sake.
2962 0 : tmpID = Lct%Dct%Scal_cID(I)
2963 0 : IF ( .NOT. Lct%Dct%Scal_cID_set ) THEN
2964 : CALL ListCont_Find ( HcoState%Config%ConfigList, &
2965 0 : tmpID, 1, FOUND, mskLct )
2966 : ELSE
2967 : CALL ListCont_Find ( HcoState%Config%ConfigList, &
2968 0 : tmpID, 0, FOUND, mskLct )
2969 : ENDIF
2970 :
2971 : ! Error if scale factor not found
2972 0 : IF ( .NOT. FOUND ) THEN
2973 0 : WRITE ( strID, * ) Lct%Dct%Scal_cID(I)
2974 0 : msg = 'No scale factor with cID: ' // TRIM(strID)
2975 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
2976 0 : RETURN
2977 : ENDIF
2978 :
2979 : ! Check if this is a mask with zero coverage over this CPU, in
2980 : ! which case we don't need to consider the base field at all!
2981 0 : IF ( (mskLct%Dct%DctType == HCO_DCTTYPE_MASK ) .AND. &
2982 0 : (mskLct%Dct%Dta%Cover == 0 ) ) THEN
2983 0 : targetID = -999
2984 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
2985 : WRITE(MSG,*) 'Data not defined over this CPU, skip ' // &
2986 0 : TRIM(Lct%Dct%cName)
2987 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
2988 : ENDIF
2989 :
2990 : ! Return
2991 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
2992 0 : RETURN
2993 : ENDIF
2994 : ENDDO ! I
2995 : ENDIF
2996 :
2997 : ! Now find out if there is another base field for the same species,
2998 : ! emission category and extension number, but higher hierarchy.
2999 : ! Such a field also needs to have full coverage over this CPU,
3000 : ! then we can ignore the current container.
3001 :
3002 : ! Initialize looping pointer
3003 0 : tmpLct => NULL()
3004 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3005 :
3006 : ! Loop over containers
3007 0 : DO WHILE ( FLAG1 == HCO_SUCCESS )
3008 :
3009 : ! Advance to next container if data container not defined
3010 0 : IF ( .NOT. ASSOCIATED(tmpLct%Dct) ) THEN
3011 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3012 0 : CYCLE
3013 : ENDIF
3014 :
3015 : ! Advance to next container if this is the current container
3016 0 : IF ( tmpLct%Dct%cID == cID ) THEN
3017 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3018 0 : CYCLE
3019 : ENDIF
3020 :
3021 : ! Advance to next container if this is not a base field
3022 0 : IF ( tmpLct%Dct%DctType /= HCO_DCTTYPE_BASE ) THEN
3023 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3024 0 : CYCLE
3025 : ENDIF
3026 :
3027 : ! Advance to next container if not the same extension nr
3028 0 : IF ( tmpLct%Dct%ExtNr /= ExtNr ) THEN
3029 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3030 0 : CYCLE
3031 : ENDIF
3032 :
3033 : ! Advance to next container if not the same species
3034 0 : IF ( tmpLct%Dct%HcoID /= HcoID ) THEN
3035 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3036 0 : CYCLE
3037 : ENDIF
3038 :
3039 : ! Advance to next container if not the same category
3040 0 : IF ( tmpLct%Dct%Cat /= Cat ) THEN
3041 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3042 0 : CYCLE
3043 : ENDIF
3044 :
3045 : ! Advance to next container if lower hierarchy
3046 0 : IF ( tmpLct%Dct%Hier < Hier ) THEN
3047 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3048 0 : CYCLE
3049 : ENDIF
3050 :
3051 : ! Advance to next container if this container has limited time
3052 : ! coverage. Emissions with limited time coverage may not be used
3053 : ! during all of the simulation time, so it's important to keep the
3054 : ! lower hierarchy emission fields in memory in case that those need
3055 : ! to be used instead (e.g. if EDGAR shall only be used between years
3056 : ! 2005 and 2013, we should keep GEIA in case that we are outside of
3057 : ! that time window).
3058 : IF ( ( tmpLct%Dct%Dta%CycleFlag == HCO_CFLAG_RANGE ) .OR. &
3059 0 : ( tmpLct%Dct%Dta%CycleFlag == HCO_CFLAG_EXACT ) .OR. &
3060 : ( tmpLct%Dct%Dta%CycleFlag == HCO_CFLAG_RANGEAVG ) ) THEN
3061 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3062 0 : CYCLE
3063 : ENDIF
3064 :
3065 : ! Check for coverage of tmpLct. Default = full coverage (1)
3066 0 : tmpCov = 1
3067 :
3068 : ! Check all scale factors of tmpLct to see if this base
3069 : ! field has full coverage over this CPU domain or not.
3070 0 : IF ( tmpLct%Dct%nScalID > 0 ) THEN
3071 0 : DO I = 1, tmpLct%Dct%nScalID
3072 :
3073 : ! Check if it's a valid scale factor
3074 0 : IF ( tmpLct%Dct%Scal_cID(I) < 0 ) CYCLE
3075 :
3076 0 : tmpID = tmpLct%Dct%Scal_cID(I)
3077 0 : IF ( .NOT. tmpLct%Dct%Scal_cID_set ) THEN
3078 : CALL ListCont_Find ( HcoState%Config%ConfigList, &
3079 0 : tmpID, 1, FOUND, mskLct )
3080 : ELSE
3081 : CALL ListCont_Find ( HcoState%Config%ConfigList, &
3082 0 : tmpID, 0, FOUND, mskLct )
3083 : ENDIF
3084 :
3085 : ! Error if container not found
3086 0 : IF ( .NOT. FOUND ) THEN
3087 0 : WRITE(MSG,*) 'No scale factor with ID: ', tmpID
3088 0 : CALL HCO_Error( msg, RC, thisLoc=loc )
3089 0 : RETURN
3090 : ENDIF
3091 :
3092 : ! Write out coverage.
3093 : ! Note: If one mask has only partial coverage, retain that
3094 : ! value! If we encounter a mask with no coverage, set coverage
3095 : ! to zero and leave immediately.
3096 0 : IF ( (mskLct%Dct%DctType == HCO_DCTTYPE_MASK) ) THEN
3097 0 : IF ( mskLct%Dct%Dta%Cover == -1 ) THEN
3098 : tmpCov = -1
3099 0 : ELSEIF ( mskLct%Dct%Dta%Cover == 0 ) THEN
3100 : tmpCov = 0
3101 : EXIT
3102 : ENDIF
3103 : ENDIF
3104 : ENDDO ! I
3105 : ENDIF
3106 :
3107 : ! If tmpLct has no coverage, we can ignore this tmpLct as
3108 : ! it will never overwrite data of currCont
3109 0 : IF ( tmpCov == 0 ) THEN
3110 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3111 0 : CYCLE
3112 : ENDIF
3113 :
3114 : ! If we made it up to here and tmpLct has full coverage, then
3115 : ! tmpLct has the same species ID, category, ext. nr.,
3116 : ! and a higher (or the same) hierarchy as Lct.
3117 :
3118 : ! If hierarchy of tmpLct is higher than Lct and this
3119 : ! container has total coverage over this CPU, it will always
3120 : ! replace all values of Lct. Hence, set targetID to -999
3121 : ! (= ignore container) and return here.
3122 0 : IF ( (tmpLct%Dct%Hier > Hier) .AND. (tmpCov==1) ) THEN
3123 0 : IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN
3124 0 : WRITE(MSG,*) 'Skip container ', TRIM(Lct%Dct%cName), &
3125 0 : ' because of ', TRIM(tmpLct%Dct%cName)
3126 0 : CALL HCO_MSG( HcoState%Config%Err, msg )
3127 : ENDIF
3128 :
3129 : ! Return
3130 0 : targetID = -999
3131 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
3132 0 : RETURN
3133 : ENDIF
3134 :
3135 : ! If currCont and tmpLct have same hierarchy, scale factors,
3136 : ! and update frequencies, we may add the two fields together
3137 : ! in order to make emission calculation more efficient.
3138 : ! Thus, set target ID to the lower of the two container IDs.
3139 : ! This procedure will ensure that emission data are added
3140 : ! when registering/updating containers in the emissions list
3141 : ! (EmisList). Since containers are sorted in ReadList with
3142 : ! increasing cID, pick the lowest cID to make sure that all
3143 : ! fields are properly added.
3144 : ! Note: this option is currently disabled for ESMF applications.
3145 0 : IF ( tmpLct%Dct%Hier == Hier .AND. .NOT. HcoState%Options%isESMF ) THEN
3146 :
3147 : ! temporary flag
3148 0 : sameCont = .TRUE.
3149 :
3150 : ! Check for same scale factors
3151 0 : IF ( tmpLct%Dct%nScalID /= Lct%Dct%nScalID ) THEN
3152 : sameCont = .FALSE.
3153 : ELSE
3154 0 : DO I = 1, tmpLct%Dct%nScalID
3155 0 : IF ( tmpLct%Dct%Scal_cID(I) /= &
3156 0 : Lct%Dct%Scal_cID(I) ) THEN
3157 : sameCont = .FALSE.
3158 : EXIT
3159 : ENDIF
3160 : ENDDO
3161 : ENDIF
3162 :
3163 : ! Check for same update frequencies
3164 0 : IF ( sameCont ) THEN
3165 0 : IF (tmpLct%Dct%Dta%ncYrs(1)/=Lct%Dct%Dta%ncYrs(1)) THEN
3166 : sameCont = .FALSE.
3167 0 : ELSEIF(tmpLct%Dct%Dta%ncYrs(2)/=Lct%Dct%Dta%ncYrs(2)) THEN
3168 : sameCont = .FALSE.
3169 0 : ELSEIF(tmpLct%Dct%Dta%ncMts(1)/=Lct%Dct%Dta%ncMts(1)) THEN
3170 : sameCont = .FALSE.
3171 0 : ELSEIF(tmpLct%Dct%Dta%ncMts(2)/=Lct%Dct%Dta%ncMts(2)) THEN
3172 : sameCont = .FALSE.
3173 0 : ELSEIF(tmpLct%Dct%Dta%ncDys(1)/=Lct%Dct%Dta%ncDys(1)) THEN
3174 : sameCont = .FALSE.
3175 0 : ELSEIF(tmpLct%Dct%Dta%ncDys(2)/=Lct%Dct%Dta%ncDys(2)) THEN
3176 : sameCont = .FALSE.
3177 0 : ELSEIF(tmpLct%Dct%Dta%ncHrs(1)/=Lct%Dct%Dta%ncHrs(1)) THEN
3178 : sameCont = .FALSE.
3179 0 : ELSEIF(tmpLct%Dct%Dta%ncHrs(2)/=Lct%Dct%Dta%ncHrs(2)) THEN
3180 : sameCont = .FALSE.
3181 : ENDIF
3182 : ENDIF
3183 :
3184 : ! Check for same emitted level
3185 : IF ( sameCont ) THEN
3186 : IF ( ( tmpLct%Dct%Dta%SpaceDim /= Lct%Dct%Dta%SpaceDim ) .OR. &
3187 : ( tmpLct%Dct%Dta%Levels /= Lct%Dct%Dta%Levels ) .OR. &
3188 0 : ( tmpLct%Dct%Dta%EmisL1 /= Lct%Dct%Dta%EmisL1 ) .OR. &
3189 : ( tmpLct%Dct%Dta%EmisL2 /= Lct%Dct%Dta%EmisL2 ) ) THEN
3190 : sameCont = .FALSE.
3191 : ENDIF
3192 : ENDIF
3193 :
3194 : ! Finally, check for "same" container names. This checks the
3195 : ! container names ignoring the name 'tags'.
3196 : IF ( sameCont ) THEN
3197 0 : sameCont = Check_ContNames( tmpLct, Lct )
3198 : ENDIF
3199 :
3200 : ! If "same" containers, set target ID to container ID of
3201 : ! tmpLct if this value is lower than current target ID.
3202 0 : IF ( sameCont ) THEN
3203 0 : targetID = MIN( targetID, tmpLct%Dct%cID )
3204 : ENDIF
3205 :
3206 : ENDIF
3207 :
3208 : ! Advance to next line
3209 : ! Don't return here, because it is still possible that there is
3210 : ! another inventory in the list coming up which overwrites this
3211 : ! inventory (or another field emissions shall be added to which
3212 : ! has lower container ID and hence needs to be the target
3213 : ! container!).
3214 0 : CALL ListCont_NextCont ( HcoState%Config%ConfigList, tmpLct, FLAG1 )
3215 :
3216 : ENDDO !Loop over all entries in ConfigList (tmpLct)
3217 :
3218 : ! Free pointers
3219 0 : tmpLct => NULL()
3220 0 : mskLct => NULL()
3221 :
3222 : ! Leave w/ success
3223 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
3224 :
3225 : END SUBROUTINE Get_targetID
3226 : !EOC
3227 : !------------------------------------------------------------------------------
3228 : ! Harmonized Emissions Component (HEMCO) !
3229 : !------------------------------------------------------------------------------
3230 : !BOP
3231 : !
3232 : ! !IROUTINE: Calc_Coverage
3233 : !
3234 : ! !DESCRIPTION: Function Calc\_Coverage calculates the coverage of
3235 : ! the specified lon/lat box with the area covered by the inventory.
3236 : ! Returns 0 if no overlap, 1 if complete overlap, and -1 for partial
3237 : ! overlap.
3238 : !\\
3239 : !\\
3240 : ! !INTERFACE:
3241 : !
3242 : FUNCTION Calc_Coverage( msk_x1, msk_x2, msk_y1, msk_y2, &
3243 : cpu_x1, cpu_x2, cpu_y1, cpu_y2 ) RESULT ( COVERAGE )
3244 : !
3245 : ! !INPUT PARAMETERS:
3246 : !
3247 : INTEGER, INTENT(IN) :: msk_x1
3248 : INTEGER, INTENT(IN) :: msk_x2
3249 : INTEGER, INTENT(IN) :: msk_y1
3250 : INTEGER, INTENT(IN) :: msk_y2
3251 : INTEGER, INTENT(IN) :: cpu_x1
3252 : INTEGER, INTENT(IN) :: cpu_x2
3253 : INTEGER, INTENT(IN) :: cpu_y1
3254 : INTEGER, INTENT(IN) :: cpu_y2
3255 : !
3256 : ! !RETURN VALUE:
3257 : !
3258 : INTEGER :: COVERAGE
3259 : !
3260 : ! !REVISION HISTORY:
3261 : ! 11 Apr 2013 - C. Keller: Initialization
3262 : ! See https://github.com/geoschem/hemco for complete history
3263 : !EOP
3264 : !------------------------------------------------------------------------------
3265 : !BOC
3266 :
3267 : !======================================================================
3268 : ! CALC_COVERAGE begins here
3269 : !======================================================================
3270 :
3271 : ! Check if specified area does not overlap with inventory
3272 : COVERAGE = 1
3273 : IF ( (msk_x1 > cpu_x2) .OR. (msk_x2 < cpu_x1) .OR. &
3274 : (msk_y1 > cpu_y2) .OR. (msk_y2 < cpu_y1) ) THEN
3275 : COVERAGE = 0
3276 : RETURN
3277 : ENDIF
3278 :
3279 : ! Check for partial coverage
3280 : IF ( (msk_x1 > cpu_x1) .OR. (msk_x2 < cpu_x2) .OR. &
3281 : (msk_y1 > cpu_y1) .OR. (msk_y2 < cpu_y2) ) THEN
3282 : COVERAGE = -1
3283 : ENDIF
3284 :
3285 : END FUNCTION Calc_Coverage
3286 : !EOC
3287 : !------------------------------------------------------------------------------
3288 : ! Harmonized Emissions Component (HEMCO) !
3289 : !------------------------------------------------------------------------------
3290 : !BOP
3291 : !
3292 : ! !IROUTINE: ReadAndSplit_Line
3293 : !
3294 : ! !DESCRIPTION: Subroutine ReadAndSplit\_Line reads a line from the HEMCO
3295 : ! config file and parses the specified columns into the passed integer
3296 : ! and character variables. If the optional argument inLine is provided,
3297 : ! this line will be parsed, otherwise a new line will be read from the config
3298 : ! file. If the optional argument outLine is provided, this variable will hold
3299 : ! the parsed line.
3300 : !\\
3301 : !\\
3302 : ! This routine splits the input line (or the next line of an open file with
3303 : ! ID IU\_HCO), using the HEMCO separator (default: space) as separator. The
3304 : ! resulting elements are then passed to the specified output characters and
3305 : ! integers. For example, to pass the 5th element of a line to variable int1,
3306 : ! set int1cl to 5, etc. An error will be returned (STAT=100) if any of the
3307 : ! output columns exceeds the number of line elements. The optional argument
3308 : ! optcl can be used to denote an optional value, e.g. no error is returned
3309 : ! if the value at position optcl cannot be read. Only one optional value can
3310 : ! be specified.
3311 : !\\
3312 : !\\
3313 : ! !INTERFACE:
3314 : !
3315 0 : SUBROUTINE ReadAndSplit_Line( HcoConfig, IU_HCO, char1, chr1cl, &
3316 : char2, chr2cl, char3, chr3cl, &
3317 : char4, chr4cl, char5, chr5cl, &
3318 : char6, chr6cl, char7, chr7cl, &
3319 : char8, chr8cl, char9, chr9cl, &
3320 : char10, chr10cl, &
3321 : int1, int1cl, int2, int2cl, &
3322 0 : int3, int3cl, STAT, inLine, &
3323 0 : outLine, optcl )
3324 : !
3325 : ! !USES:
3326 : !
3327 : USE HCO_CHARPAK_Mod, ONLY : STRREPL, STRSPLIT
3328 : !
3329 : ! !INPUT PARAMETERS:
3330 : !
3331 : TYPE(ConfigObj), POINTER :: HcoConfig
3332 : INTEGER, INTENT(IN ) :: IU_HCO
3333 : INTEGER, INTENT(IN ) :: chr1cl
3334 : INTEGER, INTENT(IN ) :: chr2cl
3335 : INTEGER, INTENT(IN ) :: chr3cl
3336 : INTEGER, INTENT(IN ) :: chr4cl
3337 : INTEGER, INTENT(IN ) :: chr5cl
3338 : INTEGER, INTENT(IN ) :: chr6cl
3339 : INTEGER, INTENT(IN ) :: chr7cl
3340 : INTEGER, INTENT(IN ) :: chr8cl
3341 : INTEGER, INTENT(IN ) :: chr9cl
3342 : INTEGER, INTENT(IN ) :: chr10cl
3343 : INTEGER, INTENT(IN ) :: int1cl
3344 : INTEGER, INTENT(IN ) :: int2cl
3345 : INTEGER, INTENT(IN ) :: int3cl
3346 : CHARACTER(LEN=255), INTENT(IN ), OPTIONAL :: inLINE
3347 : INTEGER, INTENT(IN ), OPTIONAL :: optcl
3348 : !
3349 : ! !OUTPUT PARAMETERS:
3350 : !
3351 : CHARACTER(LEN=*), INTENT(INOUT) :: char1
3352 : CHARACTER(LEN=*), INTENT(INOUT) :: char2
3353 : CHARACTER(LEN=*), INTENT(INOUT) :: char3
3354 : CHARACTER(LEN=*), INTENT(INOUT) :: char4
3355 : CHARACTER(LEN=*), INTENT(INOUT) :: char5
3356 : CHARACTER(LEN=*), INTENT(INOUT) :: char6
3357 : CHARACTER(LEN=*), INTENT(INOUT) :: char7
3358 : CHARACTER(LEN=*), INTENT(INOUT) :: char8
3359 : CHARACTER(LEN=*), INTENT(INOUT) :: char9
3360 : CHARACTER(LEN=*), INTENT(INOUT) :: char10
3361 : INTEGER, INTENT(INOUT) :: int1
3362 : INTEGER, INTENT(INOUT) :: int2
3363 : INTEGER, INTENT(INOUT) :: int3
3364 : CHARACTER(LEN=255), INTENT( OUT), OPTIONAL :: outLINE
3365 : !
3366 : ! !INPUT/OUTPUT PARAMETERS:
3367 : !
3368 : INTEGER, INTENT(INOUT) :: STAT
3369 : !
3370 : ! !REVISION HISTORY:
3371 : ! 28 Aug 2013 - C. Keller - Initial version
3372 : ! See https://github.com/geoschem/hemco for complete history
3373 : !EOP
3374 : !------------------------------------------------------------------------------
3375 : !BOC
3376 : !
3377 : ! !LOCAL VARIABLES:
3378 : !
3379 : INTEGER :: N, OPT, STRLEN, RC
3380 : CHARACTER(LEN=255) :: LINE
3381 : CHARACTER(LEN=255) :: SUBSTR(255)
3382 : LOGICAL :: EOF
3383 :
3384 : !======================================================================
3385 : ! ReadAndSplit_Line begins here
3386 : !======================================================================
3387 :
3388 : ! Output status
3389 0 : STAT = 0
3390 :
3391 : ! ---------------------------------------------------------------------
3392 : ! Read line and split column
3393 : ! ---------------------------------------------------------------------
3394 0 : IF ( PRESENT(inLINE) ) THEN
3395 0 : LINE = inLINE
3396 : ELSE
3397 : ! Read line
3398 0 : CALL HCO_READLINE( IU_HCO, LINE, EOF, RC )
3399 :
3400 : ! Return w/ error
3401 0 : IF ( RC /= HCO_SUCCESS ) THEN
3402 0 : STAT = 999
3403 0 : RETURN
3404 : ENDIF
3405 :
3406 : ! End of file
3407 0 : IF ( EOF ) THEN
3408 0 : STAT = -999
3409 0 : RETURN
3410 : ENDIF
3411 : ENDIF
3412 :
3413 : ! Check for output line
3414 0 : IF ( PRESENT(outLINE) ) outLINE = LINE
3415 :
3416 : ! Return here with flag = 10 if line starts with 'END SECTION'.
3417 0 : IF ( INDEX ( LINE, 'END SECTION' ) > 0 ) THEN
3418 0 : STAT = 10
3419 0 : RETURN
3420 : ENDIF
3421 :
3422 : ! Return here with flag = 1 if line is commented
3423 0 : IF ( LINE(1:1) == HCO_CMT ) THEN
3424 0 : STAT = 1
3425 0 : RETURN
3426 : ENDIF
3427 :
3428 : ! Get string length
3429 0 : STRLEN = LEN(TRIM(LINE))
3430 :
3431 : ! Return here with flag = 5 is line is opening a (shortcut) bracket.
3432 0 : IF ( STRLEN > 3 ) THEN
3433 0 : IF ( LINE(1:3) == '(((' ) THEN
3434 0 : STAT = 5
3435 0 : RETURN
3436 : ENDIF
3437 :
3438 : ! Return here with flag = 6 is line is opening a (shortcut) bracket.
3439 0 : IF ( LINE(1:3) == ')))' ) THEN
3440 0 : STAT = 6
3441 0 : RETURN
3442 : ENDIF
3443 : ENDIF
3444 :
3445 : ! Return with flag = 1000 if this is a link to an include file.
3446 0 : IF ( STRLEN > 11 ) THEN
3447 0 : IF ( LINE(1:10) == '>>>include' ) THEN
3448 0 : IF ( PRESENT(outLINE) ) outLINE = outLINE(12:STRLEN)
3449 0 : STAT = 1000
3450 0 : RETURN
3451 : ENDIF
3452 : ENDIF
3453 :
3454 : ! Split line into columns
3455 0 : CALL STRREPL ( LINE, HCO_TAB, HCO_SPC )
3456 0 : CALL STRSPLIT( LINE, HCO_SPC, SUBSTR, N )
3457 :
3458 : ! Also ignore empty lines
3459 0 : IF ( N <= 1 ) THEN
3460 0 : STAT = 1
3461 0 : RETURN
3462 : ENDIF
3463 :
3464 : ! Are there any optional lines?
3465 0 : IF ( PRESENT(optcl) ) THEN
3466 0 : OPT = optcl
3467 : ELSE
3468 0 : OPT = -1
3469 : ENDIF
3470 :
3471 : ! ---------------------------------------------------------------------
3472 : ! Read characters as specified and write them into given variables
3473 : ! ---------------------------------------------------------------------
3474 :
3475 0 : CALL READCHAR( LINE, SUBSTR, N, chr1cl, char1, OPT, STAT )
3476 0 : IF ( STAT == 100 ) RETURN
3477 0 : CALL READCHAR( LINE, SUBSTR, N, chr2cl, char2, OPT, STAT )
3478 0 : IF ( STAT == 100 ) RETURN
3479 0 : CALL READCHAR( LINE, SUBSTR, N, chr3cl, char3, OPT, STAT )
3480 0 : IF ( STAT == 100 ) RETURN
3481 0 : CALL READCHAR( LINE, SUBSTR, N, chr4cl, char4, OPT, STAT )
3482 0 : IF ( STAT == 100 ) RETURN
3483 0 : CALL READCHAR( LINE, SUBSTR, N, chr5cl, char5, OPT, STAT )
3484 0 : IF ( STAT == 100 ) RETURN
3485 0 : CALL READCHAR( LINE, SUBSTR, N, chr6cl, char6, OPT, STAT )
3486 0 : IF ( STAT == 100 ) RETURN
3487 0 : CALL READCHAR( LINE, SUBSTR, N, chr7cl, char7, OPT, STAT )
3488 0 : IF ( STAT == 100 ) RETURN
3489 0 : CALL READCHAR( LINE, SUBSTR, N, chr8cl, char8, OPT, STAT )
3490 0 : IF ( STAT == 100 ) RETURN
3491 0 : CALL READCHAR( LINE, SUBSTR, N, chr9cl, char9, OPT, STAT )
3492 0 : IF ( STAT == 100 ) RETURN
3493 0 : CALL READCHAR( LINE, SUBSTR, N, chr10cl, char10, OPT, STAT )
3494 0 : IF ( STAT == 100 ) RETURN
3495 :
3496 : ! ---------------------------------------------------------------------
3497 : ! Read integers as specified and write them into given variables.
3498 : ! Value -999 is returned for wildcard characters.
3499 : ! ---------------------------------------------------------------------
3500 :
3501 0 : CALL READINT( HcoConfig%ExtList, LINE, SUBSTR, N, int1cl, int1, OPT, STAT )
3502 0 : IF ( STAT == 100 ) RETURN
3503 0 : CALL READINT( HcoConfig%ExtList, LINE, SUBSTR, N, int2cl, int2, OPT, STAT )
3504 0 : IF ( STAT == 100 ) RETURN
3505 0 : CALL READINT( HcoConfig%ExtList, LINE, SUBSTR, N, int3cl, int3, OPT, STAT )
3506 0 : IF ( STAT == 100 ) RETURN
3507 :
3508 : END SUBROUTINE ReadAndSplit_Line
3509 : !EOC
3510 : !------------------------------------------------------------------------------
3511 : ! Harmonized Emissions Component (HEMCO) !
3512 : !------------------------------------------------------------------------------
3513 : !BOP
3514 : !
3515 : ! !IROUTINE: READCHAR
3516 : !
3517 : ! !DESCRIPTION: Subroutine READCHAR is a helper routine to read character
3518 : ! values from the HEMCO configuration file.
3519 : !\\
3520 : !\\
3521 : ! !INTERFACE:
3522 : !
3523 0 : SUBROUTINE READCHAR ( LINE, SUBSTR, N, chrcl, charout, OPT, STAT )
3524 : !
3525 : ! !INPUT PARAMETERS:
3526 : !
3527 : CHARACTER(LEN=255), INTENT(IN ) :: LINE
3528 : CHARACTER(LEN=255), INTENT(IN ) :: SUBSTR(255)
3529 : INTEGER, INTENT(IN ) :: N
3530 : INTEGER, INTENT(IN ) :: chrcl
3531 : INTEGER, INTENT(IN ) :: OPT
3532 : !
3533 : ! !INPUT/OUTPUT PARAMETERS:
3534 : !
3535 : CHARACTER(LEN=*), INTENT(INOUT) :: charout
3536 : INTEGER, INTENT(INOUT) :: STAT
3537 : !
3538 : ! !REVISION HISTORY:
3539 : ! 29 Dec 2014 - C. Keller - Initial version
3540 : ! See https://github.com/geoschem/hemco for complete history
3541 : !EOP
3542 : !------------------------------------------------------------------------------
3543 : !BOC
3544 : !
3545 0 : IF ( chrcl > 0 ) THEN
3546 0 : IF ( chrcl > N ) THEN
3547 0 : IF ( chrcl /= OPT ) THEN
3548 0 : WRITE(*,*) 'Not enough elements in: '//TRIM(LINE)
3549 0 : STAT = 100
3550 0 : RETURN
3551 : ELSE
3552 0 : charout = ''
3553 : ENDIF
3554 : ELSE
3555 0 : READ( SUBSTR(chrcl), '(a)' ) charout
3556 : ENDIF
3557 : ENDIF
3558 0 : charout = ADJUSTL(charout)
3559 :
3560 0 : END SUBROUTINE READCHAR
3561 : !EOC
3562 : !------------------------------------------------------------------------------
3563 : ! Harmonized Emissions Component (HEMCO) !
3564 : !------------------------------------------------------------------------------
3565 : !BOP
3566 : !
3567 : ! !IROUTINE: READINT
3568 : !
3569 : ! !DESCRIPTION: Subroutine READINT is a helper routine to read integer
3570 : ! values from the HEMCO configuration file.
3571 : !\\
3572 : !\\
3573 : ! !INTERFACE:
3574 : !
3575 0 : SUBROUTINE READINT ( ExtList, LINE, SUBSTR, N, intcl, intout, OPT, STAT )
3576 : !
3577 : ! !USES:
3578 : !
3579 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
3580 : !
3581 : ! !INPUT PARAMETERS:
3582 : !
3583 : TYPE(Ext), POINTER :: ExtList
3584 : CHARACTER(LEN=255), INTENT(IN ) :: LINE
3585 : CHARACTER(LEN=255), INTENT(IN ) :: SUBSTR(255)
3586 : INTEGER, INTENT(IN ) :: N
3587 : INTEGER, INTENT(IN ) :: intcl
3588 : INTEGER, INTENT(IN ) :: OPT
3589 : !
3590 : ! !INPUT/OUTPUT PARAMETERS:
3591 : !
3592 : INTEGER, INTENT(INOUT) :: intout
3593 : INTEGER, INTENT(INOUT) :: STAT
3594 : !
3595 : ! !REVISION HISTORY:
3596 : ! 29 Dec 2014 - C. Keller - Initial version
3597 : ! See https://github.com/geoschem/hemco for complete history
3598 : !EOP
3599 : !------------------------------------------------------------------------------
3600 : !BOC
3601 : !
3602 0 : IF ( intcl > 0 ) THEN
3603 0 : IF ( intcl > N ) THEN
3604 0 : IF ( intcl /= OPT ) THEN
3605 0 : WRITE(*,*) 'Not enough elements in: '//TRIM(LINE)
3606 0 : STAT = 100
3607 0 : RETURN
3608 : ELSE
3609 0 : intout = -999
3610 : ENDIF
3611 : ELSE
3612 : ! Check for wildcard
3613 0 : IF ( SUBSTR(intcl) == TRIM(HCO_GetOpt(ExtList,'Wildcard')) ) THEN
3614 0 : intout = -999
3615 : ELSE
3616 0 : READ( SUBSTR(intcl), * ) intout
3617 : ENDIF
3618 : ENDIF
3619 : ENDIF
3620 :
3621 : END SUBROUTINE READINT
3622 : !EOC
3623 : !------------------------------------------------------------------------------
3624 : ! Harmonized Emissions Component (HEMCO) !
3625 : !------------------------------------------------------------------------------
3626 : !BOP
3627 : !
3628 : ! !IROUTINE: Get_cID
3629 : !
3630 : ! !DESCRIPTION: Subroutine Get\_cID searches the whole ConfigList for an entry
3631 : ! with the given ScalID and returns the corresponding container ID cID.
3632 : !\\
3633 : !\\
3634 : ! !INTERFACE:
3635 : !
3636 0 : SUBROUTINE Get_cID( ScalID, HcoConfig, cID, RC )
3637 : !
3638 : ! !INPUT PARAMETERS:
3639 : !
3640 : INTEGER, INTENT(IN ) :: scalID
3641 : TYPE(ConfigObj), POINTER :: HcoConfig
3642 : !
3643 : ! !OUTPUT PARAMETERS:
3644 : !
3645 : INTEGER, INTENT( OUT) :: cID
3646 : !
3647 : ! !INPUT/OUTPUTP PARAMETERS:
3648 : !
3649 : INTEGER, INTENT(INOUT) :: RC
3650 : !
3651 : ! !REVISION HISTORY:
3652 : ! 18 Sep 2013 - C. Keller - Initial version
3653 : ! See https://github.com/geoschem/hemco for complete history
3654 : !EOP
3655 : !------------------------------------------------------------------------------
3656 : !BOC
3657 : !
3658 : ! !LOCAL VARIABLES:
3659 : !
3660 : ! Pointers
3661 : TYPE(ListCont), POINTER :: Lct
3662 :
3663 : ! Scalars
3664 : CHARACTER(LEN=255) :: MSG, LOC
3665 : CHARACTER(LEN= 31) :: strID
3666 :
3667 : ! Enter
3668 0 : LOC = 'Get_cID (hco_config_mod.F90)'
3669 0 : cID = -999
3670 :
3671 : ! Loop over all containers
3672 0 : Lct => HcoConfig%ConfigList
3673 0 : DO WHILE ( ASSOCIATED ( Lct ) )
3674 :
3675 : ! Skip if data container not defined
3676 0 : IF ( .NOT. ASSOCIATED(Lct%Dct) ) THEN
3677 0 : Lct => Lct%NextCont
3678 0 : CYCLE
3679 : ENDIF
3680 :
3681 : ! Check if this container has desired scalID
3682 0 : IF ( Lct%Dct%ScalID == ScalID ) THEN
3683 0 : cID = Lct%Dct%cID
3684 0 : EXIT
3685 : ENDIF
3686 :
3687 : ! Move to archived next line
3688 0 : Lct => Lct%NextCont
3689 : ENDDO
3690 :
3691 : ! Free pointer
3692 0 : Lct => NULL()
3693 :
3694 : ! cID must be positive!
3695 0 : IF ( cID <= 0 ) THEN
3696 0 : WRITE ( strID, * ) ScalID
3697 0 : MSG = 'Cannot find ScalID' // TRIM(strID)
3698 0 : PRINT *,'cID negative in HEMCO Get_cID'
3699 0 : PRINT *, TRIM(MSG)
3700 0 : RETURN
3701 : ENDIF
3702 :
3703 : ! Leave w/ success
3704 0 : RC = HCO_SUCCESS
3705 :
3706 : END SUBROUTINE Get_cID
3707 : !EOC
3708 : !------------------------------------------------------------------------------
3709 : ! Harmonized Emissions Component (HEMCO) !
3710 : !------------------------------------------------------------------------------
3711 : !BOP
3712 : !
3713 : ! !IROUTINE: ConfigList_AddCont
3714 : !
3715 : ! !DESCRIPTION: Subroutine ConfigList\_AddCont adds a new (blank) container to
3716 : ! the ConfigList list.
3717 : !\\
3718 : !\\
3719 : ! !INTERFACE:
3720 : !
3721 0 : SUBROUTINE ConfigList_AddCont( Lct, List )
3722 : !
3723 : ! !USES:
3724 : !
3725 : USE HCO_DATACONT_Mod, ONLY : DataCont_Init
3726 : USE HCO_DATACONT_Mod, ONLY : ListCont_Length
3727 : !
3728 : ! !INPUT/OUTPUT PARAMETERS:
3729 : !
3730 : TYPE(ListCont), POINTER :: Lct
3731 : TYPE(ListCont), POINTER :: List
3732 : !
3733 : ! !REVISION HISTORY:
3734 : ! 17 Sep 2013 - C. Keller: Initialization (update)
3735 : ! See https://github.com/geoschem/hemco for complete history
3736 : !EOP
3737 : !------------------------------------------------------------------------------
3738 : !BOC
3739 : !
3740 : ! !LOCAL VARIABLES:
3741 : !
3742 : INTEGER :: cID
3743 :
3744 : !======================================================================
3745 : ! ConfigList_AddCont begins here
3746 : !======================================================================
3747 :
3748 : ! Allocate container and create data structure.
3749 : ! The DataCont_Init call creates a new data container (type DataCont)
3750 : ! All HEMCO lists (ConfigList, ReadList, EmisList) point to this
3751 : ! container!
3752 0 : ALLOCATE ( Lct )
3753 0 : Lct%Dct => NULL()
3754 0 : Lct%NextCont => NULL()
3755 :
3756 : ! Get # of containers in list. Set new container ID (cID) to # of
3757 : ! containers + 1.
3758 0 : cID = ListCont_Length( List )
3759 0 : cID = cID + 1
3760 0 : CALL DataCont_Init ( Lct%Dct, cID )
3761 :
3762 : ! Connect blank container with ConfigList list.
3763 0 : Lct%NextCont => List
3764 0 : List => Lct
3765 :
3766 :
3767 0 : END SUBROUTINE ConfigList_AddCont
3768 : !EOC
3769 : !------------------------------------------------------------------------------
3770 : ! Harmonized Emissions Component (HEMCO) !
3771 : !------------------------------------------------------------------------------
3772 : !BOP
3773 : !
3774 : ! !IROUTINE: ScalID_Register
3775 : !
3776 : ! !DESCRIPTION: Subroutine ScalID\_Register adds the scale factor IDs ScalIDs
3777 : ! to the list of scale factor IDs.
3778 : !\\
3779 : !\\
3780 : ! !INTERFACE:
3781 : !
3782 0 : SUBROUTINE ScalID_Register( Dct, HcoConfig, RC )
3783 : !
3784 : ! !INPUT PARAMETERS:
3785 : !
3786 : TYPE(DataCont), POINTER :: Dct
3787 : TYPE(ConfigObj), POINTER :: HcoConfig
3788 : !
3789 : ! !INPUT/OUTPUT PARAMETERS:
3790 : !
3791 : INTEGER, INTENT(INOUT) :: RC
3792 : !
3793 : ! !REVISION HISTORY:
3794 : ! 10 Jan 2014 - C. Keller: Initialization (update)
3795 : ! See https://github.com/geoschem/hemco for complete history
3796 : !EOP
3797 : !------------------------------------------------------------------------------
3798 : !BOC
3799 : !
3800 : ! !LOCAL VARIABLES:
3801 : !
3802 : ! Scalars
3803 : INTEGER :: N, cID
3804 :
3805 : !======================================================================
3806 : ! ScalID_Register begins here
3807 : !======================================================================
3808 :
3809 : ! Check for every element of ScalIDs, if this scale factor ID is
3810 : ! already a member of ScalIDList. If not, add it.
3811 0 : DO N = 1, Dct%nScalID
3812 0 : IF ( Dct%Scal_cID(N) < 0 ) CYCLE
3813 :
3814 0 : CALL ScalID2List( HcoConfig%ScalIDList, Dct%Scal_cID(N), RC )
3815 0 : IF ( RC /= HCO_SUCCESS ) THEN
3816 0 : PRINT *,'Error in ScaleID2List called from HEMCO ScalID_Register (1)'
3817 0 : RETURN
3818 : ENDIF
3819 :
3820 : ! Replace scale factor ID with container ID.
3821 0 : CALL Get_cID ( Dct%Scal_cID(N), HcoConfig, cID, RC )
3822 0 : IF ( RC /= HCO_SUCCESS ) THEN
3823 0 : PRINT *,'Error in Get_cID called from HEMCO ScalID_Register (1)'
3824 0 : RETURN
3825 : ENDIF
3826 0 : Dct%Scal_cID(N) = cID
3827 :
3828 : ENDDO
3829 :
3830 : ! Also check for level scale factor IDs
3831 0 : IF ( Dct%levScalID1 > 0 ) THEN
3832 0 : CALL ScalID2List( HcoConfig%ScalIDList, Dct%levScalID1, RC )
3833 0 : IF ( RC /= HCO_SUCCESS ) THEN
3834 0 : PRINT *,'Error in ScalID2List called from HEMCO ScalID_Register (2)'
3835 0 : RETURN
3836 : ENDIF
3837 0 : CALL Get_cID ( Dct%levScalID1, HcoConfig, cID, RC )
3838 0 : IF ( RC /= HCO_SUCCESS ) THEN
3839 0 : PRINT *,'Error in Get_cID called from HEMCO ScalID_Register (2)'
3840 0 : RETURN
3841 : ENDIF
3842 0 : Dct%levScalID1 = cID
3843 : ENDIF
3844 0 : IF ( Dct%levScalID2 > 0 ) THEN
3845 0 : CALL ScalID2List( HcoConfig%ScalIDList, Dct%levScalID2, RC )
3846 0 : IF ( RC /= HCO_SUCCESS ) THEN
3847 0 : PRINT *,'Error in ScaleID2List called from HEMCO ScalID_Register (3)'
3848 0 : RETURN
3849 : ENDIF
3850 0 : CALL Get_cID ( Dct%levScalID2, HcoConfig, cID, RC )
3851 0 : IF ( RC /= HCO_SUCCESS ) THEN
3852 0 : PRINT *,'Error in Get_cID called from HEMCO ScalID_Register (3)'
3853 0 : RETURN
3854 : ENDIF
3855 0 : Dct%levScalID2 = cID
3856 : ENDIF
3857 :
3858 : ! Vector Scal_cID of this container now points to cIDs
3859 0 : Dct%Scal_cID_Set = .TRUE.
3860 :
3861 : ! Leave w/ success
3862 0 : RC = HCO_SUCCESS
3863 :
3864 : END SUBROUTINE ScalID_Register
3865 : !EOC
3866 : !------------------------------------------------------------------------------
3867 : ! Harmonized Emissions Component (HEMCO) !
3868 : !------------------------------------------------------------------------------
3869 : !BOP
3870 : !
3871 : ! !IROUTINE: ScalID2List
3872 : !
3873 : ! !DESCRIPTION: Subroutine ScalID2List adds the scale factor IDs ScalIDs
3874 : ! to the list of scale factor IDs.
3875 : !\\
3876 : !\\
3877 : ! !INTERFACE:
3878 : !
3879 0 : SUBROUTINE ScalID2List( ScalIDList, ID, RC )
3880 : !
3881 : ! !INPUT PARAMETERS:
3882 : !
3883 : TYPE(ScalIDCont), POINTER :: ScalIDList
3884 : INTEGER, INTENT(IN ) :: ID
3885 : !
3886 : ! !INPUT/OUTPUT PARAMETERS:
3887 : !
3888 : INTEGER, INTENT(INOUT) :: RC
3889 : !
3890 : ! !REVISION HISTORY:
3891 : ! 10 Jan 2014 - C. Keller: Initialization (update)
3892 : ! See https://github.com/geoschem/hemco for complete history
3893 : !EOP
3894 : !------------------------------------------------------------------------------
3895 : !BOC
3896 : !
3897 : ! !LOCAL VARIABLES:
3898 : !
3899 : ! Pointers
3900 : TYPE(ScalIDCont), POINTER :: NewScalIDCont
3901 : TYPE(ScalIDCont), POINTER :: TmpScalIDCont
3902 : TYPE(ScalIDCont), POINTER :: PrvScalIDCont
3903 :
3904 : ! Scalars
3905 : LOGICAL :: IsInList
3906 :
3907 : !======================================================================
3908 : ! ScalID2List begins here
3909 : !======================================================================
3910 :
3911 : ! Initialize
3912 0 : NewScalIDCont => NULL()
3913 0 : TmpScalIDCont => NULL()
3914 0 : PrvScalIDCont => NULL()
3915 :
3916 : ! Check for every element of ScalIDs, if this scale factor ID is
3917 : ! already a member of ScalIDList. If not, add it.
3918 :
3919 : ! Check if already in list
3920 0 : IsInList = .FALSE.
3921 0 : TmpScalIDCont => ScalIDList
3922 0 : PrvScalIDCont => TmpScalIDCont
3923 0 : DO WHILE ( ASSOCIATED(TmpScalIDCont) )
3924 0 : IF ( TmpScalIDCont%ScalID == ID ) THEN
3925 : IsInList = .TRUE.
3926 : EXIT
3927 : ENDIF
3928 0 : PrvScalIDCont => TmpScalIDCont
3929 0 : TmpScalIDCont => TmpScalIDCont%NEXT
3930 : ENDDO
3931 :
3932 : ! Add new container w/ this scal ID to (end of) list
3933 0 : IF ( .NOT. IsInList ) THEN
3934 0 : ALLOCATE ( NewScalIDCont )
3935 0 : NewScalIDCont%ScalID = ID
3936 0 : NewScalIDCont%NEXT => NULL()
3937 0 : IF ( .NOT. ASSOCIATED(PrvScalIDCont) ) THEN
3938 0 : ScalIDList => NewScalIDCont
3939 : ELSE
3940 0 : PrvScalIDCont%NEXT => NewScalIDCont
3941 : ENDIF
3942 : ! NewScalIDCont%NEXT => ScalIDList
3943 : ! ScalIDList => NewScalIDCont
3944 : ! NewScalIDCont => NULL()
3945 : ENDIF
3946 :
3947 : ! Cleanup
3948 0 : TmpScalIDCont => NULL()
3949 :
3950 : ! Leave w/ success
3951 0 : RC = HCO_SUCCESS
3952 :
3953 0 : END SUBROUTINE ScalID2List
3954 : !EOC
3955 : !------------------------------------------------------------------------------
3956 : ! Harmonized Emissions Component (HEMCO) !
3957 : !------------------------------------------------------------------------------
3958 : !BOP
3959 : !
3960 : ! !IROUTINE: ScalID_Cleanup
3961 : !
3962 : ! !DESCRIPTION: Subroutine ScalID\_Cleanup cleans up the internal ScalID
3963 : ! list.
3964 : !\\
3965 : !\\
3966 : ! !INTERFACE:
3967 : !
3968 0 : SUBROUTINE ScalID_Cleanup( ScalIDList )
3969 : !
3970 : ! !INPUT ARGUMENTS:
3971 : !
3972 : TYPE(ScalIDCont), POINTER :: ScalIDList
3973 : !
3974 : ! !REVISION HISTORY:
3975 : ! 10 Jan 2014 - C. Keller: Initialization (update)
3976 : ! See https://github.com/geoschem/hemco for complete history
3977 : !EOP
3978 : !------------------------------------------------------------------------------
3979 : !BOC
3980 : !
3981 : ! !LOCAL VARIABLES:
3982 : !
3983 : ! Pointers
3984 : TYPE(ScalIDCont), POINTER :: TmpScalIDCont
3985 : TYPE(ScalIDCont), POINTER :: NxtScalIDCont
3986 :
3987 : !======================================================================
3988 : ! ScalID_Cleanup begins here
3989 : !======================================================================
3990 :
3991 : ! Walk through list and remove each element
3992 0 : NxtScalIDCont => NULL()
3993 0 : TmpScalIDCont => ScalIDList
3994 0 : DO WHILE ( ASSOCIATED(TmpScalIDCont) )
3995 :
3996 0 : NxtScalIDCont => TmpScalIDCont%NEXT
3997 0 : TmpScalIDCont%NEXT => NULL()
3998 0 : DEALLOCATE ( TmpScalIDCont )
3999 :
4000 0 : TmpScalIDCont => NxtScalIDCont
4001 : ENDDO
4002 :
4003 : ! Exit
4004 0 : TmpScalIDCont => NULL()
4005 0 : NxtScalIDCont => NULL()
4006 0 : ScalIDList => NULL()
4007 :
4008 0 : END SUBROUTINE ScalID_Cleanup
4009 : !EOC
4010 : !------------------------------------------------------------------------------
4011 : ! Harmonized Emissions Component (HEMCO) !
4012 : !------------------------------------------------------------------------------
4013 : !BOP
4014 : !
4015 : ! !IROUTINE: SpecName_Register
4016 : !
4017 : ! !DESCRIPTION: Subroutine SpecName\_Register adds the species name SpecName
4018 : ! to the list of species names.
4019 : !\\
4020 : !\\
4021 : ! !INTERFACE:
4022 : !
4023 0 : SUBROUTINE SpecName_Register( HcoConfig, SpecName, RC )
4024 : !
4025 : ! !USES:
4026 : !
4027 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
4028 : !
4029 : ! !INPUT PARAMETERS:
4030 : !
4031 : TYPE(ConfigObj), POINTER :: HcoConfig
4032 : CHARACTER(LEN=*), INTENT(IN ) :: SpecName
4033 : !
4034 : ! !INPUT/OUTPUT PARAMETERS:
4035 : !
4036 : INTEGER, INTENT(INOUT) :: RC
4037 : !
4038 : ! !REVISION HISTORY:
4039 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4040 : ! See https://github.com/geoschem/hemco for complete history
4041 : !EOP
4042 : !------------------------------------------------------------------------------
4043 : !BOC
4044 : !
4045 : ! !LOCAL ARGUMENTS:
4046 : !
4047 : TYPE(SpecNameCont), POINTER :: NewSpecNameCont
4048 : TYPE(SpecNameCont), POINTER :: TmpSpecNameCont
4049 : LOGICAL :: IsInList
4050 :
4051 : !======================================================================
4052 : ! SpecName_Register begins here
4053 : !======================================================================
4054 :
4055 : ! Ignore if wildcard character. These fields will always be used!
4056 0 : IF ( TRIM(SpecName) == TRIM(HCO_GetOpt(HcoConfig%ExtList,'Wildcard')) ) THEN
4057 0 : RC = HCO_SUCCESS
4058 0 : RETURN
4059 : ENDIF
4060 :
4061 : ! Initialize
4062 0 : NewSpecNameCont => NULL()
4063 0 : TmpSpecNameCont => NULL()
4064 :
4065 : ! Check if already in list
4066 0 : IsInList = .FALSE.
4067 0 : TmpSpecNameCont => HcoConfig%SpecNameList
4068 0 : DO WHILE ( ASSOCIATED(TmpSpecNameCont) )
4069 0 : IF ( TRIM(TmpSpecNameCont%SpecName) == TRIM(SpecName) ) THEN
4070 0 : IsInList = .TRUE.
4071 0 : EXIT
4072 : ENDIF
4073 0 : TmpSpecNameCont => TmpSpecNameCont%NEXT
4074 : ENDDO
4075 :
4076 : ! Add new container w/ this scal ID to (beginning) of list
4077 : IF ( .NOT. IsInList ) THEN
4078 0 : ALLOCATE ( NewSpecNameCont )
4079 0 : NewSpecNameCont%SpecName = SpecName
4080 0 : NewSpecNameCont%NEXT => HcoConfig%SpecNameList
4081 0 : HcoConfig%SpecNameList => NewSpecNameCont
4082 0 : NewSpecNameCont => NULL()
4083 : ENDIF
4084 :
4085 : ! Cleanup
4086 0 : TmpSpecNameCont => NULL()
4087 :
4088 : ! Leave w/ success
4089 0 : RC = HCO_SUCCESS
4090 :
4091 0 : END SUBROUTINE SpecName_Register
4092 : !EOC
4093 : !------------------------------------------------------------------------------
4094 : ! Harmonized Emissions Component (HEMCO) !
4095 : !------------------------------------------------------------------------------
4096 : !BOP
4097 : !
4098 : ! !IROUTINE: SpecName_Cleanup
4099 : !
4100 : ! !DESCRIPTION: Subroutine SpecName\_Cleanup cleans up the internal SpecName
4101 : ! list.
4102 : !\\
4103 : !\\
4104 : ! !INTERFACE:
4105 : !
4106 0 : SUBROUTINE SpecName_Cleanup ( SpecNameList )
4107 : !
4108 : ! !INPUT/OUTPUT ARGUMENT:
4109 : !
4110 : TYPE(SpecNameCont), POINTER :: SpecNameList
4111 : !
4112 : ! !REVISION HISTORY:
4113 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4114 : ! See https://github.com/geoschem/hemco for complete history
4115 : !EOP
4116 : !------------------------------------------------------------------------------
4117 : !BOC
4118 : !
4119 : ! !LOCAL ARGUMENTS:
4120 : !
4121 : ! Pointers
4122 : TYPE(SpecNameCont), POINTER :: TmpSpecNameCont
4123 : TYPE(SpecNameCont), POINTER :: NxtSpecNameCont
4124 :
4125 : !======================================================================
4126 : ! SpecName_Cleanup begins here
4127 : !======================================================================
4128 :
4129 : ! Initialize
4130 0 : TmpSpecNameCont => NULL()
4131 0 : NxtSpecNameCont => NULL()
4132 :
4133 : ! Walk through list and remove each element
4134 0 : TmpSpecNameCont => SpecNameList
4135 0 : DO WHILE ( ASSOCIATED(TmpSpecNameCont) )
4136 :
4137 0 : NxtSpecNameCont => TmpSpecNameCont%NEXT
4138 0 : TmpSpecNameCont%NEXT => NULL()
4139 0 : DEALLOCATE ( TmpSpecNameCont )
4140 :
4141 0 : TmpSpecNameCont => NxtSpecNameCont
4142 : ENDDO
4143 :
4144 : ! Exit
4145 0 : TmpSpecNameCont => NULL()
4146 0 : NxtSpecNameCont => NULL()
4147 0 : SpecNameList => NULL()
4148 :
4149 0 : END SUBROUTINE SpecName_Cleanup
4150 : !EOC
4151 : !------------------------------------------------------------------------------
4152 : ! Harmonized Emissions Component (HEMCO) !
4153 : !------------------------------------------------------------------------------
4154 : !BOP
4155 : !
4156 : ! !IROUTINE: Config_GetnSpecies
4157 : !
4158 : ! !DESCRIPTION: Function Config\_GetnSpecies is a wrapper function to
4159 : ! get the number of (unique) species names in SpecNameList.
4160 : !\\
4161 : !\\
4162 : ! !INTERFACE:
4163 : !
4164 0 : FUNCTION Config_GetnSpecies( HcoConfig ) RESULT( nSpecies )
4165 : !
4166 : ! !INPUT ARGUMENT:
4167 : !
4168 : TYPE(ConfigObj), POINTER :: HcoConfig
4169 : !
4170 : ! !RETURN VALUE:
4171 : !
4172 : INTEGER :: nSpecies
4173 : !
4174 : ! !REVISION HISTORY:
4175 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4176 : ! See https://github.com/geoschem/hemco for complete history
4177 : !EOP
4178 : !------------------------------------------------------------------------------
4179 : !BOC
4180 : !
4181 : ! !LOCAL VARIABLES:
4182 : !
4183 : INTEGER :: THISRC
4184 :
4185 : !======================================================================
4186 : ! Config_GetnSpecies begins here
4187 : !======================================================================
4188 :
4189 0 : CALL Config_GetSpecAttr( HcoConfig, N=nSpecies, RC = THISRC )
4190 :
4191 0 : END FUNCTION Config_GetnSpecies
4192 : !EOC
4193 : !------------------------------------------------------------------------------
4194 : ! Harmonized Emissions Component (HEMCO) !
4195 : !------------------------------------------------------------------------------
4196 : !BOP
4197 : !
4198 : ! !IROUTINE: Config_GetSpecNames
4199 : !
4200 : ! !DESCRIPTION: Subroutine Config\_GetSpecNames is a wrapper routine to
4201 : ! obtain the list of (unique) species names defined in SpecNameList.
4202 : !\\
4203 : !\\
4204 : ! !INTERFACE:
4205 : !
4206 0 : SUBROUTINE Config_GetSpecNames( HcoConfig, SpecNames, nSpecies, RC )
4207 : !
4208 : ! !INPUT ARGUMENT:
4209 : !
4210 : TYPE(ConfigObj), POINTER :: HcoConfig
4211 : !
4212 : ! !OUTPUT PARAMTERS:
4213 : !
4214 : CHARACTER(LEN=*), POINTER :: SpecNames(:)
4215 : !
4216 : ! !INPUT/OUTPUT PARAMETERS:
4217 : !
4218 : INTEGER, INTENT(INOUT) :: nSpecies
4219 : INTEGER, INTENT(INOUT) :: RC
4220 : !
4221 : ! !REVISION HISTORY:
4222 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4223 : ! See https://github.com/geoschem/hemco for complete history
4224 : !EOP
4225 : !------------------------------------------------------------------------------
4226 : !BOC
4227 : !======================================================================
4228 : ! Config_GetSpecNames begins here
4229 : !======================================================================
4230 :
4231 0 : CALL Config_GetSpecAttr( HcoConfig, N=nSpecies, SpecNames=SpecNames, RC=RC )
4232 :
4233 0 : END SUBROUTINE Config_GetSpecNames
4234 : !EOC
4235 : !------------------------------------------------------------------------------
4236 : ! Harmonized Emissions Component (HEMCO) !
4237 : !------------------------------------------------------------------------------
4238 : !BOP
4239 : !
4240 : ! !IROUTINE: Config_getSpecAttr
4241 : !
4242 : ! !DESCRIPTION: Subroutine Config\_GetSpecAttr returns the number of
4243 : ! species names N and the vector of species names SpecNames.
4244 : ! SpecNames must be of length nnSpecs, i.e. in order to obtain
4245 : ! SpecNames, Config\_getSpecAttr has to be called twice:
4246 : ! N = 0
4247 : ! CALL Config\_getSpecAttr ( N=N, RC=RC )
4248 : ! ALLOCATE(SpecNames(N))
4249 : ! CALL Config\_getSpecAttr ( N=N, SpecNames=SpecNames, RC=RC )
4250 : !\\
4251 : !\\
4252 : ! !INTERFACE:
4253 : !
4254 0 : SUBROUTINE Config_GetSpecAttr( HcoConfig, N, SpecNames, RC )
4255 : !
4256 : ! !INPUT ARGUMENT:
4257 : !
4258 : TYPE(ConfigObj), POINTER :: HcoConfig
4259 : !
4260 : ! !INPUT/OUTPUT PARAMETERS:
4261 : !
4262 : INTEGER, INTENT(INOUT) :: N
4263 : INTEGER, INTENT(INOUT) :: RC
4264 : !
4265 : ! !OUTPUT PARAMETERS:
4266 : !
4267 : CHARACTER(LEN=*), POINTER, OPTIONAL :: SpecNames(:)
4268 : !
4269 : ! !REVISION HISTORY:
4270 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4271 : ! See https://github.com/geoschem/hemco for complete history
4272 : !EOP
4273 : !------------------------------------------------------------------------------
4274 : !BOC
4275 : !
4276 : ! !LOCAL VARIABLES:
4277 : !
4278 : TYPE(SpecNameCont), POINTER :: TmpSpecNameCont
4279 : INTEGER :: AS
4280 : CHARACTER(LEN=255), PARAMETER :: &
4281 : LOC = 'Config_GetSpecAttr (hco_config_mod.F90)'
4282 : CHARACTER(LEN=512) :: errMsg
4283 :
4284 : !======================================================================
4285 : ! Config_GetSpecAttr begins here
4286 : !======================================================================
4287 :
4288 : ! Initialize
4289 0 : TmpSpecNameCont => NULL()
4290 :
4291 : ! Eventually allocate pointer
4292 0 : IF ( PRESENT(SpecNames) ) THEN
4293 0 : IF ( .NOT. ASSOCIATED(SpecNames) ) THEN
4294 0 : IF ( N <= 0 ) THEN
4295 0 : errMsg = 'Cannot allocate SpecNames - N is size 0 or smaller'
4296 0 : CALL HCO_Error( errMsg, RC, thisLoc=LOC )
4297 0 : RETURN
4298 : ENDIF
4299 0 : ALLOCATE(SpecNames(N), STAT=AS )
4300 0 : IF ( AS/= 0 ) THEN
4301 0 : errMsg = 'Could not allocate the SpcNames array!'
4302 0 : CALL HCO_Error( errMsg, RC, thisLoc=LOC )
4303 0 : RETURN
4304 : ENDIF
4305 0 : SpecNames(:) = ''
4306 0 : ELSEIF ( SIZE(SpecNames) /= N ) THEN
4307 0 : errMsg = 'Size(SpecNames) does not match the passed N argument!'
4308 0 : CALL HCO_Error( errMsg, RC, thisLoc=LOC )
4309 0 : RETURN
4310 : ENDIF
4311 : ENDIF
4312 :
4313 : ! Init
4314 0 : N = 0
4315 :
4316 : ! Loop over entire list. Count number of containers and eventually
4317 : ! write out the species names.
4318 0 : TmpSpecNameCont => HcoConfig%SpecNameList
4319 0 : DO WHILE ( ASSOCIATED(TmpSpecNameCont) )
4320 0 : N = N + 1
4321 0 : IF ( PRESENT(SpecNames) ) THEN
4322 0 : SpecNames(N) = TRIM(TmpSpecNameCont%SpecName)
4323 : ENDIF
4324 0 : TmpSpecNameCont => TmpSpecNameCont%NEXT
4325 : ENDDO
4326 :
4327 : ! Cleanup and return w/ success
4328 0 : TmpSpecNameCont => NULL()
4329 :
4330 0 : RC = HCO_SUCCESS
4331 :
4332 0 : END SUBROUTINE Config_GetSpecAttr
4333 : !EOC
4334 : !------------------------------------------------------------------------------
4335 : ! Harmonized Emissions Component (HEMCO) !
4336 : !------------------------------------------------------------------------------
4337 : !BOP
4338 : !
4339 : ! !IROUTINE: Check_ContNames
4340 : !
4341 : ! !DESCRIPTION: Function Check\_Contnames compares the container names of
4342 : ! two containers, ignoring the name 'tags', i.e. ignoring everything that
4343 : ! follows double underscore (\_\_). For example, two containers with names
4344 : ! "EDGAR\_NOX\_\_PNT" and "EDGAR\_NOX\_\_MOB" are considered equal, while
4345 : ! "EDGAR\_NOX\_PNT" and "EDGAR\_NOX\_MOB" are not.
4346 : !\\
4347 : !\\
4348 : ! !INTERFACE:
4349 : !
4350 0 : FUNCTION Check_ContNames( Lct1, Lct2 ) RESULT( SameName )
4351 : !
4352 : ! !INPUT/OUTPUT PARAMETERS:
4353 : !
4354 : TYPE(ListCont), POINTER :: Lct1
4355 : TYPE(ListCont), POINTER :: Lct2
4356 : !
4357 : ! !RETURN VALUE:
4358 : !
4359 : LOGICAL :: SameName
4360 : !
4361 : ! !REVISION HISTORY:
4362 : ! 10 Jan 2014 - C. Keller: Initialization (update)
4363 : ! See https://github.com/geoschem/hemco for complete history
4364 : !EOP
4365 : !------------------------------------------------------------------------------
4366 : !BOC
4367 : !
4368 : ! !LOCAL VARIABLES:
4369 : !
4370 : CHARACTER(LEN=63) :: name1, name2
4371 : INTEGER :: idx
4372 :
4373 : !======================================================================
4374 : ! Check_ContNames begins here!
4375 : !======================================================================
4376 :
4377 0 : SameName = .FALSE.
4378 0 : name1 = 'a'
4379 0 : name2 = 'b'
4380 :
4381 0 : idx = INDEX( TRIM(Lct1%Dct%cName), '__' )
4382 0 : IF ( idx > 0 ) THEN
4383 0 : name1 = Lct1%Dct%cName(1:idx)
4384 : ELSE
4385 0 : name1 = Lct1%Dct%cName
4386 : ENDIF
4387 :
4388 0 : idx = INDEX( TRIM(Lct2%Dct%cName), '__' )
4389 0 : IF ( idx > 0 ) THEN
4390 0 : name2 = Lct2%Dct%cName(1:idx)
4391 : ELSE
4392 0 : name2 = Lct2%Dct%cName
4393 : ENDIF
4394 :
4395 0 : IF ( TRIM(name1) == TRIM(name2) ) THEN
4396 : SameName = .TRUE.
4397 : ELSE
4398 0 : SameName = .FALSE.
4399 : ENDIF
4400 :
4401 0 : END FUNCTION Check_ContNames
4402 : !EOC
4403 : !------------------------------------------------------------------------------
4404 : ! Harmonized Emissions Component (HEMCO) !
4405 : !------------------------------------------------------------------------------
4406 : !BOP
4407 : !
4408 : ! !IROUTINE: ExtractSrcDim
4409 : !
4410 : ! !DESCRIPTION: Subroutine ExtractSrcDim extracts the source dimension
4411 : ! attribute. Specifically, it checks if the field is expected to be 2D
4412 : ! (xy) or 3D. Default 3D data is xyz, but it is also possible to explicitly
4413 : ! define the number of vertical levels to be read, as well as the reading
4414 : ! direction (up or down). For example, 'xy1' will be interpreted as reading
4415 : ! only the first level, and 'xy27' will only read the first 27 levels. To
4416 : ! reverse the vertical axis, use e.g. 'xy-1' to read only the top level,
4417 : ! or 'xy-27' to read the top 27 levels, with the topmost level being put
4418 : ! into the surface level.
4419 : !\\
4420 : !\\
4421 : ! !INTERFACE:
4422 : !
4423 0 : SUBROUTINE ExtractSrcDim( HcoConfig, SrcDim, Dta, Lscal1, Lscal2, RC )
4424 : !
4425 : ! !INPUT PARAMETERS:
4426 : !
4427 : TYPE(ConfigObj), POINTER :: HcoConfig
4428 : CHARACTER(LEN=*), INTENT(IN ) :: SrcDim
4429 : TYPE(FileData), POINTER :: Dta
4430 : !
4431 : ! !OUTPUT PARAMETERS:
4432 : !
4433 : INTEGER, INTENT( OUT) :: Lscal1
4434 : INTEGER, INTENT( OUT) :: Lscal2
4435 : !
4436 : ! !INPUT/OUTPUT PARAMETERS:
4437 : !
4438 : INTEGER, INTENT(INOUT) :: RC
4439 : !
4440 : ! !REVISION HISTORY:
4441 : ! 20 May 2015 - C. Keller - Initial version
4442 : ! See https://github.com/geoschem/hemco for complete history
4443 : !EOP
4444 : !------------------------------------------------------------------------------
4445 : !BOC
4446 : !
4447 : ! !LOCAL VARIABLES:
4448 : !
4449 : INTEGER :: i, idx, idx2
4450 : INTEGER :: strLen
4451 : INTEGER :: EmisUnit
4452 : REAL(hp) :: EmisL
4453 : CHARACTER(LEN=255) :: str1, str2, tmpstr
4454 : CHARACTER(LEN=255) :: MSG
4455 : CHARACTER(LEN=255) :: LOC = 'ExtractSrcDim (hco_config_mod.F90)'
4456 :
4457 : !======================================================================
4458 : ! ExtractSrcDim begins here
4459 : !======================================================================
4460 :
4461 : msg = 'Illegal source dimension ' // TRIM(srcDim) // &
4462 : ' for file ' // TRIM(Dta%ncFile) // &
4463 0 : '. Valid entries are e.g. xy or xyz.'
4464 :
4465 : ! Init output
4466 0 : Lscal1 = -1
4467 0 : Lscal2 = -1
4468 :
4469 : ! See if there is an arbitrary additional dimension. This must be added
4470 : ! at the end of the string and be separated by a '+' sign
4471 0 : idx = INDEX( TRIM(srcDim), '+' )
4472 0 : IF ( idx > 0 ) THEN
4473 0 : str1 = srcDim(1:(idx-1))
4474 0 : str2 = srcDim((idx+1):LEN(srcDim))
4475 : ELSE
4476 0 : str1 = srcDim
4477 0 : str2 = ''
4478 : ENDIF
4479 :
4480 : ! 2D data:
4481 0 : IF ( TRIM(str1) == 'xy' .OR. TRIM(str1) == '-' ) THEN
4482 0 : Dta%SpaceDim = 2
4483 :
4484 : ! All other cases
4485 : ELSE
4486 : ! Character length
4487 0 : strLen = LEN(TRIM(str1))
4488 :
4489 : ! There must be at least 3 characters (e.g. xyz)
4490 0 : IF ( strLen < 3 ) THEN
4491 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
4492 0 : RETURN
4493 : ENDIF
4494 :
4495 : ! First two entries must be xy
4496 0 : IF ( str1(1:2) /= 'xy' ) THEN
4497 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
4498 0 : RETURN
4499 : ENDIF
4500 :
4501 : ! If third entry is 'L', this means we have 2D data that shall be put
4502 : ! into a particular level, e.g. xyL4 will cause the 2D data to be
4503 : ! emitted into level 4.
4504 0 : IF ( str1(3:3) == 'L' .OR. str1(3:3) == 'l' ) THEN
4505 0 : IF ( strLen < 4 ) THEN
4506 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
4507 0 : RETURN
4508 : ENDIF
4509 0 : Dta%SpaceDim = 2
4510 0 : Dta%EmisLmode = 1 ! Dilute emissions vertically
4511 :
4512 : ! Read levels to put emissions into:
4513 0 : i=4
4514 0 : IF ( str1(i:i) == '=' ) i = i + 1
4515 :
4516 : ! Reduce to data to be read
4517 0 : tmpstr = str1(i:strLen)
4518 :
4519 : ! Check if range of levels is provided, i.e. xyL=1:5
4520 0 : idx = INDEX( TRIM(tmpstr), ':' )
4521 :
4522 : ! If multiple levels are provided (e.g. xyL=1:5)
4523 0 : IF ( idx > 0 ) THEN
4524 :
4525 : ! Check for PBL flag. It is possible to emit stuff
4526 : ! from the PBL up to e.g. level 30 (xyL=PBL:30)
4527 : ! The call to ParseEmisL now returns three arguments: the emission
4528 : ! level, the emission unit, and the emission scale factor. Ignore
4529 : ! emission level and unit if scale factor is given.
4530 0 : CALL ParseEmisL( tmpstr(1:(idx-1)), EmisL, EmisUnit, Lscal1 )
4531 0 : Dta%EmisL1 = EmisL
4532 0 : Dta%EmisL1Unit = EmisUnit
4533 0 : CALL ParseEmisL( tmpstr((idx+1):LEN(tmpstr)), EmisL, EmisUnit, Lscal2 )
4534 0 : Dta%EmisL2 = EmisL
4535 0 : Dta%EmisL2Unit = EmisUnit
4536 0 : Dta%EmisLmode = 1
4537 :
4538 : ! If only one value is provided (e.g. xyL5, xyL=5, xyL*)
4539 : ELSE
4540 :
4541 : ! Check if wildcard provided, i.e. xyL*
4542 0 : idx = INDEX( TRIM(tmpstr), '*' )
4543 :
4544 : ! Wildcard tells HEMCO to emit same value to all emission levels
4545 : ! A scale factor should be applied to distribute the emissions
4546 : ! vertically
4547 0 : IF ( idx > 0 ) THEN
4548 :
4549 0 : Dta%EmisL1 = 1.0_hp
4550 0 : Dta%EmisL1Unit = HCO_EMISL_LEV
4551 0 : Dta%EmisL2 = 0.0_hp
4552 0 : Dta%EmisL2Unit = HCO_EMISL_TOP
4553 0 : Dta%EmisLmode = 2 ! Copy data to all levels
4554 :
4555 : ! Emissions are allocated to one level
4556 : ELSE
4557 :
4558 0 : CALL ParseEmisL( tmpstr, EmisL, EmisUnit, Lscal1 )
4559 0 : Dta%EmisL1 = EmisL
4560 0 : Dta%EmisL1Unit = EmisUnit
4561 0 : Lscal2 = Lscal1
4562 0 : Dta%EmisL2 = Dta%EmisL1
4563 0 : Dta%EmisL2Unit = Dta%EmisL1Unit
4564 :
4565 : ENDIF
4566 : ENDIF
4567 : ELSE
4568 :
4569 : ! If we get to here, it's 3D data
4570 0 : Dta%SpaceDim = 3
4571 :
4572 : ! The third entry determines the vertical dimension.
4573 : ! This can be 'z' (standard) or a number to explicitly define
4574 : ! the vertical extension and direction.
4575 0 : IF ( str1(3:3) /= 'z' ) THEN
4576 0 : READ(str1(3:strLen),*) Dta%Levels
4577 : ENDIF
4578 : ENDIF
4579 : ENDIF
4580 :
4581 : ! Eventually set additional dimension name and value
4582 0 : IF ( TRIM(str2) /= '' ) THEN
4583 : MSG = 'Cannot extract arbitrary dimension from ' &
4584 : // TRIM(srcDim) // ' for file ' // TRIM(Dta%ncFile) &
4585 : // ' - arbitrary dimensions must follow a `+` sign ' &
4586 0 : // 'and contain the name/value pair, e.g. xyz+"ens"=3'
4587 0 : idx = INDEX( TRIM(str2), '=' )
4588 0 : IF ( idx <= 0 ) THEN
4589 0 : CALL HCO_Error( msg, RC, thisLoc=LOC )
4590 0 : RETURN
4591 : ENDIF
4592 :
4593 : ! Extract dimension name. Eventually remove '"' character at
4594 : ! beginning
4595 0 : IF ( str2(1:1) == '"' .OR. &
4596 : str2(1:1) == '`' ) THEN
4597 0 : Dta%ArbDimName = str2(2:(idx-1))
4598 : ELSE
4599 0 : Dta%ArbDimName = str2(1:(idx-1))
4600 : ENDIF
4601 :
4602 : ! Extract dimension value. Eventually remove trailing '"'
4603 : ! character. The string value itself will be evaluated when
4604 : ! reading the file (in hcoio_dataread_mod.F90).
4605 0 : strlen = LEN(TRIM(str2))
4606 0 : IF ( str2(strlen:strlen) == '"' .OR. &
4607 : str2(strlen:strlen) == '`' ) THEN
4608 0 : Dta%ArbDimVal = str2((idx+1):(strlen-1))
4609 : ELSE
4610 0 : Dta%ArbDimVal = str2((idx+1):(strlen))
4611 : ENDIF
4612 :
4613 : ! Verbose
4614 0 : IF ( HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err ) ) THEN
4615 0 : WRITE(MSG,*) 'Will use additional dimension on file ', &
4616 0 : TRIM(Dta%ncFile), ': ', TRIM(Dta%ArbDimName), ' = ', &
4617 0 : TRIM(Dta%ArbDimVal)
4618 0 : CALL HCO_Msg( HcoConfig%Err, msg )
4619 : ENDIF
4620 : ENDIF
4621 :
4622 : ! Leave w/ success
4623 0 : RC = HCO_SUCCESS
4624 :
4625 0 : END SUBROUTINE ExtractSrcDim
4626 : !EOC
4627 : !------------------------------------------------------------------------------
4628 : ! Harmonized Emissions Component (HEMCO) !
4629 : !------------------------------------------------------------------------------
4630 : !BOP
4631 : !
4632 : ! !IROUTINE: ConfigInit
4633 : !
4634 : ! !DESCRIPTION: Subroutine ConfigInit is a wrapper routine to initialize the
4635 : ! HEMCO configuration object.
4636 : !\\
4637 : !\\
4638 : ! !INTERFACE:
4639 : !
4640 0 : SUBROUTINE ConfigInit ( HcoConfig, RC, nModelSpecies )
4641 : !
4642 : ! !INPUT PARAMETERS:
4643 : !
4644 : INTEGER, INTENT(IN), OPTIONAL :: nModelSpecies ! # model species
4645 : !
4646 : ! !INPUT/OUTPUT PARAMETERS:
4647 : !
4648 : TYPE(ConfigObj), POINTER :: HcoConfig
4649 : INTEGER, INTENT(INOUT) :: RC ! Success/fail
4650 : !
4651 : ! !REVISION HISTORY:
4652 : ! 16 Feb 2016 - C. Keller: Initialization (update)
4653 : ! See https://github.com/geoschem/hemco for complete history
4654 : !EOP
4655 : !------------------------------------------------------------------------------
4656 : !BOC
4657 : !
4658 : ! !LOCAL VARIABLES:
4659 : !
4660 : INTEGER :: I, AS
4661 : CHARACTER(LEN=255) :: thisLoc
4662 : CHARACTER(LEN=512) :: errMsg
4663 :
4664 : !=====================================================================
4665 : ! ConfigInit begins here!
4666 : !=====================================================================
4667 :
4668 0 : ALLOCATE(HcoConfig)
4669 0 : HcoConfig%ConfigFileName = ''
4670 0 : HcoConfig%ROOT = ''
4671 0 : HcoConfig%ConfigFileRead = .FALSE.
4672 0 : HcoConfig%ConfigList => NULL()
4673 0 : HcoConfig%ScalIDList => NULL()
4674 0 : HcoConfig%SpecNameList => NULL()
4675 0 : HcoConfig%ExtList => NULL()
4676 0 : HcoConfig%Err => NULL()
4677 :
4678 0 : IF ( PRESENT( nModelSpecies ) ) THEN
4679 :
4680 : ! Initialize strings
4681 0 : errMsg = ''
4682 0 : thisLoc = 'ConfigInit (in module hco_config_mod.F90)'
4683 :
4684 : ! Initialize vector w/ species information
4685 0 : HcoConfig%nModelSpc = nModelSpecies
4686 0 : IF ( nModelSpecies > 0 ) THEN
4687 0 : ALLOCATE ( HcoConfig%ModelSpc( nModelSpecies ), STAT=AS )
4688 0 : IF ( AS /= 0 ) THEN
4689 0 : errMsg = 'Could not allocate "ModelSpecies" array!'
4690 0 : CALL HCO_Error( errMsg, RC, thisLoc )
4691 0 : RETURN
4692 : ENDIF
4693 :
4694 : ! Initalize species information. The effective values for species
4695 : ! names, model IDs, etc. are set in the HEMCO-model interface
4696 : ! routine.
4697 0 : DO I = 1, nModelSpecies
4698 0 : HcoConfig%ModelSpc(I)%HcoID = I
4699 0 : HcoConfig%ModelSpc(I)%ModID = -1
4700 0 : HcoConfig%ModelSpc(I)%SpcName = ''
4701 : ENDDO
4702 : ENDIF
4703 :
4704 : ENDIF
4705 :
4706 : END SUBROUTINE ConfigInit
4707 : !EOC
4708 : !------------------------------------------------------------------------------
4709 : ! Harmonized Emissions Component (HEMCO) !
4710 : !------------------------------------------------------------------------------
4711 : !BOP
4712 : !
4713 : ! !IROUTINE: ParseEmisL
4714 : !
4715 : ! !DESCRIPTION: parses the emission level.
4716 : !\\
4717 : !\\
4718 : ! !INTERFACE:
4719 : !
4720 0 : SUBROUTINE ParseEmisL ( str, EmisL, EmisUnit, ScalID )
4721 : !
4722 : ! !INPUT PARAMETERS:
4723 : !
4724 : CHARACTER(LEN=*), INTENT(IN ) :: str
4725 : !
4726 : ! !INPUT/OUTPUT PARAMETERS:
4727 : !
4728 : REAL(hp), INTENT(OUT) :: EmisL
4729 : INTEGER, INTENT(OUT) :: EmisUnit
4730 : INTEGER, INTENT(OUT) :: ScalID
4731 : !
4732 : ! !REVISION HISTORY:
4733 : ! 09 May 2016 - C. Keller: Intial version.
4734 : ! See https://github.com/geoschem/hemco for complete history
4735 : !EOP
4736 : !------------------------------------------------------------------------------
4737 : !BOC
4738 : !
4739 : ! !LOCAL VARIABLES:
4740 : !
4741 : INTEGER :: nchar, idx
4742 :
4743 : !======================================================================
4744 : ! ParseEmisL begins here!
4745 : !======================================================================
4746 :
4747 : ! Init
4748 0 : EmisUnit = HCO_EMISL_LEV
4749 0 : ScalID = -1
4750 :
4751 0 : IF ( TRIM(str) == 'PBL' ) THEN
4752 0 : EmisL = 0.0_hp
4753 0 : EmisUnit = HCO_EMISL_PBL
4754 : ELSE
4755 : ! extract scale factor if string starts with 'SCAL' or 'scal'
4756 0 : nchar = LEN(str)
4757 0 : IF ( nchar > 4 ) THEN
4758 0 : IF ( str(1:4)=='SCAL' .OR. str(1:4)=='scal' ) THEN
4759 0 : READ(str(5:nchar),*) ScalID
4760 0 : EmisUnit = -1
4761 0 : EmisL = -1.0
4762 : ENDIF
4763 : ENDIF
4764 :
4765 : ! check for elevation unit flag (e.g. 1000m)
4766 0 : IF ( ScalID < 0 ) THEN
4767 0 : idx = INDEX(TRIM(str),'m')
4768 0 : IF ( idx > 0 ) THEN
4769 0 : READ(str(1:(idx-1)),*) EmisL
4770 0 : EmisUnit = HCO_EMISL_M
4771 : ELSE
4772 0 : READ(str,*) EmisL
4773 : ENDIF
4774 : ENDIF
4775 : ENDIF
4776 :
4777 0 : END SUBROUTINE ParseEmisL
4778 : !EOC
4779 : !------------------------------------------------------------------------------
4780 : ! Harmonized Emissions Component (HEMCO) !
4781 : !------------------------------------------------------------------------------
4782 : !BOP
4783 : !
4784 : ! !IROUTINE: CheckForDuplicateName
4785 : !
4786 : ! !DESCRIPTION: Subroutine CheckForDuplicateName checks if there is a
4787 : ! container in the container linked list that has the same name as the
4788 : ! name given as input argument.
4789 : !\\
4790 : !\\
4791 : ! !INTERFACE:
4792 : !
4793 0 : Subroutine CheckForDuplicateName( HcoConfig, cName, RC )
4794 : !
4795 : ! !INPUT ARGUMENT:
4796 : !
4797 : TYPE(ConfigObj) , POINTER :: HcoConfig ! HEMCO config obj
4798 : CHARACTER(LEN=*), INTENT(IN) :: cName
4799 : !
4800 : ! !OUTPUT ARGUMENT:
4801 : !
4802 : INTEGER, INTENT(INOUT) :: RC
4803 : !
4804 : ! !REVISION HISTORY:
4805 : ! 20 Jul 2018 - C. Keller: Initial version
4806 : ! See https://github.com/geoschem/hemco for complete history
4807 : !EOP
4808 : !------------------------------------------------------------------------------
4809 : !BOC
4810 : !
4811 : ! !LOCAL VARIABLES:
4812 : !
4813 : TYPE(ListCont), POINTER :: ThisLct => NULL()
4814 : LOGICAL :: Duplicate
4815 : CHARACTER(LEN=255) :: tmpName, thisLoc
4816 : CHARACTER(LEN=512) :: errMsg
4817 :
4818 : !======================================================================
4819 : ! CheckForDuplicateName begins here!
4820 : !======================================================================
4821 :
4822 : ! Init
4823 0 : RC = HCO_SUCCESS
4824 0 : errMsg = ''
4825 0 : thisLoc = 'CheckForDuplicateName (in module hco_config_mod.F90)'
4826 0 : Duplicate = .FALSE.
4827 :
4828 : ! Pass name to clear spaces
4829 0 : tmpName = ADJUSTL(cName)
4830 :
4831 : ! Walk through list and check for duplicate. Exit if found
4832 0 : ThisLct => HcoConfig%ConfigList
4833 0 : DO WHILE ( ASSOCIATED ( ThisLct ) )
4834 :
4835 : ! Skip if data container not defined
4836 0 : IF ( .NOT. ASSOCIATED(ThisLct%Dct) ) THEN
4837 0 : ThisLct => ThisLct%NextCont
4838 0 : CYCLE
4839 : ENDIF
4840 :
4841 : ! Check if this container has desired scalID
4842 0 : IF ( TRIM(ThisLct%Dct%cName) == TRIM(tmpName) ) THEN
4843 0 : Duplicate = .TRUE.
4844 0 : EXIT
4845 : ENDIF
4846 :
4847 : ! Move to next container
4848 0 : ThisLct => ThisLct%NextCont
4849 : ENDDO
4850 :
4851 : IF ( Duplicate ) THEN
4852 0 : errMsg = 'Error: HEMCO field already exists:'//TRIM(cName)
4853 0 : CALL HCO_Error( errMsg, RC, thisLoc )
4854 0 : RETURN
4855 : ENDIF
4856 :
4857 0 : END SUBROUTINE CheckForDuplicateName
4858 : !EOC
4859 : !------------------------------------------------------------------------------
4860 : ! GEOS-Chem Global Chemical Transport Model !
4861 : !------------------------------------------------------------------------------
4862 : !BOP
4863 : !
4864 : ! !IROUTINE: Hco_GetTagInfo
4865 : !
4866 : ! !DESCRIPTION: Subroutine HCO\_GETTAGINFO retrieves basic information about
4867 : ! tags given a wildcard string.
4868 : !\\
4869 : !\\
4870 : ! !INTERFACE:
4871 : !
4872 0 : SUBROUTINE Hco_GetTagInfo( tagID, HcoConfig, Found, &
4873 0 : RC, N, tagName, nTags )
4874 : !
4875 : ! !USES:
4876 : !
4877 : !
4878 : ! !INPUT PARAMETERS:
4879 : !
4880 : CHARACTER(LEN=*), INTENT(IN) :: tagID ! ID of tag (e.g. wildcard)
4881 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO Config object
4882 : INTEGER, OPTIONAL :: N ! index (1 to # tags)
4883 : !
4884 : ! !OUTPUT PARAMETERS:
4885 : !
4886 : LOGICAL, INTENT(OUT) :: Found ! Item found?
4887 : INTEGER, INTENT(OUT) :: RC ! Return code
4888 : CHARACTER(LEN=255), OPTIONAL :: tagName ! tag name for index N
4889 : INTEGER, OPTIONAL :: nTags ! # tags
4890 : !
4891 : ! !REMARKS:
4892 : !
4893 : ! !REVISION HISTORY:
4894 : ! 23 Oct 2018 - M. Sulprizio- Initial version based on routine Get_TagInfo in
4895 : ! GEOS-Chem's Headers/state_diag_mod.F90
4896 : ! See https://github.com/geoschem/hemco for complete history
4897 : !EOP
4898 : !------------------------------------------------------------------------------
4899 : !BOC
4900 : !
4901 : ! !LOCAL VARIABLES:
4902 : !
4903 : ! Scalars
4904 : INTEGER :: D, numTags
4905 : LOGICAL :: isNumTags, isTagName, isN
4906 :
4907 : ! Strings
4908 : CHARACTER(LEN=255) :: thisLoc, Nstr
4909 : CHARACTER(LEN=512) :: errMsg
4910 :
4911 : !=======================================================================
4912 : ! Hco_GetTagInfo begins here
4913 : !=======================================================================
4914 :
4915 : ! Initialize
4916 0 : errMsg = ''
4917 0 : thisLoc = 'Hco_Get_TagInfo (in module hco_config_mod.F90)'
4918 0 : Found = .TRUE.
4919 0 : numTags = 0
4920 :
4921 : ! Optional arguments present?
4922 0 : isN = PRESENT( N )
4923 0 : isTagName = PRESENT( TagName )
4924 0 : isNumTags = PRESENT( nTags )
4925 :
4926 : ! Exit with error if getting tag name but index not specified
4927 0 : IF ( isTagName .AND. .NOT. isN ) THEN
4928 0 : ErrMsg = 'Index must be specified if retrieving an individual tag name'
4929 0 : CALL HCO_Error( errMsg, RC, thisLoc )
4930 0 : RETURN
4931 : ENDIF
4932 :
4933 : !=======================================================================
4934 : ! Get number of tags
4935 : !=======================================================================
4936 0 : SELECT CASE( TRIM( tagId ) )
4937 : CASE( 'ALL' )
4938 0 : numTags = HcoConfig%nModelSpc
4939 : CASE( 'ADV' )
4940 0 : numTags = HcoConfig%nModelAdv
4941 : CASE DEFAULT
4942 0 : FOUND = .FALSE.
4943 : ErrMsg = 'Handling of tagId ' // TRIM(tagId) // &
4944 0 : ' is not implemented for getting number of tags'
4945 0 : CALL HCO_Error( errMsg, RC, thisLoc )
4946 0 : RETURN
4947 : END SELECT
4948 :
4949 : !=======================================================================
4950 : ! Sanity checks -- exit under certain conditions
4951 : !=======================================================================
4952 :
4953 : ! If not getting tag name then set nTags and exit
4954 0 : IF ( .NOT. isTagName ) THEN
4955 0 : nTags = numTags
4956 0 : RETURN
4957 : ENDIF
4958 :
4959 : ! Exit with error if index exceeds number of tags for this wildcard
4960 : IF ( isTagName .AND. .NOT. isN ) THEN
4961 : errMsg = &
4962 : 'Index must be greater than total number of tags for wildcard' &
4963 : // TRIM(tagId)
4964 : CALL HCO_Error( errMsg, RC, thisLoc )
4965 : RETURN
4966 : ENDIF
4967 :
4968 : !=======================================================================
4969 : ! Get mapping index
4970 : !=======================================================================
4971 0 : SELECT CASE( TRIM( tagID ) )
4972 : CASE( 'ALL', 'ADV' )
4973 0 : D = N
4974 : CASE DEFAULT
4975 0 : FOUND = .FALSE.
4976 : errMsg = 'Handling of tagId ' // TRIM( tagId ) // &
4977 0 : ' is not implemented for getting tag name'
4978 0 : CALL HCO_Error( errMsg, RC, thisLoc )
4979 0 : RETURN
4980 : END SELECT
4981 :
4982 : !=======================================================================
4983 : ! Return the tag name
4984 : !=======================================================================
4985 0 : tagName = HcoConfig%ModelSpc(D)%SpcName
4986 :
4987 : END SUBROUTINE Hco_GetTagInfo
4988 : !EOC
4989 : !------------------------------------------------------------------------------
4990 : ! GEOS-Chem Global Chemical Transport Model !
4991 : !------------------------------------------------------------------------------
4992 : !BOP
4993 : !
4994 : ! !IROUTINE: UpdateDtaProperties
4995 : !
4996 : ! !DESCRIPTION: Updates metdata about the current data container that is
4997 : ! being created (e.g. time cycle information, level information, etc.)
4998 : !\\
4999 : !\\
5000 : ! !INTERFACE:
5001 : !
5002 0 : SUBROUTINE UpdateDtaProperties( char1, char2, dctType, int3, &
5003 : separator, srcDim, tagCName, tmCycle, &
5004 : wildCard, HcoConfig, Lct, Dta, &
5005 : RC )
5006 : !
5007 : ! !INPUT PARAMETERS:
5008 : !
5009 : CHARACTER(LEN=*), INTENT(IN) :: char1 !
5010 : CHARACTER(LEN=1), INTENT(IN) :: char2 !
5011 : INTEGER, INTENT(IN) :: dctType ! 1=base; 2=scale; 3=mask
5012 : INTEGER, INTENT(IN) :: int3 !
5013 : CHARACTER(LEN=*), INTENT(IN) :: separator ! Separator character
5014 : CHARACTER(LEN=*), INTENT(IN) :: srcDim ! e.g. "xyz", "xy", etc.
5015 : CHARACTER(LEN=*), INTENT(IN) :: tagCName ! Contaniner name
5016 : CHARACTER(LEN=*), INTENT(IN) :: tmCycle ! Tioe cycle flag setting
5017 : CHARACTER(LEN=*), INTENT(IN) :: wildCard ! Wild card character
5018 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO configuration object
5019 : !
5020 : ! !INPUT/OUTPUT PARAMETERS:
5021 : !
5022 : TYPE(ListCont), POINTER :: Lct ! List container object
5023 : TYPE(FileData), POINTER :: Dta ! Data container object
5024 : !
5025 : ! !OUTPUT PARAMETERS:
5026 : !
5027 : INTEGER, INTENT(OUT) :: RC ! Success or failure
5028 : !
5029 : ! !REMARKS:
5030 : ! Abstracted from routine Config_ReadCont.
5031 : !EOP
5032 : !------------------------------------------------------------------------------
5033 : !BOC
5034 : !
5035 : ! !LOCAL VARIABLES:
5036 : !
5037 : ! Scalars
5038 : INTEGER :: levScal1
5039 : INTEGER :: levScal2
5040 : INTEGER :: nEdges
5041 :
5042 : ! Arrays
5043 : INTEGER :: splitInts(255)
5044 :
5045 : ! Strings
5046 : CHARACTER(LEN=255) :: thisLoc
5047 : CHARACTER(LEN=512) :: errMsg
5048 :
5049 : ! String arrays
5050 : CHARACTER(LEN=255) :: SubStrs(255)
5051 :
5052 : !========================================================================
5053 : ! UpdateDtaProperties begins here!
5054 : !========================================================================
5055 :
5056 : ! Initialize
5057 0 : RC = HCO_SUCCESS
5058 0 : levScal1 = 0
5059 0 : levScal2 = 0
5060 0 : nEdges = 0
5061 0 : splitInts = 0
5062 0 : errMsg = ''
5063 : thisLoc = &
5064 0 : ' -> at UpdateDtaProperties (in module HEMCO/src/Core/hco_config_mod.F90)'
5065 :
5066 : !========================================================================
5067 : ! Set time cycling behaviour. Possible values are:
5068 : ! - "C" : cycling <-- DEFAULT
5069 : ! - "CS" : cycling, skip if not exist
5070 : ! - "CY" : cycling, always use simulation year
5071 : ! - "CYS" : cycling, always use simulation yr, skip if not exist
5072 : ! - "R" : range
5073 : ! - "RA" : range, average outside
5074 : ! - "RF" : range, forced (error if not in range)
5075 : ! - "RFY" : range, forced, always use simulation year
5076 : ! - "RFY3 : range, forced, always use simulation year, 3-hourly
5077 : ! - "RY" : range, always use simulation year
5078 : ! - "E" : exact, read/query once
5079 : ! - "EF" : exact, forced (error if not exist), read/query once
5080 : ! - "EFY" : exact, forced, always use sim year
5081 : ! - "EFYO": exact, forced, always use sim year, read once
5082 : ! - "EC" : exact, read/query continuously (e.g. for ESMF interface)
5083 : ! - "ECF" : exact, forced, read/query continuously
5084 : ! - "EY" : exact, always use simulation year, read/query once
5085 : ! - "A" : average
5086 : ! - "I" : interpolate
5087 : ! - "ID" : interpolate, discontinuous dataset
5088 : !========================================================================
5089 :
5090 : ! Zero logical fields of Dta for safety's sake
5091 0 : Dta%MustFind = .FALSE.
5092 0 : Dta%UseSimYear = .FALSE.
5093 0 : Dta%Discontinuous = .FALSE.
5094 :
5095 : ! Look for time cycle values
5096 0 : SELECT CASE( TRIM( TmCycle ) )
5097 : CASE( "C" )
5098 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
5099 0 : Dta%MustFind = .TRUE.
5100 : CASE( "CS" )
5101 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
5102 0 : Dta%MustFind = .FALSE.
5103 : CASE( "CY" )
5104 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
5105 0 : Dta%MustFind = .TRUE.
5106 0 : Dta%UseSimYear = .TRUE.
5107 : CASE( "CYS" )
5108 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
5109 0 : Dta%MustFind = .FALSE.
5110 0 : Dta%UseSimYear = .TRUE.
5111 : CASE( "R" )
5112 0 : Dta%CycleFlag = HCO_CFLAG_RANGE
5113 : CASE( "RA" )
5114 0 : Dta%CycleFlag = HCO_CFLAG_RANGEAVG
5115 : CASE( "RF" )
5116 0 : Dta%CycleFlag = HCO_CFLAG_RANGE
5117 0 : Dta%MustFind = .TRUE.
5118 : CASE( "RFY" )
5119 0 : Dta%CycleFlag = HCO_CFLAG_RANGE
5120 0 : Dta%MustFind = .TRUE.
5121 0 : Dta%UseSimYear = .TRUE.
5122 : CASE( "RFY3" )
5123 0 : Dta%CycleFlag = HCO_CFLAG_RANGE
5124 0 : Dta%MustFind = .TRUE.
5125 0 : Dta%UseSimYear = .TRUE.
5126 0 : Dta%UpdtFlag = HCO_UFLAG_3HR
5127 : CASE( "RY" )
5128 0 : Dta%CycleFlag = HCO_CFLAG_RANGE
5129 0 : Dta%UseSimYear = .TRUE.
5130 : CASE( "E" )
5131 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5132 0 : Dta%UpdtFlag = HCO_UFLAG_ONCE
5133 : CASE( "EF" )
5134 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5135 0 : Dta%UpdtFlag = HCO_UFLAG_ONCE
5136 0 : Dta%MustFind = .TRUE.
5137 : CASE( "EFY" )
5138 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5139 0 : Dta%MustFind = .TRUE.
5140 0 : Dta%UseSimYear = .TRUE.
5141 : CASE( "EFYO" )
5142 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5143 0 : Dta%UpdtFlag = HCO_UFLAG_ONCE
5144 0 : Dta%MustFind = .TRUE.
5145 0 : Dta%UseSimYear = .TRUE.
5146 : CASE( "EC" )
5147 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5148 : CASE( "ECF" )
5149 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5150 0 : Dta%MustFind = .TRUE.
5151 : CASE( "EY" )
5152 0 : Dta%CycleFlag = HCO_CFLAG_EXACT
5153 0 : Dta%UpdtFlag = HCO_UFLAG_ONCE
5154 0 : Dta%UseSimYear = .TRUE.
5155 : CASE( "A" )
5156 0 : Dta%CycleFlag = HCO_CFLAG_AVERG
5157 : CASE( "I" )
5158 0 : Dta%CycleFlag = HCO_CFLAG_INTER
5159 : CASE( "ID" )
5160 0 : Dta%CycleFlag = HCO_CFLAG_INTER
5161 0 : Dta%Discontinuous = .TRUE.
5162 : CASE( "-" )
5163 0 : Dta%CycleFlag = HCO_CFLAG_CYCLE
5164 : CASE DEFAULT
5165 : errMsg = 'Invalid time cycling attribute: ' // tmCycle // &
5166 0 : ' - in ' // tagcName
5167 0 : CALL HCO_Error( errMsg, RC, thisLoc )
5168 0 : RETURN
5169 : END SELECT
5170 :
5171 : !========================================================================
5172 : ! Set space dimension. This will determine the dimension of the
5173 : ! data array vector, i.e. 3D or 2D. Different time slices will
5174 : ! be stored as different vector elements.
5175 : ! For 3D data, it is now possible to explicitly set the number
5176 : ! of vertical levels to be used, as well as the 'reading
5177 : ! direction' (up or down). These information is also extracted
5178 : ! from srcDim and will be stored in variable Dta%Levels.
5179 : ! (ckeller, 5/20/15)
5180 : ! ExtractSrcDim now also returns possible scale factors for the
5181 : ! injection level, which will be stored in container variable
5182 : ! levScalID1 (bottom level) and levScalID2 (top level).
5183 : !========================================================================
5184 0 : CALL ExtractSrcDim( HcoConfig, srcDim, Dta, levScal1, levScal2, RC )
5185 0 : IF ( RC /= HCO_SUCCESS ) THEN
5186 0 : errMsg = 'Error encountered in routine "ExtractSrcDim"!'
5187 0 : CALL HCO_Error( errMsg, RC, thisLoc )
5188 0 : RETURN
5189 : ENDIF
5190 :
5191 : ! Set level scale factor index
5192 0 : IF ( levScal1 > 0 ) Lct%Dct%levScalID1 = levScal1
5193 0 : IF ( levScal2 > 0 ) Lct%Dct%levScalID2 = levScal2
5194 :
5195 : !========================================================================
5196 : ! For scale factors: check if a mask is assigned to this scale factor.
5197 : ! In this case, pass mask ID to first slot of Scal_cID vector. This
5198 : ! value will be set to the container ID of the corresponding mask
5199 : ! field later on.
5200 : !========================================================================
5201 0 : IF ( DctType == HCO_DCTTYPE_SCAL .AND. Int3 > 0 ) THEN
5202 0 : ALLOCATE ( Lct%Dct%Scal_cID(1) )
5203 0 : Lct%Dct%Scal_cID(1) = Int3
5204 0 : Lct%Dct%nScalID = 1
5205 : ENDIF
5206 :
5207 : !========================================================================
5208 : ! For masks: extract grid box edges. These will be used later on to
5209 : ! determine if emissions have to be considered by this CPU.
5210 : !========================================================================
5211 0 : IF ( DctType == HCO_DCTTYPE_MASK ) THEN
5212 :
5213 : ! Extract grid box edges. Need to be four values.
5214 : CALL HCO_CharSplit( char1, separator, wildcard, &
5215 0 : splitInts, nEdges, RC )
5216 0 : IF ( RC /= HCO_SUCCESS ) THEN
5217 0 : errMsg = 'Error encountered in routine "HCO_CharSplit"!'
5218 0 : CALL HCO_Error( errMsg, RC, thisLoc )
5219 0 : RETURN
5220 : ENDIF
5221 0 : IF ( nEdges /= 4 ) THEN
5222 : errMsg = 'Cannot properly read mask coverage: ' // &
5223 0 : TRIM( Lct%Dct%cName )
5224 0 : CALL HCO_Error( errMsg, RC, thisLoc )
5225 0 : RETURN
5226 : ENDIF
5227 :
5228 : ! Save temporarily in year and month range. Will be
5229 : ! reset lateron.
5230 0 : Dta%ncYrs(1) = splitInts(1)
5231 0 : Dta%ncYrs(2) = splitInts(2)
5232 0 : Dta%ncMts(1) = splitInts(3)
5233 0 : Dta%ncMts(2) = splitInts(4)
5234 :
5235 : ! Make sure that masks are always being read if specified so.
5236 0 : IF ( char2 == 'y' .OR. char2 == 'Y' ) THEN
5237 0 : CALL ScalID2List( HcoConfig%ScalIDList, Lct%Dct%ScalID, RC )
5238 0 : IF ( RC /= HCO_SUCCESS ) THEN
5239 0 : errMsg = 'Error encountered in routine "ScalID2List"!'
5240 0 : CALL HCO_Error( errMsg, RC, thisLoc )
5241 0 : RETURN
5242 : ENDIF
5243 : ENDIF
5244 : ENDIF
5245 :
5246 0 : END SUBROUTINE UpdateDtaProperties
5247 : !EOC
5248 : END MODULE HCO_Config_Mod
|
