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,2) .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
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 scale factors
657 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
658 : !
659 : ! !REVISION HISTORY:
660 : ! 10 Jun 2015 - C. Keller - Initial version
661 : ! See https://github.com/geoschem/hemco for complete history
662 : !EOP
663 : !------------------------------------------------------------------------------
664 : !BOC
665 :
666 : !======================================================================
667 : ! GetExtSpcVal_Sp begins here
668 : !======================================================================
669 :
670 : ! Make sure output is properly allocated
671 0 : IF ( ALLOCATED(SpcScal) ) DEALLOCATE(SpcScal)
672 0 : ALLOCATE(SpcScal(NSPC))
673 0 : SpcScal=DefValue
674 :
675 : CALL GetExtSpcVal_Dr ( HcoConfig, ExtNr, NSPC, SpcNames, Prefix, RC, &
676 0 : DefVal_SP=DefValue, SpcScal_SP=SpcScal )
677 :
678 0 : END SUBROUTINE GetExtSpcVal_sp
679 : !EOC
680 : !------------------------------------------------------------------------------
681 : ! Harmonized Emissions Component (HEMCO) !
682 : !------------------------------------------------------------------------------
683 : !BOP
684 : !
685 : ! !ROUTINE: GetExtSpcVal_Int
686 : !
687 : ! !DESCRIPTION: Subroutine GetExtSpcVal\_Int returns integer values
688 : ! associated with the species for a given extension. Specifically, this routine
689 : ! searches for extension setting '<Prefix>\_SpecName' for every species passed
690 : ! through input argument SpcNames and writes those into output argument SpcScal.
691 : ! The default value DefValue is assigned to all elements of SpcScal with no
692 : ! corresponding extension setting.
693 : !\\
694 : !\\
695 : ! !INTERFACE:
696 : !
697 0 : SUBROUTINE GetExtSpcVal_Int( HcoConfig, ExtNr, NSPC, SpcNames, &
698 : Prefix, DefValue, SpcScal, RC )
699 : !
700 : ! !INPUT PARAMETERS:
701 : !
702 : TYPE(ConfigObj), POINTER :: HcoConfig
703 : INTEGER, INTENT(IN ) :: ExtNr ! Extension Nr.
704 : INTEGER, INTENT(IN ) :: NSPC ! # of species
705 : CHARACTER(LEN=*), INTENT(IN ) :: SpcNames(NSPC) ! Species string
706 : CHARACTER(LEN=*), INTENT(IN ) :: Prefix ! search prefix
707 : INTEGER, INTENT(IN ) :: DefValue ! default value
708 : !
709 : ! !INPUT/OUTPUT PARAMETERS:
710 : !
711 : INTEGER, ALLOCATABLE, INTENT(INOUT) :: SpcScal(:) ! Species scale factors
712 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
713 : !
714 : ! !REVISION HISTORY:
715 : ! 10 Jun 2015 - C. Keller - Initial version
716 : ! See https://github.com/geoschem/hemco for complete history
717 : !EOP
718 : !------------------------------------------------------------------------------
719 : !BOC
720 :
721 : !======================================================================
722 : ! GetExtSpcVal_Int begins here
723 : !======================================================================
724 :
725 : ! Make sure output is properly allocated
726 0 : IF ( ALLOCATED(SpcScal) ) DEALLOCATE(SpcScal)
727 0 : ALLOCATE(SpcScal(NSPC))
728 0 : SpcScal=DefValue
729 :
730 : CALL GetExtSpcVal_Dr ( HcoConfig, ExtNr, NSPC, SpcNames, Prefix, RC, &
731 0 : DefVal_IN=DefValue, SpcScal_IN=SpcScal )
732 :
733 0 : END SUBROUTINE GetExtSpcVal_Int
734 : !EOC
735 : !------------------------------------------------------------------------------
736 : ! Harmonized Emissions Component (HEMCO) !
737 : !------------------------------------------------------------------------------
738 : !BOP
739 : !
740 : ! !ROUTINE: GetExtSpcVal_Char
741 : !
742 : ! !DESCRIPTION: Subroutine GetExtSpcVal\_Char returns character values
743 : ! associated with the species for a given extension. Specifically, this routine
744 : ! searches for extension setting '<Prefix>\_SpecName' for every species passed
745 : ! through input argument SpcNames and writes those into output argument SpcScal.
746 : ! The default value DefValue is assigned to all elements of SpcScal with no
747 : ! corresponding extension setting.
748 : !\\
749 : !\\
750 : ! !INTERFACE:
751 : !
752 0 : SUBROUTINE GetExtSpcVal_Char( HcoConfig, ExtNr, NSPC, SpcNames, &
753 : Prefix, DefValue, SpcScal, RC )
754 : !
755 : ! !INPUT PARAMETERS:
756 : !
757 : TYPE(ConfigObj), POINTER :: HcoConfig
758 : INTEGER, INTENT(IN ) :: ExtNr ! Extension Nr.
759 : INTEGER, INTENT(IN ) :: NSPC ! # of species
760 : CHARACTER(LEN=*), INTENT(IN ) :: SpcNames(NSPC) ! Species string
761 : CHARACTER(LEN=*), INTENT(IN ) :: Prefix ! search prefix
762 : CHARACTER(LEN=*), INTENT(IN ) :: DefValue ! default value
763 : !
764 : ! !INPUT/OUTPUT PARAMETERS:
765 : !
766 : CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: SpcScal(:) ! Species scale factors
767 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
768 : !
769 : ! !REVISION HISTORY:
770 : ! 10 Jun 2015 - C. Keller - Initial version
771 : ! See https://github.com/geoschem/hemco for complete history
772 : !EOP
773 : !------------------------------------------------------------------------------
774 : !BOC
775 :
776 : !======================================================================
777 : ! GetExtSpcVal_Char begins here
778 : !======================================================================
779 :
780 : ! Make sure output is properly allocated
781 0 : IF ( ALLOCATED(SpcScal) ) DEALLOCATE(SpcScal)
782 0 : ALLOCATE(SpcScal(NSPC))
783 0 : SpcScal=DefValue
784 :
785 : CALL GetExtSpcVal_Dr ( HcoConfig, ExtNr, NSPC, SpcNames, Prefix, RC, &
786 0 : DefVal_Char=DefValue, SpcScal_Char=SpcScal )
787 :
788 0 : END SUBROUTINE GetExtSpcVal_char
789 : !EOC
790 : !------------------------------------------------------------------------------
791 : ! Harmonized Emissions Component (HEMCO) !
792 : !------------------------------------------------------------------------------
793 : !BOP
794 : !
795 : ! !ROUTINE: GetExtSpcVal_Dr
796 : !
797 : ! !DESCRIPTION: Subroutine GetExtSpcVal\_Dr is the GetExtSpcVal driver routine.
798 : !\\
799 : !\\
800 : ! !INTERFACE:
801 : !
802 0 : SUBROUTINE GetExtSpcVal_Dr( HcoConfig, ExtNr, NSPC, &
803 0 : SpcNames, Prefix, RC, &
804 0 : DefVal_SP, SpcScal_SP, &
805 0 : DefVal_Char, SpcScal_Char, &
806 0 : DefVal_IN, SpcScal_IN )
807 : !
808 : ! !INPUT PARAMETERS:
809 : !
810 : TYPE(ConfigObj), POINTER :: HcoConfig
811 : INTEGER, INTENT(IN ) :: ExtNr ! Extension Nr.
812 : INTEGER, INTENT(IN ) :: NSPC ! # of species
813 : CHARACTER(LEN=*), INTENT(IN ) :: SpcNames(NSPC) ! Species string
814 : CHARACTER(LEN=*), INTENT(IN ) :: Prefix ! search prefix
815 : REAL(sp), INTENT(IN ), OPTIONAL :: DefVal_SP ! default value
816 : INTEGER, INTENT(IN ), OPTIONAL :: DefVal_IN ! default value
817 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: DefVal_Char ! default value
818 : !
819 : ! !OUTPUT PARAMETERS:
820 : !
821 : REAL(sp), INTENT( OUT), OPTIONAL :: SpcScal_SP(NSPC) ! Species values
822 : INTEGER, INTENT( OUT), OPTIONAL :: SpcScal_IN(NSPC) ! Species values
823 : CHARACTER(LEN=*), INTENT( OUT), OPTIONAL :: SpcScal_Char(NSPC) ! Species values
824 : !
825 : ! !INPUT/OUTPUT PARAMETERS:
826 : !
827 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
828 : !
829 : ! !REVISION HISTORY:
830 : ! 10 Jun 2015 - C. Keller - Initial version
831 : ! See https://github.com/geoschem/hemco for complete history
832 : !EOP
833 : !------------------------------------------------------------------------------
834 : !BOC
835 : !
836 : ! !LOCAL ARGUMENTS:
837 : !
838 : INTEGER :: I
839 : LOGICAL :: FND
840 : REAL(sp) :: iScal_sp
841 : INTEGER :: iScal_in
842 : CHARACTER(LEN=255) :: iScal_char
843 : CHARACTER(LEN= 61) :: IOptName
844 : CHARACTER(LEN=255) :: MSG
845 : CHARACTER(LEN=255) :: LOC = 'GetExtSpcVal_Dr (hco_extlist_mod.F90)'
846 :
847 : !======================================================================
848 : ! GetExtSpcVal_Dr begins here
849 : !======================================================================
850 :
851 : ! Do for every species
852 0 : DO I = 1, NSPC
853 0 : IOptName = TRIM(Prefix)//'_'//TRIM(SpcNames(I))
854 :
855 0 : IF ( PRESENT(SpcScal_sp) ) THEN
856 0 : CALL GetExtOpt ( HcoConfig, ExtNr, IOptName, OptValSp=iScal_sp, FOUND=FND, RC=RC )
857 0 : IF ( RC /= HCO_SUCCESS ) THEN
858 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
859 0 : RETURN
860 : ENDIF
861 0 : IF ( FND ) SpcScal_sp(I) = iScal_sp
862 : ENDIF
863 0 : IF ( PRESENT(SpcScal_in) ) THEN
864 0 : CALL GetExtOpt ( HcoConfig, ExtNr, IOptName, OptValInt=iScal_in, FOUND=FND, RC=RC )
865 0 : IF ( RC /= HCO_SUCCESS ) THEN
866 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
867 0 : RETURN
868 : ENDIF
869 0 : IF ( FND ) SpcScal_in(I) = iScal_in
870 : ENDIF
871 0 : IF ( PRESENT(SpcScal_char) ) THEN
872 0 : CALL GetExtOpt ( HcoConfig, ExtNr, IOptName, OptValChar=iScal_char, FOUND=FND, RC=RC )
873 0 : IF ( RC /= HCO_SUCCESS ) THEN
874 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
875 0 : RETURN
876 : ENDIF
877 0 : IF ( FND ) SpcScal_char(I) = iScal_char
878 : ENDIF
879 : ENDDO
880 :
881 : ! Return w/ success
882 0 : RC = HCO_SUCCESS
883 :
884 0 : END SUBROUTINE GetExtSpcVal_Dr
885 : !EOC
886 : !------------------------------------------------------------------------------
887 : ! Harmonized Emissions Component (HEMCO) !
888 : !------------------------------------------------------------------------------
889 : !BOP
890 : !
891 : ! !IROUTINE: SetExtNr
892 : !
893 : ! !DESCRIPTION: Subroutine SetExtNr overwrites the extension number of a
894 : ! given extension. The extension of interest is provided in argument
895 : ! ExtName. If this argument is omitted, the extension numbers of all
896 : ! extensions currently listed in ExtList will be set to the provided
897 : ! number. This is useful to disable all extensions by setting the ExtNr
898 : ! to a negative value.
899 : !\\
900 : !\\
901 : ! !INTERFACE:
902 : !
903 0 : SUBROUTINE SetExtNr( HcoConfig, ExtNr, ExtName, RC )
904 : !
905 : ! !USES:
906 : !
907 : USE HCO_CHARPAK_MOD, ONLY : TRANLC
908 : !
909 : ! !INPUT PARAMETERS:
910 : !
911 : TYPE(ConfigObj), POINTER :: HcoConfig
912 : INTEGER, INTENT(IN ) :: ExtNr
913 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: ExtName
914 : !
915 : ! !INPUT/OUTPUT PARAMETER:
916 : !
917 : INTEGER, INTENT(INOUT) :: RC
918 : !
919 : ! !REVISION HISTORY:
920 : ! 12 Jan 2015 - C. Keller - Initial version
921 : ! See https://github.com/geoschem/hemco for complete history
922 : !EOP
923 : !------------------------------------------------------------------------------
924 : !BOC
925 : !
926 : ! !INTERNAL VARIABLES:
927 : !
928 : TYPE(Ext), POINTER :: ThisExt
929 : CHARACTER(LEN=255) :: LCname
930 : CHARACTER(LEN=255) :: MSG
931 : LOGICAL :: verb, overwrite
932 :
933 : !======================================================================
934 : ! SetExtNr begins here
935 : !======================================================================
936 :
937 : ! verbose?
938 0 : verb = HCO_IsVerb( HcoConfig%Err, 1 )
939 :
940 : ! Pass name to module and set to lower case
941 0 : IF ( PRESENT(ExtName) ) THEN
942 0 : LCname = TRIM(ExtName)
943 0 : CALL TRANLC( LCname ) ! lower case
944 : ELSE
945 0 : LCname = ''
946 : ENDIF
947 :
948 : ! Point to header of extensions list
949 0 : ThisExt => HcoConfig%ExtList
950 :
951 : ! Loop over all used extensions and check if any of them matches
952 : ! ExtName.
953 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
954 :
955 : ! Overwrite this ExtNr?
956 0 : overwrite = .FALSE.
957 :
958 : ! If argument ExtName is given, only overwrite extension number
959 : ! of that particular extension.
960 0 : IF ( PRESENT(ExtName) ) THEN
961 0 : IF ( TRIM(ThisExt%ExtName) == TRIM(LCname) ) overwrite = .TRUE.
962 :
963 : ! If argument is not given, overwrite all extensions except for
964 : ! HEMCO core
965 0 : ELSEIF ( ThisExt%ExtNr /= CoreNr ) THEN
966 : overwrite = .TRUE.
967 : ENDIF
968 :
969 : ! Overwrite extension number if needed
970 : IF ( overwrite ) THEN
971 0 : ThisExt%ExtNr = ExtNr
972 0 : IF ( verb ) THEN
973 0 : WRITE(MSG,*) 'Force ExtNr of extension ', TRIM(ThisExt%ExtName), &
974 0 : ' to ', ExtNr
975 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
976 : ENDIF
977 : ENDIF
978 :
979 : ! Advance to next extension
980 0 : ThisExt => ThisExt%NextExt
981 : ENDDO
982 :
983 : ! Cleanup
984 0 : ThisExt => NULL()
985 :
986 : ! Return w/ success
987 0 : RC = HCO_SUCCESS
988 :
989 0 : END SUBROUTINE SetExtNr
990 : !EOC
991 : !------------------------------------------------------------------------------
992 : ! Harmonized Emissions Component (HEMCO) !
993 : !------------------------------------------------------------------------------
994 : !BOP
995 : !
996 : ! !IROUTINE: ExtNrInUse
997 : !
998 : ! !DESCRIPTION: Function ExtNrInUse checks if extension number ExtNr is
999 : ! in the list of used extensions or not.
1000 : !\\
1001 : !\\
1002 : ! !INTERFACE:
1003 : !
1004 0 : FUNCTION ExtNrInUse( ExtList, ExtNr ) Result ( InUse )
1005 : !
1006 : ! !INPUT PARAMETERS:
1007 : !
1008 : TYPE(Ext), POINTER :: ExtList
1009 : INTEGER, INTENT(IN ) :: ExtNr
1010 : !
1011 : ! !RETURN VALUE::
1012 : !
1013 : LOGICAL :: InUse
1014 : !
1015 : ! !REVISION HISTORY:
1016 : ! 03 Oct 2013 - C. Keller - Initial version
1017 : ! See https://github.com/geoschem/hemco for complete history
1018 : !EOP
1019 : !------------------------------------------------------------------------------
1020 : !BOC
1021 : !
1022 : ! !INTERNAL VARIABLES:
1023 : !
1024 : TYPE(Ext), POINTER :: ThisExt
1025 : CHARACTER(LEN=255) :: LCname
1026 :
1027 : !======================================================================
1028 : ! ExtNrInUse begins here
1029 : !======================================================================
1030 :
1031 : ! Use number -999 for wildcard values
1032 0 : IF ( ExtNr == -999 ) THEN
1033 0 : InUse = .TRUE.
1034 : RETURN
1035 : ENDIF
1036 :
1037 : ! Init output
1038 0 : InUse = .FALSE.
1039 :
1040 : ! Point to header of extensions list
1041 0 : ThisExt => ExtList
1042 :
1043 : ! Loop over all used extensions and check if any of them matches
1044 : ! ExtName.
1045 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
1046 :
1047 : ! Compare extension names
1048 0 : IF ( ThisExt%ExtNr == ExtNr ) THEN
1049 : InUse = .TRUE.
1050 : EXIT
1051 : ENDIF
1052 :
1053 : ! Advance to next extension
1054 0 : ThisExt => ThisExt%NextExt
1055 : ENDDO
1056 :
1057 : ! Cleanup
1058 0 : ThisExt => NULL()
1059 :
1060 : END FUNCTION ExtNrInUse
1061 : !EOC
1062 : !------------------------------------------------------------------------------
1063 : ! Harmonized Emissions Component (HEMCO) !
1064 : !------------------------------------------------------------------------------
1065 : !BOP
1066 : !
1067 : ! !IROUTINE: ExtFinal
1068 : !
1069 : ! !DESCRIPTION: Function ExtFinal finalizes the extensions list.
1070 : !\\
1071 : !\\
1072 : ! !INTERFACE:
1073 : !
1074 0 : SUBROUTINE ExtFinal( ExtList )
1075 : !
1076 : ! !INPUT/OUTPUT ARGUMENT:
1077 : !
1078 : TYPE(Ext), POINTER :: ExtList
1079 : !
1080 : ! !REVISION HISTORY:
1081 : ! 03 Oct 2013 - C. Keller - Initial version
1082 : ! See https://github.com/geoschem/hemco for complete history
1083 : !EOP
1084 : !------------------------------------------------------------------------------
1085 : !BOC
1086 : !
1087 : ! !INTERNAL VARIABLES:
1088 : !
1089 : TYPE(Ext), POINTER :: ThisExt
1090 : TYPE(Ext), POINTER :: NextExt
1091 :
1092 : !======================================================================
1093 : ! ExtFinal begins here
1094 : !======================================================================
1095 :
1096 : ! Point to header of extensions list
1097 0 : ThisExt => ExtList
1098 0 : NextExt => NULL()
1099 :
1100 : ! Loop over all extensions and deallocate the types
1101 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
1102 :
1103 : ! First set pointer to next entry
1104 0 : NextExt => ThisExt%NextExt
1105 :
1106 : ! Now clean up this entry
1107 0 : ThisExt%NextExt => NULL()
1108 0 : CALL HCO_CleanupOpt( ThisExt%Opts )
1109 0 : DEALLOCATE ( ThisExt )
1110 :
1111 : ! Advance to next extension
1112 0 : ThisExt => NextExt
1113 : ENDDO
1114 :
1115 : ! Cleanup
1116 0 : ThisExt => NULL()
1117 0 : ExtList => NULL()
1118 :
1119 0 : END SUBROUTINE ExtFinal
1120 : !EOC
1121 : !------------------------------------------------------------------------------
1122 : ! Harmonized Emissions Component (HEMCO) !
1123 : !------------------------------------------------------------------------------
1124 : !BOP
1125 : !
1126 : ! !IROUTINE: HCO_AddOpt
1127 : !
1128 : ! !DESCRIPTION: Subroutine HCO\_AddOpt adds a option name/value pair to the
1129 : ! list of options.
1130 : !\\
1131 : !\\
1132 : ! !INTERFACE:
1133 : !
1134 0 : SUBROUTINE HCO_AddOpt ( HcoConfig, OptName, OptValue, ExtNr, RC, &
1135 : VERB, IgnoreIfExist )
1136 : !
1137 : ! !INPUT PARAMETERS:
1138 : !
1139 : TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO config obj
1140 : CHARACTER(LEN=*), INTENT(IN ) :: OptName ! OptName
1141 : CHARACTER(LEN=*), INTENT(IN ) :: OptValue ! OptValue
1142 : INTEGER, INTENT(IN ) :: ExtNr ! Extension Nr.
1143 : LOGICAL, INTENT(IN ), OPTIONAL :: VERB ! Verbose on
1144 : LOGICAL, INTENT(IN ), OPTIONAL :: IgnoreIfExist ! Ignore if already exists
1145 : !
1146 : ! !OUTPUT PARAMETERS:
1147 : !
1148 : INTEGER, INTENT(INOUT) :: RC ! Return code
1149 : !
1150 : ! !REVISION HISTORY:
1151 : ! 18 Sep 2015 - C. Keller - Initial version
1152 : ! See https://github.com/geoschem/hemco for complete history
1153 : !EOP
1154 : !------------------------------------------------------------------------------
1155 : !BOC
1156 : !
1157 : ! !LOCAL VARIABLES:
1158 : !
1159 : TYPE(Ext), POINTER :: ThisExt
1160 : TYPE(Opt), POINTER :: NewOpt
1161 : CHARACTER(LEN=OPTLEN) :: DUM
1162 : LOGICAL :: Exists
1163 : LOGICAL :: VRB
1164 : LOGICAL :: Ignore
1165 : CHARACTER(LEN=255) :: MSG
1166 : CHARACTER(LEN=255) :: LOC = 'HCO_AddOpt (hco_extlist_mod.F90)'
1167 :
1168 : !=================================================================
1169 : ! HCO_AddOpt begins here!
1170 : !=================================================================
1171 :
1172 : ! Nullify
1173 0 : ThisExt => NULL()
1174 0 : NewOpt => NULL()
1175 :
1176 : ! Init optional variables
1177 0 : VRB = .TRUE.
1178 0 : Ignore = .FALSE.
1179 0 : IF ( PRESENT(VERB) ) VRB = VERB
1180 0 : IF ( PRESENT(IgnoreIfExist) ) Ignore = IgnoreIfExist
1181 :
1182 : ! Check if this option already exists
1183 0 : DUM = HCO_GetOpt( HcoConfig%ExtList, OptName, ExtNr=ExtNr )
1184 :
1185 : ! If option already exists...
1186 0 : IF ( TRIM(DUM) /= TRIM(EMPTYOPT) ) THEN
1187 :
1188 : ! Can leave here if we shall ignore the option if it already exists
1189 0 : IF ( Ignore ) THEN
1190 :
1191 : ! If option exists and is the same, nothing to do
1192 0 : IF ( TRIM(DUM) /= ADJUSTL(TRIM(OptValue)) ) THEN
1193 0 : WRITE(*,*) 'Option is already defined - use original value of ', &
1194 0 : TRIM(DUM), ' and ignore the following value: ', &
1195 0 : TRIM(OptName), ': ', TRIM(OptValue)
1196 : ENDIF
1197 0 : RC = HCO_SUCCESS
1198 0 : RETURN
1199 :
1200 : ! If ignore flag is false:
1201 : ELSE
1202 : ! Error if values are not the same
1203 0 : IF ( TRIM(DUM) /= ADJUSTL(TRIM(OptValue)) ) THEN
1204 : MSG = 'Cannot add option pair: '//TRIM(OptName)//': '//TRIM(OptValue) &
1205 0 : // ' - option already exists: '//TRIM(OptName)//': '//TRIM(DUM)
1206 0 : CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
1207 0 : RETURN
1208 : ! Return with no error if values are the same
1209 : ELSE
1210 0 : RC = HCO_SUCCESS
1211 0 : RETURN
1212 : ENDIF
1213 : ENDIF
1214 : ENDIF
1215 :
1216 : ! Find extension of interest
1217 0 : ThisExt => HcoConfig%ExtList
1218 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
1219 0 : IF ( ThisExt%ExtNr == ExtNr ) EXIT
1220 0 : ThisExt => ThisExt%NextExt
1221 : ENDDO
1222 :
1223 0 : IF ( .NOT. ASSOCIATED( ThisExt ) ) THEN
1224 0 : WRITE(MSG,*) 'Cannot add option to extension Nr. ', ExtNr
1225 0 : MSG = TRIM(MSG) // '. Make sure this extension is activated!'
1226 0 : CALL HCO_ERROR(MSG,RC,THISLOC='AddOpt (hco_extlist_mod)')
1227 0 : RETURN
1228 : ENDIF
1229 :
1230 : ! Create new option
1231 0 : ALLOCATE(NewOpt)
1232 0 : NewOpt%OptName = ADJUSTL( TRIM(OptName ) )
1233 0 : NewOpt%OptValue = ADJUSTL( TRIM(OptValue) )
1234 :
1235 : ! Add to option linked list
1236 0 : IF ( ASSOCIATED(ThisExt%Opts) ) THEN
1237 0 : NewOpt%NextOpt => ThisExt%Opts
1238 : ELSE
1239 0 : NewOpt%NextOpt => NULL()
1240 : ENDIF
1241 0 : ThisExt%Opts => NewOpt
1242 :
1243 : ! Verbose
1244 0 : IF ( VRB .AND. HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err,2) ) THEN
1245 0 : MSG = 'Added the following option: ' // TRIM(OptName)//': '//TRIM(OptValue)
1246 0 : CALL HCO_MSG(HcoConfig%Err,MSG)
1247 : ENDIF
1248 :
1249 : ! Cleanup and return w/ success
1250 0 : ThisExt => NULL()
1251 0 : RC = HCO_SUCCESS
1252 :
1253 : END SUBROUTINE HCO_AddOpt
1254 : !EOC
1255 : !------------------------------------------------------------------------------
1256 : ! Harmonized Emissions Component (HEMCO) !
1257 : !------------------------------------------------------------------------------
1258 : !BOP
1259 : !
1260 : ! !IROUTINE: HCO_GetOpt
1261 : !
1262 : ! !DESCRIPTION: Subroutine HCO\_GetOpt returns a option value for the given
1263 : ! option name.
1264 : !\\
1265 : !\\
1266 : ! !INTERFACE:
1267 : !
1268 0 : FUNCTION HCO_GetOpt ( ExtList, OptName, ExtNr ) RESULT ( OptValue )
1269 : !
1270 : ! !INPUT PARAMETERS:
1271 : !
1272 : TYPE(Ext), POINTER :: ExtList ! Extension list
1273 : CHARACTER(LEN=*), INTENT(IN ) :: OptName ! OptName
1274 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr ! Extension Nr.
1275 : !
1276 : ! !OUTPUT PARAMETERS:
1277 : !
1278 : CHARACTER(LEN=OPTLEN) :: OptValue ! OptValue
1279 : !
1280 : ! !REVISION HISTORY:
1281 : ! 18 Sep 2015 - C. Keller - Initial version
1282 : ! See https://github.com/geoschem/hemco for complete history
1283 : !EOP
1284 : !------------------------------------------------------------------------------
1285 : !BOC
1286 : !
1287 : ! !LOCAL VARIABLES:
1288 : !
1289 : INTEGER :: ThisExtNr
1290 : LOGICAL :: OptFound
1291 : TYPE(Opt), POINTER :: ThisOpt
1292 : TYPE(Ext), POINTER :: ThisExt
1293 :
1294 : !=================================================================
1295 : ! HCO_GetOpt begins here!
1296 : !=================================================================
1297 :
1298 : ! Init
1299 0 : OptValue = EMPTYOPT
1300 0 : OptFound = .FALSE.
1301 0 : ThisOpt => NULL()
1302 0 : ThisExt => NULL()
1303 :
1304 : ! Extension number to search for. If not explicitly set through the
1305 : ! input argument, set to -999 to search all extensions.
1306 0 : IF ( PRESENT(ExtNr) ) THEN
1307 0 : ThisExtNr = ExtNr
1308 : ELSE
1309 : ThisExtNr = -999
1310 : ENDIF
1311 :
1312 : ! Find extension of interest
1313 0 : ThisExt => ExtList
1314 0 : DO WHILE ( ASSOCIATED ( ThisExt ) )
1315 :
1316 : ! Check if this is the extension of interest. If extension number
1317 : ! is set to -999, scan through all extensions.
1318 0 : IF ( ThisExtNr /= -999 .AND. ThisExt%ExtNr /= ThisExtNr ) THEN
1319 0 : ThisExt => ThisExt%NextExt
1320 0 : CYCLE
1321 : ENDIF
1322 :
1323 : ! Walk through token list until we find the given value
1324 0 : ThisOpt => ThisExt%Opts
1325 0 : DO WHILE ( ASSOCIATED(ThisOpt) )
1326 :
1327 : ! Check if this is the token of interest
1328 0 : IF ( TRIM(ThisOpt%OptName) == ADJUSTL(TRIM(OptName)) ) THEN
1329 0 : OptValue = ADJUSTL( TRIM(ThisOpt%OptValue) )
1330 0 : OptFound = .TRUE.
1331 0 : EXIT
1332 : ENDIF
1333 :
1334 : ! Advance in list
1335 0 : ThisOpt => ThisOpt%NextOpt
1336 : END DO
1337 :
1338 : ! Advance to next extension
1339 0 : IF ( OptFound ) THEN
1340 : ThisExt => NULL()
1341 : ELSE
1342 0 : ThisExt => ThisExt%NextExt
1343 : ENDIF
1344 : ENDDO
1345 :
1346 : ! Free pointer
1347 0 : ThisOpt => NULL()
1348 0 : ThisExt => NULL()
1349 :
1350 0 : END FUNCTION HCO_GetOpt
1351 : !EOC
1352 : !------------------------------------------------------------------------------
1353 : ! Harmonized Emissions Component (HEMCO) !
1354 : !------------------------------------------------------------------------------
1355 : !BOP
1356 : !
1357 : ! !IROUTINE: HCO_ROOT
1358 : !
1359 : ! !DESCRIPTION: Function HCO\_ROOT returns the root character string. This is
1360 : ! a wrapper routine equivalent to HCO\_GetOpt('ROOT'). Since the ROOT character
1361 : ! is called very frequently, it is recommended to use this routine instead.
1362 : !\\
1363 : !\\
1364 : ! !INTERFACE:
1365 : !
1366 0 : FUNCTION HCO_ROOT ( HcoConfig ) RESULT ( OutRoot )
1367 : !
1368 : ! !INPUT PARAMETERS:
1369 : !
1370 : !
1371 : ! !OUTPUT PARAMETERS:
1372 : !
1373 : TYPE(ConfigObj), POINTER :: HcoConfig
1374 : CHARACTER(LEN=OPTLEN) :: OutRoot ! Root output
1375 : !
1376 : ! !REVISION HISTORY:
1377 : ! 18 Sep 2015 - C. Keller - Initial version
1378 : ! See https://github.com/geoschem/hemco for complete history
1379 : !EOP
1380 : !------------------------------------------------------------------------------
1381 : !BOC
1382 :
1383 0 : OutRoot = HcoConfig%ROOT
1384 :
1385 0 : END FUNCTION HCO_ROOT
1386 : !EOC
1387 : !------------------------------------------------------------------------------
1388 : ! Harmonized Emissions Component (HEMCO) !
1389 : !------------------------------------------------------------------------------
1390 : !BOP
1391 : !
1392 : ! !IROUTINE: HCO_CleanupOpt
1393 : !
1394 : ! !DESCRIPTION: Subroutine HCO\_CleanupOpt cleans up the given options linked
1395 : ! list.
1396 : !\\
1397 : !\\
1398 : ! !INTERFACE:
1399 : !
1400 0 : SUBROUTINE HCO_CleanupOpt ( OptList )
1401 : !
1402 : ! !INPUT PARAMETERS:
1403 : !
1404 : !
1405 : ! !OUTPUT PARAMETERS:
1406 : !
1407 : TYPE(Opt), POINTER :: OptList
1408 : !
1409 : ! !REVISION HISTORY:
1410 : ! 18 Sep 2015 - C. Keller - Initial version
1411 : ! See https://github.com/geoschem/hemco for complete history
1412 : !EOP
1413 : !------------------------------------------------------------------------------
1414 : !BOC
1415 : !
1416 : ! !LOCAL VARIABLES:
1417 : !
1418 : TYPE(Opt), POINTER :: ThisOpt
1419 : TYPE(Opt), POINTER :: NextOpt
1420 :
1421 : !=================================================================
1422 : ! HCO_CleanupOpt begins here!
1423 : !=================================================================
1424 :
1425 : ! Walk through option list until we find the given value
1426 0 : NextOpt => NULL()
1427 0 : ThisOpt => OptList
1428 0 : DO WHILE ( ASSOCIATED(ThisOpt) )
1429 :
1430 : ! Archive next option in list
1431 0 : NextOpt => ThisOpt%NextOpt
1432 :
1433 : ! Free the memory allocated to ThisOpt (this avoids memory leaks)
1434 0 : ThisOpt%NextOpt => NULL()
1435 0 : DEALLOCATE( ThisOpt )
1436 :
1437 : ! Go to next option in list (previously archived)
1438 0 : ThisOpt => NextOpt
1439 : END DO
1440 :
1441 : ! Free pointer
1442 0 : ThisOpt => NULL()
1443 0 : NextOpt => NULL()
1444 :
1445 0 : END SUBROUTINE HCO_CleanupOpt
1446 : !EOC
1447 : !------------------------------------------------------------------------------
1448 : ! Harmonized Emissions Component (HEMCO) !
1449 : !------------------------------------------------------------------------------
1450 : !BOP
1451 : !
1452 : ! !IROUTINE: HCO_SetDefaultToken
1453 : !
1454 : ! !DESCRIPTION: Subroutine HCO\_SetDefaultToken is a wrapper routine to
1455 : ! initialize the default set of HEMCO tokens. These can be obtained at any
1456 : ! place in the HEMCO code via subroutine HCO\_GetOpt, e.g. HCO\_GetOpt('RES')
1457 : ! will return the 'RES' token.
1458 : !\\
1459 : !\\
1460 : ! !INTERFACE:
1461 : !
1462 0 : SUBROUTINE HCO_SetDefaultToken( CF, RC )
1463 : !
1464 : ! !USES:
1465 : !
1466 : !
1467 : ! !INPUT PARAMETERS:
1468 : !
1469 : TYPE(ConfigObj), POINTER :: CF ! Config object
1470 : !
1471 : ! !OUTPUT PARAMETERS:
1472 : !
1473 : INTEGER, INTENT(INOUT) :: RC ! Return code
1474 : !
1475 : ! !REVISION HISTORY:
1476 : ! 18 Sep 2015 - C. Keller - Initial version
1477 : ! See https://github.com/geoschem/hemco for complete history
1478 : !EOP
1479 : !------------------------------------------------------------------------------
1480 : !BOC
1481 : !
1482 : ! !LOCAL VARIABLES:
1483 : !
1484 : CHARACTER(LEN=OPTLEN) :: DUM
1485 : CHARACTER(LEN=255) :: LOC
1486 : LOGICAL :: FOUND
1487 :
1488 : !=================================================================
1489 : ! HCO_SetDefaultToken begins here!
1490 : !=================================================================
1491 0 : LOC = 'HCO_SetDefaultToken (HCO_EXTLIST_MOD)'
1492 :
1493 0 : IF ( Trim(CF%MetField) == 'GEOSFP' ) THEN
1494 0 : DEF_MET_UC = 'GEOSFP'
1495 0 : DEF_MET_LC = 'geosfp'
1496 0 : DEF_CN_YR = '2011' ! Constant met fld year
1497 0 : DEF_NC_VER = 'nc' ! NetCDF extension
1498 0 : ELSE IF ( TRIM(CF%MetField) == 'MERRA2' ) THEN
1499 0 : DEF_MET_UC = 'MERRA2'
1500 0 : DEF_MET_LC = 'merra2'
1501 0 : DEF_CN_YR = '2015' ! Constant met fld year
1502 0 : DEF_NC_VER = 'nc4' ! NetCDF extension
1503 : ENDIF
1504 :
1505 0 : IF ( TRIM(CF%GridRes) == '4.0x5.0' ) THEN
1506 0 : DEF_RES = '4x5'
1507 0 : ELSE IF ( TRIM(CF%GridRes) == '2.0x2.5' ) THEN
1508 0 : DEF_RES = '2x25'
1509 0 : ELSE IF ( TRIM(CF%GridRes) == '0.5x0.625' ) THEN
1510 0 : DEF_RES = '05x0625'
1511 0 : ELSE IF ( TRIM(CF%GridRes) == '0.25x0.3125' ) THEN
1512 0 : DEF_RES = '025x03125'
1513 : ENDIF
1514 :
1515 : ! Wildcard character
1516 0 : CALL GetExtOpt( CF, CoreNr, 'Wildcard', OptValChar=DUM, Found=FOUND, RC=RC )
1517 0 : IF ( RC /= HCO_SUCCESS ) THEN
1518 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
1519 0 : RETURN
1520 : ENDIF
1521 0 : IF ( .NOT. FOUND) DUM = DEF_WILDCARD
1522 0 : CALL HCO_AddOpt( CF, 'Wildcard', DUM, CoreNr, RC, VERB=.FALSE. )
1523 :
1524 : ! Separator
1525 0 : CALL GetExtOpt( CF, CoreNr, 'Separator', OptValChar=DUM, Found=FOUND, RC=RC )
1526 0 : IF ( RC /= HCO_SUCCESS ) THEN
1527 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
1528 0 : RETURN
1529 : ENDIF
1530 0 : IF ( .NOT. FOUND) DUM = DEF_SEPARATOR
1531 0 : CALL HCO_AddOpt( CF, 'Separator', DUM, CoreNr, RC, VERB=.FALSE. )
1532 :
1533 : ! Colon
1534 0 : CALL GetExtOpt( CF, CoreNr, 'Colon', OptValChar=DUM, Found=FOUND, RC=RC )
1535 0 : IF ( RC /= HCO_SUCCESS ) THEN
1536 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
1537 0 : RETURN
1538 : ENDIF
1539 0 : IF ( .NOT. FOUND) DUM = DEF_COLON
1540 0 : CALL HCO_AddOpt( CF, 'Colon', DUM, CoreNr, RC, VERB=.FALSE. )
1541 :
1542 : ! Root directory
1543 0 : CALL GetExtOpt( CF, CoreNr, 'ROOT', OptValChar=DUM, Found=FOUND, RC=RC )
1544 0 : IF ( RC /= HCO_SUCCESS ) THEN
1545 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
1546 0 : RETURN
1547 : ENDIF
1548 0 : IF ( .NOT. FOUND) DUM = DEF_ROOT
1549 0 : CALL HCO_AddOpt( CF, 'ROOT', DUM, CoreNr, RC, VERB=.FALSE. )
1550 :
1551 : ! Also save in local variable (for fast access via HCO_ROOT)
1552 0 : CF%ROOT = ADJUSTL( TRIM(DUM) )
1553 :
1554 : ! Meteorology token (uppercase)
1555 0 : CALL GetExtOpt( CF, CoreNr, 'MET', OptValChar=DUM, Found=FOUND, RC=RC )
1556 0 : IF ( RC /= HCO_SUCCESS ) THEN
1557 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
1558 0 : RETURN
1559 : ENDIF
1560 0 : IF ( .NOT. FOUND) DUM = DEF_MET_UC
1561 0 : CALL HCO_AddOpt( CF, 'MET', DUM, CoreNr, RC, VERB=.FALSE. )
1562 :
1563 : ! Meteorology token (lowercase)
1564 0 : CALL GetExtOpt( CF, CoreNr, 'met', OptValChar=DUM, Found=FOUND, RC=RC )
1565 0 : IF ( RC /= HCO_SUCCESS ) THEN
1566 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
1567 0 : RETURN
1568 : ENDIF
1569 0 : IF ( .NOT. FOUND) DUM = DEF_MET_LC
1570 0 : CALL HCO_AddOpt( CF, 'met', DUM, CoreNr, RC, VERB=.FALSE. )
1571 :
1572 : ! Year for constant met fields
1573 0 : CALL GetExtOpt( CF, CoreNr, 'CNYR', OptValChar=DUM, Found=FOUND, RC=RC )
1574 0 : IF ( RC /= HCO_SUCCESS ) THEN
1575 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
1576 0 : RETURN
1577 : ENDIF
1578 0 : IF ( .NOT. FOUND) DUM = DEF_CN_YR
1579 0 : CALL HCO_AddOpt( CF, 'CNYR', DUM, CoreNr, RC, VERB=.FALSE. )
1580 :
1581 : ! NetCDF version extension
1582 0 : CALL GetExtOpt( CF, CoreNr, 'NC', OptValChar=DUM, Found=FOUND, RC=RC )
1583 0 : IF ( RC /= HCO_SUCCESS ) THEN
1584 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
1585 0 : RETURN
1586 : ENDIF
1587 0 : IF ( .NOT. FOUND) DUM = DEF_NC_VER
1588 0 : CALL HCO_AddOpt( CF, 'NC', DUM, CoreNr, RC, VERB=.FALSE. )
1589 :
1590 : ! Resolution token
1591 0 : CALL GetExtOpt( CF, CoreNr, 'RES', OptValChar=DUM, Found=FOUND, RC=RC )
1592 0 : IF ( RC /= HCO_SUCCESS ) THEN
1593 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
1594 0 : RETURN
1595 : ENDIF
1596 0 : IF ( .NOT. FOUND ) DUM = DEF_RES
1597 0 : CALL HCO_AddOpt( CF, 'RES', DUM, CoreNr, RC, VERB=.FALSE. )
1598 :
1599 : ! Return w/ success
1600 0 : RC = HCO_SUCCESS
1601 :
1602 : END SUBROUTINE HCO_SetDefaultToken
1603 : !EOC
1604 : END MODULE HCO_ExtList_Mod
|