Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !!BOP
5 : !
6 : ! !MODULE: hco_chartools_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCO\_CHARTOOLS\_MOD contains a collection of
9 : ! helper routines to handle character strings and parse tokens. It also
10 : ! contains definitions of special characters such as space, tab and
11 : ! comment.
12 : ! \\
13 : ! !INTERFACE:
14 : !
15 : MODULE HCO_CharTools_Mod
16 : !
17 : ! !USES:
18 : !
19 : USE HCO_Error_Mod
20 :
21 : IMPLICIT NONE
22 : PRIVATE
23 : !
24 : ! !PUBLIC MEMBER FUNCTIONS:
25 : !
26 : PUBLIC :: HCO_CharSplit
27 : PUBLIC :: HCO_CharMatch
28 : PUBLIC :: HCO_CharParse
29 : PUBLIC :: HCO_GetBase
30 : PUBLIC :: IsInWord
31 : PUBLIC :: NextCharPos
32 : PUBLIC :: GetNextLine
33 : PUBLIC :: HCO_READLINE
34 : !
35 : ! !REVISION HISTORY:
36 : ! 18 Dec 2013 - C. Keller - Initialization
37 : ! See https://github.com/geoschem/hemco for complete history
38 : !EOP
39 : !------------------------------------------------------------------------------
40 : !BOC
41 : !
42 : ! !MODULE INTERFACES:
43 : !
44 : INTERFACE HCO_CharSplit
45 : MODULE PROCEDURE HCO_CharSplit_R8
46 : MODULE PROCEDURE HCO_CharSplit_R4
47 : MODULE PROCEDURE HCO_CharSplit_INT
48 : END INTERFACE
49 : !
50 : ! !MODULE PARAMETER:
51 : !
52 : ! Fixed characters
53 : CHARACTER(LEN=1), PARAMETER, PUBLIC :: HCO_SPC = ' '
54 : CHARACTER(LEN=1), PARAMETER, PUBLIC :: HCO_TAB = ACHAR(9)
55 : CHARACTER(LEN=1), PARAMETER, PUBLIC :: HCO_CMT = '#'
56 : !
57 : ! !PRIVATE MEMBER FUNCTIONS:
58 : !
59 : CONTAINS
60 : !EOC
61 : !------------------------------------------------------------------------------
62 : ! Harmonized Emissions Component (HEMCO) !
63 : !------------------------------------------------------------------------------
64 : !BOP
65 : !
66 : ! !IROUTINE: HCO_CharSplit_R8
67 : !
68 : ! !DESCRIPTION: Subroutine HCO\_CharSplit\_R8 splits the passed character
69 : ! string into N real8 values, using character SEP as separator. Wildcard
70 : ! values (WC) are set to -999.
71 : !\\
72 : ! !INTERFACE:
73 : !
74 0 : SUBROUTINE HCO_CharSplit_R8( CharStr, SEP, WC, Reals, N, RC )
75 : !
76 : ! !USES:
77 : !
78 : USE HCO_CharPak_Mod, ONLY : StrSplit
79 : !
80 : ! !INPUT PARAMETERS:
81 : !
82 : CHARACTER(LEN=*), INTENT(IN ) :: CharStr ! Character string
83 : CHARACTER(LEN=1), INTENT(IN ) :: SEP ! Separator
84 : CHARACTER(LEN=1), INTENT(IN ) :: WC ! Wildcard character
85 : !
86 : ! !OUTPUT PARAMETERS:
87 : !
88 : REAL(dp), INTENT( OUT) :: Reals(:) ! Output values
89 : INTEGER, INTENT( OUT) :: N ! # of valid values
90 : !
91 : ! !INPUT/OUTPUT PARAMETERS:
92 : !
93 : INTEGER, INTENT(INOUT) :: RC ! Return code
94 : !
95 : ! !REVISION HISTORY:
96 : ! 18 Sep 2013 - C. Keller - Initial version (update)
97 : ! See https://github.com/geoschem/hemco for complete history
98 : !EOP
99 : !------------------------------------------------------------------------------
100 : !BOC
101 : !
102 : ! !LOCAL VARIABLES:
103 : !
104 :
105 : INTEGER :: I
106 : CHARACTER(LEN=255) :: SUBSTR(255)
107 : CHARACTER(LEN=255) :: LOC
108 :
109 : !=================================================================
110 : ! HCO_CharSplit_R8 begins here!
111 : !=================================================================
112 :
113 : ! Enter
114 0 : LOC = 'HCO_CharSplit_R8 (HCO_CHARTOOLS_MOD.F90)'
115 :
116 : ! Init
117 0 : Reals(:) = -999_dp
118 :
119 : ! Extract strings to be translated into integers
120 : !CALL STRSPLIT( CharStr, TRIM(SEP), SUBSTR, N )
121 0 : CALL STRSPLIT( CharStr, SEP, SUBSTR, N )
122 0 : IF ( N > SIZE(Reals,1) ) THEN
123 0 : WRITE(*,*) 'Too many substrings - error in ', TRIM(LOC)
124 0 : RC = HCO_FAIL
125 0 : RETURN
126 : ENDIF
127 :
128 : ! Return here if no entry found
129 0 : IF ( N == 0 ) RETURN
130 :
131 : ! Pass all extracted strings to integer vector. Replace wildcard
132 : ! character with -999!
133 0 : DO I = 1, N
134 0 : IF ( TRIM(SUBSTR(I)) == TRIM(WC) ) THEN
135 0 : Reals(I) = -999_dp
136 0 : ELSEIF ( TRIM(SUBSTR(I)) == '-' ) THEN
137 0 : Reals(I) = -999_dp
138 : ELSE
139 0 : READ( SUBSTR(I), * ) Reals(I)
140 : ENDIF
141 : ENDDO
142 :
143 : ! Leave w/ success
144 0 : RC = HCO_SUCCESS
145 :
146 : END SUBROUTINE HCO_CharSplit_R8
147 : !EOC
148 : !------------------------------------------------------------------------------
149 : ! Harmonized Emissions Component (HEMCO) !
150 : !------------------------------------------------------------------------------
151 : !BOP
152 : !
153 : ! !IROUTINE: HCO_CharSplit_R4
154 : !
155 : ! !DESCRIPTION: Subroutine HCO\_CharSplit\_R4 splits the passed character
156 : ! string into N real4 values, using character SEP as separator. Wildcard
157 : ! values (WC) are set to -999.
158 : !\\
159 : ! !INTERFACE:
160 : !
161 0 : SUBROUTINE HCO_CharSplit_R4( CharStr, SEP, WC, Reals, N, RC )
162 : !
163 : ! !USES:
164 : !
165 : USE HCO_CharPak_Mod, ONLY : StrSplit
166 : !
167 : ! !INPUT PARAMETERS:
168 : !
169 : CHARACTER(LEN=*), INTENT(IN ) :: CharStr ! Character string
170 : CHARACTER(LEN=1), INTENT(IN ) :: SEP ! Separator
171 : CHARACTER(LEN=1), INTENT(IN ) :: WC ! Wildcard character
172 : !
173 : ! !OUTPUT PARAMETERS:
174 : !
175 : REAL(sp), INTENT( OUT) :: Reals(:) ! Output values
176 : INTEGER, INTENT( OUT) :: N ! # of valid values
177 : !
178 : ! !INPUT/OUTPUT PARAMETERS:
179 : !
180 : INTEGER, INTENT(INOUT) :: RC ! Return code
181 : !
182 : ! !REVISION HISTORY:
183 : ! 18 Sep 2013 - C. Keller - Initial version (update)
184 : ! See https://github.com/geoschem/hemco for complete history
185 : !EOP
186 : !------------------------------------------------------------------------------
187 : !BOC
188 : !
189 : ! !LOCAL VARIABLES:
190 : !
191 : INTEGER :: I
192 : CHARACTER(LEN=255) :: SUBSTR(255)
193 : CHARACTER(LEN=255) :: LOC
194 :
195 : !=================================================================
196 : ! HCO_CharSplit_R4 begins here!
197 : !=================================================================
198 :
199 : ! Enter
200 0 : LOC = 'HCO_CharSplit_R4 (HCO_CHARTOOLS_MOD.F90)'
201 :
202 : ! Init
203 0 : Reals(:) = -999._sp
204 :
205 : ! Extract strings to be translated into integers
206 : !CALL STRSPLIT( CharStr, TRIM(SEP), SUBSTR, N )
207 0 : CALL STRSPLIT( CharStr, SEP, SUBSTR, N )
208 0 : IF ( N > SIZE(Reals,1) ) THEN
209 0 : WRITE(*,*) 'Too many substrings - error in ', TRIM(LOC)
210 0 : RC = HCO_FAIL
211 0 : RETURN
212 : ENDIF
213 :
214 : ! Return here if no entry found
215 0 : IF ( N == 0 ) RETURN
216 :
217 : ! Pass all extracted strings to integer vector. Replace wildcard
218 : ! character with -999!
219 0 : DO I = 1, N
220 0 : IF ( TRIM(SUBSTR(I)) == TRIM(WC) ) THEN
221 0 : Reals(I) = -999._sp
222 0 : ELSEIF ( TRIM(SUBSTR(I)) == '-' ) THEN
223 0 : Reals(I) = -999._sp
224 : ELSE
225 0 : READ( SUBSTR(I), * ) Reals(I)
226 : ENDIF
227 : ENDDO
228 :
229 : ! Leave w/ success
230 0 : RC = HCO_SUCCESS
231 :
232 : END SUBROUTINE HCO_CharSplit_R4
233 : !EOC
234 : !------------------------------------------------------------------------------
235 : ! Harmonized Emissions Component (HEMCO) !
236 : !------------------------------------------------------------------------------
237 : !BOP
238 : !
239 : ! !IROUTINE: HCO_CharSplit_Int
240 : !
241 : ! !DESCRIPTION: Subroutine HCO\_CharSplit\_Int splits the passed character
242 : ! string into N integers, using character SEP as separator. Wildcard
243 : ! values (WC) are set to -999.
244 : !\\
245 : ! !INTERFACE:
246 : !
247 0 : SUBROUTINE HCO_CharSplit_INT( CharStr, SEP, WC, Ints, N, RC )
248 : !
249 : ! !USES:
250 : !
251 : USE HCO_CharPak_Mod, ONLY : StrSplit
252 : !
253 : ! !INPUT PARAMETERS:
254 : !
255 : CHARACTER(LEN=*), INTENT(IN ) :: CharStr ! Character string
256 : CHARACTER(LEN=1), INTENT(IN ) :: SEP ! Separator
257 : CHARACTER(LEN=1), INTENT(IN ) :: WC ! Wildcard character
258 : !
259 : ! !OUTPUT PARAMETERS:
260 : !
261 : INTEGER, INTENT( OUT) :: Ints(:) ! Output values
262 : INTEGER, INTENT( OUT) :: N ! # of valid values
263 : !
264 : ! !INPUT/OUTPUT PARAMETERS:
265 : !
266 : INTEGER, INTENT(INOUT) :: RC ! Return code
267 : !
268 : ! !REVISION HISTORY:
269 : ! 18 Sep 2013 - C. Keller - Initial version (update)
270 : ! See https://github.com/geoschem/hemco for complete history
271 : !EOP
272 : !------------------------------------------------------------------------------
273 : !BOC
274 : !
275 : ! !LOCAL VARIABLES:
276 : !
277 : INTEGER :: I
278 : CHARACTER(LEN=255) :: SUBSTR(255)
279 : CHARACTER(LEN=255) :: LOC
280 :
281 : !=================================================================
282 : ! HCO_CharSplit_INT begins here!
283 : !=================================================================
284 :
285 : ! Enter
286 0 : LOC = 'HCO_CharSplit_Int (HCO_CHARTOOLS_MOD.F90)'
287 :
288 : ! Init
289 0 : Ints(:) = -999
290 :
291 : ! If input string is wildcard or otherwise empty, return here.
292 0 : IF ( TRIM(CharStr) == TRIM(WC) .OR. &
293 : TRIM(CharStr) == '-' ) THEN
294 0 : N = 0
295 0 : RETURN
296 : ENDIF
297 :
298 : ! Extract strings to be translated into integers
299 : !CALL STRSPLIT( CharStr, TRIM(SEP), SUBSTR, N )
300 0 : CALL STRSPLIT( CharStr, SEP, SUBSTR, N )
301 0 : IF ( N > SIZE(Ints,1) ) THEN
302 0 : WRITE(*,*) 'Too many substrings - error in ', TRIM(LOC)
303 0 : RC = HCO_FAIL
304 0 : RETURN
305 : ENDIF
306 :
307 : ! Return here if no entry found
308 0 : IF ( N == 0 ) RETURN
309 :
310 : ! Pass all extracted strings to integer vector.
311 0 : DO I = 1, N
312 0 : READ( SUBSTR(I), * ) Ints(I)
313 : ENDDO
314 :
315 : ! Leave w/ success
316 0 : RC = HCO_SUCCESS
317 :
318 : END SUBROUTINE HCO_CharSplit_INT
319 : !EOC
320 : !------------------------------------------------------------------------------
321 : ! Harmonized Emissions Component (HEMCO) !
322 : !------------------------------------------------------------------------------
323 : !BOP
324 : !
325 : ! !IROUTINE: HCO_CharMatch
326 : !
327 : ! !DESCRIPTION: Subroutine HCO\_CharMatch returns the index of each
328 : ! vector element of vec1 in vec2. nnmatch denotes the number of
329 : ! vec1 elements which have a matching counterpart in vec2.
330 : ! For example, if vec1 is (/ 'NO', 'CO', 'ALK4', 'HBr' /), and
331 : ! vec2 is (/ 'CO', 'NO', 'CH3Br' /), then matchidx becomes
332 : ! (/ 2, 1, -1, -1 /) and nnmatch is 2.
333 : !\\
334 : !\\
335 : ! !INTERFACE:
336 : !
337 0 : SUBROUTINE HCO_CharMatch( vec1, n1, vec2, n2, matchidx, nnmatch )
338 : !
339 : ! !INPUT PARAMETERS:
340 : !
341 : INTEGER, INTENT(IN ) :: n1 ! len of vec1
342 : INTEGER, INTENT(IN ) :: n2 ! len of vec2
343 : CHARACTER(LEN=*), INTENT(IN ) :: vec1(n1) ! char. vector 1
344 : CHARACTER(LEN=*), INTENT(IN ) :: vec2(n2) ! char. vector 2
345 : !
346 : ! !OUTPUT PARAMETERS:
347 : !
348 : INTEGER, INTENT( OUT) :: matchidx(n1) ! index of vec2 in vec1
349 : INTEGER, INTENT( OUT) :: nnmatch ! # of matches
350 : !
351 : ! !REVISION HISTORY:
352 : ! 18 Sep 2013 - C. Keller - Initial version (update)
353 : ! See https://github.com/geoschem/hemco for complete history
354 : !EOP
355 : !------------------------------------------------------------------------------
356 : !BOC
357 : !
358 : ! !LOCAL VARIABLES:
359 : !
360 : INTEGER :: I, J
361 :
362 : !=================================================================
363 : ! HCO_CharMatch begins here!
364 : !=================================================================
365 :
366 : ! Init
367 0 : nnmatch = 0
368 :
369 : ! Do for every element in vec1
370 0 : DO I = 1, n1
371 :
372 : ! Default = no match
373 0 : matchidx(I) = -1
374 :
375 0 : DO J = 1, n2
376 0 : IF ( TRIM(vec1(I)) == TRIM(vec2(J)) ) THEN
377 0 : matchidx(I) = J
378 0 : nnmatch = nnmatch + 1
379 0 : EXIT
380 : ENDIF
381 : ENDDO
382 : ENDDO
383 :
384 0 : END SUBROUTINE HCO_CharMatch
385 : !EOC
386 : !------------------------------------------------------------------------------
387 : ! Harmonized Emissions Component (HEMCO) !
388 : !------------------------------------------------------------------------------
389 : !BOP
390 : !
391 : ! !IROUTINE: HCO_CharParse
392 : !
393 : ! !DESCRIPTION: Routine HCO\_CharParse parses the provided character string
394 : ! by searching for tokens such as \$ROOT, \$YYYY, etc., within the string and
395 : ! replacing those values by the intendend characters.
396 : !\\
397 : !\\
398 : ! The following list shows the 'default' HEMCO tokens. These are available
399 : ! in any HEMCO simulation. Tokens \$ROOT, \$MET, and \$RES are internally
400 : ! stored as a HEMCO option in module hco\_extlist\_mod.F90 (see subroutine
401 : ! HCO\_SetDefaultToken).
402 : ! \begin{itemize}
403 : ! \item \$ROOT: will be replaced by the root path specified in the settings
404 : ! section of the configuration file.
405 : ! \item \$MET: will be replaced by the met-field token.
406 : ! \item \$RES: will be replaced by the resolution token.
407 : ! \item \$YYYY: will be replaced by the (4-digit) year according to the
408 : ! source time settings set in the configuration file.
409 : ! \item \$MM: will be replaced by the (2-digit) month according to the
410 : ! source time settings set in the configuration file.
411 : ! \item \$DD: will be replaced by the (2-digit) day according to the
412 : ! source time settings set in the configuration file.
413 : ! \item \$HH: will be replaced by the (2-digit) hour according to the
414 : ! source time settings set in the configuration file.
415 : ! \item \$MN: will be replaced by the (2-digit) minute.
416 : ! \end{itemize}
417 : !
418 : ! !INTERFACE:
419 : !
420 0 : SUBROUTINE HCO_CharParse ( HcoConfig, str, yyyy, mm, dd, hh, mn, RC )
421 : !
422 : ! !USES:
423 : !
424 : USE HCO_ExtList_Mod, ONLY : HCO_GetOpt, HCO_Root
425 : USE HCO_Types_Mod, ONLY : ConfigObj
426 : !
427 : ! !INPUT PARAMETERS:
428 : !
429 : TYPE(ConfigObj), POINTER :: HcoConfig
430 : INTEGER, INTENT(IN ) :: yyyy ! replace $YYYY with this value
431 : INTEGER, INTENT(IN ) :: mm ! replace $MM with this value
432 : INTEGER, INTENT(IN ) :: dd ! replace $DD with this value
433 : INTEGER, INTENT(IN ) :: hh ! replace $HH with this value
434 : INTEGER, INTENT(IN ) :: mn ! replace $MN with this value
435 : !
436 : ! !OUTPUT PARAMETERS:
437 : !
438 : CHARACTER(LEN=*), INTENT( OUT) :: str ! string to be parsed
439 : !
440 : ! !INPUT/OUTPUT PARAMETERS:
441 : !
442 : INTEGER, INTENT(INOUT) :: RC ! return code
443 : !
444 : ! !REVISION HISTORY:
445 : ! 01 Oct 2014 - C. Keller - Initial version
446 : ! See https://github.com/geoschem/hemco for complete history
447 : !EOP
448 : !------------------------------------------------------------------------------
449 : !BOC
450 : !
451 : ! !LOCAL VARIABLES:
452 : !
453 : CHARACTER(LEN=255) :: MSG
454 : CHARACTER(LEN=255) :: LOC = 'HCO_CharParse (HCO_CharTools_Mod.F90)'
455 : CHARACTER(LEN=255) :: TOKEN
456 : CHARACTER(LEN=2047) :: TMPSTR, BEFORE, AFTER
457 : INTEGER :: I, LN, IDX, OFF
458 : CHARACTER(LEN=4) :: str4
459 : CHARACTER(LEN=2) :: str2
460 : CHARACTER(LEN=1) :: SEP
461 :
462 : !=================================================================
463 : ! HCO_CharParse begins here
464 : !=================================================================
465 :
466 : ! Get characters
467 0 : SEP = HCO_GetOpt(HcoConfig%ExtList,'Separator')
468 :
469 : ! Check for year token
470 : !-------------------------------------------------------------------
471 0 : DO
472 0 : IDX = INDEX( str, '$YYYY' )
473 0 : IF ( IDX <= 0 ) EXIT
474 0 : LN = LEN(str)
475 0 : IF ( IDX > 1 ) THEN
476 0 : BEFORE = str(1:(IDX-1))
477 : ELSE
478 0 : BEFORE = ''
479 : ENDIF
480 0 : OFF = 5
481 0 : AFTER = str((IDX+OFF):LN)
482 :
483 0 : WRITE(str4,'(i4.4)') yyyy
484 :
485 : ! Updated string
486 0 : str = TRIM(BEFORE) // TRIM(str4) // TRIM(AFTER)
487 : ENDDO
488 :
489 : ! Check for month token
490 : !-------------------------------------------------------------------
491 0 : DO
492 0 : IDX = INDEX( str, '$MM' )
493 0 : IF ( IDX <= 0 ) EXIT
494 0 : LN = LEN(str)
495 0 : IF ( IDX > 1 ) THEN
496 0 : BEFORE = str(1:(IDX-1))
497 : ELSE
498 0 : BEFORE = ''
499 : ENDIF
500 0 : OFF = 3
501 0 : AFTER = str((IDX+OFF):LN)
502 :
503 0 : WRITE(str2,'(i2.2)') mm
504 :
505 : ! Updated string
506 0 : str = TRIM(BEFORE) // TRIM(str2) // TRIM(AFTER)
507 : ENDDO
508 :
509 : ! Check for day token
510 : !-------------------------------------------------------------------
511 0 : DO
512 0 : IDX = INDEX( str, '$DD' )
513 0 : IF ( IDX <= 0 ) EXIT
514 0 : LN = LEN(str)
515 0 : IF ( IDX > 1 ) THEN
516 0 : BEFORE = str(1:(IDX-1))
517 : ELSE
518 0 : BEFORE = ''
519 : ENDIF
520 0 : OFF = 3
521 0 : AFTER = str((IDX+OFF):LN)
522 :
523 0 : WRITE(str2,'(i2.2)') dd
524 :
525 : ! Updated string
526 0 : str = TRIM(BEFORE) // TRIM(str2) // TRIM(AFTER)
527 : ENDDO
528 :
529 : ! Check for hour token
530 : !-------------------------------------------------------------------
531 0 : DO
532 0 : IDX = INDEX( str, '$HH' )
533 0 : IF ( IDX <= 0 ) EXIT
534 0 : LN = LEN(str)
535 0 : IF ( IDX > 1 ) THEN
536 0 : BEFORE = str(1:(IDX-1))
537 : ELSE
538 0 : BEFORE = ''
539 : ENDIF
540 0 : OFF = 3
541 0 : AFTER = str((IDX+OFF):LN)
542 :
543 0 : WRITE(str2,'(i2.2)') hh
544 :
545 : ! Updated string
546 0 : str = TRIM(BEFORE) // TRIM(str2) // TRIM(AFTER)
547 : ENDDO
548 :
549 : ! Check for minute token
550 : !-------------------------------------------------------------------
551 0 : DO
552 0 : IDX = INDEX( str, '$MN' )
553 0 : IF ( IDX <= 0 ) EXIT
554 0 : LN = LEN(str)
555 0 : IF ( IDX > 1 ) THEN
556 0 : BEFORE = str(1:(IDX-1))
557 : ELSE
558 0 : BEFORE = ''
559 : ENDIF
560 0 : OFF = 3
561 0 : AFTER = str((IDX+OFF):LN)
562 :
563 0 : WRITE(str2,'(i2.2)') mn
564 :
565 : ! Updated string
566 0 : str = TRIM(BEFORE) // TRIM(str2) // TRIM(AFTER)
567 : ENDDO
568 :
569 : ! Check for root token
570 : !-------------------------------------------------------------------
571 0 : IDX = INDEX( str, '$ROOT' )
572 0 : IF ( IDX > 0 ) THEN
573 0 : LN = LEN(str)
574 0 : IF ( IDX > 1 ) THEN
575 0 : BEFORE = str(1:(IDX-1))
576 : ELSE
577 0 : BEFORE = ''
578 : ENDIF
579 0 : OFF = 5
580 0 : AFTER = str((IDX+OFF):LN)
581 :
582 : ! Updated string
583 0 : str = TRIM(BEFORE) // TRIM(HCO_ROOT(HcoConfig)) // TRIM(AFTER)
584 : ENDIF
585 :
586 : ! Check for any other token
587 : !-------------------------------------------------------------------
588 0 : DO
589 0 : IDX = INDEX( str, '$' )
590 0 : IF ( IDX <= 0 ) EXIT
591 0 : LN = LEN(TRIM(str))
592 :
593 : ! Determine token name:
594 : ! Find end of token by starting at the first character after the
595 : ! token and then advance in string until a 'token end character'
596 : ! is encountered.
597 0 : DO I = IDX+1,LN
598 :
599 : ! Special case that end of string is encountered:
600 0 : IF ( I == LN ) THEN
601 0 : TOKEN = str( (IDX+1) : I )
602 : OFF = I
603 : EXIT
604 : ENDIF
605 :
606 : ! Scan for token cap:
607 0 : IF ( str(I:I) == ' ' .OR. &
608 : str(I:I) == '.' .OR. &
609 : str(I:I) == ':' .OR. &
610 : str(I:I) == '$' .OR. &
611 : str(I:I) == '%' .OR. &
612 : str(I:I) == '+' .OR. &
613 : str(I:I) == '*' .OR. &
614 : str(I:I) == '/' .OR. &
615 : str(I:I) == '^' .OR. &
616 : str(I:I) == '_' .OR. &
617 : str(I:I) == '*' .OR. &
618 : str(I:I) == '/' .OR. &
619 : str(I:I) == '^' .OR. &
620 : str(I:I) == '-' .OR. &
621 : str(I:I) == 'x' .OR. &
622 : str(I:I) == '(' .OR. &
623 : str(I:I) == ')' .OR. &
624 : str(I:I) == '0' .OR. &
625 : str(I:I) == '1' .OR. &
626 : str(I:I) == '2' .OR. &
627 : str(I:I) == '3' .OR. &
628 : str(I:I) == '4' .OR. &
629 : str(I:I) == '5' .OR. &
630 : str(I:I) == '6' .OR. &
631 : str(I:I) == '7' .OR. &
632 : str(I:I) == '8' .OR. &
633 0 : str(I:I) == '9' .OR. &
634 0 : str(I:I) == SEP ) THEN
635 :
636 0 : TOKEN = str( (IDX+1) : (I-1) )
637 : OFF = I
638 : EXIT
639 : ENDIF
640 : ENDDO
641 :
642 0 : IF ( IDX > 1 ) THEN
643 0 : BEFORE = str(1:(IDX-1))
644 : ELSE
645 0 : BEFORE = ''
646 : ENDIF
647 0 : IF ( OFF >= LN ) THEN
648 0 : AFTER = ''
649 : ELSE
650 0 : AFTER = str(OFF:LN)
651 : ENDIF
652 :
653 : ! Update string
654 : str = TRIM(BEFORE) // &
655 : TRIM(HCO_GetOpt(HcoConfig%ExtList,TOKEN)) // &
656 0 : TRIM(AFTER)
657 :
658 : ENDDO
659 :
660 : ! Return w/ success
661 0 : RC = HCO_SUCCESS
662 :
663 0 : END SUBROUTINE HCO_CharParse
664 : !EOC
665 : !------------------------------------------------------------------------------
666 : ! Harmonized Emissions Component (HEMCO) !
667 : !------------------------------------------------------------------------------
668 : !BOP
669 : !
670 : ! !IROUTINE: HCO_GetBase
671 : !
672 : ! !DESCRIPTION: Routine HCO\_GetBase returns the base location of the given
673 : ! file. This is the entire file path up to the last forward slash, e.g. for
674 : ! file '/home/dir/Config.rc', the base is '/home/dir/'
675 : !
676 : ! !INTERFACE:
677 : !
678 0 : SUBROUTINE HCO_GetBase ( str, base, RC )
679 : !
680 : ! !USES:
681 : !
682 : USE HCO_CharPak_Mod, ONLY : StrSplit
683 : !
684 : ! !INPUT PARAMETERS:
685 : !
686 : CHARACTER(LEN=*), INTENT(IN ) :: str ! string to be checked
687 : !
688 : ! !OUTPUT PARAMETERS:
689 : !
690 : CHARACTER(LEN=*), INTENT( OUT) :: base ! base
691 : !
692 : ! !INPUT/OUTPUT PARAMETERS:
693 : !
694 : INTEGER, INTENT(INOUT) :: RC ! return code
695 : !
696 : ! !REVISION HISTORY:
697 : ! 16 Mar 2015 - C. Keller - Initial version
698 : ! See https://github.com/geoschem/hemco for complete history
699 : !EOP
700 : !------------------------------------------------------------------------------
701 : !BOC
702 : !
703 : ! !LOCAL VARIABLES:
704 : !
705 : INTEGER :: I, N
706 : CHARACTER(LEN=255) :: SUBSTR(255)
707 :
708 : !=================================================================
709 : ! HCO_GetBase begins here
710 : !=================================================================
711 :
712 0 : CALL STRSPLIT( str, '/', SUBSTR, N )
713 0 : IF ( N <= 1 ) THEN
714 0 : base = '.'
715 : ELSE
716 0 : base = '/' // TRIM(SUBSTR(1))
717 0 : IF ( N > 2 ) THEN
718 0 : DO I = 2,(N-1)
719 0 : base = TRIM(base) // '/' // TRIM(SUBSTR(I))
720 : ENDDO
721 : ENDIF
722 : ENDIF
723 :
724 :
725 : ! Return w/ success
726 0 : RC = HCO_SUCCESS
727 :
728 0 : END SUBROUTINE HCO_GetBase
729 : !EOC
730 : !------------------------------------------------------------------------------
731 : ! Harmonized Emissions Component (HEMCO) !
732 : !------------------------------------------------------------------------------
733 : !BOP
734 : !
735 : ! !IROUTINE: IsInWord
736 : !
737 : ! !DESCRIPTION: Function IsInWord checks if the word InString contains the
738 : ! sequence of SearchString.
739 : !\\
740 : ! !INTERFACE:
741 : !
742 0 : FUNCTION IsInWord( InString, SearchString ) RESULT ( Cnt )
743 : !
744 : ! !INPUT PARAMETERS:
745 : !
746 : CHARACTER(LEN=*), INTENT(IN ) :: InString
747 : CHARACTER(LEN=*), INTENT(IN ) :: SearchString
748 : !
749 : ! !RETURN VALUE:
750 : !
751 : LOGICAL :: Cnt
752 : !
753 : ! !REVISION HISTORY:
754 : ! 23 Oct 2012 - C. Keller - Initial Version
755 : ! See https://github.com/geoschem/hemco for complete history
756 : !EOP
757 : !------------------------------------------------------------------------------
758 :
759 0 : Cnt = INDEX( TRIM(InString), TRIM(SearchString) ) > 0
760 :
761 0 : END FUNCTION IsInWord
762 : !EOC
763 : !------------------------------------------------------------------------------
764 : ! Harmonized Emissions Component (HEMCO) !
765 : !------------------------------------------------------------------------------
766 : !BOP
767 : !
768 : ! !IROUTINE: NextCharPos
769 : !
770 : ! !DESCRIPTION: Function NextCharPos returns the position of the next
771 : ! occurrence of character CHR in word WORD, starting from position START.
772 : ! Returns -1 if the word does not contain CHR at all (after position START).
773 : !\\
774 : !\\
775 : ! !INTERFACE:
776 : !
777 0 : FUNCTION NextCharPos ( WORD, CHR, START ) RESULT ( POS )
778 : !
779 : ! !USES:
780 : !
781 : !
782 : ! !INPUT ARGUMENTS:
783 : !
784 : CHARACTER(LEN=*), INTENT(IN) :: WORD
785 : CHARACTER(LEN=1), INTENT(IN) :: CHR
786 : INTEGER, OPTIONAL, INTENT(IN) :: START
787 : !
788 : ! !RETURN ARGUMENT:
789 : !
790 : INTEGER :: POS
791 : !
792 : ! !REVISION HISTORY:
793 : ! 09 Jul 2014 - C. Keller - Initial Version
794 : ! See https://github.com/geoschem/hemco for complete history
795 : !EOP
796 : !------------------------------------------------------------------------------
797 : !BOC
798 : !
799 : ! LOCAL VARIABLES:
800 : !
801 : INTEGER :: LNG, N, BEG
802 :
803 : !=================================================================
804 : ! NextCharPos begins here
805 : !=================================================================
806 :
807 : ! Initialize
808 0 : POS = -1
809 :
810 : ! Get first index
811 0 : IF ( PRESENT(START) ) THEN
812 0 : BEG = START
813 : ELSE
814 : BEG = 1
815 : ENDIF
816 :
817 : ! Lenght of word
818 0 : LNG = LEN(TRIM(WORD))
819 :
820 : ! Error traps
821 0 : IF ( BEG > LNG ) RETURN
822 :
823 : ! Search for occurrence of CHR
824 0 : DO N = BEG, LNG
825 0 : IF ( WORD(N:N) == CHR ) THEN
826 : POS = N
827 : EXIT
828 : ENDIF
829 : ENDDO
830 :
831 : END FUNCTION NextCharPos
832 : !EOC
833 : !------------------------------------------------------------------------------
834 : ! Harmonized Emissions Component (HEMCO) !
835 : !------------------------------------------------------------------------------
836 : !BOP
837 : !
838 : ! !IROUTINE: GetNextLine
839 : !
840 : ! !DESCRIPTION: Subroutine GetNextLine returns the next line.
841 : !\\
842 : !\\
843 : ! !INTERFACE:
844 : !
845 0 : SUBROUTINE GetNextLine( LUN, LINE, EOF, RC )
846 : !
847 : ! !USES:
848 : !
849 : !
850 : ! !INPUT PARAMETERS:
851 : !
852 : INTEGER, INTENT(IN ) :: LUN ! Stream to read from
853 : !
854 : ! !OUTPUT PARAMETERS
855 : !
856 : CHARACTER(LEN=*), INTENT( OUT) :: LINE ! Next (valid) line in stream
857 : !
858 : ! !INPUT/OUTPUT PARAMETERS
859 : !
860 : LOGICAL, INTENT(INOUT) :: EOF ! End of file encountered?
861 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
862 : !
863 : ! !REVISION HISTORY:
864 : ! 10 Apr 2015 - C. Keller - Initial Version
865 : ! See https://github.com/geoschem/hemco for complete history
866 : !EOP
867 : !------------------------------------------------------------------------------
868 : !BOC
869 : !
870 : ! LOCAL VARIABLES:
871 : !
872 : INTEGER :: IOS
873 : CHARACTER(LEN=5500) :: DUM
874 :
875 : !=================================================================
876 : ! GetNextLine begins here
877 : !=================================================================
878 :
879 : ! Init
880 0 : RC = HCO_SUCCESS
881 :
882 : ! Repeat until valid line is encountered
883 : DO
884 0 : CALL HCO_ReadLine( LUN, DUM, EOF, RC )
885 0 : IF ( EOF .OR. RC /= HCO_SUCCESS ) RETURN
886 :
887 : ! Skip if empty or commented line
888 0 : IF ( TRIM(DUM) == '' ) CYCLE
889 0 : IF ( DUM(1:1) == HCO_CMT ) CYCLE
890 :
891 : ! Make sure that character string DUM is not longer than LINE
892 0 : IF ( LEN_TRIM(DUM) > LEN(LINE) ) THEN
893 0 : WRITE( 6, '(a)' ) REPEAT( '=', 79 )
894 0 : WRITE( 6, * ) ' Line is too long - cannot copy into output argument '
895 0 : WRITE( 6, * ) TRIM(DUM)
896 0 : WRITE( 6, * ) ' '
897 0 : WRITE( 6, * ) ' To fix this, increase length of argument `LINE` in '
898 0 : WRITE( 6, * ) ' the subprogram which is calling '
899 0 : WRITE( 6, * ) ' HCO_ReadLine (hco_chartools_mod.F90)'
900 0 : RC = HCO_FAIL
901 0 : RETURN
902 : WRITE( 6, '(a)' ) REPEAT( '=', 79 )
903 : ELSE
904 : ! If we get here, exit loop
905 0 : LINE = DUM
906 : EXIT
907 : ENDIF
908 :
909 : ENDDO
910 :
911 : ! Return w/ success
912 0 : RC = HCO_SUCCESS
913 :
914 0 : END SUBROUTINE GetNextLine
915 : !EOC
916 : !------------------------------------------------------------------------------
917 : ! Harmonized Emissions Component (HEMCO) !
918 : !------------------------------------------------------------------------------
919 : !BOP
920 : !
921 : ! !IROUTINE: HCO_ReadLine
922 : !
923 : ! !DESCRIPTION: Subroutine HCO\_Line reads a line from the provided stream.
924 : !\\
925 : !\\
926 : ! !INTERFACE:
927 : !
928 0 : SUBROUTINE HCO_ReadLine( LUN, LINE, EOF, RC )
929 : !
930 : ! !USES:
931 : !
932 : USE Hco_CharPak_Mod, ONLY : CStrip
933 : !
934 : ! !INPUT PARAMETERS:
935 : !
936 : INTEGER, INTENT(IN ) :: LUN ! Stream LUN
937 : !
938 : ! !OUTPUT PARAMETERS:
939 : !
940 : CHARACTER(LEN=*), INTENT(INOUT) :: LINE ! Line
941 : LOGICAL, INTENT(INOUT) :: EOF ! End of file?
942 : INTEGER, INTENT(INOUT) :: RC ! Return code
943 : !
944 : ! !REVISION HISTORY:
945 : ! 18 Sep 2013 - C. Keller - Initial version (adapted from B. Yantosca's code)
946 : ! See https://github.com/geoschem/hemco for complete history
947 : !EOP
948 : !------------------------------------------------------------------------------
949 : !BOC
950 : !
951 : ! !LOCAL VARIABLES:
952 : !
953 : INTEGER :: IOS, C
954 : CHARACTER(LEN=255) :: MSG
955 : CHARACTER(LEN=5500) :: DUM
956 :
957 : !=================================================================
958 : ! HCO_ReadLine begins here!
959 : !=================================================================
960 :
961 : ! Initialize
962 0 : EOF = .FALSE.
963 0 : RC = HCO_SUCCESS
964 :
965 : ! Read a line from the file
966 0 : READ( LUN, '(a)', IOSTAT=IOS ) DUM
967 :
968 : ! IO Status < 0: EOF condition
969 0 : IF ( IOS < 0 ) THEN
970 0 : EOF = .TRUE.
971 0 : RETURN
972 : ENDIF
973 :
974 : ! IO Status > 0: true I/O error condition
975 0 : IF ( IOS > 0 ) THEN
976 0 : WRITE( 6, '(a)' ) REPEAT( '=', 79 )
977 0 : WRITE( 6, 100 ) IOS
978 : 100 FORMAT( 'ERROR ', i5, ' in HCO_Readline (hco_chartools_mod.F90)' )
979 0 : WRITE( 6, '(a)' ) REPEAT( '=', 79 )
980 0 : RC = HCO_FAIL
981 0 : RETURN
982 : ENDIF
983 :
984 : ! Make sure that character string DUM is not longer than LINE
985 0 : IF ( LEN(TRIM(DUM)) > LEN(LINE) ) THEN
986 0 : WRITE( 6, '(a)' ) REPEAT( '=', 79 )
987 0 : WRITE( 6, * ) ' Line is too long - cannot read line ', TRIM(DUM)
988 0 : WRITE( 6, * ) ' '
989 0 : WRITE( 6, * ) ' To fix this, increase length of argument `LINE` in '
990 0 : WRITE( 6, * ) ' HCO_ReadLine (hco_chartools_mod.F90)'
991 0 : RC = HCO_FAIL
992 0 : RETURN
993 : WRITE( 6, '(a)' ) REPEAT( '=', 79 )
994 : ELSE
995 0 : LINE = DUM(1:LEN(LINE))
996 : ENDIF
997 :
998 : ! Strip tabs and other non-printing characters but keep spaces
999 0 : CALL CStrip( Line, KeepSpaces=.TRUE. )
1000 :
1001 : ! Skip any comments at the end of a line (unless the
1002 : ! comment character # is in the first column)
1003 0 : C = INDEX( Line, '#' )
1004 0 : IF ( C > 1 ) Line = Line(1:C-1)
1005 :
1006 0 : END SUBROUTINE HCO_ReadLine
1007 : !EOC
1008 : END MODULE HCO_CharTools_Mod
|
