var/external/bufr/parstr.f

   1       SUBROUTINE PARSTR(STR,TAGS,MTAG,NTAG,SEP,LIMIT80)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    PARSTR
   6 C   PRGMMR: J. ATOR          ORG: NP12       DATE: 2007-01-19
   7 C
   8 C ABSTRACT: THIS SUBROUTINE PARSES A STRING CONTAINING ONE OR MORE
   9 C   SUBSTRINGS INTO AN ARRAY OF SUBSTRINGS.  THE SEPARATOR FOR THE
  10 C   SUBSTRINGS IS SPECIFIED DURING INPUT, AND MULTIPLE ADJACENT
  11 C   OCCURRENCES OF THIS CHARACTER WILL BE TREATED AS A SINGLE
  12 C   OCCURRENCE WHEN THE STRING IS ACTUALLY PARSED.
  13 C
  14 C PROGRAM HISTORY LOG:
  15 C 2007-01-19  J. ATOR    -- BASED UPON SUBROUTINE PARSEQ
  16 C
  17 C USAGE:    CALL PARSTR (STR, TAGS, MTAG, NTAG, SEP, LIMIT80)
  18 C   INPUT ARGUMENT LIST:
  19 C     STR      - CHARACTER*(*): STRING
  20 C     MTAG     - INTEGER: MAXIMUM NUMBER OF SUBSTRINGS TO BE PARSED
  21 C                FROM STRING
  22 C     SEP      - CHARACTER*1: SEPARATOR CHARACTER FOR SUBSTRINGS
  23 C     LIMIT80  - LOGICAL: .TRUE. IF AN ABORT SHOULD OCCUR WHEN STR IS
  24 C                LONGER THAN 80 CHARACTERS; INCLUDED FOR HISTORICAL
  25 C                CONSISTENCY WITH OLD SUBROUTINE PARSEQ
  26 C
  27 C   OUTPUT ARGUMENT LIST:
  28 C     TAGS     - CHARACTER*(*): MTAG-WORD ARRAY OF SUBSTRINGS (FIRST
  29 C                NTAG WORDS FILLED)
  30 C     NTAG     - INTEGER: NUMBER OF SUBSTRINGS RETURNED
  31 C
  32 C REMARKS:
  33 C    THIS ROUTINE CALLS:        BORT2
  34 C    THIS ROUTINE IS CALLED BY: GETNTBE  GETTAGPR GETTBH   GETVALNB
  35 C                               PARUSR   READLC   SEQSDX   SNTBBE
  36 C                               UFBSEQ   UFBTAB   UFBTAM   WRITLC
  37 C                               Normally not called by any application
  38 C                               programs but it could be.
  39 C
  40 C ATTRIBUTES:
  41 C   LANGUAGE: FORTRAN 77
  42 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  43 C
  44 C$$$
  45
  46       CHARACTER*(*) STR,TAGS(MTAG)
  47       CHARACTER*128 BORT_STR1,BORT_STR2
  48       CHARACTER*1   SEP
  49       LOGICAL       SUBSTR,LIMIT80
  50
  51 C-----------------------------------------------------------------------
  52 C-----------------------------------------------------------------------
  53
  54       LSTR = LEN(STR)
  55       LTAG = LEN(TAGS(1))
  56       IF( LIMIT80 .AND. (LSTR.GT.80) ) GOTO 900
  57       NTAG = 0
  58       NCHR = 0
  59       SUBSTR = .FALSE.
  60
  61       DO I=1,LSTR
  62
  63       IF( .NOT.SUBSTR .AND. (STR(I:I).NE.SEP) ) THEN
  64          NTAG = NTAG+1
  65          IF(NTAG.GT.MTAG) GOTO 901
  66          TAGS(NTAG) = ' '
  67       ENDIF
  68
  69       IF( SUBSTR .AND. (STR(I:I).EQ.SEP) ) NCHR = 0
  70       SUBSTR = STR(I:I).NE.SEP
  71
  72       IF(SUBSTR) THEN
  73          NCHR = NCHR+1
  74          IF(NCHR.GT.LTAG) GOTO 902
  75          TAGS(NTAG)(NCHR:NCHR) = STR(I:I)
  76       ENDIF
  77
  78       ENDDO
  79
  80 C  EXITS
  81 C  -----
  82
  83       RETURN
  84 900   WRITE(BORT_STR1,'("BUFRLIB: PARSTR - INPUT STRING (",A,") HAS ")')
  85      . STR
  86       WRITE(BORT_STR2,'(18X,"LENGTH (",I4,"), > LIMIT OF 80 CHAR.")')
  87      . LSTR
  88       CALL BORT2(BORT_STR1,BORT_STR2)
  89 901   WRITE(BORT_STR1,'("BUFRLIB: PARSTR - INPUT STRING (",A,") '//
  90      . 'CONTAINS",I4)') STR,NTAG
  91       WRITE(BORT_STR2,'(18X,"SUBSTRINGS, EXCEEDING THE LIMIT {",I4,'//
  92      . '" - THIRD (INPUT) ARGUMENT}")') MTAG
  93       CALL BORT2(BORT_STR1,BORT_STR2)
  94 902   WRITE(BORT_STR1,'("BUFRLIB: PARSTR - INPUT STRING (",A,") ")') STR
  95       WRITE(BORT_STR2,'(18X,"CONTAINS A PARSED SUBSTRING WITH LENGTH '//
  96      . 'EXCEEDING THE MAXIMUM OF",I4," CHARACTERS")') LTAG
  97       CALL BORT2(BORT_STR1,BORT_STR2)
  98       END