Fortran Wiki
delim

C   delim - parse a string and store tokens into an array
C
C SYNOPSIS/USAGE
C       SUBROUTINE DELIM(LINE,ARRAY,N,ICOUNT,IBEGIN,ITERM,ILEN,DLIM)
C       CHARACTER*(*) STRING
C       CHARACTER DLIM*(*)
C       CHARACTER*(n) ARRAY(N)
C
C DESCRIPTION
C
C      Given a LINE of structure " par1 par2 par3 ... par(n) "
C      store each par(n) into a separate variable in ARRAY (UNLESS
C      ARRAY(1).eq.'#NULL#')
C
C      Also set ICOUNT to number of elements of array initialized, and
C      return beginning and ending positions for each element in IBEGIN(N)
C      and ITERM(N).
C      Return position of last non-blank character (even if more
C      than n elements were found) in ILEN
C      No quoting or escaping of delimiter is allowed, so the delimiter
C      character can not be placed in a token.
C      No checking for more than N parameters; If any more they are ignored.
C
C       o  LINE      - input string to parse into tokens
C       o  ARRAY(N)  - array that receives tokens. Elements should be up to
C                      size of LINE to avoid truncation (eg. LINE may contain
C                      only on token).
C       o  N         - size of arrays ARRAY, IBEGIN, ITERM
C       o  ICOUNT    - number of tokens found
C       o  IBEGIN(N) - starting columns of tokens found
C       o  ITERM(N)  - ending columns of tokens found
C       o  ILEN      -  position of last non-blank character in input string LINE
C       o  DLIM      - delimiter character(s)
C
C   NOTES
C
C     Still F77-compatible, except for F90 intrinsic use of LEN_TRIM(). Common
C     variants store only token end points, treat blank tokens at end of line
C     or null tokens differently, or store only tokens and no end points, or
C     allow delimiters in tokens when in quotes or "escaped" with a backslash
C     character.

C       o  Legal Restrictions: none
C       o  Dependencies: LEN_TRIM()
C       o  Authors: John S. Urban
C       o  Circa:   1981, 2010

      PROGRAM DEMO
      CHARACTER *80 LINE
      PARAMETER (N=10)
      CHARACTER*20 ARRAY(N)

C     a nice idea in case full of garbage
      ARRAY(1)=' '
      LINE=' first  second 10.3 words_of_stuff  '
      CALL TESTIT(LINE,' ',ARRAY)
      CALL TESTIT('abc : def: ::hijk:',':',ARRAY)
C     note space is first in delimiter list
      CALL TESTIT(LINE,' aeiou',ARRAY)
      ARRAY(1)='#NULL#'
      CALL TESTIT(LINE,'aeiou',ARRAY)
      LINE='AAAaBBBBBBbIIIIIi  J K L'
      CALL TESTIT(LINE,'aeiou',ARRAY)
      END

      SUBROUTINE TESTIT(LINE,DLM,ARRAY)
      CHARACTER *(*) LINE
      character*(*) DLM
      PARAMETER (N=10)
      CHARACTER*20 ARRAY(N)

      INTEGER IBEGIN(N),ITERM(N)
      WRITE(*,'(80(''=''))')
      WRITE(*,'(''PARSING=['',a,'']'')')LINE
      WRITE(*,'(a,a,a)')'DELIMITERS==[',DLM,']'
      CALL DELIM(LINE,ARRAY,N,ICOUNT,IBEGIN,ITERM,ILEN,DLM)
      WRITE(*,*)'number of tokens found=',ICOUNT
      WRITE(*,*)'last character in column ',ILEN
      IF(ICOUNT.GT.0)THEN
         IF(ILEN.NE.ITERM(ICOUNT))THEN
            WRITE(*,*)'ignored from column ',ITERM(ICOUNT)+1,' to ',ILEN
         ENDIF
         DO 10 I10=1,ICOUNT
         if(array(1).ne.'#NULL#')then
            WRITE(*,*)'[',ARRAY(I10)(:ITERM(I10)-IBEGIN(I10)+1),']'   ! from array
         else
            WRITE(*,*)'[',LINE(IBEGIN(I10):ITERM(I10)),']'            ! from original line
         endif
