C 
C Program COORCHG to transform the coordinates of lines or points
C from Cartesian coordinates to polar spherical or geographic spherical
C coordinates and vice versa
C
C Version: 6.00
C Date: 2006, March 2
C
C Coded by Petr Bulant
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mail: bulant@seis.karlov.mff.cuni.cz
C
C Program COORCHG reads the line(s) specified in the form
C LIN, or the point(s) specified in the
C form PTS, and transforms the
C coordinates of the lines or points from Cartesian coordinates
C to polar spherical or geographic spherical coordinates and vice versa
C according to the input parameters MODEL and TOCART.
C
C.......................................................................
C                                                    
C Description of data files:
C
C Input data read from the standard input device (*):
C     The data are read by the list directed input (free format) and
C     consist of a single string 'SEP':
C     'SEP'...String in apostrophes containing the name of the input
C             SEP parameter or history file with the input data.
C     No default, 'SEP' must be specified and cannot be blank.
C
C                                                     
C Input data file 'SEP':
C     File 'SEP' has the form of the SEP
C     parameter file.  The parameters, which do not differ from their
C     defaults, need not be specified in file 'SEP'.
C Names of input and output files:
C     Just one input file and one corresponding output file must be
C     specified.
C     LIN='string'... Name of the input file with the input line(s).
C             Description of file LIN
C             Default: LIN=' ' (no file given)
C     LINOUT='string'... Name of the output file with the transformed
C             line(s). Description of file LINOUT
C             Default: LINOUT=' ' (no file given)
C     PTS='string'... Name of the input file with the input point(s).
C             Description of file PTS
C             Default: PTS=' ' (no file given)
C     PTSOUT='string'... Name of the output file with the transformed
C             point(s). Description of file PTSOUT
C             Default: PTSOUT=' ' (no file given)
C Specification of the non-Cartesian coordinate system (one coordinate
C system (input or output) is always Cartesian):
C     MODEL='string'... Name of the input formatted file with the input
C             data for the model.
C             Only integer KOORS specifying the type of the coordinate
C             system and additional data (2A) for the coordinate system
C             are read from data file MODEL.
C             Default: MODEL='model.dat'
C Parameter describing the transformation:
C     TOCART=integer ... Specifies the transformation to be performed.
C             TOCART=0 ... From Cartesian coordinates to coordinates
C               given by MODEL.
C             TOCART=1 ... From coordinate system given by MODEL to
C               Cartesian coordinates.
C             Default: TOCART=0
C Optional parameters specifying the form of the real quantities
C written in the output formatted files:
C     MINDIG,MAXDIG=positive integers ... See the description in file
C             forms.for.
C
C                                                     
C Input file LIN with the lines:
C (1) None to several strings terminated by / (a slash). Only first
C     20 strings are read by COORCHG. The strings must not begin by $
C     (dolar). If the string begins by $, the string is not read and
C     reading of the succesive strings is terminated.
C (2) For each line data (2.1), (2.2) and (2.3):
C (2.1) 'NAME',X1,X2,X3,/
C     'NAME' ... Name of the line.  May be blank but must be different
C             from $.
C     X1,X2,X3 ... Optional coordinates of the reference point of the
C             line.  Need not be defined, but must be different from
C             the value of UNDEF, for value of UNDEF see function UARRAY
C             of file forms.for.
C             If X1 is defined, than X2 and X3 need not be defined
C             and their default is 0. (zero).
C     / ...   List of values must be terminated by a slash.  In place
C             of the terminating slash, several additional numbers
C             terminated by a slash may be written.  These numbers are
C             read and written to the output file LINOUT. At most 17
C             additional numbers are read, the numbers must be different
C             from UNDEF.
C (2.2) For each point of the line data (2.2.1):
C (2.2.1) X1,X2,X3,/
C     X1,X2,X3 ... Coordinates of the point of the line.
C             X1 must be different from the value of UNDEF.
C             Default for X2 and X3 is 0.
C     / ...   List of values must be terminated by a slash.  In place
C             of the terminating slash, several additional numbers
C             terminated by a slash may be written.  These numbers are
C             read and written to the output file LINOUT. At most 17
C             additional numbers are read, the numbers must be different
C             from UNDEF.
C (2.3) /
C (3) / or end of file.
C
C                                                  
C Output file LINOUT with the transformed lines:
C (1) Strings as in file LIN terminated by / (a slash). Only the
C     first 20 strings from file LIN are written to file LINOUT. Each
C     line contains only one string or the final /. Spaces at the ends
C     of the strings are not written.
C (2) For each line data (2.1), (2.2) and (2.3):
C (2.1) 'NAME',X1,X2,X3,/
C     'NAME' ... Name of the line.
C     X1,X2,X3 ... Optional coordinates of the reference point
C             transformed according to the input parameter TOCART.
C     / ...   Terminating slash or 17 unchanged additional numbers
C             terminated by slash.
C (2.2) For each point of the line data (2.2.1):
C (2.2.1) X1,X2,X3,/
C     X1,X2,X3 ... Coordinates of the point of the line transformed
C             according to the input parameter TOCART.
C     / ...   Terminating slash or 17 unchanged additional numbers
C             terminated by slash.
C (2.3) / (a slash)
C (3) / (a slash) at the end of file.
C
C                                                     
C Input file PTS with the points:
C (1) None to several strings terminated by / (a slash). Only first
C     20 strings are read by COORCHG. The strings must not begin by $
C     (dolar). If the string begins by $, the string is not read and
C     reading of the succesive strings is terminated.
C (2) For each point data (2.1):
C (2.1) 'NAME',X1,X2,X3,/
C     'NAME' ... Name of the point.  May be blank but must be different
C             from $.
C     X1,X2,X3 ... Coordinates of the point.  Must be different from
C             the value of UNDEF, for value of UNDEF see function UARRAY
C             of file forms.for.
C             If X1 is defined, than X2 and X3 need not be defined
C             and their default is 0. (zero).
C     / ...   List of values must be terminated by a slash.  In place
C             of the terminating slash, several additional numbers
C             terminated by a slash may be written.  These numbers are
C             read and written to the output file PTSOUT. At most 17
C             additional numbers are read, the numbers must be different
C             from UNDEF.
C (3) / or end of file.
C
C                                                  
C Output file PTSOUT with the transformed points:
C (1) Strings as in file PTS terminated by / (a slash). Only the
C     first 20 strings from file PTS are written to file PTSOUT. Each
C     line contains only one string or the final /. Spaces at the ends
C     of the strings are not written.
C (2) For each point data (2.1):
C (2.1) 'NAME',X1,X2,X3,/
C     'NAME' ... Name of the point.
C     X1,X2,X3 ... Coordinates of the point transformed according to the
C             input parameter TOCART.
C     / ...   Terminating slash or 17 unchanged additional numbers
C             terminated by slash.
C (3) / (a slash) at the end of file.
C
C-----------------------------------------------------------------------
C Subroutines and external functions required:
      EXTERNAL ERROR,RSEP1,RSEP3T,RSEP3I,FORM1,LENGTH,METR1,CARTES
      EXTERNAL UARRAY
      REAL UARRAY
      INTEGER  LENGTH
