*------------- Telecommunications & Signal Processing Lab --------------
*                          McGill University
*
*
* Module:
*     SUBROUTINE GTPSTR (STRING, SCHARS, QCHARS, ISS, IES, ISEP)
*
*
* Purpose:
*     Parse a string with a separator (with white space)
*
*
* Description:
*     This routine finds the first occurrence of a separator string in
*     an input string.  A separator string occurs between substrings in
*     the original string and consists of either white space separator
*     or an ordinary  separator.  A white space separator consists
*     entirely of white space (blanks, tabs or null characters).  An
*     ordinary separator consists of a given character, optionally
*     surrounded by white space.  A white space separator cannot occur
*     at the beginning or end of the input string, while an ordinary
*     separator can occur at the beginning or end of the input string.
*
*     Optionally paired quote characters can be specified to allow
*     white space and the separator character to appear in the string
*     without acting as separators.
*
*     The non-blank extent of the string before the separator is
*     STRING(ISS:IES), with the possibility that the substring has a
*     zero length (IES=ISS-1).  The last character in the separator
*     is STRING(ISEP:ISEP).  If a separator is not found, ISEP is set
*     to LEN(STRING)+1.  If a separator is found, the non-blank portion
*     of the string following the separator starts with
*     STRING(ISEP+1:ISEP+1).
*     Summarizing,
*     1 (a) non-blank string before a separator: ISS <= IES,
*       (b) blank string before a separator: ISS=1, IES=0,
*     2 (a) separator: 1 <= ISEP <= LEN(STRING),
*       (b) no separator: ISEP = LEN(STRING)+1.
*
*
* Parameters:
* C ->  STRING - Input character string
* C ->  SCHARS - Separator characters.  Each character in SCHARS is a
*                potential separator character.
* C ->  QCHARS - Character string specifying pairs of quote characters
*                (the left and right quote characters).  For instance,
*                QCHARS='""()' specifies that double quotes and
*                parentheses serve as quote characters.  In the part of
*                the input string between a matched pair of quote
*                characters, any other characters, including quote
*                characters other than from the pair in question, are
*                treated as ordinary characters.  Up to 5 pairs of
*                quote characters can be specified.  A blank string
*                signifies no quote characters are to be recognized.
*                Trailing blanks in the string QCHARS are ignored.
* I <-  ISS    - Pointer to the characters that starts the non-blank
*                portion of the input string before the first
*                separator.  ISS will be equal to 1 in the case of no
*                non-blank characters being found in front of a
*                separator.
* I <-  IES    - Pointer to the character that terminates the portion
*                of the input string before the first separator.
*                Normally IES will point to a non-blank character.
*                However, in the case of no non-blank characters being
*                found in front of the separator, IES will be set to
*                zero.
* I <-  ISEP   - Pointer to the character that ends the separator.  In
*                the case of a separator with trailing white space,
*                ISEP points to the last white space character in the
*                separator.  In the case of no separator being found,
*                ISEP is equal to LEN(STRING)+1.
*
*
* Author / revision:
*     P. Kabal
*     $Revision: 1.7 $  $Date: 1995/03/08 15:41:16 $
*
*
*-----------------------------------------------------------------------

      SUBROUTINE GTPSTR (STRING, SCHARS, QCHARS, ISS, IES, ISEP)


      INTEGER SIWS,SNBC,SWSA,SSEP,SFIN
      PARAMETER (SIWS=1,SNBC=2,SWSA=3,SSEP=4,SFIN=5)
      INTEGER WSC,SEP,OTH
      PARAMETER (WSC=1,SEP=2,OTH=3)
      INTEGER MXQ
      PARAMETER (MXQ=5)

      INTEGER ISS,IES,ISEP
      INTEGER LENS,NS,ISTATE,LQ,NQ,K,I,ICC
      INTEGER LEVQ(MXQ)
      INTEGER LENBLK

      LOGICAL ERRQ

      CHARACTER*(*) STRING,SCHARS,QCHARS
      CHARACTER*1 CH,QL(MXQ),QR(MXQ)

      INTEGER ITRANS(OTH,SFIN-1),IPTR(SFIN)
      DATA ITRANS/SIWS,SSEP,SNBC, SWSA,SSEP,SNBC, SWSA,SSEP,SFIN,
     -            SSEP,SFIN,SFIN/


