Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_extlist_mod
7 : !
8 : ! !DESCRIPTION: Module HCO\_EXTLIST\_MOD contains routines and
9 : ! variables to organize HEMCO extensions and the corresponding
10 : ! settings (options). This is done through the ExtList object,
11 : ! which is a simple list containing all enabled HEMCO extensions
12 : ! (name and ext. ID) and the corresponding options, as defined in
13 : ! the HEMCO configuration file. The general HEMCO settings are
14 : ! stored as options of the HEMCO core extension (Extension number
15 : ! = 0). The CORE extension is activated in every HEMCO run, while
16 : ! all other extensions are only activated if enabled in the
17 : ! configuration file.
18 : !\\
19 : !\\
20 : ! Extension number -999 is used as 'wildcard' value, e.g. data
21 : ! containers with extension number -999 will always be read by
22 : ! HEMCO but will be ignored for emission calculation. This is
23 : ! particularly useful for data fields that shall be used outside
24 : ! of HEMCO, e.g. stratospheric chemistry prod/loss rates, etc.
25 : !\\
26 : !\\
27 : ! Extension options are 'flexible' in a sense that any option
28 : ! name/value pair can be assigned to an extension. The value of
29 : ! any of these options can be queried using subroutine GetExtOpt
30 : ! or function HCO\_GetOpt. In fact, the HEMCO filename parser
31 : ! (in hco\_chartools\_mod.F90) will attempt to find an option
32 : ! value for any HEMCO 'token' (a character starting with the
33 : ! HEMCO token sign (which is, the dollar sign '\$'). This allows
34 : ! the user to specify as many individual tokens as HEMCO
35 : ! settings as needed.
36 : !\\
37 : !\\
38 : ! !INTERFACE:
39 : !
40 : MODULE HCO_ExtList_Mod
41 : !
42 : ! !USES:
43 : !
44 : USE HCO_Error_Mod
45 : USE HCO_Types_Mod
46 :
47 : IMPLICIT NONE
48 : PRIVATE
49 : !
50 : ! !PUBLIC MEMBER FUNCTIONS:
51 : !
52 : PUBLIC :: AddExt
53 : PUBLIC :: AddExtOpt
54 : PUBLIC :: GetExtOpt
55 : PUBLIC :: GetExtNr
56 : PUBLIC :: GetExtSpcStr
57 : PUBLIC :: GetExtSpcVal
58 : PUBLIC :: SetExtNr
59 : PUBLIC :: ExtNrInUse
60 : PUBLIC :: ExtFinal
61 : PUBLIC :: HCO_GetOpt
62 : PUBLIC :: HCO_SetDefaultToken
63 : PUBLIC :: HCO_ROOT
64 :
65 : PRIVATE :: HCO_AddOpt
66 : PRIVATE :: HCO_CleanupOpt
67 :
68 : ! Core extension number
69 : INTEGER, PARAMETER, PUBLIC :: CoreNr = -1
70 : !
71 : ! !REVISION HISTORY:
72 : ! 02 Oct 2013 - C. Keller - Initial version
73 : ! See https://github.com/geoschem/hemco for complete history
74 : !EOP
75 : !-----------------------------------------------------------------------------
76 : !BOC
77 : !
78 : ! !PRIVATE TYPES:
79 : !
80 : ! Lenght of maximum token character length
81 : CHARACTER(LEN=OPTLEN), PARAMETER :: EMPTYOPT = '---'
82 :
83 : !---------------------------------------------------------------------------
84 : ! Default tokens
85 : ! HEMCO has three tokens that can be specified in the HEMCO configuration
86 : ! file: ROOT (root directory), MET/met (met fields), and RES (horizontal
87 : ! resolution). These tokens can be used in file names to be dynamically
88 : ! replaced, e.g. file.$MET.$RES.nc becomes file.GEOSFP.4x5.nc if MET is set
89 : ! to 'GEOSFP' and RES to '4x5'. Opts are also allowed for dates ($YYYY,
90 : ! $MM, $DD, $HH, see routine HCO_CharParse).
91 : ! The default tokens below will be used if by default, i.e. if the
92 : ! corresponding token is not specified in the HEMCO configuration file.
93 : !---------------------------------------------------------------------------
94 :
95 : ! Default root directory
96 : CHARACTER(LEN=OPTLEN), PARAMETER :: DEF_ROOT = '/please/provide/root/path'
97 :
98 : ! Default values for characters that can be changed
99 : ! through the configuration file
100 : CHARACTER(LEN=1), PARAMETER :: DEF_COLON = ':'
101 : CHARACTER(LEN=1), PARAMETER :: DEF_SEPARATOR = '/'
102 : CHARACTER(LEN=1), PARAMETER :: DEF_WILDCARD = '*'
103 :
104 : ! Met field and grid tokens
105 : CHARACTER(LEN=15) :: DEF_MET_UC = 'UNKNOWN_MET'
106 : CHARACTER(LEN=15) :: DEF_MET_LC = 'unknown_met'
107 : CHARACTER(LEN=15) :: DEF_MET_EXT= 'unknown_extension'
108 : CHARACTER(LEN=15) :: DEF_CN_YR = 'unknown_year'
109 : CHARACTER(LEN=15) :: DEF_RES = 'unknown_res'
110 : CHARACTER(LEN=15) :: DEF_NC_VER = 'nc'
111 :
112 : INTERFACE GetExtSpcVal
113 : MODULE PROCEDURE GetExtSpcVal_Char
114 : MODULE PROCEDURE GetExtSpcVal_Int
115 : MODULE PROCEDURE GetExtSpcVal_Sp
116 : END INTERFACE GetExtSpcVal
117 :
118 : CONTAINS
119 : !EOC
120 : !------------------------------------------------------------------------------
121 : ! Harmonized Emissions Component (HEMCO) !
122 : !------------------------------------------------------------------------------
123 : !BOP
124 : !
125 : ! !IROUTINE: AddExt
126 : !
127 : ! !DESCRIPTION: Subroutine AddExt adds a new extension to the extensions
128 : ! list. The extension name, number and species (multiple species separated
129 : ! by the HEMCO separator sign) need to be provided. Extension options are
130 : ! left blank but can be added lateron using AddExtOpt.
131 : !\\
132 : !\\
133 : ! !INTERFACE:
134 : !
135 0 : SUBROUTINE AddExt( HcoConfig, ExtName, ExtNr, InUse, Spcs, RC )
136 : !
137 : ! !USES:
138 : !
139 : USE HCO_CHARPAK_MOD, ONLY : TRANLC
140 : !
141 : ! !INPUT PARAMETERS::
142 : !
143 : TYPE(ConfigObj), POINTER :: HcoConfig
144 : CHARACTER(LEN=*), INTENT(IN ) :: ExtName
145 : INTEGER, INTENT(IN ) :: ExtNr
146 : LOGICAL, INTENT(IN ) :: InUse
147 : CHARACTER(LEN=*), INTENT(IN ) :: Spcs
148 : !
149 : ! !INPUT/OUTPUT PARAMETERS::
150 : !
151 : INTEGER, INTENT(INOUT) :: RC
152 : !
153 : ! !REVISION HISTORY:
154 : ! 03 Oct 2013 - C. Keller - Initial version
155 : ! See https://github.com/geoschem/hemco for complete history
156 : !EOP
157 : !------------------------------------------------------------------------------
158 : !BOC
159 : !
160 : ! !INTERNAL VARIABLES:
161 : !
162 : INTEGER :: OrigExtNr
163 : CHARACTER(LEN=255) :: MSG, lcName
164 : TYPE(Ext), POINTER :: NewExt
165 : TYPE(Ext), POINTER :: ThisExt
166 :
167 : !======================================================================
168 : ! AddExt
169 : !======================================================================
170 :
171 : ! Init
172 0 : NewExt => NULL()
173 0 : ThisExt => NULL()
174 :
175 : ! All extension names are lower case
176 0 : lcName = TRIM(ExtName)
177 0 : CALL TRANLC( lcName )
178 :
179 : ! Check if extension already exists
180 0 : OrigExtNr = GetExtNr( HcoConfig%ExtList, TRIM(lcName) )
181 0 : IF ( OrigExtNr /= -999 ) THEN
182 :
183 : ! Return w/ error if extension numbers do not match
184 0 : IF ( OrigExtNr /= ExtNr ) THEN
185 0 : WRITE(MSG,*) 'Cannot create extension - extension already exists', &
186 0 : TRIM(lcName), ExtNr, OrigExtNr
187 0 : CALL HCO_ERROR(MSG,RC,THISLOC='AddExt (hco_extlist_mod.F90)')
188 0 : RETURN
189 :
190 : ! Nothing to do otherwise
191 : ELSE
192 0 : RC = HCO_SUCCESS
193 0 : RETURN
194 : ENDIF
195 : ENDIF
196 :
197 : ! Allocate type
198 0 : ALLOCATE ( NewExt )
199 0 : NewExt%NextExt => NULL()
200 :
201 : ! Set extension name
202 0 : NewExt%ExtName = lcName
203 :
204 : ! Set extension number and species. Set to invalid values if not used.
205 0 : IF ( InUse ) THEN
206 0 : NewExt%ExtNr = ExtNr
207 0 : NewExt%Spcs = Spcs
208 : ELSE
209 0 : NewExt%ExtNr = -1
210 0 : NewExt%Spcs = 'None'
211 : ENDIF
212 :
213 : ! Initialize extension options. These will be filled lateron
214 0 : NewExt%Opts => NULL()
215 :
216 : ! Place at end of extension list
217 : ! The rational for this is simply that the more often used extension options
218 : ! (of the HEMCO 'core' and 'base' extensions) are set first and we better have
219 : ! them at the beginning of ExtList for better efficiency.
220 :
221 : ! If this is the first entry...
222 0 : IF ( .NOT. ASSOCIATED(HcoConfig%ExtList) ) THEN
223 0 : HcoConfig%ExtList => NewExt
224 :
225 : ! Otherwise, scan list until last extension is encountered
226 : ELSE
227 : ThisExt => HcoConfig%ExtList
228 0 : DO WHILE(ASSOCIATED(ThisExt))
229 0 : IF ( .NOT. ASSOCIATED(ThisExt%NextExt) ) EXIT
230 0 : ThisExt => ThisExt%NextExt
231 : END DO
232 :
233 : ! Append new extension to the list
234 0 : ThisExt%NextExt => NewExt
235 : ENDIF
236 :
237 : ! Verbose
238 0 : IF ( HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err) .AND. InUse ) THEN
239 0 : WRITE(MSG,*) 'Added HEMCO extension: ', TRIM(ExtName), ExtNr
240 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
241 : ENDIF
242 :
243 : ! Cleanup
244 0 : ThisExt => NULL()
245 :
246 : ! Return w/ success
247 0 : RC = HCO_SUCCESS
248 :
249 0 : END SUBROUTINE AddExt
250 : !EOC
251 : !------------------------------------------------------------------------------
252 : ! Harmonized Emissions Component (HEMCO) !
253 : !------------------------------------------------------------------------------
254 : !BOP
255 : !
256 : ! !IROUTINE: AddExtOpt
257 : !
258 : ! !DESCRIPTION: Function AddExtOpt appends the given string to the options
259 : ! character of the desired extension (identified by its extension number).
260 : ! The options string is expected to contain an option name and value,
261 : ! separated by a colon (:).
262 : ! Function GetExtOpt can be used to extract the option value at a later
263 : ! point.
264 : !\\
265 : !\\
266 : ! !INTERFACE:
267 : !
268 0 : SUBROUTINE AddExtOpt( HcoConfig, Opt, ExtNr, RC, IgnoreIfExist )
269 : !
270 : ! !USES:
271 : !
272 : USE HCO_CHARPAK_MOD, ONLY : STRSPLIT, TRANLC
273 : !
274 : ! !INPUT PARAMETERS:
275 : !
276 : TYPE(ConfigObj), POINTER :: HcoConfig ! Configuration object
277 : CHARACTER(LEN=*), INTENT(IN ) :: Opt ! Option name & value
278 : INTEGER, INTENT(IN ) :: ExtNr ! Add to this extension
279 : LOGICAL, INTENT(IN ), OPTIONAL :: IgnoreIfExist ! Ignore this entry if it exists already?
280 : !
281 : ! !INPUT/OUTPUT PARAMETERS:
282 : !
283 : INTEGER, INTENT(INOUT) :: RC
284 : !
285 : ! !REVISION HISTORY:
286 : ! 03 Oct 2013 - C. Keller - Initial version
287 : ! See https://github.com/geoschem/hemco for complete history
288 : !EOP
289 : !------------------------------------------------------------------------------
290 : !BOC
291 : !
292 : ! !INTERNAL VARIABLES:
293 : !
294 : INTEGER :: IDX
295 : CHARACTER(LEN=255) :: MSG, LOC
296 : CHARACTER(LEN=OPTLEN) :: TmpStr, OptName, OptValue
297 :
298 : !======================================================================
299 : ! AddExtOpt begins here
300 : !======================================================================
301 0 : LOC = 'AddExtOpt (HCO_EXTLIST_MOD.F90)'
302 :
303 : ! Parse option name and option value. These must be separated by colon.
304 0 : IDX = INDEX( TRIM(Opt), ':' )
305 :
306 : ! Error check
307 0 : IF ( IDX <= 0 ) THEN
308 : MSG = 'Cannot extract option name/value pair - these must be ' // &
309 0 : 'separated by a colon (:) character: ' // TRIM(Opt)
310 0 : CALL HCO_ERROR(MSG,RC,THISLOC='AddExtOpt (hco_extlist_mod)')
311 0 : RETURN
312 : ENDIF
313 :
314 : ! Now split option name / value pair
315 0 : OptName = Opt(1:(IDX-1))
316 0 : OptValue = Opt((IDX+1):LEN(Opt))
317 :
318 : ! Also check for '-->' option indicatior. This string must be stripped
319 : ! off the option name!
320 0 : IDX = INDEX( TRIM(OptName), '-->' )
321 0 : IF ( IDX > 0 ) THEN
322 0 : TmpStr = OptName( (IDX+3) : LEN(TRIM(OptName)) )
323 0 : OptName = TmpStr
324 : ENDIF
325 :
326 : ! Pass to options
327 : CALL HCO_AddOpt( HcoConfig, OptName, OptValue, ExtNr, RC, &
328 0 : IgnoreIfExist=IgnoreIfExist )
329 0 : IF ( RC /= HCO_SUCCESS ) THEN
330 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
331 0 : RETURN
332 : ENDIF
333 :
334 : ! Cleanup and leave
335 0 : RC = HCO_SUCCESS
336 :
337 : END SUBROUTINE AddExtOpt
338 : !EOC
339 : !------------------------------------------------------------------------------
340 : ! Harmonized Emissions Component (HEMCO) !
341 : !------------------------------------------------------------------------------
342 : !BOP
343 : !
344 : ! !IROUTINE: GetExtOpt
345 : !
346 : ! !DESCRIPTION: Function GetExtOpt returns the option value for a given
347 : ! extension and option name. The type of the return value depends on the
348 : ! provided argument (real, boolean, character). The optional output
349 : ! argument FOUND returns TRUE if the given option name was found, and
350 : ! FALSE otherwise. If the FOUND argument is provided, no error is
351 : ! returned if the option name is not found!
352 : ! If the ExtNr is set to -999, the settings of all extensions are searched.
353 : !\\
354 : !\\
355 : ! !INTERFACE:
356 : !
357 0 : SUBROUTINE GetExtOpt ( HcoConfig, ExtNr, OptName, OptValHp, &
358 : OptValSp, OptValDp, OptValInt, &
359 : OptValBool, OptValChar, Found, RC )
360 : !
361 : ! !USES:
362 : !
363 : USE HCO_CHARPAK_MOD, ONLY : STRSPLIT, TRANLC
364 : !
365 : ! !INPUT PARAMETERS:
366 : !
367 : TYPE(ConfigObj), POINTER :: HcoConfig
368 : INTEGER, INTENT(IN ) :: ExtNr
369 : CHARACTER(LEN=*), INTENT(IN ) :: OptName
370 : !
371 : ! !OUTPUT PARAMETERS:
372 : !
373 : REAL(hp), INTENT( OUT), OPTIONAL :: OptValHp
374 : REAL(sp), INTENT( OUT), OPTIONAL :: OptValSp
375 : REAL(dp), INTENT( OUT), OPTIONAL :: OptValDp
376 : INTEGER, INTENT( OUT), OPTIONAL :: OptValInt
377 : LOGICAL, INTENT( OUT), OPTIONAL :: OptValBool
378 : CHARACTER(LEN=*), INTENT( OUT), OPTIONAL :: OptValChar
379 : LOGICAL, INTENT( OUT), OPTIONAL :: Found
380 : !
381 : ! !INPUT/OUTPUT PARAMETERS:
382 : !
383 : INTEGER, INTENT(INOUT) :: RC
384 : !
385 : ! !REVISION HISTORY:
386 : ! 03 Oct 2013 - C. Keller - Initial version
387 : ! See https://github.com/geoschem/hemco for complete history
388 : !EOP
389 : !------------------------------------------------------------------------------
390 : !BOC
391 : !
392 : ! !INTERNAL VARIABLES:
393 : !
394 : CHARACTER(LEN=OPTLEN) :: OptValue
395 : LOGICAL :: OptFound
396 : CHARACTER(LEN=255) :: MSG, LOC
397 :
398 : !======================================================================
399 : ! GetExtOpt begins here
400 : !======================================================================
401 :
402 : ! Init
403 0 : LOC = 'GetExtOpt (hco_extlist_mod)'
404 :
405 : ! Get option
406 0 : OptValue = HCO_GetOpt( HcoConfig%ExtList, OptName, ExtNr=ExtNr )
407 0 : IF ( TRIM(OptValue) == TRIM(EMPTYOPT) ) THEN
408 : OptFound = .FALSE.
409 : ELSE
410 0 : OptFound = .TRUE.
411 : ENDIF
412 :
413 : ! Check if option was found. Handling depends on presence
414 : ! of argument 'FOUND'. If FOUND is not present and option
415 : ! was not found, return with error.
416 0 : IF ( PRESENT(FOUND) ) THEN
417 0 : FOUND = OptFound
418 0 : ELSEIF ( .NOT. OptFound ) THEN
419 0 : WRITE(MSG,*) '(A) Cannot find option ', TRIM(OptName), &
420 0 : ' in extension ', ExtNr
421 0 : CALL HCO_ERROR(MSG,RC,THISLOC=LOC )
422 0 : RETURN
423 : ENDIF
424 :
425 : ! Pass option value to output
426 0 : IF ( PRESENT(OptValSp) ) THEN
427 0 : IF ( OptFound ) THEN
428 0 : READ( OptValue, * ) OptValSp
429 : ELSE
430 0 : OptValSp = -999.0_sp
431 : ENDIF
432 0 : ELSEIF ( PRESENT(OptValDp) ) THEN
433 0 : IF ( OptFound ) THEN
434 0 : READ( OptValue, * ) OptValDp
435 : ELSE
436 0 : OptValDp = -999.0_dp
437 : ENDIF
438 0 : ELSEIF ( PRESENT(OptValHp) ) THEN
439 0 : IF ( OptFound ) THEN
440 0 : READ( OptValue, * ) OptValHp
441 : ELSE
442 0 : OptValHp = -999.0_hp
443 : ENDIF
444 0 : ELSEIF ( PRESENT(OptValInt) ) THEN
445 0 : IF ( OptFound ) THEN
446 0 : READ( OptValue, * ) OptValInt
447 : ELSE
448 0 : OptValInt = -999
449 : ENDIF
450 0 : ELSEIF ( PRESENT(OptValBool) ) THEN
451 0 : IF ( OptFound ) THEN
452 0 : CALL TRANLC( OptValue )
453 0 : IF ( INDEX( TRIM(OptValue), 'true' ) > 0 ) THEN
454 0 : OptValBool = .TRUE.
455 : ELSE
456 0 : OptValBool = .FALSE.
457 : ENDIF
458 : ELSE
459 0 : OptValBool = .FALSE.
460 : ENDIF
461 0 : ELSEIF ( PRESENT(OptValChar) ) THEN
462 0 : IF ( OptFound ) THEN
463 0 : OptValChar = ADJUSTL( TRIM(OptValue) )
464 : ELSE
465 0 : OptValChar = ''
466 : ENDIF
467 : ENDIF
468 :
469 : ! Cleanup and leave
470 0 : RC = HCO_SUCCESS
471 :
472 0 : END SUBROUTINE GetExtOpt
473 : !EOC
474 : !------------------------------------------------------------------------------
475 : ! Harmonized Emissions Component (HEMCO) !
476 : !------------------------------------------------------------------------------
477 : !BOP
478 : !
479 : ! !IROUTINE: GetExtNr
480 : !
481 : ! !DESCRIPTION: Function GetExtNr returns the extension number of
482 : ! extension ExtName. Returns -999 if no extension with the given name is
483 : ! found.
484 : !\\
485 : !\\
486 : ! !INTERFACE:
487 : !
488 0 : FUNCTION GetExtNr( ExtList, ExtName ) Result ( ExtNr )
489 : !
490 : ! !USES:
491 : !
492 : USE HCO_CHARPAK_MOD, ONLY : TRANLC
493 : !
494 : ! !INPUT PARAMETERS:
495 : !
496 : TYPE(Ext), POINTER :: ExtList
497 : CHARACTER(LEN=*), INTENT(IN ) :: ExtName
498 : !
499 : ! !RETURN VALUE:
500 : !
501 : INTEGER :: ExtNr
502 : !
503 : ! !REVISION HISTORY:
504 : ! 03 Oct 2013 - C. Keller - Initial version
505 : ! See https://github.com/geoschem/hemco for complete history
506 : !EOP
507 : !------------------------------------------------------------------------------
508 : !BOC
509 : !
510 : ! !INTERNAL VARIABLES:
511 : !
512 : TYPE(Ext), POINTER :: ThisExt
513 : CHARACTER(LEN=255) :: LCname
514 :
515 : !======================================================================
516 : ! GetExtNr begins here
517 : !======================================================================
518 :
519 : ! Init
520 0 : ThisExt => NULL()
521 :
522 : ! Pass name to module
523 0 : LCname = TRIM(ExtName)
524 :
525 : ! Set to lower case
526 0 : CALL TRANLC( LCname )
527 :
528 : ! Init output
529 0 : ExtNr = -999
530 :
531 : ! Point to header of extensions list
532 0 : ThisExt => ExtList
533 :
534 : ! Loop over all used extensions and check if any of them matches
535 : ! ExtName.
536 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
537 :
538 : ! Compare extension names
539 0 : IF ( TRIM(ThisExt%ExtName) == TRIM(LCname) ) THEN
540 0 : ExtNr = ThisExt%ExtNr
541 0 : EXIT
542 : ENDIF
543 :
544 : ! Advance to next extension
545 0 : ThisExt => ThisExt%NextExt
546 : ENDDO
547 :
548 : ! Cleanup
549 0 : ThisExt => NULL()
550 :
551 0 : END FUNCTION GetExtNr
552 : !EOC
553 : !------------------------------------------------------------------------------
554 : ! Harmonized Emissions Component (HEMCO) !
555 : !------------------------------------------------------------------------------
556 : !BOP
557 : !
558 : ! !ROUTINE: GetExtSpcStr
559 : !
560 : ! !DESCRIPTION: Subroutine GetExtSpcStr returns the HEMCO species names
561 : ! string of all species assigned to the given extension (identified by its
562 : ! extension number).
563 : !\\
564 : !\\
565 : ! !INTERFACE:
566 : !
567 0 : SUBROUTINE GetExtSpcStr( HcoConfig, ExtNr, SpcStr, RC )
568 : !
569 : ! !INPUT PARAMETERS:
570 : !
571 : TYPE(ConfigObj), POINTER :: HcoConfig
572 : INTEGER, INTENT(IN ) :: ExtNr ! Extension Nr.
573 : !
574 : ! !OUTPUT PARAMETERS:
575 : !
576 : CHARACTER(LEN=*), INTENT( OUT) :: SpcStr ! Species string
577 : !
578 : ! !INPUT/OUTPUT PARAMETERS:
579 : !
580 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
581 : !
582 : ! !REVISION HISTORY:
583 : ! 10 Jan 2014 - C. Keller: Initialization (update)
584 : ! See https://github.com/geoschem/hemco for complete history
585 : !EOP
586 : !------------------------------------------------------------------------------
587 : !BOC
588 : !
589 : ! !LOCAL ARGUMENTS:
590 : !
591 : CHARACTER(LEN=255) :: MSG, LOC
592 : TYPE(Ext), POINTER :: ThisExt
593 :
594 : !======================================================================
595 : ! GetExtSpcStr begins here
596 : !======================================================================
597 :
598 : ! Enter
599 0 : LOC = 'GetExtSpcStr (hco_extlist_mod.F90)'
600 0 : RC = HCO_SUCCESS
601 0 : ThisExt => NULL()
602 :
603 : ! Find extension of interest
604 0 : ThisExt => HcoConfig%ExtList
605 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
606 0 : IF ( ThisExt%ExtNr == ExtNr ) EXIT
607 0 : ThisExt => ThisExt%NextExt
608 : ENDDO
609 :
610 0 : IF ( .NOT. ASSOCIATED( ThisExt ) ) THEN
611 0 : WRITE(MSG,*) 'Cannot find extension Nr. ', ExtNr
612 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
613 0 : RETURN
614 : ENDIF
615 :
616 : ! Get species string
617 0 : SpcStr = TRIM(ThisExt%Spcs)
618 0 : ThisExt => NULL()
619 :
620 : ! Return w/ success
621 0 : RC = HCO_SUCCESS
622 :
623 0 : END SUBROUTINE GetExtSpcStr
624 : !EOC
625 : !------------------------------------------------------------------------------
626 : ! Harmonized Emissions Component (HEMCO) !
627 : !------------------------------------------------------------------------------
628 : !BOP
629 : !
630 : ! !ROUTINE: GetExtSpcVal_Sp
631 : !
632 : ! !DESCRIPTION: Subroutine GetExtSpcVal\_Sp returns single precision values
633 : ! associated with the species for a given extension. Specifically, this routine
634 : ! searches for extension setting '<Prefix>\_SpecName' for every species passed
635 : ! through input argument SpcNames and writes those into output argument SpcScal.
636 : ! The default value DefValue is assigned to all elements of SpcScal with no
637 : ! corresponding extension setting.
638 : !\\
639 : !\\
640 : ! !INTERFACE:
641 : !
642 0 : SUBROUTINE GetExtSpcVal_sp( HcoConfig, extNr, NSPC, spcNames, &
643 : prefix, defValue, spcScal, RC )
644 : !
645 : ! !INPUT PARAMETERS:
646 : !
647 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO config obj
648 : INTEGER, INTENT(IN) :: extNr ! Extension Nr.
649 : INTEGER, INTENT(IN) :: NSPC ! # of species
650 : CHARACTER(LEN=*), INTENT(IN) :: spcNames(NSPC) ! Species string
651 : CHARACTER(LEN=*), INTENT(IN) :: prefix ! Search prefix
652 : REAL(sp), INTENT(IN) :: defValue ! Default value
653 : !
654 : ! !INPUT/OUTPUT PARAMETERS:
655 : !
656 : REAL(sp), ALLOCATABLE, INTENT(INOUT) :: spcScal(:) ! Species scalefacs
657 : !
658 : ! !OUTPUT PARAMETERS:
659 : !
660 : INTEGER, INTENT(OUT) :: RC ! Success or failure?
661 : !
662 : ! !REVISION HISTORY:
663 : ! 10 Jun 2015 - C. Keller - Initial version
664 : ! See https://github.com/geoschem/hemco for complete history
665 : !EOP
666 : !------------------------------------------------------------------------------
667 : !BOC
668 :
669 : ! Scalars
670 : LOGICAL :: found
671 : INTEGER :: I
672 : REAL(sp) :: scaleFac
673 :
674 : ! Strings
675 : CHARACTER(LEN= 61) :: name
676 : CHARACTER(LEN=255) :: errMsg
677 : CHARACTER(LEN=255) :: thisLoc
678 :
679 : !========================================================================
680 : ! GetExtSpcVal_sp begins here
681 : !========================================================================
682 :
683 : ! Initialize
684 0 : RC = HCO_SUCCESS
685 0 : errMsg = ''
686 : thisLoc = &
687 0 : ' -> at GetExtSpcVal_sp (in module src/Core/hco_extlist_mod.F90)'
688 :
689 : !========================================================================
690 : ! Make sure output array SpcScal is properly allocated
691 : !========================================================================
692 0 : IF ( ALLOCATED( spcScal ) ) DEALLOCATE( spcScal )
693 0 : ALLOCATE( SpcScal(NSPC), STAT=RC )
694 0 : IF ( RC /= HCO_SUCCESS ) THEN
695 0 : errMsg = 'Could not allocate SpcScal array!'
696 0 : CALL HCO_ERROR( errMsg, RC, thisLoc )
697 0 : RETURN
698 : ENDIF
699 :
700 : ! Initialize to default values
701 0 : spcScal = defValue
702 :
703 : !========================================================================
704 : ! Look for species scale factors; save to spcScal array
705 : !========================================================================
706 0 : DO I = 1, NSPC
707 :
708 : ! Species name
709 0 : name = TRIM( prefix ) // '_' // TRIM( spcNames(I) )
710 :
711 : ! Look for the scale factor
712 : CALL GetExtOpt( &
713 : HcoConfig = HcoConfig, &
714 : extNr = extNr, &
715 : optName = name, &
716 : optValSp = scaleFac, &
717 : found = found, &
718 0 : RC = RC )
719 :
720 : ! Trap errors
721 0 : IF ( RC /= HCO_SUCCESS ) THEN
722 0 : errMsg = 'Error encountered in "GetExtOpt" routine!'
723 0 : CALL HCO_ERROR( errMsg, RC, thisLoc )
724 0 : RETURN
725 : ENDIF
726 :
727 : ! If scale factor was found, assign it to SpcScal
728 0 : IF ( found ) spcScal(I) = scaleFac
729 : ENDDO
730 :
731 : END SUBROUTINE GetExtSpcVal_sp
732 : !EOC
733 : !------------------------------------------------------------------------------
734 : ! Harmonized Emissions Component (HEMCO) !
735 : !------------------------------------------------------------------------------
736 : !BOP
737 : !
738 : ! !ROUTINE: GetExtSpcVal_Int
739 : !
740 : ! !DESCRIPTION: Subroutine GetExtSpcVal\_Int returns integer values
741 : ! associated with the species for a given extension. Specifically, this routine
742 : ! searches for extension setting '<Prefix>\_SpecName' for every species passed
743 : ! through input argument SpcNames and writes those into output argument SpcScal.
744 : ! The default value DefValue is assigned to all elements of SpcScal with no
745 : ! corresponding extension setting.
746 : !\\
747 : !\\
748 : ! !INTERFACE:
749 : !
750 0 : SUBROUTINE GetExtSpcVal_int( HcoConfig, extNr, NSPC, spcNames, &
751 : prefix, defValue, spcScal, RC )
752 : !
753 : ! !INPUT PARAMETERS:
754 : !
755 : TYPE(ConfigObj), POINTER :: HcoConfig
756 : INTEGER, INTENT(IN) :: extNr ! Extension Nr.
757 : INTEGER, INTENT(IN) :: NSPC ! # of species
758 : CHARACTER(LEN=*), INTENT(IN) :: spcNames(NSPC) ! Species string
759 : CHARACTER(LEN=*), INTENT(IN) :: prefix ! search prefix
760 : INTEGER, INTENT(IN) :: defValue ! default value
761 : !
762 : ! !INPUT/OUTPUT PARAMETERS:
763 : !
764 : INTEGER, ALLOCATABLE, INTENT(INOUT) :: spcScal(:) ! Species scalefacs
765 : !
766 : ! !OUTPUT PARAMETERS::
767 : !
768 : INTEGER, INTENT(OUT) :: RC ! Success or failure?
769 : !
770 : ! !REVISION HISTORY:
771 : ! 10 Jun 2015 - C. Keller - Initial version
772 : ! See https://github.com/geoschem/hemco for complete history
773 : !EOP
774 : !------------------------------------------------------------------------------
775 : !BOC
776 :
777 : ! Scalars
778 : LOGICAL :: found
779 : INTEGER :: I
780 : INTEGER :: scaleFac
781 :
782 : ! Strings
783 : CHARACTER(LEN= 61) :: name
784 : CHARACTER(LEN=255) :: errMsg
785 : CHARACTER(LEN=255) :: thisLoc
786 :
787 : !========================================================================
788 : ! GetExtSpcVal_int begins here
789 : !========================================================================
790 :
791 : ! Initialize
792 0 : RC = HCO_SUCCESS
793 0 : errMsg = ''
794 : thisLoc = &
795 0 : ' -> at GetExtSpcVal_Int (in module src/Core/hco_extlist_mod.F90)'
796 :
797 : !========================================================================
798 : ! Make sure output array SpcScal is properly allocated
799 : !========================================================================
800 0 : IF ( ALLOCATED( spcScal ) ) DEALLOCATE( spcScal )
801 0 : ALLOCATE( SpcScal(NSPC), STAT=RC )
802 0 : IF ( RC /= HCO_SUCCESS ) THEN
803 0 : errMsg = 'Could not allocate SpcScal array!'
804 0 : CALL HCO_ERROR( errMsg, RC, thisLoc )
805 0 : RETURN
806 : ENDIF
807 :
808 : ! Initialize to default values
809 0 : spcScal = defValue
810 :
811 : !========================================================================
812 : ! Look for species scale factors; save to spcScal array
813 : !========================================================================
814 0 : DO I = 1, NSPC
815 :
816 : ! Species name
817 0 : name = TRIM( prefix ) // '_' // TRIM( spcNames(I) )
818 :
819 : ! Look for the scale factor
820 : CALL GetExtOpt( &
821 : HcoConfig = HcoConfig, &
822 : extNr = extNr, &
823 : optName = name, &
824 : optValInt = scaleFac, &
825 : found = found, &
826 0 : RC = RC )
827 :
828 : ! Trap errors
829 0 : IF ( RC /= HCO_SUCCESS ) THEN
830 0 : errMsg = 'Error encountered in "GetExtOpt" routine!'
831 0 : CALL HCO_ERROR( errMsg, RC, thisLoc )
832 0 : RETURN
833 : ENDIF
834 :
835 : ! If scale factor was found, assign it to SpcScal
836 0 : IF ( found ) spcScal(I) = scaleFac
837 : ENDDO
838 :
839 : END SUBROUTINE GetExtSpcVal_int
840 : !EOC
841 : !------------------------------------------------------------------------------
842 : ! Harmonized Emissions Component (HEMCO) !
843 : !------------------------------------------------------------------------------
844 : !BOP
845 : !
846 : ! !ROUTINE: GetExtSpcVal_char
847 : !
848 : ! !DESCRIPTION: Subroutine GetExtSpcVal\_char returns character values
849 : ! associated with the species for a given extension. Specifically, this routine
850 : ! searches for extension setting '<Prefix>\_SpecName' for every species passed
851 : ! through input argument SpcNames and writes those into output argument SpcScal.
852 : ! The default value DefValue is assigned to all elements of SpcScal with no
853 : ! corresponding extension setting.
854 : !\\
855 : !\\
856 : ! !INTERFACE:
857 : !
858 0 : SUBROUTINE GetExtSpcVal_char( HcoConfig, extNr, NSPC, spcNames, &
859 : prefix, defValue, spcScal, RC )
860 : !
861 : ! !INPUT PARAMETERS:
862 : !
863 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO config object
864 : INTEGER, INTENT(IN) :: extNr ! Extension Nr.
865 : INTEGER, INTENT(IN) :: NSPC ! # of species
866 : CHARACTER(LEN=*), INTENT(IN) :: spcNames(NSPC) ! Species string
867 : CHARACTER(LEN=*), INTENT(IN) :: prefix ! search prefix
868 : CHARACTER(LEN=*), INTENT(IN) :: defValue ! default value
869 : !
870 : ! !INPUT/OUTPUT PARAMETERS:
871 : !
872 : CHARACTER(LEN=*), &
873 : ALLOCATABLE, INTENT(INOUT) :: SpcScal(:) ! Species scale factors
874 : !
875 : ! !OUTPUT PARAMETERS:
876 : !
877 : INTEGER, INTENT(OUT) :: RC ! Success or failure?
878 : !
879 : ! !REVISION HISTORY:
880 : ! 10 Jun 2015 - C. Keller - Initial version
881 : ! See https://github.com/geoschem/hemco for complete history
882 : !EOP
883 : !------------------------------------------------------------------------------
884 : !BOC
885 :
886 : ! Scalars
887 : LOGICAL :: found
888 : INTEGER :: I
889 :
890 : ! Strings
891 : CHARACTER(LEN= 61) :: name
892 : CHARACTER(LEN=255) :: scaleFac
893 : CHARACTER(LEN=255) :: errMsg
894 : CHARACTER(LEN=255) :: thisLoc
895 :
896 : !========================================================================
897 : ! GetExtSpcVal_Char begins here
898 : !========================================================================
899 :
900 : ! Initialize
901 0 : RC = HCO_SUCCESS
902 0 : errMsg = ''
903 : thisLoc = &
904 0 : ' -> at GetExtSpcVal_Char (in module src/Core/hco_extlist_mod.F90)'
905 :
906 : !========================================================================
907 : ! Make sure output array SpcScal is properly allocated
908 : !========================================================================
909 0 : IF ( ALLOCATED( spcScal ) ) DEALLOCATE( spcScal )
910 0 : ALLOCATE( SpcScal(NSPC), STAT=RC )
911 0 : IF ( RC /= HCO_SUCCESS ) THEN
912 0 : errMsg = 'Could not allocate SpcScal array!'
913 0 : CALL HCO_ERROR( errMsg, RC, thisLoc )
914 0 : RETURN
915 : ENDIF
916 :
917 : ! Initialize to default values
918 0 : spcScal = defValue
919 :
920 : !========================================================================
921 : ! Look for species scale factors; save to spcScal array
922 : !========================================================================
923 0 : DO I = 1, NSPC
924 :
925 : ! Species name
926 0 : name = TRIM( prefix ) // '_' // TRIM( spcNames(I) )
927 :
928 : ! Look for the scale factor
929 : CALL GetExtOpt( &
930 : HcoConfig = HcoConfig, &
931 : extNr = extNr, &
932 : optName = name, &
933 : optValChar = scaleFac, &
934 : found = found, &
935 0 : RC = RC )
936 :
937 : ! Trap errors
938 0 : IF ( RC /= HCO_SUCCESS ) THEN
939 0 : errMsg = 'Error encountered in "GetExtOpt" routine!'
940 0 : CALL HCO_ERROR( errMsg, RC, thisLoc )
941 0 : RETURN
942 : ENDIF
943 :
944 : ! If scale factor was found, assign it to SpcScal
945 0 : IF ( found ) spcScal(I) = scaleFac
946 : ENDDO
947 :
948 0 : END SUBROUTINE GetExtSpcVal_char
949 : !EOC
950 : !------------------------------------------------------------------------------
951 : ! Harmonized Emissions Component (HEMCO) !
952 : !------------------------------------------------------------------------------
953 : !BOP
954 : !
955 : ! !IROUTINE: SetExtNr
956 : !
957 : ! !DESCRIPTION: Subroutine SetExtNr overwrites the extension number of a
958 : ! given extension. The extension of interest is provided in argument
959 : ! ExtName. If this argument is omitted, the extension numbers of all
960 : ! extensions currently listed in ExtList will be set to the provided
961 : ! number. This is useful to disable all extensions by setting the ExtNr
962 : ! to a negative value.
963 : !\\
964 : !\\
965 : ! !INTERFACE:
966 : !
967 0 : SUBROUTINE SetExtNr( HcoConfig, ExtNr, ExtName, RC )
968 : !
969 : ! !USES:
970 : !
971 : USE HCO_CHARPAK_MOD, ONLY : TRANLC
972 : !
973 : ! !INPUT PARAMETERS:
974 : !
975 : TYPE(ConfigObj), POINTER :: HcoConfig
976 : INTEGER, INTENT(IN ) :: ExtNr
977 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: ExtName
978 : !
979 : ! !INPUT/OUTPUT PARAMETER:
980 : !
981 : INTEGER, INTENT(INOUT) :: RC
982 : !
983 : ! !REVISION HISTORY:
984 : ! 12 Jan 2015 - C. Keller - Initial version
985 : ! See https://github.com/geoschem/hemco for complete history
986 : !EOP
987 : !------------------------------------------------------------------------------
988 : !BOC
989 : !
990 : ! !INTERNAL VARIABLES:
991 : !
992 : TYPE(Ext), POINTER :: ThisExt
993 : CHARACTER(LEN=255) :: LCname
994 : CHARACTER(LEN=255) :: MSG
995 : LOGICAL :: verb, overwrite
996 :
997 : !======================================================================
998 : ! SetExtNr begins here
999 : !======================================================================
1000 :
1001 : ! verbose?
1002 0 : verb = HCO_IsVerb( HcoConfig%Err )
1003 :
1004 : ! Pass name to module and set to lower case
1005 0 : IF ( PRESENT(ExtName) ) THEN
1006 0 : LCname = TRIM(ExtName)
1007 0 : CALL TRANLC( LCname ) ! lower case
1008 : ELSE
1009 0 : LCname = ''
1010 : ENDIF
1011 :
1012 : ! Point to header of extensions list
1013 0 : ThisExt => HcoConfig%ExtList
1014 :
1015 : ! Loop over all used extensions and check if any of them matches
1016 : ! ExtName.
1017 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
1018 :
1019 : ! Overwrite this ExtNr?
1020 0 : overwrite = .FALSE.
1021 :
1022 : ! If argument ExtName is given, only overwrite extension number
1023 : ! of that particular extension.
1024 0 : IF ( PRESENT(ExtName) ) THEN
1025 0 : IF ( TRIM(ThisExt%ExtName) == TRIM(LCname) ) overwrite = .TRUE.
1026 :
1027 : ! If argument is not given, overwrite all extensions except for
1028 : ! HEMCO core
1029 0 : ELSEIF ( ThisExt%ExtNr /= CoreNr ) THEN
1030 : overwrite = .TRUE.
1031 : ENDIF
1032 :
1033 : ! Overwrite extension number if needed
1034 : IF ( overwrite ) THEN
1035 0 : ThisExt%ExtNr = ExtNr
1036 0 : IF ( verb ) THEN
1037 0 : WRITE(MSG,*) 'Force ExtNr of extension ', TRIM(ThisExt%ExtName), &
1038 0 : ' to ', ExtNr
1039 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
1040 : ENDIF
1041 : ENDIF
1042 :
1043 : ! Advance to next extension
1044 0 : ThisExt => ThisExt%NextExt
1045 : ENDDO
1046 :
1047 : ! Cleanup
1048 0 : ThisExt => NULL()
1049 :
1050 : ! Return w/ success
1051 0 : RC = HCO_SUCCESS
1052 :
1053 0 : END SUBROUTINE SetExtNr
1054 : !EOC
1055 : !------------------------------------------------------------------------------
1056 : ! Harmonized Emissions Component (HEMCO) !
1057 : !------------------------------------------------------------------------------
1058 : !BOP
1059 : !
1060 : ! !IROUTINE: ExtNrInUse
1061 : !
1062 : ! !DESCRIPTION: Function ExtNrInUse checks if extension number ExtNr is
1063 : ! in the list of used extensions or not.
1064 : !\\
1065 : !\\
1066 : ! !INTERFACE:
1067 : !
1068 0 : FUNCTION ExtNrInUse( ExtList, ExtNr ) Result ( InUse )
1069 : !
1070 : ! !INPUT PARAMETERS:
1071 : !
1072 : TYPE(Ext), POINTER :: ExtList
1073 : INTEGER, INTENT(IN ) :: ExtNr
1074 : !
1075 : ! !RETURN VALUE::
1076 : !
1077 : LOGICAL :: InUse
1078 : !
1079 : ! !REVISION HISTORY:
1080 : ! 03 Oct 2013 - C. Keller - Initial version
1081 : ! See https://github.com/geoschem/hemco for complete history
1082 : !EOP
1083 : !------------------------------------------------------------------------------
1084 : !BOC
1085 : !
1086 : ! !INTERNAL VARIABLES:
1087 : !
1088 : TYPE(Ext), POINTER :: ThisExt
1089 : CHARACTER(LEN=255) :: LCname
1090 :
1091 : !======================================================================
1092 : ! ExtNrInUse begins here
1093 : !======================================================================
1094 :
1095 : ! Use number -999 for wildcard values
1096 0 : IF ( ExtNr == -999 ) THEN
1097 0 : InUse = .TRUE.
1098 : RETURN
1099 : ENDIF
1100 :
1101 : ! Init output
1102 0 : InUse = .FALSE.
1103 :
1104 : ! Point to header of extensions list
1105 0 : ThisExt => ExtList
1106 :
1107 : ! Loop over all used extensions and check if any of them matches
1108 : ! ExtName.
1109 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
1110 :
1111 : ! Compare extension names
1112 0 : IF ( ThisExt%ExtNr == ExtNr ) THEN
1113 : InUse = .TRUE.
1114 : EXIT
1115 : ENDIF
1116 :
1117 : ! Advance to next extension
1118 0 : ThisExt => ThisExt%NextExt
1119 : ENDDO
1120 :
1121 : ! Cleanup
1122 0 : ThisExt => NULL()
1123 :
1124 : END FUNCTION ExtNrInUse
1125 : !EOC
1126 : !------------------------------------------------------------------------------
1127 : ! Harmonized Emissions Component (HEMCO) !
1128 : !------------------------------------------------------------------------------
1129 : !BOP
1130 : !
1131 : ! !IROUTINE: ExtFinal
1132 : !
1133 : ! !DESCRIPTION: Function ExtFinal finalizes the extensions list.
1134 : !\\
1135 : !\\
1136 : ! !INTERFACE:
1137 : !
1138 0 : SUBROUTINE ExtFinal( ExtList )
1139 : !
1140 : ! !INPUT/OUTPUT ARGUMENT:
1141 : !
1142 : TYPE(Ext), POINTER :: ExtList
1143 : !
1144 : ! !REVISION HISTORY:
1145 : ! 03 Oct 2013 - C. Keller - Initial version
1146 : ! See https://github.com/geoschem/hemco for complete history
1147 : !EOP
1148 : !------------------------------------------------------------------------------
1149 : !BOC
1150 : !
1151 : ! !INTERNAL VARIABLES:
1152 : !
1153 : TYPE(Ext), POINTER :: ThisExt
1154 : TYPE(Ext), POINTER :: NextExt
1155 :
1156 : !======================================================================
1157 : ! ExtFinal begins here
1158 : !======================================================================
1159 :
1160 : ! Point to header of extensions list
1161 0 : ThisExt => ExtList
1162 0 : NextExt => NULL()
1163 :
1164 : ! Loop over all extensions and deallocate the types
1165 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
1166 :
1167 : ! First set pointer to next entry
1168 0 : NextExt => ThisExt%NextExt
1169 :
1170 : ! Now clean up this entry
1171 0 : ThisExt%NextExt => NULL()
1172 0 : CALL HCO_CleanupOpt( ThisExt%Opts )
1173 0 : DEALLOCATE ( ThisExt )
1174 :
1175 : ! Advance to next extension
1176 0 : ThisExt => NextExt
1177 : ENDDO
1178 :
1179 : ! Cleanup
1180 0 : ThisExt => NULL()
1181 0 : ExtList => NULL()
1182 :
1183 0 : END SUBROUTINE ExtFinal
1184 : !EOC
1185 : !------------------------------------------------------------------------------
1186 : ! Harmonized Emissions Component (HEMCO) !
1187 : !------------------------------------------------------------------------------
1188 : !BOP
1189 : !
1190 : ! !IROUTINE: HCO_AddOpt
1191 : !
1192 : ! !DESCRIPTION: Subroutine HCO\_AddOpt adds a option name/value pair to the
1193 : ! list of options.
1194 : !\\
1195 : !\\
1196 : ! !INTERFACE:
1197 : !
1198 0 : SUBROUTINE HCO_AddOpt ( HcoConfig, OptName, OptValue, ExtNr, RC, &
1199 : VERB, IgnoreIfExist )
1200 : !
1201 : ! !INPUT PARAMETERS:
1202 : !
1203 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO config obj
1204 : CHARACTER(LEN=*), INTENT(IN ) :: OptName ! OptName
1205 : CHARACTER(LEN=*), INTENT(IN ) :: OptValue ! OptValue
1206 : INTEGER, INTENT(IN ) :: ExtNr ! Extension Nr.
1207 : LOGICAL, INTENT(IN ), OPTIONAL :: VERB ! Verbose on
1208 : LOGICAL, INTENT(IN ), OPTIONAL :: IgnoreIfExist ! Ignore if already exists
1209 : !
1210 : ! !OUTPUT PARAMETERS:
1211 : !
1212 : INTEGER, INTENT(INOUT) :: RC ! Return code
1213 : !
1214 : ! !REVISION HISTORY:
1215 : ! 18 Sep 2015 - C. Keller - Initial version
1216 : ! See https://github.com/geoschem/hemco for complete history
1217 : !EOP
1218 : !------------------------------------------------------------------------------
1219 : !BOC
1220 : !
1221 : ! !LOCAL VARIABLES:
1222 : !
1223 : TYPE(Ext), POINTER :: ThisExt
1224 : TYPE(Opt), POINTER :: NewOpt
1225 : CHARACTER(LEN=OPTLEN) :: DUM
1226 : LOGICAL :: Exists
1227 : LOGICAL :: VRB
1228 : LOGICAL :: Ignore
1229 : CHARACTER(LEN=255) :: MSG
1230 : CHARACTER(LEN=255) :: LOC = 'HCO_AddOpt (hco_extlist_mod.F90)'
1231 :
1232 : !=================================================================
1233 : ! HCO_AddOpt begins here!
1234 : !=================================================================
1235 :
1236 : ! Nullify
1237 0 : ThisExt => NULL()
1238 0 : NewOpt => NULL()
1239 :
1240 : ! Init optional variables
1241 0 : VRB = .TRUE.
1242 0 : Ignore = .FALSE.
1243 0 : IF ( PRESENT(VERB) ) VRB = VERB
1244 0 : IF ( PRESENT(IgnoreIfExist) ) Ignore = IgnoreIfExist
1245 :
1246 : ! Check if this option already exists
1247 0 : DUM = HCO_GetOpt( HcoConfig%ExtList, OptName, ExtNr=ExtNr )
1248 :
1249 : ! If option already exists...
1250 0 : IF ( TRIM(DUM) /= TRIM(EMPTYOPT) ) THEN
1251 :
1252 : ! Can leave here if we shall ignore the option if it already exists
1253 0 : IF ( Ignore ) THEN
1254 :
1255 : ! If option exists and is the same, nothing to do
1256 0 : IF ( TRIM(DUM) /= ADJUSTL(TRIM(OptValue)) ) THEN
1257 0 : WRITE(*,*) 'Option is already defined - use original value of ', &
1258 0 : TRIM(DUM), ' and ignore the following value: ', &
1259 0 : TRIM(OptName), ': ', TRIM(OptValue)
1260 : ENDIF
1261 0 : RC = HCO_SUCCESS
1262 0 : RETURN
1263 :
1264 : ! If ignore flag is false:
1265 : ELSE
1266 : ! Error if values are not the same
1267 0 : IF ( TRIM(DUM) /= ADJUSTL(TRIM(OptValue)) ) THEN
1268 : MSG = 'Cannot add option pair: '//TRIM(OptName)//': '//TRIM(OptValue) &
1269 0 : // ' - option already exists: '//TRIM(OptName)//': '//TRIM(DUM)
1270 0 : CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
1271 0 : RETURN
1272 : ! Return with no error if values are the same
1273 : ELSE
1274 0 : RC = HCO_SUCCESS
1275 0 : RETURN
1276 : ENDIF
1277 : ENDIF
1278 : ENDIF
1279 :
1280 : ! Find extension of interest
1281 0 : ThisExt => HcoConfig%ExtList
1282 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
1283 0 : IF ( ThisExt%ExtNr == ExtNr ) EXIT
1284 0 : ThisExt => ThisExt%NextExt
1285 : ENDDO
1286 :
1287 0 : IF ( .NOT. ASSOCIATED( ThisExt ) ) THEN
1288 0 : WRITE(MSG,*) 'Cannot add option to extension Nr. ', ExtNr
1289 0 : MSG = TRIM(MSG) // '. Make sure this extension is activated!'
1290 0 : CALL HCO_ERROR(MSG,RC,THISLOC='AddOpt (hco_extlist_mod)')
1291 0 : RETURN
1292 : ENDIF
1293 :
1294 : ! Create new option
1295 0 : ALLOCATE(NewOpt)
1296 0 : NewOpt%OptName = ADJUSTL( TRIM(OptName ) )
1297 0 : NewOpt%OptValue = ADJUSTL( TRIM(OptValue) )
1298 :
1299 : ! Add to option linked list
1300 0 : IF ( ASSOCIATED(ThisExt%Opts) ) THEN
1301 0 : NewOpt%NextOpt => ThisExt%Opts
1302 : ELSE
1303 0 : NewOpt%NextOpt => NULL()
1304 : ENDIF
1305 0 : ThisExt%Opts => NewOpt
1306 :
1307 : ! Verbose
1308 0 : IF ( VRB .AND. HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err) ) THEN
1309 0 : MSG = 'Added the following option: ' // TRIM(OptName)//': '//TRIM(OptValue)
1310 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
1311 : ENDIF
1312 :
1313 : ! Cleanup and return w/ success
1314 0 : ThisExt => NULL()
1315 0 : RC = HCO_SUCCESS
1316 :
1317 : END SUBROUTINE HCO_AddOpt
1318 : !EOC
1319 : !------------------------------------------------------------------------------
1320 : ! Harmonized Emissions Component (HEMCO) !
1321 : !------------------------------------------------------------------------------
1322 : !BOP
1323 : !
1324 : ! !IROUTINE: HCO_GetOpt
1325 : !
1326 : ! !DESCRIPTION: Subroutine HCO\_GetOpt returns a option value for the given
1327 : ! option name.
1328 : !\\
1329 : !\\
1330 : ! !INTERFACE:
1331 : !
1332 0 : FUNCTION HCO_GetOpt ( ExtList, OptName, ExtNr ) RESULT ( OptValue )
1333 : !
1334 : ! !INPUT PARAMETERS:
1335 : !
1336 : TYPE(Ext), POINTER :: ExtList ! Extension list
1337 : CHARACTER(LEN=*), INTENT(IN ) :: OptName ! OptName
1338 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr ! Extension Nr.
1339 : !
1340 : ! !OUTPUT PARAMETERS:
1341 : !
1342 : CHARACTER(LEN=OPTLEN) :: OptValue ! OptValue
1343 : !
1344 : ! !REVISION HISTORY:
1345 : ! 18 Sep 2015 - C. Keller - Initial version
1346 : ! See https://github.com/geoschem/hemco for complete history
1347 : !EOP
1348 : !------------------------------------------------------------------------------
1349 : !BOC
1350 : !
1351 : ! !LOCAL VARIABLES:
1352 : !
1353 : INTEGER :: ThisExtNr
1354 : LOGICAL :: OptFound
1355 : TYPE(Opt), POINTER :: ThisOpt
1356 : TYPE(Ext), POINTER :: ThisExt
1357 :
1358 : !=================================================================
1359 : ! HCO_GetOpt begins here!
1360 : !=================================================================
1361 :
1362 : ! Init
1363 0 : OptValue = EMPTYOPT
1364 0 : OptFound = .FALSE.
1365 0 : ThisOpt => NULL()
1366 0 : ThisExt => NULL()
1367 :
1368 : ! Extension number to search for. If not explicitly set through the
1369 : ! input argument, set to -999 to search all extensions.
1370 0 : IF ( PRESENT(ExtNr) ) THEN
1371 0 : ThisExtNr = ExtNr
1372 : ELSE
1373 : ThisExtNr = -999
1374 : ENDIF
1375 :
1376 : ! Find extension of interest
1377 0 : ThisExt => ExtList
1378 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
1379 :
1380 : ! Check if this is the extension of interest. If extension number
1381 : ! is set to -999, scan through all extensions.
1382 0 : IF ( ThisExtNr /= -999 .AND. ThisExt%ExtNr /= ThisExtNr ) THEN
1383 0 : ThisExt => ThisExt%NextExt
1384 0 : CYCLE
1385 : ENDIF
1386 :
1387 : ! Walk through token list until we find the given value
1388 0 : ThisOpt => ThisExt%Opts
1389 0 : DO WHILE ( ASSOCIATED(ThisOpt) )
1390 :
1391 : ! Check if this is the token of interest
1392 0 : IF ( TRIM(ThisOpt%OptName) == ADJUSTL(TRIM(OptName)) ) THEN
1393 0 : OptValue = ADJUSTL( TRIM(ThisOpt%OptValue) )
1394 0 : OptFound = .TRUE.
1395 0 : EXIT
1396 : ENDIF
1397 :
1398 : ! Advance in list
1399 0 : ThisOpt => ThisOpt%NextOpt
1400 : END DO
1401 :
1402 : ! Advance to next extension
1403 0 : IF ( OptFound ) THEN
1404 : ThisExt => NULL()
1405 : ELSE
1406 0 : ThisExt => ThisExt%NextExt
1407 : ENDIF
1408 : ENDDO
1409 :
1410 : ! Free pointer
1411 0 : ThisOpt => NULL()
1412 0 : ThisExt => NULL()
1413 :
1414 0 : END FUNCTION HCO_GetOpt
1415 : !EOC
1416 : !------------------------------------------------------------------------------
1417 : ! Harmonized Emissions Component (HEMCO) !
1418 : !------------------------------------------------------------------------------
1419 : !BOP
1420 : !
1421 : ! !IROUTINE: HCO_ROOT
1422 : !
1423 : ! !DESCRIPTION: Function HCO\_ROOT returns the root character string. This is
1424 : ! a wrapper routine equivalent to HCO\_GetOpt('ROOT'). Since the ROOT character
1425 : ! is called very frequently, it is recommended to use this routine instead.
1426 : !\\
1427 : !\\
1428 : ! !INTERFACE:
1429 : !
1430 0 : FUNCTION HCO_ROOT ( HcoConfig ) RESULT ( OutRoot )
1431 : !
1432 : ! !INPUT PARAMETERS:
1433 : !
1434 : !
1435 : ! !OUTPUT PARAMETERS:
1436 : !
1437 : TYPE(ConfigObj), POINTER :: HcoConfig
1438 : CHARACTER(LEN=OPTLEN) :: OutRoot ! Root output
1439 : !
1440 : ! !REVISION HISTORY:
1441 : ! 18 Sep 2015 - C. Keller - Initial version
1442 : ! See https://github.com/geoschem/hemco for complete history
1443 : !EOP
1444 : !------------------------------------------------------------------------------
1445 : !BOC
1446 :
1447 0 : OutRoot = HcoConfig%ROOT
1448 :
1449 0 : END FUNCTION HCO_ROOT
1450 : !EOC
1451 : !------------------------------------------------------------------------------
1452 : ! Harmonized Emissions Component (HEMCO) !
1453 : !------------------------------------------------------------------------------
1454 : !BOP
1455 : !
1456 : ! !IROUTINE: HCO_CleanupOpt
1457 : !
1458 : ! !DESCRIPTION: Subroutine HCO\_CleanupOpt cleans up the given options linked
1459 : ! list.
1460 : !\\
1461 : !\\
1462 : ! !INTERFACE:
1463 : !
1464 0 : SUBROUTINE HCO_CleanupOpt ( OptList )
1465 : !
1466 : ! !INPUT PARAMETERS:
1467 : !
1468 : !
1469 : ! !OUTPUT PARAMETERS:
1470 : !
1471 : TYPE(Opt), POINTER :: OptList
1472 : !
1473 : ! !REVISION HISTORY:
1474 : ! 18 Sep 2015 - C. Keller - Initial version
1475 : ! See https://github.com/geoschem/hemco for complete history
1476 : !EOP
1477 : !------------------------------------------------------------------------------
1478 : !BOC
1479 : !
1480 : ! !LOCAL VARIABLES:
1481 : !
1482 : TYPE(Opt), POINTER :: ThisOpt
1483 : TYPE(Opt), POINTER :: NextOpt
1484 :
1485 : !=================================================================
1486 : ! HCO_CleanupOpt begins here!
1487 : !=================================================================
1488 :
1489 : ! Walk through option list until we find the given value
1490 0 : NextOpt => NULL()
1491 0 : ThisOpt => OptList
1492 0 : DO WHILE ( ASSOCIATED(ThisOpt) )
1493 :
1494 : ! Archive next option in list
1495 0 : NextOpt => ThisOpt%NextOpt
1496 :
1497 : ! Free the memory allocated to ThisOpt (this avoids memory leaks)
1498 0 : ThisOpt%NextOpt => NULL()
1499 0 : DEALLOCATE( ThisOpt )
1500 :
1501 : ! Go to next option in list (previously archived)
1502 0 : ThisOpt => NextOpt
1503 : END DO
1504 :
1505 : ! Free pointer
1506 0 : ThisOpt => NULL()
1507 0 : NextOpt => NULL()
1508 :
1509 0 : END SUBROUTINE HCO_CleanupOpt
1510 : !EOC
1511 : !------------------------------------------------------------------------------
1512 : ! Harmonized Emissions Component (HEMCO) !
1513 : !------------------------------------------------------------------------------
1514 : !BOP
1515 : !
1516 : ! !IROUTINE: HCO_SetDefaultToken
1517 : !
1518 : ! !DESCRIPTION: Subroutine HCO\_SetDefaultToken is a wrapper routine to
1519 : ! initialize the default set of HEMCO tokens. These can be obtained at any
1520 : ! place in the HEMCO code via subroutine HCO\_GetOpt, e.g. HCO\_GetOpt('RES')
1521 : ! will return the 'RES' token.
1522 : !\\
1523 : !\\
1524 : ! !INTERFACE:
1525 : !
1526 0 : SUBROUTINE HCO_SetDefaultToken( CF, RC )
1527 : !
1528 : ! !USES:
1529 : !
1530 : !
1531 : ! !INPUT PARAMETERS:
1532 : !
1533 : TYPE(ConfigObj), POINTER :: CF ! Config object
1534 : !
1535 : ! !OUTPUT PARAMETERS:
1536 : !
1537 : INTEGER, INTENT(INOUT) :: RC ! Return code
1538 : !
1539 : ! !REVISION HISTORY:
1540 : ! 18 Sep 2015 - C. Keller - Initial version
1541 : ! See https://github.com/geoschem/hemco for complete history
1542 : !EOP
1543 : !------------------------------------------------------------------------------
1544 : !BOC
1545 : !
1546 : ! !LOCAL VARIABLES:
1547 : !
1548 : CHARACTER(LEN=OPTLEN) :: DUM
1549 : CHARACTER(LEN=255) :: LOC
1550 : LOGICAL :: FOUND
1551 :
1552 : !=================================================================
1553 : ! HCO_SetDefaultToken begins here!
1554 : !=================================================================
1555 0 : LOC = 'HCO_SetDefaultToken (HCO_EXTLIST_MOD)'
1556 :
1557 0 : IF ( Trim(CF%MetField) == 'GEOSFP' ) THEN
1558 0 : DEF_MET_UC = 'GEOSFP'
1559 0 : DEF_MET_LC = 'geosfp'
1560 0 : DEF_CN_YR = '2011' ! Constant met fld year
1561 0 : DEF_NC_VER = 'nc' ! NetCDF extension
1562 0 : ELSE IF ( TRIM(CF%MetField) == 'MERRA2' ) THEN
1563 0 : DEF_MET_UC = 'MERRA2'
1564 0 : DEF_MET_LC = 'merra2'
1565 0 : DEF_CN_YR = '2015' ! Constant met fld year
1566 0 : DEF_NC_VER = 'nc4' ! NetCDF extension
1567 0 : ELSE IF ( TRIM(CF%MetField) == 'GEOSIT' ) THEN
1568 0 : DEF_MET_UC = 'GEOSIT'
1569 0 : DEF_MET_LC = 'geosit'
1570 0 : DEF_CN_YR = '1998' ! Constant met fld year
1571 0 : DEF_NC_VER = 'nc' ! NetCDF extension
1572 : ENDIF
1573 :
1574 0 : IF ( TRIM(CF%GridRes) == '4.0x5.0' ) THEN
1575 0 : DEF_RES = '4x5'
1576 0 : ELSE IF ( TRIM(CF%GridRes) == '2.0x2.5' ) THEN
1577 0 : DEF_RES = '2x25'
1578 0 : ELSE IF ( TRIM(CF%GridRes) == '0.5x0.625' ) THEN
1579 0 : DEF_RES = '05x0625'
1580 0 : ELSE IF ( TRIM(CF%GridRes) == '0.25x0.3125' ) THEN
1581 0 : DEF_RES = '025x03125'
1582 : ENDIF
1583 :
1584 : ! Wildcard character
1585 0 : CALL GetExtOpt( CF, CoreNr, 'Wildcard', OptValChar=DUM, Found=FOUND, RC=RC )
1586 0 : IF ( RC /= HCO_SUCCESS ) THEN
1587 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
1588 0 : RETURN
1589 : ENDIF
1590 0 : IF ( .NOT. FOUND) DUM = DEF_WILDCARD
1591 0 : CALL HCO_AddOpt( CF, 'Wildcard', DUM, CoreNr, RC, VERB=.FALSE. )
1592 :
1593 : ! Separator
1594 0 : CALL GetExtOpt( CF, CoreNr, 'Separator', OptValChar=DUM, Found=FOUND, RC=RC )
1595 0 : IF ( RC /= HCO_SUCCESS ) THEN
1596 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
1597 0 : RETURN
1598 : ENDIF
1599 0 : IF ( .NOT. FOUND) DUM = DEF_SEPARATOR
1600 0 : CALL HCO_AddOpt( CF, 'Separator', DUM, CoreNr, RC, VERB=.FALSE. )
1601 :
1602 : ! Colon
1603 0 : CALL GetExtOpt( CF, CoreNr, 'Colon', OptValChar=DUM, Found=FOUND, RC=RC )
1604 0 : IF ( RC /= HCO_SUCCESS ) THEN
1605 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
1606 0 : RETURN
1607 : ENDIF
1608 0 : IF ( .NOT. FOUND) DUM = DEF_COLON
1609 0 : CALL HCO_AddOpt( CF, 'Colon', DUM, CoreNr, RC, VERB=.FALSE. )
1610 :
1611 : ! Root directory
1612 0 : CALL GetExtOpt( CF, CoreNr, 'ROOT', OptValChar=DUM, Found=FOUND, RC=RC )
1613 0 : IF ( RC /= HCO_SUCCESS ) THEN
1614 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
1615 0 : RETURN
1616 : ENDIF
1617 0 : IF ( .NOT. FOUND) DUM = DEF_ROOT
1618 0 : CALL HCO_AddOpt( CF, 'ROOT', DUM, CoreNr, RC, VERB=.FALSE. )
1619 :
1620 : ! Also save in local variable (for fast access via HCO_ROOT)
1621 0 : CF%ROOT = ADJUSTL( TRIM(DUM) )
1622 :
1623 : ! Meteorology token (uppercase)
1624 0 : CALL GetExtOpt( CF, CoreNr, 'MET', OptValChar=DUM, Found=FOUND, RC=RC )
1625 0 : IF ( RC /= HCO_SUCCESS ) THEN
1626 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
1627 0 : RETURN
1628 : ENDIF
1629 0 : IF ( .NOT. FOUND) DUM = DEF_MET_UC
1630 0 : CALL HCO_AddOpt( CF, 'MET', DUM, CoreNr, RC, VERB=.FALSE. )
1631 :
1632 : ! Meteorology token (lowercase)
1633 0 : CALL GetExtOpt( CF, CoreNr, 'met', OptValChar=DUM, Found=FOUND, RC=RC )
1634 0 : IF ( RC /= HCO_SUCCESS ) THEN
1635 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
1636 0 : RETURN
1637 : ENDIF
1638 0 : IF ( .NOT. FOUND) DUM = DEF_MET_LC
1639 0 : CALL HCO_AddOpt( CF, 'met', DUM, CoreNr, RC, VERB=.FALSE. )
1640 :
1641 : ! Year for constant met fields
1642 0 : CALL GetExtOpt( CF, CoreNr, 'CNYR', OptValChar=DUM, Found=FOUND, RC=RC )
1643 0 : IF ( RC /= HCO_SUCCESS ) THEN
1644 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
1645 0 : RETURN
1646 : ENDIF
1647 0 : IF ( .NOT. FOUND) DUM = DEF_CN_YR
1648 0 : CALL HCO_AddOpt( CF, 'CNYR', DUM, CoreNr, RC, VERB=.FALSE. )
1649 :
1650 : ! NetCDF version extension
1651 0 : CALL GetExtOpt( CF, CoreNr, 'NC', OptValChar=DUM, Found=FOUND, RC=RC )
1652 0 : IF ( RC /= HCO_SUCCESS ) THEN
1653 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
1654 0 : RETURN
1655 : ENDIF
1656 0 : IF ( .NOT. FOUND) DUM = DEF_NC_VER
1657 0 : CALL HCO_AddOpt( CF, 'NC', DUM, CoreNr, RC, VERB=.FALSE. )
1658 :
1659 : ! Resolution token
1660 0 : CALL GetExtOpt( CF, CoreNr, 'RES', OptValChar=DUM, Found=FOUND, RC=RC )
1661 0 : IF ( RC /= HCO_SUCCESS ) THEN
1662 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
1663 0 : RETURN
1664 : ENDIF
1665 0 : IF ( .NOT. FOUND ) DUM = DEF_RES
1666 0 : CALL HCO_AddOpt( CF, 'RES', DUM, CoreNr, RC, VERB=.FALSE. )
1667 :
1668 : ! Return w/ success
1669 0 : RC = HCO_SUCCESS
1670 :
1671 : END SUBROUTINE HCO_SetDefaultToken
1672 : !EOC
1673 : END MODULE HCO_ExtList_Mod
|