C     ERROR ... File error.for.
C     RSEP1,RSEP3T,RSEP3I ...
C             File sep.for.
C     FORM1 ... File forms.for.
C     LENGTH ... File length.for.
C     METR1,CARTES .. File metric.for.
C
C
C     Filenames and parameters:
      CHARACTER*80 FSEP,FMOD,FIN,FOUT,FINL,FOUTL,FINP,FOUTP
      INTEGER LU1,LU2
      REAL UNDEF
      PARAMETER (LU1=1,LU2=2)
C
C     Other variables:
      CHARACTER*(24) FORMAT
      INTEGER I1,I2,I,ITO
      REAL R(20),R1,R2,R3,S(3),S1,S2,S3,DER(9),OUTMIN,OUTMAX
      CHARACTER*1 TEXTM
      CHARACTER*255 TEXT(20)
      LOGICAL TOCAR
      EQUIVALENCE (R(1),R1),(R(2),R2),(R(3),R3)
      EQUIVALENCE (S(1),S1),(S(2),S2),(S(3),S3)
      DATA  TEXT/20*'$'/
C
      UNDEF=UARRAY()
C
C.......................................................................
C
C     Reading a name of the file with the input data:
      FSEP=' '
      WRITE(*,'(A)') '+COORCHG: Enter input filename: '
      READ(*,*) FSEP
      IF (FSEP.EQ.' ') THEN
