C @(#)extrss.for 17.1.1.1 (ES0-DMD) 01/25/02 17:40:34 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