C @(#)extrss.for	19.1 (ES0-DMD) 02/25/03 14:01:06
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
        SUBROUTINE EXTRSS(STRING,DELIM,START,SS,SLEN)
C
C++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  subroutine EXTRSS         	version 2.50	880201
C  K. Banse                      ESO - Garching
C
C.KEYWORDS
C  character string , parsing
C
C.PURPOSE
C  from a given string extract a substring limited by given
C  delimiters 
C
C.ALGORITHM
C  find the given delimiter in the string 
C  copy the relevant part into the substring
C  spaces in front or after delimiters are ignored
C
C.INPUT/OUTPUT
C  call as  EXTRSS(STRING,DELIM,START,SS,SLEN)
C
C  input par:
C  STRING:        char. exp.        character string which is to be parsed
C  DELIM:        char. exp.        delimiter string
C
C  input/output par:
C  START:        I*4                starting index within the input
C                                string - will be set to the position
C                                just following the next delimiter
C                                upon return
C
C  output par:
C  SS:                char. exp.        extracted substring
C                                will be set to spaces, if nothing there
C  SLEN:        I*4                length of extracted substring in bytes
C
C--------------------------------------------------
C
      INTEGER   START,SLEN
      INTEGER   SOSS,EOSS,SKIP,NEXTD
      INTEGER   KOFF,KLEN,N
      INTEGER   MM
C 
      CHARACTER*(*)   STRING,DELIM,SS
C
      SS = ' ' 
      SLEN = 0
C
C  see, if already the end of string reached
      KLEN = LEN(STRING)
      IF (KLEN.LT.START) GOTO 3000
C
C  skip leading blanks
      SKIP = 0
      KOFF = START - 1
C 
      DO 100 N=1,KLEN
         IF (STRING(KOFF+N:KOFF+N).NE.' ') THEN
            SKIP = N
            GOTO 150
         ENDIF
100   CONTINUE
      SKIP = KLEN
C 
150   IF (SKIP.LE.0) GOTO 3000                
C 
C  find begin of substring + next delimiter
      SOSS = START + SKIP - 1
      MM = INDEX(STRING(SOSS:KLEN),DELIM) 
      IF (MM.LE.0) MM = KLEN - SOSS + 2
      NEXTD = MM + SOSS - 2
      IF (NEXTD.LT.SOSS) GOTO 500                
C
C  cut off trailing blanks
      IF (DELIM.EQ.' ') THEN
         EOSS = NEXTD
      ELSE
         MM = INDEX(STRING(SOSS:NEXTD),DELIM) 
         IF (MM.LE.0) MM = NEXTD - SOSS + 2
         EOSS = MM + SOSS - 2
      ENDIF
C        
C  look for character constants with embedded blanks, ".. .."
      IF ((DELIM.NE.' ').OR.(STRING(SOSS:SOSS).NE.'"')) GOTO 400
      IF ((SOSS.EQ.EOSS).OR.
     +    (STRING(EOSS:EOSS).NE.'"')) THEN
         MM = INDEX(STRING(SOSS+1:KLEN),'"') 
         IF (MM.GT.0) THEN
            IF ( (STRING(SOSS+MM+1:SOSS+MM+1).EQ.' ') .OR.
     +           ((SOSS + MM).EQ.KLEN) ) THEN
C  update end of substring
               EOSS = MM + SOSS                
               NEXTD = EOSS                        
            ENDIF
         ENDIF
      ENDIF
C        
C  copy string
400   SS(1:) = STRING(SOSS:EOSS)
      SLEN = EOSS - SOSS + 1
500   START = NEXTD + LEN(DELIM) + 1
      RETURN
C
3000  START = 0
      RETURN
      END
