LCOV - code coverage report
Current view: | top level - hemco/HEMCO/src/Shared/Headers - hco_charpak_mod.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 225 | 0.0 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 0 | 16 | 0.0 %

              Line data    Source code
           1             : !------------------------------------------------------------------------------
           2             : !                   Harmonized Emissions Component (HEMCO)                    !
           3             : !------------------------------------------------------------------------------
           4             : !BOP
           5             : !
           6             : ! !MODULE: HCO_charpak_mod.F90
           7             : !
           8             : ! !DESCRIPTION: Module HCO\_CHARPAK\_MOD contains routines from the CHARPAK
           9             : !  string and character manipulation package used by GEOS-Chem.
          10             : !\\
          11             : !\\
          12             : ! !INTERFACE:
          13             : !
          14             : MODULE HCO_Charpak_Mod
          15             : !
          16             : ! !USES:
          17             : !
          18             :   IMPLICIT NONE
          19             :   PRIVATE
          20             : !
          21             : ! !PUBLIC MEMBER FUNCTIONS:
          22             : !
          23             :   PUBLIC  :: CleanText
          24             :   PUBLIC  :: CntMat
          25             :   PUBLIC  :: CopyTxt
          26             :   PUBLIC  :: CStrip
          27             :   PUBLIC  :: IsDigit
          28             :   PUBLIC  :: ReadOneLine
          29             :   PUBLIC  :: Str2Hash14
          30             :   PUBLIC  :: Str2Hash31
          31             :   PUBLIC  :: StrRepl
          32             :   PUBLIC  :: StrSplit
          33             :   PUBLIC  :: StrSqueeze
          34             :   PUBLIC  :: To_UpperCase
          35             :   PUBLIC  :: TranLc
          36             :   PUBLIC  :: TranUc
          37             :   PUBLIC  :: Txtext
          38             :   PUBLIC  :: WordWrapPrint
          39             : !
          40             : ! !PRIVATE MEMBER FUNCTIONS
          41             : !
          42             : !
          43             : ! !REMARKS:
          44             : !  CHARPAK routines by Robert D. Stewart, 1992.  Subsequent modifications
          45             : !  made for GEOS-CHEM by Bob Yantosca (1998, 2002, 2004).
          46             : !
          47             : ! !REVISION HISTORY:
          48             : !  See https://github.com/geoschem/hemco for complete history
          49             : !EOP
          50             : !------------------------------------------------------------------------------
          51             : !BOC
          52             : !
          53             : ! !DEFINED PARAMETERS
          54             : !
          55             :   ! Maximum string length
          56             :   INTEGER, PARAMETER, PUBLIC :: MAXSTRLEN = 500
          57             :
          58             : CONTAINS
          59             : !EOC
          60             : !------------------------------------------------------------------------------
          61             : !                   Harmonized Emissions Component (HEMCO)                    !
          62             : !------------------------------------------------------------------------------
          63             : !BOP
          64             : !
          65             : ! !IROUTINE: CntMat
          66             : !
          67             : ! !DESCRIPTION: Counts the number of characters in str1 that match
          68             : !  a character in str2.
          69             : !\\
          70             : !\\
          71             : ! !INTERFACE:
          72             : !
          73           0 :   SUBROUTINE CntMat( Str1, Str2, Imat, Locations )
          74             : !
          75             : ! !INPUT PARAMETERS:
          76             : !
          77             :     CHARACTER(LEN=*), INTENT(IN) ::  Str1             ! Text to scan
          78             :     CHARACTER(LEN=*), INTENT(IN) ::  Str2             ! Character to match
          79             : !
          80             : ! !OUTPUT PARAMETERS:
          81             : !
          82             :     INTEGER,          INTENT(OUT) :: imat             ! Number of matches
          83             :     INTEGER,          OPTIONAL    :: Locations(255)   ! Positions of matches
          84             : !
          85             : ! !REVISION HISTORY:
          86             : !     DATE:   JAN. 6, 1995
          87             : !     AUTHOR: R.D. STEWART
          88             : !     COMMENTS: Revised slightly (2-5-1996) so that trailing
          89             : !               blanks in str1 are ignored.  Revised again
          90             : !               on 3-6-1996.
          91             : !  See https://github.com/geoschem/hemco for complete history
          92             : !EOP
          93             : !------------------------------------------------------------------------------
          94             : !BOC
          95             : !
          96             : ! !LOCAL VARIABLES:
          97             : !
          98             :     ! Scalars
          99             :     INTEGER :: L1, L2, i, j
         100             :     LOGICAL :: again
         101             :
         102             :     ! Arrays
         103             :     INTEGER :: TmpLocations(255)
         104             :
         105             :     ! Initialize
         106           0 :     TmpLocations = 0
         107           0 :     L1           = MAX(1,LEN_TRIM(str1))
         108           0 :     L2           = LEN(str2)
         109           0 :     imat         = 0
         110             :
         111           0 :     DO i=1,L1
         112             :        again = .true.
         113             :        j = 1
         114           0 :        DO WHILE (again)
         115           0 :           IF (str2(j:j).EQ.str1(i:i)) THEN
         116           0 :              imat               = imat+1
         117           0 :              TmpLocations(imat) = i
         118           0 :              again              = .false.
         119           0 :           ELSEIF (j.LT.L2) THEN
         120           0 :              j=j+1
         121             :           ELSE
         122             :              again = .false.
         123             :           ENDIF
         124             :        ENDDO
         125             :     ENDDO
         126             :
         127             :     ! Return positions where matches occured (OPTIONAL)
         128           0 :     IF ( PRESENT( Locations ) ) Locations = TmpLocations
         129             :
         130           0 :   END SUBROUTINE CntMat
         131             : !EOC
         132             : !------------------------------------------------------------------------------
         133             : !                   Harmonized Emissions Component (HEMCO)                    !
         134             : !------------------------------------------------------------------------------
         135             : !BOP
         136             : !
         137             : ! !IROUTINE: CopyTxt
         138             : !
         139             : ! !DESCRIPTION: Write all of the characters in str1 into variable
         140             : !               str2 beginning at column, col.  If the length of str1
         141             : !               + col is longer than the number of characters str2
         142             : !               can store, some characters will not be transfered to
         143             : !               str2.  Any characters already existing in str2 will
         144             : !               will be overwritten.
         145             : !\\
         146             : !\\
         147             : ! !INTERFACE:
         148             : !
         149           0 :   SUBROUTINE CopyTxt( col, str1, str2 )
         150             : !
         151             : ! !INPUT PARAMETERS:
         152             : !
         153             :     INTEGER,          INTENT(IN)    :: col
         154             :     CHARACTER(LEN=*), INTENT(IN)    :: str1
         155             : !
         156             : ! !OUTPUT PARAMETERS:
         157             : !
         158             :     CHARACTER(LEN=*), INTENT(INOUT) :: str2
         159             : !
         160             : ! !REVISION HISTORY:
         161             : !     DATE:   DEC. 24, 1993
         162             : !     AUTHOR: R.D. STEWART
         163             : !  See https://github.com/geoschem/hemco for complete history
         164             : !EOP
         165             : !------------------------------------------------------------------------------
         166             : !BOC
         167             : !
         168             : ! !LOCAL VARIABLES:
         169             : !
         170             :     INTEGER :: ilt1,i1,i,j,ic
         171             :
         172           0 :     i1 = LEN(str2)
         173           0 :     IF (i1.GT.0) THEN
         174           0 :        ilt1 = LEN(str1)
         175           0 :        IF (ilt1.GT.0) THEN
         176           0 :           ic = MAX0(col,1)
         177           0 :           i = 1
         178           0 :           j = ic
         179           0 :           DO WHILE ((i.LE.ilt1).and.(j.LE.i1))
         180           0 :              str2(j:j) = str1(i:i)
         181           0 :              i = i + 1
         182           0 :              j = ic + (i-1)
         183             :           ENDDO
         184             :        ENDIF
         185             :     ENDIF
         186             :
         187           0 :   END SUBROUTINE CopyTxt
         188             : !EOC
         189             : !------------------------------------------------------------------------------
         190             : !                   Harmonized Emissions Component (HEMCO)                    !
         191             : !------------------------------------------------------------------------------
         192             : !BOP
         193             : !
         194             : ! !IROUTINE: Cstrip
         195             : !
         196             : ! !DESCRIPTION: Strip blanks and null characters for the variable TEXT.
         197             : !\\
         198             : !\\
         199             : ! !INTERFACE:
         200             : !
         201           0 :   SUBROUTINE CStrip( text, KeepSpaces )
         202             : !
         203             : ! !INPUT PARAMETERS:
         204             : !
         205             :     LOGICAL,          OPTIONAL      :: KeepSpaces ! If =T, then keep spaces
         206             :                                                   !  but skip all other
         207             :                                                   !  non-printing chars
         208             : !
         209             : ! !INPUT/OUTPUT PARAMETERS:
         210             : !
         211             :     CHARACTER(LEN=*), INTENT(INOUT) :: TEXT       ! Text to be modified
         212             : !
         213             : ! !REMARKS:
         214             : !  The original "text" is destroyed upon exit.
         215             : !
         216             : ! !REVISION HISTORY:
         217             : !      AUTHOR: Robert D. Stewart
         218             : !        DATE: May 19, 1992
         219             : !  See https://github.com/geoschem/hemco for complete history
         220             : !EOP
         221             : !------------------------------------------------------------------------------
         222             : !BOC
         223             : !
         224             : ! !LOCAL VARIABLES:
         225             : !
         226             :     INTEGER          :: ilen, iasc, icnt, i, Start
         227             :     CHARACTER(LEN=1) :: ch
         228             :
         229             :     ! Default: Skip space characters
         230           0 :     Start = 32
         231             :
         232             :     ! If KEEPSPACES=T then skip all non-printing characters,
         233             :     ! but keep space characters. (bmy, 1/30/18)
         234           0 :     IF ( PRESENT( KeepSpaces ) ) THEN
         235           0 :        IF ( KeepSpaces ) Start = 31
         236             :     ENDIF
         237             :
         238           0 :     ilen = LEN(text)
         239           0 :     IF (ilen.GT.1) THEN
         240             :        icnt = 1
         241           0 :        DO i=1,ilen
         242           0 :           iasc = ICHAR(text(i:i))
         243             :
         244             :           ! Keep characters between these limits
         245           0 :           IF ( ( iasc > Start ).AND. (iasc < 255 ) ) THEN
         246           0 :              ch = text(i:i)
         247           0 :              text(icnt:icnt) = ch
         248           0 :              icnt = icnt + 1
         249             :           ENDIF
         250             :        ENDDO
         251             :        ! Fill remainder of text with blanks
         252           0 :        DO i=icnt,ilen
         253           0 :           text(i:i) = ' '
         254             :        ENDDO
         255             :     ENDIF
         256             :
         257           0 :   END SUBROUTINE CStrip
         258             : !EOC
         259             : !------------------------------------------------------------------------------
         260             : !                   Harmonized Emissions Component (HEMCO)                    !
         261             : !------------------------------------------------------------------------------
         262             : !BOP
         263             : !
         264             : ! !IROUTINE: IsDigit
         265             : !
         266             : ! !DESCRIPTION: Returned as true if ch is a numeric character (i.e., one of
         267             : !  the numbers from 0 to 9).
         268             : !\\
         269             : !\\
         270             : ! !INTERFACE:
         271             : !
         272           0 :   FUNCTION IsDigit( ch ) RESULT( lnum )
         273             : !
         274             : ! !INPUT PARAMETERS:
         275             : !
         276             :     CHARACTER(LEN=1), INTENT(IN) :: ch
         277             : !
         278             : ! !RETURN VALUE:
         279             : !
         280             :     LOGICAL                      :: lnum
         281             : !
         282             : ! !REMARKS:
         283             : !  NOTE: Changed name from ISNUM to ISDIGIT (bmy, 7/15/04)
         284             : !
         285             : ! !REVISION HISTORY:
         286             : !     DATE:   NOV. 11, 1993
         287             : !     AUTHOR: R.D. STEWART
         288             : !  See https://github.com/geoschem/hemco for complete history
         289             : !EOP
         290             : !------------------------------------------------------------------------------
         291             : !BOC
         292             : !
         293             : ! !LOCAL VARIABLES:
         294             : !
         295             :     INTEGER iasc
         296             :
         297           0 :     iasc = ICHAR(ch)
         298           0 :     lnum = .FALSE.
         299           0 :     IF ((iasc.GE.48).AND.(iasc.LE.57)) THEN
         300           0 :        lnum = .TRUE.
         301             :     ENDIF
         302             :
         303           0 :   END FUNCTION IsDigit
         304             : !EOC
         305             : !------------------------------------------------------------------------------
         306             : !                   Harmonized Emissions Component (HEMCO)                    !
         307             : !------------------------------------------------------------------------------
         308             : !BOP
         309             : !
         310             : ! !IROUTINE: StrRepl
         311             : !
         312             : ! !DESCRIPTION: Subroutine StrRepl replaces all instances of PATTERN within
         313             : !  a string STR with replacement text REPLTXT.
         314             : !\\
         315             : !\\
         316             : ! !INTERFACE:
         317             : !
         318           0 :   SUBROUTINE StrRepl( Str, Pattern, ReplTxt )
         319             : !
         320             : ! !INPUT PARAMETERS:
         321             : !
         322             :     CHARACTER(LEN=*), INTENT(IN)    :: Pattern   ! Pattern to search for
         323             :     CHARACTER(LEN=*), INTENT(IN)    :: ReplTxt   ! Text to replace
         324             : !
         325             : ! !INPUT/OUTPUT PARAMETERS:
         326             : !
         327             :     CHARACTER(LEN=*), INTENT(INOUT) :: Str       ! String to be manipulated
         328             : !
         329             : ! !REMARKS:
         330             : !  PATTERN and REPLTXT can now have a different number of characters.
         331             : !
         332             : ! !REVISION HISTORY:
         333             : !  25 Jun 2002 - R. Yantosca - Initial version
         334             : !  See https://github.com/geoschem/hemco for complete history
         335             : !EOP
         336             : !------------------------------------------------------------------------------
         337             : !BOC
         338             : !
         339             : ! !LOCAL VARIABLES:
         340             : !
         341             :     ! Local variables
         342             :     INTEGER :: I1, I2
         343             :
         344             :     !=================================================================
         345             :     ! StrRepl begins here!
         346             :     !=================================================================
         347           0 :     DO
         348             :
         349             :        ! I1 is the first character that matches the search pattern;
         350             :        ! it must be 1 or larger.  Otherwise exit the routine.
         351           0 :        I1 = INDEX( Str, Pattern )
         352           0 :        IF ( I1 < 1 ) RETURN
         353             :
         354             :        ! Replace the text.  I2 is the starting position of the
         355             :        ! string following the point of text replacement.
         356           0 :        I2 = I1 + LEN( Pattern )
         357           0 :        Str = Str(1:I1-1) // ReplTxt // Str(I2:)
         358             :
         359             :     ENDDO
         360             :
         361           0 :   END SUBROUTINE StrRepl
         362             : !EOC
         363             : !------------------------------------------------------------------------------
         364             : !                   Harmonized Emissions Component (HEMCO)                    !
         365             : !------------------------------------------------------------------------------
         366             : !BOP
         367             : !
         368             : ! !IROUTINE: StrSplit
         369             : !
         370             : ! !DESCRIPTION: Subroutine STRSPLIT returns substrings in a string, separated
         371             : !  by a separator character (similar to IDL's StrSplit function).  This is
         372             : !  mainly a convenience wrapper for CHARPAK routine TxtExt.
         373             : !\\
         374             : !\\
         375             : ! !INTERFACE:
         376             : !
         377           0 :   SUBROUTINE StrSplit( Str, Sep, Result, N_SubStrs )
         378             : !
         379             : ! !INPUT PARAMETERS:
         380             : !
         381             :     CHARACTER(LEN=*), INTENT(IN)  :: STR           ! String to be searched
         382             :     CHARACTER(LEN=1), INTENT(IN)  :: SEP           ! Separator character
         383             : !
         384             : ! !OUTPUT PARAMETERS:
         385             : !
         386             :     CHARACTER(LEN=*), INTENT(OUT) :: Result(255)   ! Returned substrings
         387             :     INTEGER,          OPTIONAL    :: N_SubStrs     ! # of substrings
         388             : !
         389             : ! !REVISION HISTORY:
         390             : !  11 Jul 2002 - R. Yantosca - Initial version
         391             : !  See https://github.com/geoschem/hemco for complete history
         392             : !EOP
         393             : !------------------------------------------------------------------------------
         394             : !BOC
         395             : !
         396             : ! !LOCAL VARIABLES:
         397             : !
         398             :     INTEGER             :: I, IFLAG, COL
         399             :     CHARACTER(LEN=2047) :: WORD
         400             :
         401             :     !=======================================================================
         402             :     ! STRSPLIT begins here!
         403             :     !=======================================================================
         404             :
         405             :     ! Initialize
         406           0 :     I         = 0
         407           0 :     COL       = 1
         408           0 :     IFLAG     = 0
         409           0 :     RESULT(:) = ''
         410             :
         411             :     ! Loop until all matches found, or end of string
         412           0 :     DO WHILE ( IFLAG == 0 )
         413             :
         414             :        ! Look for strings beteeen separator string
         415           0 :        CALL TXTEXT ( SEP, TRIM( STR ), COL, WORD, IFLAG )
         416             :
         417             :        ! Store substrings in RESULT array
         418           0 :        I         = I + 1
         419           0 :        RESULT(I) = TRIM( WORD )
         420             :
         421             :     ENDDO
         422             :
         423             :     ! Optional argument: return # of substrings found
         424           0 :     IF ( PRESENT( N_SUBSTRS ) ) N_SUBSTRS = I
         425             :
         426           0 :   END SUBROUTINE StrSplit
         427             : !EOC
         428             : !------------------------------------------------------------------------------
         429             : !                   Harmonized Emissions Component (HEMCO)                    !
         430             : !------------------------------------------------------------------------------
         431             : !BOP
         432             : !
         433             : ! !IROUTINE: StrSqueeze
         434             : !
         435             : ! !DESCRIPTION: Subroutine STRSQUEEZE strips white space from both ends of a
         436             : !  string.  White space in the middle of the string (i.e. between characters)
         437             : !  will be preserved as-is.  Somewhat similar (though not exactly) to IDL's
         438             : !  STRCOMPRESS function.
         439             : !\\
         440             : !\\
         441             : ! !INTERFACE:
         442             : !
         443           0 :   SUBROUTINE StrSqueeze( Str )
         444             : !
         445             : ! !INPUT/OUTPUT PARAMETERS:
         446             : !
         447             :     CHARACTER(LEN=*), INTENT(INOUT) :: Str   ! String to be squeezed
         448             : !
         449             : ! !REVISION HISTORY:
         450             : !  11 Jul 2002 - R. Yantosca - Initial version
         451             : !  See https://github.com/geoschem/hemco for complete history
         452             : !EOP
         453             : !------------------------------------------------------------------------------
         454             : !BOC
         455             :     !=================================================================
         456             :     ! STRSQUEEZE begins here!
         457             :     !=================================================================
         458           0 :     Str = ADJUSTR( TRIM( Str ) )
         459           0 :     Str = ADJUSTL( TRIM( Str ) )
         460             :
         461           0 :   END SUBROUTINE StrSqueeze
         462             : !EOC
         463             : !------------------------------------------------------------------------------
         464             : !                   Harmonized Emissions Component (HEMCO)                    !
         465             : !------------------------------------------------------------------------------
         466             : !BOP
         467             : !
         468             : ! !IROUTINE: TranLc
         469             : !
         470             : ! !DESCRIPTION: Tranlate a character variable to all lowercase letters.
         471             : !               Non-alphabetic characters are not affected.
         472             : !\\
         473             : !\\
         474             : ! !INTERFACE:
         475             : !
         476           0 :   SUBROUTINE TranLc( text )
         477             : !
         478             : ! !INPUT/OUTPUT PARAMETERS:
         479             : !
         480             :     CHARACTER(LEN=*) :: text
         481             : !
         482             : ! !REMARKS:
         483             : !  The original "text" is destroyed.
         484             : !
         485             : ! !REVISION HISTORY:
         486             : !      AUTHOR: Robert D. Stewart
         487             : !        DATE: May 19, 1992
         488             : !  See https://github.com/geoschem/hemco for complete history
         489             : !EOP
         490             : !------------------------------------------------------------------------------
         491             : !BOC
         492             : !
         493             : ! !LOCAL VARIABLES:
         494             : !
         495             :     INTEGER :: iasc,i,ilen
         496             :
         497           0 :     ilen = LEN(text)
         498           0 :     DO I=1,ilen
         499           0 :        iasc = ICHAR(text(i:i))
         500           0 :        IF ((iasc.GT.64).AND.(iasc.LT.91)) THEN
         501           0 :           text(i:i) = CHAR(iasc+32)
         502             :        ENDIF
         503             :     ENDDO
         504             :
         505           0 :   END SUBROUTINE TRANLC
         506             : !EOC
         507             : !------------------------------------------------------------------------------
         508             : !                   Harmonized Emissions Component (HEMCO)                    !
         509             : !------------------------------------------------------------------------------
         510             : !BOP
         511             : !
         512             : ! !IROUTINE: TranUc
         513             : !
         514             : ! !DESCRIPTION: Tranlate a character variable to all upper case letters.
         515             : !               Non-alphabetic characters are not affected.
         516             : !\\
         517             : !\\
         518             : ! !INTERFACE:
         519             : !
         520           0 :   SUBROUTINE TranUc( text )
         521             : !
         522             : ! !INPUT/OUTPUT PARAMETERS:
         523             : !
         524             :     CHARACTER(LEN=*) :: text
         525             : !
         526             : ! !REMARKS:
         527             : !  The original "text" is destroyed.
         528             : !
         529             : ! !REVISION HISTORY:
         530             : !      AUTHOR: Robert D. Stewart
         531             : !        DATE: May 19, 1992
         532             : !  See https://github.com/geoschem/hemco for complete history
         533             : !EOP
         534             : !------------------------------------------------------------------------------
         535             : !BOC
         536             : !
         537             : ! !LOCAL VARIABLES:
         538             : !
         539             :     INTEGER :: iasc,i,ilen
         540             :
         541           0 :     ilen = LEN(text)
         542           0 :     DO i=1,ilen
         543           0 :        iasc = ICHAR(text(i:i))
         544           0 :        IF ((iasc.GT.96).AND.(iasc.LT.123)) THEN
         545           0 :           text(i:i) = CHAR(iasc-32)
         546             :        ENDIF
         547             :     ENDDO
         548             :
         549           0 :   END SUBROUTINE TRANUC
         550             : !EOC
         551             : !------------------------------------------------------------------------------
         552             : !                   Harmonized Emissions Component (HEMCO)                    !
         553             : !------------------------------------------------------------------------------
         554             : !BOP
         555             : !
         556             : ! !IROUTINE: TxtExt
         557             : !
         558             : ! !DESCRIPTION: TxtExt extracts a sequence of characters from
         559             : !               text and transfers them to word.  The extraction
         560             : !               procedure uses a set of character "delimiters"
         561             : !               to denote the desired sequence of characters.
         562             : !               For example if ch=' ', the first character sequence
         563             : !               bracketed by blank spaces will be returned in word.
         564             : !               The extraction procedure begins in column, col,
         565             : !               of TEXT.  If text(col:col) = ch (any character in
         566             : !               the character string), the text is returned beginning
         567             : !               with col+1 in text (i.e., the first match with ch
         568             : !               is ignored).
         569             : !\\
         570             : !\\
         571             : !               After completing the extraction, col is incremented to
         572             : !               the location of the first character following the
         573             : !               end of the extracted text.
         574             : !\\
         575             : !\\
         576             : !               A status flag is also returned with the following
         577             : !               meaning(s)
         578             : !\\
         579             : !\\
         580             : !               IF iflg = -1, found a text block, but no more characters
         581             : !                             are available in TEXT
         582             : !                  iflg = 0,  task completed sucessfully (normal term)
         583             : !                  iflg = 1,  ran out of text before finding a block of
         584             : !                             text.
         585             : !\\
         586             : !\\
         587             : ! !INTERFACE:
         588             : !
         589           0 :   SUBROUTINE TxtExt(ch,text,col,word,iflg)
         590             : !
         591             : ! !INPUT PARAMETERS:
         592             : !
         593             :     CHARACTER(LEN=*), INTENT(IN)    :: ch,text
         594             : !
         595             : ! !INPUT/OUTPUT PARAMETERS:
         596             : !
         597             :     INTEGER,          INTENT(INOUT) :: col
         598             : !
         599             : ! !OUTPUT PARAMETERS:
         600             : !
         601             :     CHARACTER(LEN=*), INTENT(OUT)   :: word
         602             :     INTEGER                         :: iflg
         603             : !
         604             : ! !REMARKS:
         605             : !  TxtExt is short for Text Extraction.  This routine provides a set of
         606             : !  powerful line-by-line text search and extraction capabilities in
         607             : !  standard FORTRAN.
         608             : !
         609             : ! !REVISION HISTORY:
         610             : !      AUTHOR: Robert D. Stewart
         611             : !        DATE: Jan. 1st, 1995
         612             : !  See https://github.com/geoschem/hemco for complete history
         613             : !EOP
         614             : !------------------------------------------------------------------------------
         615             : !BOC
         616             : !
         617             : ! !LOCAL VARIABLES:
         618             : !
         619             :     INTEGER :: Tmax,T1,T2,imat
         620             :     LOGICAL :: again,prev
         621             :
         622             :     ! Length of text
         623           0 :     Tmax = LEN(text)
         624             :
         625             :     ! Fill Word with blanks
         626           0 :     WORD = REPEAT( ' ', LEN( WORD ) )
         627             :
         628           0 :     IF (col.GT.Tmax) THEN
         629             :        ! Text does not contain any characters past Tmax.
         630             :        ! Reset col to one and return flag = {error condition}
         631           0 :        iflg = 1
         632           0 :        col = 1
         633           0 :     ELSEIF (col.EQ.Tmax) THEN
         634             :        ! End of TEXT reached
         635           0 :        CALL CntMat(ch,text(Tmax:Tmax),imat)
         636           0 :        IF (imat.EQ.0) THEN
         637             :           ! Copy character into Word and set col=1
         638           0 :           CALL CopyTxt(1,Text(Tmax:Tmax),Word)
         639           0 :           col = 1
         640           0 :           iflg = -1
         641             :        ELSE
         642             :           ! Same error condition as if col.GT.Tmax
         643           0 :           iflg = 1
         644             :        ENDIF
         645             :     ELSE
         646             :        ! Make sure column is not less than 1
         647           0 :        IF (col.LT.1) col=1
         648           0 :        CALL CntMat(ch,text(col:col),imat)
         649           0 :        IF (imat.GT.0) THEN
         650             :           prev=.true.
         651             :        ELSE
         652           0 :           prev=.false.
         653             :        ENDIF
         654           0 :        T1=col
         655           0 :        T2 = T1
         656             :
         657           0 :        again = .true.
         658           0 :        DO WHILE (again)
         659             :           ! Check for a match with a character in ch
         660           0 :           CALL CntMat(ch,text(T2:T2),imat)
         661           0 :           IF (imat.GT.0) THEN
         662             :              ! Current character in TEXT matches one (or more) of the
         663             :              ! characters in ch.
         664           0 :              IF (prev) THEN
         665           0 :                 IF (T2.LT.Tmax) THEN
         666             :                    ! Keep searching for a block of text
         667           0 :                    T2=T2+1
         668           0 :                    T1=T2
         669             :                 ELSE
         670             :                    ! Did not find any text blocks before running
         671             :                    ! out of characters in TEXT.
         672           0 :                    again=.false.
         673           0 :                    iflg=1
         674             :                 ENDIF
         675             :              ELSE
         676             :                  ! Previous character did not match ch, so terminate.
         677             :                  ! NOTE: This is "NORMAL" termination of the loop
         678           0 :                 again=.false.
         679           0 :                 T2=T2-1
         680           0 :                 iflg = 0
         681             :              ENDIF
         682           0 :           ELSEIF (T2.LT.Tmax) THEN
         683             :              ! Add a letter to the current block of text
         684           0 :              prev = .false.
         685           0 :              T2=T2+1
         686             :           ELSE
         687             :              ! Reached the end of the characters in TEXT before reaching
         688             :              ! another delimiting character.  A text block was identified
         689             :              ! however.
         690           0 :              again=.false.
         691           0 :              iflg=-1
         692             :           ENDIF
         693             :        ENDDO
         694             :
         695           0 :        IF (iflg.EQ.0) THEN
         696             :           ! Copy characters into WORD and set col for return
         697           0 :           CALL CopyTxt(1,Text(T1:T2),Word)
         698           0 :           col = T2+1
         699             :        ELSE
         700             :           ! Copy characters into WORD and set col for return
         701           0 :           CALL CopyTxt(1,Text(T1:T2),Word)
         702           0 :           col = 1
         703             :        ENDIF
         704             :     ENDIF
         705             :
         706           0 :   END SUBROUTINE TxtExt
         707             : !EOC
         708             : !------------------------------------------------------------------------------
         709             : !                   Harmonized Emissions Component (HEMCO)                    !
         710             : !------------------------------------------------------------------------------
         711             : !BOP
         712             : !
         713             : ! !IROUTINE: Str2Hash14
         714             : !
         715             : ! !DESCRIPTION: Returns a unique integer hash for a given character string.
         716             : !  This allows us to implement a fast name lookup algorithm.
         717             : !\\
         718             : !\\
         719             : ! !INTERFACE:
         720             : !
         721           0 :   FUNCTION Str2Hash14( Str ) RESULT( Hash )
         722             : !
         723             : ! !INPUT PARAMETERS:
         724             : !
         725             :     CHARACTER(LEN=14), INTENT(IN) :: Str    ! String (14 chars long)
         726             : !
         727             : ! !RETURN VALUE:
         728             : !
         729             :     INTEGER                       :: Hash   ! Hash value from string
         730             : !
         731             : ! !REMARKS:
         732             : !  (1) Algorithm taken from this web page:
         733             : !       https://fortrandev.wordpress.com/2013/07/06/fortran-hashing-algorithm/
         734             : !
         735             : !  (2) For now, we only use the first 14 characers of the character string
         736             : !       to compute the hash value.  Most GEOS-Chem species names only use
         737             : !       at most 14 unique characters.  We can change this later if need be.
         738             : !
         739             : ! !REVISION HISTORY:
         740             : !  04 May 2016 - R. Yantosca - Initial version
         741             : !  See https://github.com/geoschem/hemco for complete history
         742             : !EOP
         743             : !------------------------------------------------------------------------------
         744             : !BOC
         745             : !
         746             : ! !LOCAL VARIABLES:
         747             : !
         748             :     ! Initialize
         749           0 :     Hash = 5381
         750             :
         751             :     !-----------------------------------------------------------------------
         752             :     ! Construct the hash from the first 14 characters of the string,
         753             :     ! which is about the longest species name for GEOS-Chem.
         754             :     !
         755             :     ! NOTE: It's MUCH faster to explicitly write these statements
         756             :     ! instead of writing them using a DO loop (bmy, 5/4/16)
         757             :     !-----------------------------------------------------------------------
         758           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 1: 1) )
         759           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 2: 2) )
         760           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 3: 3) )
         761           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 4: 4) )
         762           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 5: 5) )
         763           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 6: 6) )
         764           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 7: 7) )
         765           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 8: 8) )
         766           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 9: 9) )
         767           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(10:10) )
         768           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(11:11) )
         769           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(12:12) )
         770           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(13:13) )
         771           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(14:14) )
         772             :
         773           0 :   END FUNCTION Str2Hash14
         774             : !EOC
         775             : !------------------------------------------------------------------------------
         776             : !                   Harmonized Emissions Component (HEMCO)                    !
         777             : !------------------------------------------------------------------------------
         778             : !BOP
         779             : !
         780             : ! !IROUTINE: Str2Hash
         781             : !
         782             : ! !DESCRIPTION: Returns a unique integer hash for a given character string.
         783             : !  This allows us to implement a fast name lookup algorithm.
         784             : !\\
         785             : !\\
         786             : ! !INTERFACE:
         787             : !
         788           0 :   FUNCTION Str2Hash31( Str ) RESULT( Hash )
         789             : !
         790             : ! !INPUT PARAMETERS:
         791             : !
         792             :     CHARACTER(LEN=31), INTENT(IN) :: Str    ! String (31 chars long)
         793             : !
         794             : ! !RETURN VALUE:
         795             : !
         796             :     INTEGER                       :: Hash   ! Hash value from string
         797             : !
         798             : ! !REMARKS:
         799             : !  (1) Algorithm taken from this web page:
         800             : !       https://fortrandev.wordpress.com/2013/07/06/fortran-hashing-algorithm/
         801             : !
         802             : !  (2) For now, we only use the first 31 characers of the character string
         803             : !       to compute the hash value.  Most GEOS-Chem variable names only use
         804             : !       up to 31 unique characters.  We can change this later if need be.
         805             : !
         806             : ! !REVISION HISTORY:
         807             : !  26 Jun 2017 - R. Yantosca - Initial version
         808             : !  See https://github.com/geoschem/hemco for complete history
         809             : !EOP
         810             : !------------------------------------------------------------------------------
         811             : !BOC
         812             : !
         813             : ! !LOCAL VARIABLES:
         814             : !
         815             :     ! Initialize
         816           0 :     Hash = 5381
         817             :
         818             :     !-----------------------------------------------------------------------
         819             :     ! Construct the hash from the first 31 characters of the string,
         820             :     ! which is about the longest variable name for GEOS-Chem.
         821             :     !
         822             :     ! NOTE: It's MUCH faster to explicitly write these statements
         823             :     ! instead of writing them using a DO loop.
         824             :     !-----------------------------------------------------------------------
         825           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 1: 1) )
         826           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 2: 2) )
         827           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 3: 3) )
         828           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 4: 4) )
         829           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 5: 5) )
         830           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 6: 6) )
         831           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 7: 7) )
         832           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 8: 8) )
         833           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str( 9: 9) )
         834           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(10:10) )
         835           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(11:11) )
         836           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(12:12) )
         837           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(13:13) )
         838           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(14:14) )
         839           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(15:15) )
         840           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(16:16) )
         841           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(17:17) )
         842           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(18:18) )
         843           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(19:19) )
         844           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(20:20) )
         845           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(21:21) )
         846           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(22:22) )
         847           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(23:23) )
         848           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(24:24) )
         849           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(25:25) )
         850           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(26:26) )
         851           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(27:27) )
         852           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(28:28) )
         853           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(29:29) )
         854           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(30:30) )
         855           0 :     Hash = ( ISHFT( Hash, 5 ) + Hash ) + ICHAR( Str(31:31) )
         856             :
         857           0 :   END FUNCTION Str2Hash31
         858             : !EOC
         859             : !------------------------------------------------------------------------------
         860             : !                   Harmonized Emissions Component (HEMCO)                    !
         861             : !------------------------------------------------------------------------------
         862             : !BOP
         863             : !
         864             : ! !IROUTINE: To_Uppercase
         865             : !
         866             : ! !DESCRIPTION: Converts a string to uppercase, so that we can reliably
         867             : !  do string matching.
         868             : !\\
         869             : !\\
         870             : ! !INTERFACE:
         871             : !
         872           0 :   FUNCTION To_UpperCase( Text ) RESULT( UpCaseText )
         873             : !
         874             : ! !INPUT PARAMETERS:
         875             : !
         876             :     CHARACTER(LEN=*), INTENT(IN) :: Text         ! Input test
         877             : !
         878             : ! !RETURN VALUE:
         879             : !
         880             :     CHARACTER(LEN=255)           :: UpCaseText   ! Output text, uppercase
         881             : !
         882             : ! !REMARKS:
         883             : !  Code originally from routine TRANUC (Author: R. D. Stewart, 19 May 1992)
         884             : !
         885             : ! !REVISION HISTORY:
         886             : !  26 Jun 2017 - R. Yantosca - Initial version
         887             : !  See https://github.com/geoschem/hemco for complete history
         888             : !EOP
         889             : !------------------------------------------------------------------------------
         890             : !BOC
         891             : !
         892             : ! !LOCAL VARIABLES:
         893             : !
         894             :     ! Scalars
         895             :     INTEGER :: C, Ascii
         896             :
         897             :     !=======================================================================
         898             :     ! Convert to uppercase
         899             :     !=======================================================================
         900             :
         901             :     ! Initialize
         902           0 :     UpCaseText = Text
         903             :
         904             :     ! Loop over all characters
         905           0 :     DO C = 1, LEN_TRIM( UpCaseText )
         906             :
         907             :        ! Get the ASCII code for each character
         908           0 :        Ascii = ICHAR( UpCaseText(C:C) )
         909             :
         910             :        ! If lowercase, convert to uppercase
         911           0 :        IF ( Ascii > 96 .and. Ascii < 123 ) THEN
         912           0 :           UpCaseText(C:C) = CHAR( Ascii - 32 )
         913             :        ENDIF
         914             :     ENDDO
         915             :
         916           0 :   END FUNCTION To_UpperCase
         917             : !EOC
         918             : !------------------------------------------------------------------------------
         919             : !                   Harmonized Emissions Component (HEMCO)                    !
         920             : !------------------------------------------------------------------------------
         921             : !BOP
         922             : !
         923             : ! !IROUTINE: ReadOneLine
         924             : !
         925             : ! !DESCRIPTION: Subroutine READ\_ONE\_LINE reads a line from the input file.
         926             : !  If the global variable VERBOSE is set, the line will be printed to stdout.
         927             : !  READ\_ONE\_LINE can trap an unexpected EOF if LOCATION is passed.
         928             : !  Otherwise, it will pass a logical flag back to the calling routine,
         929             : !  where the error trapping will be done.
         930             : !\\
         931             : !\\
         932             : ! !INTERFACE:
         933             : !
         934           0 :   FUNCTION ReadOneLine( fId, EndOfFile, IoStatus, Squeeze ) RESULT( Line )
         935             : !
         936             : ! !INPUT PARAMETERS:
         937             : !
         938             :     INTEGER, INTENT(IN)      :: fId        ! File unit number
         939             :     LOGICAL, OPTIONAL        :: Squeeze    ! Call Strsqueeze?
         940             : !
         941             : ! !OUTPUT PARAMETERS:
         942             : !
         943             :     LOGICAL, INTENT(OUT)     :: EndOfFile  ! Denotes EOF condition
         944             :     INTEGER, INTENT(OUT)     :: IoStatus   ! I/O status code
         945             : !
         946             : ! !RETURN VALUE:
         947             : !
         948             :     CHARACTER(LEN=MAXSTRLEN) :: Line       ! Single line from the input file
         949             : !
         950             : ! !REMARKS:
         951             : !  Mostly used by routines in the History/ folder.
         952             : !
         953             : ! !REVISION HISTORY:
         954             : !  16 Jun 2017 - R. Yantosca - Initial version, based on GEOS-Chem
         955             : !  See https://github.com/geoschem/hemco for complete history
         956             : !EOP
         957             : !------------------------------------------------------------------------------
         958             : !BOC
         959             :
         960             :     !=================================================================
         961             :     ! Initialize
         962             :     !=================================================================
         963           0 :     EndOfFile = .FALSE.
         964           0 :     IoStatus  = 0
         965           0 :     Line      = ''
         966             :
         967             :     !=================================================================
         968             :     ! Read data from the file
         969             :     !=================================================================
         970             :
         971             :     ! Read a line from the file
         972           0 :     READ( fId, '(a)', IOSTAT=IoStatus ) Line
         973             :
         974             :     ! IO Status < 0: EOF condition
         975           0 :     IF ( IoStatus < 0 ) THEN
         976           0 :        EndOfFile = .TRUE.
         977           0 :        RETURN
         978             :     ENDIF
         979             :
         980             :     ! If desired, call StrSqueeze to strip leading and trailing blanks
         981           0 :     IF ( PRESENT( Squeeze ) ) THEN
         982           0 :        IF ( Squeeze ) THEN
         983           0 :           CALL StrSqueeze( Line )
         984             :        ENDIF
         985             :     ENDIF
         986             :
         987             :   END FUNCTION ReadOneLine
         988             : !EOC
         989             : !------------------------------------------------------------------------------
         990             : !                   Harmonized Emissions Component (HEMCO)                    !
         991             : !------------------------------------------------------------------------------
         992             : !BOP
         993             : !
         994             : ! !IROUTINE: CleanText
         995             : !
         996             : ! !DESCRIPTION: Strips commas, apostrophes, spaces, and tabs from a string.
         997             : !\\
         998             : !\\
         999             : ! !INTERFACE:
        1000             : !
        1001           0 :   FUNCTION CleanText( Str ) RESULT( CleanStr )
        1002             : !
        1003             : ! !INPUT PARAMETERS:
        1004             : !
        1005             :     CHARACTER(LEN=*), INTENT(IN) :: Str        ! Original string
        1006             : !
        1007             : ! !RETURN VALUE
        1008             : !
        1009             :     CHARACTER(LEN=255)           :: CleanStr   ! Cleaned-up string
        1010             : !
        1011             : ! !REMARKS:
        1012             : !  Mostly used by routines in the History/ folder.
        1013             : !
        1014             : ! !REVISION HISTORY:
        1015             : !  06 Jan 2015 - R. Yantosca - Initial version
        1016             : !  See https://github.com/geoschem/hemco for complete history
        1017             : !EOP
        1018             : !------------------------------------------------------------------------------
        1019             : !BOC
        1020             :
        1021             :     ! Initialize
        1022           0 :     CleanStr = Str
        1023             :
        1024             :     ! Strip out non-printing characters (e.g. tabs)
        1025           0 :     CALL CStrip    ( CleanStr           )
        1026             :
        1027             :     ! Remove commas and quotes
        1028           0 :     CALL StrRepl   ( CleanStr, ",", " " )
        1029           0 :     CALL StrRepl   ( CleanStr, "'", " " )
        1030             :
        1031             :     ! Remove leading and trailing spaces
        1032           0 :     CALL StrSqueeze( CleanStr           )
        1033             :
        1034           0 :   END FUNCTION CleanText
        1035             : !EOC
        1036             : !------------------------------------------------------------------------------
        1037             : !                   Harmonized Emissions Component (HEMCO)                    !
        1038             : !------------------------------------------------------------------------------
        1039             : !BOP
        1040             : !
        1041             : ! !IROUTINE: WordWrapPrint
        1042             : !
        1043             : ! !DESCRIPTION: Prints a text string wrapped to a specified line width.
        1044             : !  Useful for displaying error and warning messages.
        1045             : !\\
        1046             : !\\
        1047             : ! !INTERFACE:
        1048             : !
        1049           0 :   SUBROUTINE WordWrapPrint( Text, LineWidth, Delimiter )
        1050             : !
        1051             : ! !INPUT PARAMETERS:
        1052             : !
        1053             :     CHARACTER(LEN=*), INTENT(IN) :: Text        ! Text to print
        1054             :     INTEGER,          INTENT(IN) :: LineWidth   ! Width (characters) of lines
        1055             :     CHARACTER(LEN=1), OPTIONAL   :: Delimiter   ! Delimiter between words
        1056             : !
        1057             : ! !REMARKS:
        1058             : !  The default DELIMITER is the space (" ") character.
        1059             : !
        1060             : ! !REVISION HISTORY:
        1061             : !  20 Dec 2015 - R. Yantosca - Initial version
        1062             : !  See https://github.com/geoschem/hemco for complete history
        1063             : !EOP
        1064             : !------------------------------------------------------------------------------
        1065             : !BOC
        1066             : !
        1067             : ! !LOCAL VARIABLES:
        1068             : !
        1069             :     ! Scalars
        1070             :     INTEGER          :: C, S, B, Matches, Length
        1071             :
        1072             :     ! Arrays
        1073             :     INTEGER          :: BreakPts(100)
        1074             :     INTEGER          :: SpaceLoc(500)
        1075             :
        1076             :     ! Strings
        1077             :     CHARACTER(LEN=1) :: Delim
        1078             :
        1079             :     !=======================================================================
        1080             :     ! WordWrapPrint begins here!
        1081             :     !=======================================================================
        1082             :
        1083             :     ! SpaceLoc is the array of where delimiters (usually the " "
        1084             :     ! character) occur in the text, and S is its index.
        1085           0 :     S           = 1
        1086           0 :     SpaceLoc    = 0
        1087             :
        1088             :     ! BreakPts is the array of where line breaks occur
        1089             :     ! and B is its index.
        1090           0 :     BreakPts    = 0
        1091           0 :     B           = 1
        1092           0 :     BreakPts(B) = 1
        1093             :
        1094             :     ! Delimiter for separating words (will be the space character by default)
        1095           0 :     IF ( PRESENT( Delimiter ) ) THEN
        1096           0 :        Delim = Delimiter
        1097             :     ELSE
        1098           0 :        Delim = ' '
        1099             :     ENDIF
        1100             :
        1101             :     ! Find the Location of spaces in the text
        1102           0 :     CALL CntMat( Text, ' ', Matches, SpaceLoc )
        1103             :
        1104             :     ! Loop through the number of matches
        1105             :     DO
        1106             :
        1107             :        ! Move to the next delimiter location
        1108           0 :        S = S + 1
        1109             :
        1110             :        ! Compute the length of the line
        1111           0 :        Length = SpaceLoc(S) - BreakPts(B)
        1112             :
        1113             :        ! If the length of this segment is greater than the requested
        1114             :        ! line length, store the position of this line break
        1115           0 :        IF ( Length > LineWidth ) THEN
        1116           0 :           B           = B             + 1
        1117           0 :           BreakPts(B) = SpaceLoc(S-1) + 1
        1118             :        ENDIF
        1119             :
        1120             :        ! If we have exceeded the number of delimiters in the text, then set
        1121             :        ! the last breakpoint at the end of the text and exit the loop.
        1122           0 :        IF ( S > Matches ) THEN
        1123           0 :           B           = B + 1
        1124           0 :           BreakPts(B) = LEN_TRIM( Text ) + 1
        1125             :           EXIT
        1126             :        ENDIF
        1127             :
        1128             :     ENDDO
        1129             :
        1130             :     ! Print each line
        1131           0 :     DO C = 1, B-1
        1132           0 :        WRITE( 6, '(a)' ) Text( BreakPts(C):BreakPts(C+1)-1 )
        1133             :     ENDDO
        1134             :
        1135           0 :   END SUBROUTINE WordWrapPrint
        1136             : !EOC
        1137             : END MODULE HCO_CharPak_Mod

Generated by: LCOV version 1.14