10       CONTINUE
      ENDIF
      write(*,*)'Press "Enter" to continue ....'
      read(*,*)
      END

C=======================================================================--------
      SUBROUTINE DELIM(LINE0,ARRAY,N,ICOUNT,IBEGIN,ITERM,ILEN,DLIM)
C     @(#) parse a string and store tokens into an array
C
C     given a line of structure " par1 par2 par3 ... parn "
C     store each par(n) into a separate variable in array.
C
C     IF ARRAY(1).eq.'#NULL#' do not store into string array  (KLUDGE))
C
C     also count number of elements of array initialized, and
C     return beginning and ending positions for each element.
C     also return position of last non-blank character (even if more
C     than n elements were found).
C
C     no quoting of delimiter is allowed
C     no checking for more than n parameters, if any more they are ignored
C
C     input line limited to 1024 characters
C
      CHARACTER*(*)     LINE0, DLIM*(*)
      PARAMETER (MAXLEN=1024)
      CHARACTER*(MAXLEN) LINE
      CHARACTER ARRAY(N)*(*)
      INTEGER ICOUNT, IBEGIN(N),ITERM(N),ILEN
      LOGICAL LSTORE
      ICOUNT=0
      ILEN=LEN_TRIM(LINE0)
      IF(ILEN.GT.MAXLEN)THEN
         write(*,*)'*delim* input line too long'
      ENDIF
      LINE=LINE0

      IDLIM=LEN(DLIM)
      IF(IDLIM.GT.5)THEN
C        dlim a lot of blanks on some machines if dlim is a big string
         IDLIM=LEN_TRIM(DLIM)
C        blank string
         IF(IDLIM.EQ.0)IDLIM=1
      ENDIF

C     command was totally blank
      IF(ILEN.EQ.0)RETURN
C
C     there is at least one non-blank character in the command
C     ilen is the column position of the last non-blank character
C     find next non-delimiter
      icol=1

C     special flag to not store into character array
      IF(ARRAY(1).EQ.'#NULL#')THEN
         LSTORE=.FALSE.
      ELSE
         LSTORE=.TRUE.
      ENDIF

C     store into each array element until done or too many words
      DO 100 IARRAY=1,N,1
200      CONTINUE
C        if current character is not a delimiter
         IF(INDEX(DLIM(1:IDLIM),LINE(ICOL:ICOL)).EQ.0)THEN
C          start new token on the non-delimiter character
           ISTART=ICOL
           IBEGIN(IARRAY)=ICOL
C          assume no delimiters so put past end of line
           IEND=ILEN-ISTART+1+1

           DO 10 I10=1,IDLIM
              IFOUND=INDEX(LINE(ISTART:ILEN),DLIM(I10:I10))
              IF(IFOUND.GT.0)THEN
                IEND=MIN(IEND,IFOUND)
              ENDIF
10         CONTINUE

C          no remaining delimiters
           IF(IEND.LE.0)THEN
             ITERM(IARRAY)=ILEN
             IF(LSTORE)ARRAY(IARRAY)=LINE(ISTART:ILEN)
             ICOUNT=IARRAY
             RETURN
           ELSE
             IEND=IEND+ISTART-2
             ITERM(IARRAY)=IEND
             IF(LSTORE)ARRAY(IARRAY)=LINE(ISTART:IEND)
           ENDIF
           ICOL=IEND+2
         ELSE
           ICOL=ICOL+1
           GOTO 200
         ENDIF
C        last character in line was a delimiter, so no text left
C        (should not happen where blank=delimiter)
         IF(ICOL.GT.ILEN)THEN
           ICOUNT=IARRAY
           RETURN
         ENDIF
100   CONTINUE
C     more than n elements
      ICOUNT=N
      RETURN
      END