C 
C Program PTSSELEC to remove points of equal coordinates from a given
C file, and to replace the names of the points by their indices
C
C Version: 7.40
C Date: 2017, May 19
C
C Coded by: Petr Bulant
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     http://sw3d.cz/staff/bulant.htm
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 a SEP
C     parameter file.  The parameters, which do not differ from their
C     defaults, need not be specified in file 'SEP'.
C Data specifying input files:
C     PTS='string'... Name of the input file with points.
C             Description of file PTS
C             Default: PTS='pts.out'
C Data for selecting of the triangles:
C     KOLUM1=integer, KOLUM2=integer, KOLUM3=integer ... Indices
C             of columns in the input file PTS, which contain
C             the coordinates of the points.
C             Default: KOLUM1=1, KOLUM2=2, KOLUM3=3
C Data specifying output files:
C     PTSNEW='string' ... Name of the output file with points.
C             Individual points are succesively read from file PTS.  The
C             points of coordinates which differ from coordinates of all
C             previously read points are written to file PTSNEW.
C             Description of file PTSNEW
C             Default: PTSNEW='ptsnew.out'
C Value of undefined quantities:
C     UNDEF=real... The value to be used for undefined real quantities.
C             Default: UNDEF=undefined value used in forms.for
C
C                                                     
C Input file PTS with the points:
C (1) None to several strings terminated by / (a slash)
C (2) For each point data (2.1):
C (2.1) 'NAME',R1,R2,R3,...,/
C     'NAME'... Name of the point.  Not considered.  May be blank.
C     R1,R2,R3,...,/... Several values terminated by a slash.
C             The coordinates must be specified among the values.
C             Number of values must be the same for all the points.
C (3) / or end of file.
C
C                                                  
C Output file PTSNEW with the points:
C (1) / (a slash)
C (2) For each point data (2.1):
C (2.1) 'NAME',R1,R2,R3,...,/
C     'NAME'..Name of the point.  String in apostrophes containing
C             the index of the point.  The points in file PTS1
C             are indexed by positive integers according to their order.
C     R1,R2,R3,...,/... Unchanged values from file PTS.
C (3) / (a slash)
C
C=======================================================================
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     ram.inc
C
      INTEGER IRAM(MRAM)
      EQUIVALENCE (IRAM,RAM)
C
C.......................................................................
C
      EXTERNAL LENGTH,ERROR,FORM1,WARN,RSEP1,RSEP3T,RSEP3R,RSEP3I,UARRAY
      INTEGER  LENGTH
      REAL UARRAY
C
C.......................................................................
C
C     Filenames and parameters:
      CHARACTER*80 FSEP,FPTS,FPTS1
      INTEGER LU,LU1,IUNDEF
      PARAMETER (LU=1,LU1=2,IUNDEF=-999999)
      REAL UNDEF
C     Input data:
      CHARACTER*26 FORMA2
      CHARACTER*80 TEXT
C     Other variables:
      INTEGER NPTS,N,I,I1,I2,J1,J2,J3,NQ
      INTEGER NPTS1,NPTS2,KOLUM1,KOLUM2,KOLUM3
      REAL A1,A2,A3,B1,B2,B3,W1,W2,OUTMIN,OUTMAX,X1,X2,X3
C
C     NPTS...Number of storage locations for the points,
C             i.e. NQ times the number of points.
C
C-----------------------------------------------------------------------
C
C     Reading name of SEP file with input data:
      WRITE(*,'(A)') '+PTSSELEC: Enter input filename: '
      FSEP=' '
      READ (*,*) FSEP
      WRITE(*,'(A)') '+PTSSELEC: Working...            '
C
C     Reading all data from the SEP file into the memory:
      IF (FSEP.NE.' ') THEN
        CALL RSEP1(LU,FSEP)
      ELSE
C       PTSSELEC-01
        CALL ERROR('PTSSELEC-01: SEP file not given')
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
C
      UNDEF=UARRAY()
C
C     Reading input and output filenames:
      CALL RSEP3T('PTS',FPTS,'pts.out')
      CALL RSEP3T('PTSNEW',FPTS1,'ptsnew.out')
C
C     Reading the columns with the values and the limits of coordinates:
      CALL RSEP3I('KOLUM1',KOLUM1,1)
      CALL RSEP3I('KOLUM2',KOLUM2,2)
      CALL RSEP3I('KOLUM3',KOLUM3,3)
