C 
C Subroutine file 'sep.for' to read data in the form of the SEP header
C or parameter files.
C
C Version: 5.10
C Date: 1997, October 21
C
C Coded by: Ludek Klimes
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mail: klimes@seis.karlov.mff.cuni.cz
C
C.......................................................................
C
C This file consists of the following external procedures:
C     SEPB... Subprogram designed to initiate the number of parameters
C             stored in common blocks /SEPT/ and /SEPC/ (include file
C             'sep.inc').
C             SEPB
C     RSEP1...Subroutine designed to read a SEP-like parameter or header
C             file and to store the parameter names and values for
C             future use.
C             RSEP1
C     RSEP2...Subroutine designed to take a line from a SEP-like
C             parameter or header file and to store the parameter names
C             and values for future use.
C             RSEP2
C     RSEP3R..Subroutine designed to read the value of a given
C             real-valued parameter from previously stored contents of
C             SEP-like parameter or header files.
C             RSEP3R
C     RSEP3I..Subroutine designed to read the value of a given integer
C             parameter from previously stored contents of SEP-like
C             parameter or header files.
C             RSEP3I
C     RSEP3T..Subroutine designed to read the value of a given
C             text-valued parameter from previously stored contents of
C             SEP-like parameter or header files.
C             RSEP3T
C     WSEPR...Subroutine designed to write the value of a given
C             real-valued parameter into the output string.
C             WSEPR
C     WSEPI...Subroutine designed to write the value of a given
C             integer parameter into the output string.
C             WSEPI
C     LOWER...Subroutine changing a given character string to lowercase.
C             LOWER
C
C Referred external function:
C     LENGTH..file 'length.for'
C
C.......................................................................
C
C                                                    
C Form of the SEP (Stanford Exploration Project) parameter files:
C
C     All the data are specified in the form of PARAMETER=VALUE, e.g.
C     N1=50, with PARAMETER directly preceding = without intervening
C     spaces and with VALUE directly following = without intervening
C     spaces.  The PARAMETER=VALUE couple must be delimited by a space
C     or comma from both sides.  PARAMETER= followed by a space resets
C     the default parameter value.
C
C     All other text in the input files is ignored.  The file thus may
C     contain unused data or comments without leading comment character.
C     Everything between comment character # and the end of the
C     respective line is ignored, too.
C
C     The PARAMETER=VALUE couples may be specified in any order.
C     The last appearance takes precedence.
C
C     PARAMETER is the string identifying the variable.  It must not be
C     enclosed in apostrophes (if it were, the apostrophes would be
C     considered as the part of the identifier).  It must immediately
C     precede '=', with no intervening spaces.  From the left, PARAMETER
C     is delimited by a space ' ', or by comma ','.
C     The PARAMETER string is not case-sensitive.
C
C     On input, all characters '=' are determined and each of them
C     is assumed to correspond to one PARAMETER=VALUE couple.
C     Only characters '=' within 'value' strings enclosed in apostrophes
C     or within comments (after #) do not create PARAMETER=VALUE
C     couples.
C
C The most common parameters:
C     N1=positive integer... Number of gridpoints along the X1 axis.
C             Default: N1=1
C     N2=positive integer... Number of gridpoints along the X2 axis.
C             Default: N2=1
C     N3=positive integer... Number of gridpoints along the X3 axis.
C             Default: N3=1
C     D1=real... Grid interval in the direction of the first coordinate
C             axis.
C             Default: D1=1.
C     D2=real... Grid interval in the direction of the second coordinate
C             axis.
C             Default: D2=1.
C     D3=real... Grid interval in the direction of the third coordinate
C             axis.
C             Default: D3=1.
C     O1=real... First coordinate of the grid origin (first point of the
C             grid).
C             Default: O1=0.
C     O2=real... Second coordinate of the grid origin.
C             Default: O2=0.
C     O3=real... Third coordinate of the grid origin.
C             Default: O3=0.
C
C Example of the SEP parameter file:
C     grd.h
C
C Each program should consider just a single set of SEP-like specified
C parameters.  However, these parameters may by step-by-step redefined.
C A considerable attention should thus be paid to the order in which
C the parameter files are read and in which subroutines RSEP1 and RSEP2
C are invoked with input files or lines.  The order specifies the order
C of preferences of redefined values.
C
C For example:
C (a) Subroutine RSEP1 reads the parameters of the input file.
C (b) Invocations of function RSEP3I define dimensions N1,N2,N3 of the
C     input file.
C (c) Subroutine RSEP1 reads the parameters of the output file and
C     redefines the values of parameters N1,N2,N3.
C (d) New invocations of function RSEP3I define dimensions N1,N2,N3 of
C     the output file.
C
C=======================================================================
C
C     
C
      BLOCK DATA SEPB
C
C Subprogram designed to initiate the number of parameters stored in
C common blocks /SEPT/ and /SEPC/ (include file 'sep.inc').
C
C-----------------------------------------------------------------------
C
      INCLUDE 'sep.inc'
C     sep.inc
C
C-----------------------------------------------------------------------
C
C     At the beginning, no parameters are defined:
      DATA NPAR/0/
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RSEP1(LU,FILE)
      INTEGER LU
      CHARACTER*(*) FILE
C
C Subroutine designed to read a SEP-like parameter or header file and to
C store the parameter names and values for future use.
C
C Input:
C     LU...   Logical unit number of the input file.  The file will be
C             opened, read and closed.
C     FILE... String containing the name of the input SEP parameter
C             file to be read.
C             If FILE=' ', no action is done.
C
C No output.
C
C-----------------------------------------------------------------------
C
      EXTERNAL RSEP2
C
C-----------------------------------------------------------------------
C
      CHARACTER*255 LINE
C
      IF(FILE.NE.' ') THEN
        OPEN(LU,FILE=FILE,STATUS='OLD')
    1   CONTINUE
          READ(LU,'(A)',END=9) LINE
          CALL RSEP2(LINE)
        GO TO 1
    9   CONTINUE
        CLOSE(LU)
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RSEP2(LINE)
      CHARACTER*(*) LINE
C
C Subroutine designed to take a line from a SEP-like parameter or header
C file and to store the parameter names and values for future use.
C
C Input:
C     LINE... String containing a line from a SEP parameter file.
C
C No output.
C
C-----------------------------------------------------------------------
C
      INCLUDE 'sep.inc'
C     sep.inc
C
C-----------------------------------------------------------------------
C
      EXTERNAL LENGTH,LOWER
      INTEGER  LENGTH
C
C-----------------------------------------------------------------------
C
      INTEGER M,K,L,I,J
C
C     M...    Length of the line.
C     K...    Position of the current '=' character in the line, later
C             of the next character.
C     L...    Starting position of the line part being interpreted.
C     I,J...  Temporary indices.
C
C.......................................................................
C
C     Length of the input line up to the comment sign '#':
      M=LEN(LINE)
      I=INDEX(LINE,'#')
      IF(I.GT.0) THEN
        M=I-1
      END IF
C
      L=1
    1 CONTINUE
C       Assessing part LINE(L:M) of the input line:
        IF(L.GT.M) THEN
          GO TO 9
        END IF
C
C       Searching for '=' in the line:
        K=INDEX(LINE(L:M),'=')+L-1
        IF(K.LT.L) THEN
          GO TO 9
        END IF
        NPAR=NPAR+1
        IF(NPAR.GT.MPAR) THEN
C         SEP-01
          PAUSE 'Error SEP-01: Too many input parameters to store'
          STOP
        END IF
C
C       Name of the parameter must precede '=':
        DO 2 I=K-1,L,-1
          IF(LINE(I:I).EQ.' '.OR.LINE(I:I).EQ.',') THEN
            GO TO 3
          END IF
    2   CONTINUE
    3   CONTINUE
        IF(I.GE.K-1) THEN
          PAR(NPAR)=' '
        ELSE
          PAR(NPAR)=LINE(I+1:K-1)
          CALL LOWER(PAR(NPAR))
        END IF
C
C       Value of the parameter must follow '=':
        K=K+1
        IF(K.GT.M) THEN
C         End of line just after '=':
          NCHAR(NPAR)=0
          L=K
        ELSE IF(LINE(K:K).EQ.''''.OR.LINE(K:K).EQ.'"') THEN
C         String enclosed in apostrophes or quotes following '=':
          NCHAR(NPAR)=0
          L=K
C         Loop for embedded apostrophes
    5     CONTINUE
            L=L+1
C           L is the position after the opening apostrophe
            I=INDEX(LINE(L:M),LINE(K:K))
            IF(I.LE.0) THEN
C             SEP-02
              PAUSE 'Error SEP-02: String not terminated by apostrophe'
              STOP
            END IF
            J=NCHAR(NPAR)
            NCHAR(NPAR)=J+I-1
            VALUE(NPAR)(J+1:J+I-1)=LINE(L:L+I-2)
            L=L+I
C           L is the position after the terminating apostrophe
          IF(LINE(L:L).EQ.LINE(K:K)) GO TO 5
        ELSE
C         String without apostrophes or quotes following '=':
          I=INDEX(LINE(K:M),' ')
          J=INDEX(LINE(K:M),',')
          IF(I.LE.0) THEN
            IF(J.LE.0) THEN
              I=M-K+2
            ELSE
              I=J
            END IF
          ELSE
            IF(J.GT.0) THEN
              I=MIN0(I,J)
            END IF
          END IF
          NCHAR(NPAR)=I-1
          IF(I.GT.1) THEN
            VALUE(NPAR)=LINE(K:K+I-2)
          END IF
          L=K+I
C         L is the position after the terminating separator ' ' or ','
        END IF
C
C       Blank parameter:
        IF(PAR(NPAR).EQ.' ') THEN
          NPAR=NPAR-1
        END IF
C
C       Removing duplicate registrations:
        DO 7 I=NPAR-1,1,-1
          IF(PAR(I).EQ.PAR(NPAR)) THEN
            NCHAR(I)=NCHAR(NPAR)
            VALUE(I)=VALUE(NPAR)
            NPAR=NPAR-1
            GO TO 8
          END IF
    7   CONTINUE
    8   CONTINUE
      GO TO 1
C
    9 CONTINUE
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RSEP3R(NAME,ROUT,RDEF)
      CHARACTER*(*) NAME
      REAL ROUT,RDEF
C
C Subroutine designed to read the value of a given real-valued parameter
C from previously stored contents of SEP-like parameter or header files.
C
C Input:
C     NAME... String containing the name of the parameter.  Except for
C             its case, it should match the parameter name in the input
C             SEP parameter file.
C     RDEF... Default value of the parameter.
C
C Output:
C     ROUT... Value of the parameter.
C
C-----------------------------------------------------------------------
C
      INCLUDE 'sep.inc'
C     sep.inc
C
C-----------------------------------------------------------------------
C
      EXTERNAL LENGTH,LOWER
      INTEGER  LENGTH
C
C-----------------------------------------------------------------------
C
      CHARACTER*20 LOWNAM
      CHARACTER*7 FORMAT
      INTEGER I
C
      LOWNAM=NAME
      CALL LOWER(LOWNAM)
      ROUT=RDEF
      DO 10 I=1,NPAR
        IF(PAR(I).EQ.LOWNAM) THEN
          IF(NCHAR(I).LE.0) THEN
            ROUT=RDEF
          ELSE
            FORMAT='(F00.0)'
            FORMAT(3:3)=CHAR(ICHAR('0')+NCHAR(I)/10)
            FORMAT(4:4)=CHAR(ICHAR('0')+MOD(NCHAR(I),10))
            READ(VALUE(I),FORMAT,ERR=20) ROUT
          END IF
        END IF
   10 CONTINUE
      RETURN
C
   20 CONTINUE
C     SEP-03
      WRITE(*,'(5A)') ' Parameter: ''',PAR(I)(1:LENGTH(PAR(I))),
     *                ''', Value: ''',VALUE(I)(1:NCHAR(I)),''''
      PAUSE 'Error SEP-03 in RSEP3R when reading real value'
      STOP
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RSEP3I(NAME,IOUT,IDEF)
      CHARACTER*(*) NAME
      INTEGER IOUT,IDEF
C
C Subroutine designed to read the value of a given integer parameter
C from previously stored contents of SEP-like parameter or header files.
C
C Input:
C     NAME... String containing the name of the parameter.  Except for
C             its case, it should match the parameter name in the input
C             SEP parameter file.
C     IDEF... Default value of the parameter.
C
C Output:
C     IOUT... Value of the parameter.
C
C-----------------------------------------------------------------------
C
      INCLUDE 'sep.inc'
C     sep.inc
C
C-----------------------------------------------------------------------
C
      EXTERNAL LENGTH,LOWER
      INTEGER  LENGTH
C
C-----------------------------------------------------------------------
C
      CHARACTER*20 LOWNAM
      CHARACTER*5 FORMAT
      INTEGER I
C
      LOWNAM=NAME
      CALL LOWER(LOWNAM)
      IOUT=IDEF
      DO 10 I=1,NPAR
        IF(PAR(I).EQ.LOWNAM) THEN
          IF(NCHAR(I).LE.0) THEN
            IOUT=IDEF
          ELSE
            FORMAT='(I00)'
            FORMAT(3:3)=CHAR(ICHAR('0')+NCHAR(I)/10)
            FORMAT(4:4)=CHAR(ICHAR('0')+MOD(NCHAR(I),10))
            READ(VALUE(I),FORMAT,ERR=20) IOUT
          END IF
        END IF
   10 CONTINUE
      RETURN
C
   20 CONTINUE
C     SEP-04
      WRITE(*,'(5A)') ' Parameter: ''',PAR(I)(1:LENGTH(PAR(I))),
     *                ''', Value: ''',VALUE(I)(1:NCHAR(I)),''''
      PAUSE 'Error SEP-04 in RSEP3I when reading integer value'
      STOP
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RSEP3T(NAME,TOUT,TDEF)
      CHARACTER*(*) NAME,TOUT,TDEF
C
C Subroutine designed to read the value of a given text-valued parameter
C from previously stored contents of SEP-like parameter or header files.
C
C Input:
C     NAME... String containing the name of the parameter.  Except for
C             its case, it should match the parameter name in the input
C             SEP parameter file.
C     TDEF... Default value of the parameter.
C
C Output:
C     TOUT... Value of the parameter.
C
C-----------------------------------------------------------------------
C
      INCLUDE 'sep.inc'
C     sep.inc
C
C-----------------------------------------------------------------------
C
      EXTERNAL LOWER
C
C-----------------------------------------------------------------------
C
      CHARACTER*20 LOWNAM
      CHARACTER*5 FORMAT
      INTEGER I
C
      LOWNAM=NAME
      CALL LOWER(LOWNAM)
      TOUT=TDEF
      DO 10 I=1,NPAR
        IF(PAR(I).EQ.LOWNAM) THEN
          IF(NCHAR(I).LE.0) THEN
            TOUT=TDEF
          ELSE
            TOUT=VALUE(I)(1:NCHAR(I))
          END IF
        END IF
   10 CONTINUE
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE WSEPR(LINE,NAME,RVAL)
      CHARACTER*(*) LINE,NAME
      REAL RVAL
C
C Subroutine designed to write the value of a given real-valued
C parameter into the output string.
C
C Input:
C     NAME... String containing the name of the parameter.
C     RVAL... Value of the parameter.
C
C Output:
C     LINE... String containing a space followed by the NAME=RVAL
C             couple.
C
C-----------------------------------------------------------------------
C
      EXTERNAL LENGTH
      INTEGER  LENGTH
C
C-----------------------------------------------------------------------
C
C     NWIDTH is the maximum width of the output real number in
C     characters.  The real number should be written with the accuracy
C     of NWIDTH-6 digits.
C
      INTEGER NWIDTH,I,J
      PARAMETER (NWIDTH=12)
      CHARACTER*(NWIDTH) TEXT
      CHARACTER*7 FORMAT
C
C     Output format:
      FORMAT='(G12.6)'
      FORMAT(3:3)=CHAR(ICHAR('0')+NWIDTH/10)
      FORMAT(4:4)=CHAR(ICHAR('0')+MOD(NWIDTH,10))
C
      WRITE(TEXT,FORMAT) RVAL
      DO 11 J=1,NWIDTH
        IF(TEXT(J:J).NE.' ') THEN
          GO TO 12
        END IF
   11 CONTINUE
   12 CONTINUE
      I=LENGTH(NAME)+2
      IF(I+LENGTH(TEXT(J:)).GT.LEN(LINE)) THEN
C       SEP-05
        PAUSE 'Error SEP-05 in WSEPR: Too small output string'
        STOP
      END IF
      LINE(1:1)=' '
      LINE(2:I-1)=NAME
      LINE(I:I)='='
      LINE(I+1:)=TEXT(J:)
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE WSEPI(LINE,NAME,IVAL)
      CHARACTER*(*) LINE,NAME
      INTEGER IVAL
C
C Subroutine designed to write the value of a given integer
C parameter into the output string.
C
C Input:
C     NAME... String containing the name of the parameter.
C     IVAL... Value of the parameter.
C
C Output:
C     LINE... String containing a space followed by the NAME=IVAL
C             couple.
C
C-----------------------------------------------------------------------
C
      EXTERNAL LENGTH
      INTEGER  LENGTH
C
C-----------------------------------------------------------------------
C
C     NWIDTH is the maximum width of the output integer in characters.
C
      INTEGER NWIDTH,I,J
      PARAMETER (NWIDTH=12)
      CHARACTER*(NWIDTH) TEXT
      CHARACTER*5 FORMAT
C
C     Output format:
      FORMAT='(I00)'
      FORMAT(3:3)=CHAR(ICHAR('0')+NWIDTH/10)
      FORMAT(4:4)=CHAR(ICHAR('0')+MOD(NWIDTH,10))
C
      WRITE(TEXT,FORMAT) IVAL
      DO 11 J=1,NWIDTH
        IF(TEXT(J:J).NE.' ') THEN
          GO TO 12
        END IF
   11 CONTINUE
   12 CONTINUE
      I=LENGTH(NAME)+2
      IF(I+LENGTH(TEXT(J:)).GT.LEN(LINE)) THEN
C       SEP-06
        PAUSE 'Error SEP-06 in WSEPI: Too small output string'
        STOP
      END IF
      LINE(1:1)=' '
      LINE(2:I-1)=NAME
      LINE(I:I)='='
      LINE(I+1:)=TEXT(J:)
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE LOWER(TEXT)
      CHARACTER*(*) TEXT
C
C Subroutine changing a given character string to lowercase.
C
C Input:
C     TEXT... A given string.
C
C Output:
C     TEXT... The given string converted to lowercase.
C
C-----------------------------------------------------------------------
C
      EXTERNAL LENGTH
      INTEGER  LENGTH
C
C-----------------------------------------------------------------------
C
      CHARACTER*1 LETTER
      INTEGER ISHIFT,I
C
      ISHIFT=ICHAR('a')-ICHAR('A')
      DO 10 I=1,LENGTH(TEXT)
        LETTER=TEXT(I:I)
        IF('A'.LE.LETTER.AND.LETTER.LE.'Z') THEN
          TEXT(I:I)=CHAR(ICHAR(LETTER)+ISHIFT)
        END IF
   10 CONTINUE
      RETURN
      END
C
C=======================================================================
C