C       COORCHG-01
        CALL ERROR('COORCHG-01: No input file specified')
C       Input file in the form of the SEP (Stanford Exploration Project)
C       parameter or history file must be specified.
C       There is no default filename.
      ENDIF
      WRITE(*,'(A)') '+COORCHG: Working ...           '
C
C     Reading all the data from the SEP file into the memory:
      CALL RSEP1(LU1,FSEP)
C
C     Reading input and output filenames:
      CALL RSEP3T('LIN'   ,FINL ,' ')
      CALL RSEP3T('LINOUT',FOUTL,' ')
      CALL RSEP3T('PTS'   ,FINP ,' ')
      CALL RSEP3T('PTSOUT',FOUTP,' ')
      IF ((FINL.EQ.' ').OR.(FOUTL.EQ.' ')) FINL=' '
      IF ((FINP.EQ.' ').OR.(FOUTP.EQ.' ')) FINP=' '
      IF (((FINL.EQ.' ').AND.(FINP.EQ.' ')).OR.
     *    ((FINL.NE.' ').AND.(FINP.NE.' '))) THEN
C       COORCHG-02
        CALL ERROR
     *  ('COORCHG-02: Wrong specification of input and output files')
C       Just one input file and one corresponding output file must be
C       specified.  There is no default.  It is not allowed to specify
C       both LIN, LINOUT and PTS, PTSOUT.  If LIN is specified, then
C       LINOUT must be specified and PTS and PTSOUT must not be
C       specified.
      ENDIF
C     Storing the names of input and output files to FIN and FOUT:
      IF (FINL.NE.' ') THEN
        FIN=FINL
        FOUT=FOUTL
      ELSE
        FIN=FINP
        FOUT=FOUTP
      ENDIF
C
      CALL RSEP3T('MODEL',FMOD,'model.dat')
      OPEN(LU1,FILE=FMOD,STATUS='OLD')
      READ(LU1,*) TEXTM
      I=0
      READ(LU1,*) I
      CALL METR1(I,LU1)
      CLOSE(LU1)
C
      CALL RSEP3I('TOCART',ITO,0)
      IF ((ITO.NE.0).AND.(ITO.NE.1)) THEN
C       COORCHG-04
        CALL ERROR('COORCHG-04: Wrong value of TOCART')
C       See the description of input data.
      ENDIF
      IF (ITO.EQ.0) THEN
        TOCAR=.FALSE.
      ELSEIF (ITO.EQ.1) THEN
        TOCAR=.TRUE.
      ENDIF
C
C     Beginning of the output file:
      OPEN(LU2,FILE=FOUT)
C
C     Reading input file:
      OPEN(LU1,FILE=FIN,STATUS='OLD')
      READ(LU1,*) TEXT
      I2=0
      DO 10, I1=20,1,-1
        IF (TEXT(I1).NE.'$') THEN
          I2=I1
          GOTO 11
        ENDIF
  10  CONTINUE
  11  CONTINUE
      DO 20, I1=1,I2
        WRITE(LU2,'(3A)')  '''',TEXT(I1)(1:LENGTH(TEXT(I1))),''''
  20  CONTINUE
      WRITE(LU2,'(A)')  ' /'