C
C     Reading points:
      OPEN(LU,FILE=FPTS,STATUS='OLD')
      READ(LU,*) (TEXT,I=1,20)
      DO 2, I=1,MRAM
        RAM(I)=UNDEF
   2  CONTINUE
      TEXT='$'
      READ(LU,*,END=18) TEXT,(RAM(I),I=1,MRAM)
      IF(TEXT.EQ.'$') GO TO 18
      NQ=0
      DO 4, I=MRAM,1,-1
        IF (RAM(I).NE.UNDEF) THEN
          NQ=I
          GOTO 5
        ENDIF
   4  CONTINUE
   5  CONTINUE
      IF (NQ.LT.MAX0(KOLUM1,KOLUM2)) THEN
C       PTSSELEC-04
        CALL ERROR('PTSSELEC-04: Missing values in file PTS')
C       Each line of file PTS must contain at least MAX(KOLUM1,KOLUM2)
C       quantities.
      ENDIF
      CLOSE(LU)
      OPEN(LU,FILE=FPTS,STATUS='OLD')
      READ(LU,*) (TEXT,I=1,20)
      NPTS=0
  10  CONTINUE
        IF(NPTS+NQ.GT.MRAM) THEN
C         PTSSELEC-02
          CALL ERROR('PTSSELEC-02: Too small array RAM')
        END IF
        DO 12, I=1,NQ
          RAM(NPTS+I)=UNDEF
  12    CONTINUE
        TEXT='$'
        READ(LU,*,END=18) TEXT,(RAM(I),I=NPTS+1,NPTS+NQ)
        IF(TEXT.EQ.'$') THEN
          GO TO 18
        END IF
        DO 14, I1=KOLUM1,NPTS,NQ
          IF (RAM(I1).EQ.RAM(NPTS+KOLUM1)) THEN
            IF (RAM(I1-KOLUM1+KOLUM2).EQ.RAM(NPTS+KOLUM2)) THEN
              IF (RAM(I1-KOLUM1+KOLUM3).EQ.RAM(NPTS+KOLUM3)) THEN
                GOTO 10
              ENDIF
            ENDIF
          ENDIF
  14    CONTINUE
        NPTS=NPTS+NQ
      GOTO 10
   18 CONTINUE
      CLOSE(LU)
C
C     Output format for the file with points
      FORMA2='(A,1I0.0,A,00(F00.0,1X),A)'
      I=INT(ALOG10(FLOAT(NPTS/NQ)))+1
      IF (I.GT.9) THEN
C       PTSSELEC-03
        CALL ERROR('PTSSELEC-03: Too many points in file PTSNEW')
C       This format specification allows for maximum of 100 000 000
C       of points in file PTSNEW
      ENDIF
      FORMA2(6:6)=CHAR(ICHAR('0')+I)
      FORMA2(8:8)=FORMA2(6:6)
      FORMA2(13:13)=CHAR(ICHAR('0')+MOD(NQ/1,10))
      FORMA2(12:12)=CHAR(ICHAR('0')+MOD(NQ/10,10))
C
      IF (FPTS1.NE.' ') THEN
C     Writing the points:
        OPEN(LU1,FILE=FPTS1)
        WRITE(LU1,'(A)') '/'
        NPTS1=0
        DO 28, I1=1,NPTS/NQ
          J1=NQ*(I1-1)
          OUTMIN=0.
          OUTMAX=0.
          DO 29, I=J1+1,J1+NQ
            IF(RAM(I).LT.OUTMIN) OUTMIN=RAM(I)
            IF(RAM(I).GT.OUTMAX) OUTMAX=RAM(I)
  29      CONTINUE
          CALL FORM1(OUTMIN,OUTMAX,FORMA2(15:22))
          FORMA2(21:24)= '1X),'
          NPTS1=NPTS1+1
          WRITE(LU1,FORMA2)
     *          ' ''',NPTS1,''' ',(RAM(J1+I),I=1,NQ),'/'
  28    CONTINUE
        WRITE(LU1,'(A)') '/'
        CLOSE(LU1)
      ENDIF
C
      WRITE(*,'(A)') '+PTSSELEC: Done.                 '
C
      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
C
C=======================================================================
C