Fortran Wiki
strtok

PROGRAM test_strtok
!
!  This test program reads standard input and parses it into tokens
!  assuming everything not a-ZA-Z0-9 is a delimiter; as a test of
!  the function strtok(3f), which is very similar to the C function
!  strtok(3c).
!
   CHARACTER(LEN=255) :: inline 
   CHARACTER(LEN=255) :: strtok
   CHARACTER(LEN=80)  :: token
   CHARACTER(LEN=66)  :: delimiters(0:55)
   INTEGER :: ios
   CHARACTER(LEN=128) ::  alphabet ! (0:127)

   !DECIMAL
   !*-------*-------*-------*-------*-------*-------*-------*-------*
   !| 00 nul| 01 soh| 02 stx| 03 etx| 04 eot| 05 enq| 06 ack| 07 bel|
   !| 08 bs | 09 ht | 10 nl | 11 vt | 12 np | 13 cr | 14 so | 15 si |
   !| 16 dle| 17 dc1| 18 dc2| 19 dc3| 20 dc4| 21 nak| 22 syn| 23 etb|
   !| 24 can| 25 em | 26 sub| 27 esc| 28 fs | 29 gs | 30 rs | 31 us |
   !| 32 sp | 33  ! | 34  " | 35  # | 36  $ | 37  % | 38  & | 39  ' |
   !| 40  ( | 41  ) | 42  * | 43  + | 44  , | 45  - | 46  . | 47  / |
   !| 48  0 | 49  1 | 50  2 | 51  3 | 52  4 | 53  5 | 54  6 | 55  7 |
   !| 56  8 | 57  9 | 58  : | 59  ; | 60  < | 61  = | 62  > | 63  ? |
   !| 64  @ | 65  A | 66  B | 67  C | 68  D | 69  E | 70  F | 71  G |
   !| 72  H | 73  I | 74  J | 75  K | 76  L | 77  M | 78  N | 79  O |
   !| 80  P | 81  Q | 82  R | 83  S | 84  T | 85  U | 86  V | 87  W |
   !| 88  X | 89  Y | 90  Z | 91  [ | 92  \ | 93  ] | 94  ^ | 95  _ |
   !| 96  ` | 97  a | 98  b | 99  c |100  d |101  e |102  f |103  g |
   !|104  h |105  i |106  j |107  k |108  l |109  m |110  n |111  o |
   !|112  p |113  q |114  r |115  s |116  t |117  u |118  v |119  w |
   !|120  x |121  y |122  z |123  { |124  | |125  } |126  ~ |127 del|
   !*-------*-------*-------*-------*-------*-------*-------*-------*
   DO i10=0,127
         alphabet(i10+1:i10+1)=char(i10)
   ENDDO
   delimiters=alphabet(0+1:47+1)//alphabet(58+1:64+1)//alphabet(91+1:96+1)//alphabet(123+1:127+1)

   DO
      READ (UNIT=*,FMT="(a)",IOSTAT=ios) inline
      IF(ios.NE.0)THEN
         STOP
      ELSE
         token = strtok(inline, delimiters)
         DO WHILE (token .NE. char(0))
             PRINT *, token
             token = strtok(CHAR(0), delimiters)
         ENDDO
      ENDIF
   ENDDO

END PROGRAM test_strtok

CHARACTER*255 FUNCTION strtok (source_string, delimiters)

!     @(#) Tokenize a string in a similar manner to C routine strtok(3c). 
!
!     Usage:  First call STRTOK() with the string to tokenize as SOURCE_STRING,
!             and the delimiter list used to tokenize SOURCE_STRING in DELIMITERS.
!
!             then, if the returned value is not equal to CHAR(0), keep calling until it is
!             with SOURCE_STRING set to CHAR(0).
!
!            STRTOK will return a token on each call until the entire line is processed,
!            which it signals by returning CHAR(0). 
!
!     Input:  source_string =   Source string to tokenize. 
!             delimiters    =   delimiter string.  Used to determine the beginning/end of each token in a string.
!
!     Output: strtok()
!
!     LIMITATIONS:
!     can not be called with a different string until current string is totally processed, even from different procedures
!     input string length limited to set size
!     function returns fixed 255 character length
!     length of returned string not given

!     PARAMETERS:
      CHARACTER(len=*),intent(in)  :: source_string
      CHARACTER(len=*),intent(in)  :: delimiters

!     SAVED VALUES:
      CHARACTER(len=255),save :: saved_string
      INTEGER,save :: isaved_start  ! points to beginning of unprocessed data
      INTEGER,save :: isource_len   ! length of original input string

!     LOCAL VALUES:
      INTEGER :: ibegin        ! beginning of token to return
      INTEGER :: ifinish       ! end of token to return

      ! initialize stored copy of input string and pointer into input string on first call
      IF (source_string(1:1) .NE. CHAR(0)) THEN
          isaved_start = 1                 ! beginning of unprocessed data
          saved_string = source_string     ! save input string from first call in series
          isource_len = LEN(saved_string)  ! length of input string from first call
      ENDIF

      ibegin = isaved_start

      DO
         IF ( (ibegin .LE. isource_len) .AND. (INDEX(delimiters,saved_string(ibegin:ibegin)) .NE. 0)) THEN
             ibegin = ibegin + 1
         ELSE
             EXIT
         ENDIF
      ENDDO

      IF (ibegin .GT. isource_len) THEN
          strtok = CHAR(0)
          RETURN
      ENDIF

      ifinish = ibegin

      DO
         IF ((ifinish .LE. isource_len) .AND.  (INDEX(delimiters,saved_string(ifinish:ifinish)) .EQ. 0)) THEN
             ifinish = ifinish + 1
         ELSE
             EXIT
         ENDIF
      ENDDO

      !strtok = "["//saved_string(ibegin:ifinish-1)//"]"
      strtok = saved_string(ibegin:ifinish-1)
      isaved_start = ifinish

END FUNCTION strtok