C     Loop over lines or points:
   60 CONTINUE
        TEXT(1)='$'
        DO 62, I1=1,20
          R(I1)=UNDEF
   62   CONTINUE
        R2=0.
        R3=0.
        READ(LU1,*,END=90) TEXT(1),R
        IF (TEXT(1).EQ.'$') GOTO 90
        FORMAT(1:7)='(3A,20('
        FORMAT(16:17)='))'
        IF     (R1.EQ.UNDEF) THEN
          WRITE(LU2,'(3A)')
     *      '''',TEXT(1)(1:LENGTH(TEXT(1))),''' /'
        ELSE
          IF (TOCAR) THEN
            CALL CARTES(R,TOCAR,S,DER)
          ELSE
            CALL CARTES(S,TOCAR,R,DER)
          ENDIF
          I2=3
          DO 63, I1=20,4,-1
            IF (R(I1).NE.UNDEF) THEN
              I2=I1
              GOTO 64
            ENDIF
  63      CONTINUE
  64      CONTINUE
          OUTMIN=AMIN1(S1,S2,S3)
          OUTMAX=AMAX1(S1,S2,S3)
          DO 645, I1=4,I2
            OUTMIN=AMIN1(OUTMIN,R(I1))
            OUTMAX=AMAX1(OUTMAX,R(I1))
  645     CONTINUE
          CALL FORM1(OUTMIN,OUTMAX,FORMAT(8:15))
          WRITE(LU2,FORMAT)
     *      '''',TEXT(1)(1:LENGTH(TEXT(1))),''' ',S1,' ',S2,' ',S3,
     *      (' ',R(I1),I1=4,I2),' /'
        ENDIF
C
        IF (FINL.NE.' ') THEN
C         Reading the line points
   65     CONTINUE
            DO 66, I1=1,20
              R(I1)=UNDEF
   66       CONTINUE
            R2=0.
            R3=0.
            READ(LU1,*,END=80) R
            IF (R1.EQ.UNDEF) GOTO 80
            FORMAT(1:4)='(20('
            FORMAT(13:14)='))'
            IF (TOCAR) THEN
              CALL CARTES(R,TOCAR,S,DER)
            ELSE
              CALL CARTES(S,TOCAR,R,DER)
            ENDIF
            I2=3
            DO 67, I1=20,4,-1
              IF (R(I1).NE.UNDEF) THEN
                I2=I1
                GOTO 68
              ENDIF
  67        CONTINUE
  68        CONTINUE
            OUTMIN=AMIN1(S1,S2,S3)
            OUTMAX=AMAX1(S1,S2,S3)
            DO 685, I1=4,I2
              OUTMIN=AMIN1(OUTMIN,R(I1))
              OUTMAX=AMAX1(OUTMAX,R(I1))
  685       CONTINUE
            CALL FORM1(OUTMIN,OUTMAX,FORMAT(5:12))
            WRITE(LU2,FORMAT)
     *           S1,' ',S2,' ',S3,(' ',R(I1),I1=4,I2),' /'
          GOTO 65
   80     CONTINUE
C         End of line.
          WRITE(LU2,'(A)') ' /'
        ENDIF
      GOTO 60
   90 CONTINUE
C     End of file.
      WRITE(LU2,'(A)') ' /'
      CLOSE(LU1)
      CLOSE(LU2)
      WRITE(*,'(A)') '+COORCHG: Done.                 '
      STOP
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     error.for
      INCLUDE 'sep.for'
C     sep.for
      INCLUDE 'forms.for'
C     forms.for
      INCLUDE 'length.for'
C     length.for
      INCLUDE 'metric.for'
C     metric.for
C
C=======================================================================
C