parstr.f

Go to the documentation of this file.

C> @file
C> @author J @date 2007-01-19
      
C> THIS SUBROUTINE PARSES A STRING CONTAINING ONE OR MORE
C>   SUBSTRINGS INTO AN ARRAY OF SUBSTRINGS.  THE SEPARATOR FOR THE
C>   SUBSTRINGS IS SPECIFIED DURING INPUT, AND MULTIPLE ADJACENT
C>   OCCURRENCES OF THIS CHARACTER WILL BE TREATED AS A SINGLE
C>   OCCURRENCE WHEN THE STRING IS ACTUALLY PARSED.
C>
C> PROGRAM HISTORY LOG:
C> 2007-01-19  J. ATOR    -- BASED UPON SUBROUTINE PARSEQ
C>
C> USAGE:    CALL PARSTR (STR, TAGS, MTAG, NTAG, SEP, LIMIT80)
C>   INPUT ARGUMENT LIST:
C>     STR      - CHARACTER*(*): STRING
C>     MTAG     - INTEGER: MAXIMUM NUMBER OF SUBSTRINGS TO BE PARSED
C>                FROM STRING
C>     SEP      - CHARACTER*1: SEPARATOR CHARACTER FOR SUBSTRINGS
C>     LIMIT80  - LOGICAL: .TRUE. IF AN ABORT SHOULD OCCUR WHEN STR IS
C>                LONGER THAN 80 CHARACTERS; INCLUDED FOR HISTORICAL
C>                CONSISTENCY WITH OLD SUBROUTINE PARSEQ
C>
C>   OUTPUT ARGUMENT LIST:
C>     TAGS     - CHARACTER*(*): MTAG-WORD ARRAY OF SUBSTRINGS (FIRST
C>                NTAG WORDS FILLED)
C>     NTAG     - INTEGER: NUMBER OF SUBSTRINGS RETURNED
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        BORT2
C>    THIS ROUTINE IS CALLED BY: FSTAG    GETCFMNG GETNTBE  GETTBH
C>                               PARUSR   READLC   SEQSDX   SNTBBE
C>                               SNTBDE   SNTBFE   UFBSEQ   UFBTAB
C>                               UFBTAM   WRITLC
C>                               Normally not called by any application
C>                               programs but it could be.
C>
      SUBROUTINE parstr(STR,TAGS,MTAG,NTAG,SEP,LIMIT80)



      CHARACTER*(*) str,tags(mtag)
      CHARACTER*128 bort_str1,bort_str2
      CHARACTER*1   sep
      LOGICAL       substr,limit80

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

      lstr = len(str)
      ltag = len(tags(1))
      IF( limit80 .AND. (lstr.GT.80) ) goto 900
      ntag = 0
      nchr = 0
      substr = .false.

      DO i=1,lstr

      IF( .NOT.substr .AND. (str(i:i).NE.sep) ) THEN
         ntag = ntag+1
         IF(ntag.GT.mtag) goto 901
         tags(ntag) = ' '
      ENDIF

      IF( substr .AND. (str(i:i).EQ.sep) ) nchr = 0
      substr = str(i:i).NE.sep

      IF(substr) THEN
         nchr = nchr+1
         IF(nchr.GT.ltag) goto 902
         tags(ntag)(nchr:nchr) = str(i:i)
      ENDIF

      ENDDO

C  EXITS
C  -----

      RETURN
900   WRITE(bort_str1,'("BUFRLIB: PARSTR - INPUT STRING (",A,") HAS ")')
     . str
      WRITE(bort_str2,'(18X,"LENGTH (",I4,"), > LIMIT OF 80 CHAR.")')
     . lstr
      CALL bort2(bort_str1,bort_str2)
901   WRITE(bort_str1,'("BUFRLIB: PARSTR - INPUT STRING (",A,") '//
     . 'CONTAINS",I4)') str,ntag
      WRITE(bort_str2,'(18X,"SUBSTRINGS, EXCEEDING THE LIMIT {",I4,'//
     . '" - THIRD (INPUT) ARGUMENT}")') mtag
      CALL bort2(bort_str1,bort_str2)
902   WRITE(bort_str1,'("BUFRLIB: PARSTR - INPUT STRING (",A,") ")') str
      WRITE(bort_str2,'(18X,"CONTAINS A PARSED SUBSTRING WITH LENGTH '//
     . 'EXCEEDING THE MAXIMUM OF",I4," CHARACTERS")') ltag
      CALL bort2(bort_str1,bort_str2)
      END