* The presence of a separator is identified using a state driven
* parser.  The next state is given by  ITRANS(char, state).  The
* position in the string of the end of a given state is given
* by IPTR(state).
* Character Description
*   WSC     White space
*   SEP     Separator
*   OTH     Other
* State   Description
*  SIWS   Initial white space
*  SNBC   Non-blank character before a separator
*  SWSA   White space after non-blank characters
*  SSEP   Separator character, or white space after a separator
*  SFIN   Finished

      LENS=LEN(STRING)
      NS=LEN(SCHARS)
      ISTATE=SIWS
      IPTR(SIWS)=0
      IPTR(SNBC)=0
      IPTR(SWSA)=0
      IPTR(SSEP)=0
      IPTR(SFIN)=LENS+1

* Pick up the quote characters
      LQ=LENBLK(QCHARS)
      NQ=MIN(LQ/2,MXQ)
      IF (2*NQ.NE.LQ)
     -  CALL WARN('GTPSTR - Invalid quote character string')
      ERRQ=.FALSE.
      DO 100 K=1,NQ
        QL(K)=QCHARS(2*K-1:2*K-1)
        QR(K)=QCHARS(2*K:2*K)
        LEVQ(K)=0
 100  CONTINUE


* Main loop to check each character in the string
* The search is terminated when the string is exhausted or the first
* non-blank character is found after a separator
      DO 300 I=1,LENS

        CH=STRING(I:I)

* Check for quote characters
* Notes:
*  - The order of the check is changed depending on whether we are
*    within quotes already.  This allows the left and right quote
*    characters to be the same.
*  - The first "other" character after state SWSA or SSEP pushes us
*    into state SFIN.  A left quote character in this situation should
*    not trigger an unpaired quote error.  This situation arises only
*    we are not within quotes already.
        ICC=0
        DO 220 K=1,NQ
          IF (LEVQ(K).EQ.0) THEN
            IF (CH.EQ.QL(K)) THEN
              IF (ISTATE.NE.SWSA .AND. ISTATE.NE.SSEP)
     -          LEVQ(K)=LEVQ(K)+1
              ICC=OTH
            ELSE IF (CH.EQ.QR(K)) THEN
              ERRQ=.TRUE.
              ICC=OTH
            END IF
          ELSE
            IF (CH.EQ.QR(K)) THEN
              LEVQ(K)=LEVQ(K)-1
            ELSE IF (CH.EQ.QL(K)) THEN
              LEVQ(K)=LEVQ(K)+1
            END IF
            ICC=OTH
          END IF
          IF (ICC.EQ.OTH) GO TO 280
 220    CONTINUE

* Check for a separator character
        DO 240 K=1,NS
          IF (CH.EQ.SCHARS(K:K)) THEN
            ICC=SEP
            GO TO 280
          END IF
 240    CONTINUE
          

* Check for other characters
        IF (CH.EQ.' ' .OR. CH.EQ.CHAR(9) .OR. CH.EQ.CHAR(0)) THEN
          ICC=WSC
        ELSE
          ICC=OTH
        END IF

* Make a state transition
 280    ISTATE=ITRANS(ICC,ISTATE)
        IPTR(ISTATE)=I
        IF (ISTATE.GE.SFIN) GO TO 320

 300  CONTINUE

* Return the pointers
 320  CONTINUE

* Let the string be A <sep> B
* Find the limits of A: see if we have passed through state SNBC
      IF (IPTR(SNBC).GT.0) THEN
        ISS=IPTR(SIWS)+1
        IES=IPTR(SNBC)
      ELSE
        ISS=1
        IES=ISS-1
      END IF

* Find the end of the separator
      IF (ISTATE.EQ.SSEP .OR. ISTATE.EQ.SFIN) THEN
        ISEP=IPTR(SFIN)-1
      ELSE
        ISEP=LENS+1
      END IF

* Error checks
      DO 400 K=1,NQ
        IF (LEVQ(K).NE.0) ERRQ=.TRUE.
 400  CONTINUE
      IF (ERRQ) CALL WARN('GTPSTR - Unpaired quote character')


      RETURN

      END
