C
C Program LINDEN to densify lines
C
C Version: 5.40
C Date: 2000, February 21
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 LINDEN reads the line(s) specified in the form
C LIN, and divides each part of each
C line into NLINDEN subparts (i.e. adds NLINDEN-1 new points in
C between each two subsequent points of each line). The subparts of
C each part are of the same length (the new points are added
C equidistantly).
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 LIN='string'... Name of the input file with the input line(s).
C Description of file LIN
C Default: LIN='lin.dat'
C LINOUT='string'... Name of the output file with the densified
C line(s). Description of file LINOUT
C Default: LINOUT='lin.out'
C Data specifying the form of the output file:
C NLINDEN=integer ... Number of subparts, to which each part of the
C input line is to be divided.
C Default: NLINDEN=1 (No new points added)
C
C Input file LIN with the lines:
C (1) None to several strings terminated by / (a slash)
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. Not considered. May be blank but
C must be different from '$'.
C X1,X2,X3... Optional coordinates of the reference point of the
C line. Not considered. Need not be defined, but must
C must be different from the value of UNDEF
C (the deffinition of the parameter UNDEF see below).
C /... List of values must be terminated by a slash.
C (2.2) For each point of the line data (2.2.1):
C (2.2.1) X1,X2,X3,V1,...,VN,/
C X1,X2,X3... Coordinates of the point of the line.
C X1 must be different from the value of UNDEF
C (the deffinition of the parameter UNDEF see below).
C Default for X2 and X3 is 0.
C V1,...,VN...Other real values. Not considered. Up to 100 values
C is allowed.
C /... List of values must be terminated by a slash.
C (2.3) /
C (3) / or end of file.
C
C
C Output file LINOUT with the densified 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 of the line and the optional coordinates as in the file LIN.
C (2.2) For each point of the line data (2.2.1):
C (2.2.1) X1,X2,X3,/
C Coordinates of the point of the line. Points from file LIN are
C repeated, NLINDEN-1 new points is added equidistantly in between
C each pair of subsequent points from file LIN.
C (2.3) / (a 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
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
C
C Filenames and parameters:
CHARACTER*80 FSEP,FIN,FOUT
INTEGER LU1,LU2,NDEN,NDEN1
REAL UNDEF
PARAMETER (LU1=1,LU2=2,UNDEF=-999999.)
C
C Other variables:
CHARACTER*(24) FORMAT
INTEGER I1,I2,I
REAL R1,R2,R3,X1,X2,X3,Y1,Y2,Y3,Z1,Z2,Z3,DX1,DX2,DX3,DEN,V(100)
CHARACTER*255 TEXT(20)
DATA TEXT/20*'$'/
C
C.......................................................................
C
C Reading a name of the file with the input data:
FSEP=' '
WRITE(*,'(A)') ' LINDEN: Enter input filename: '
READ(*,*) FSEP
IF (FSEP.EQ.' ') THEN
C LINDEN-01
CALL ERROR('LINDEN-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)') '+LINDEN: 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' ,FIN ,'lin.dat')
CALL RSEP3T('LINOUT',FOUT,'lin.out')
CALL RSEP3I('NLINDEN',NDEN,1)
NDEN=IABS(NDEN)
DEN=FLOAT(NDEN)
NDEN1=0
IF (NDEN.NE.0) NDEN1=NDEN-1
C
C Beginning of the output file:
OPEN(LU2,FILE=FOUT)
C
C Reading lines:
OPEN(LU1,FILE=FIN,STATUS='OLD')
READ(LU1,*) (TEXT(I),I=1,20)
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:
60 CONTINUE
TEXT(1)='$'
R1=UNDEF
R2=UNDEF
R3=UNDEF
READ(LU1,*,END=90) TEXT(1),R1,R2,R3
IF (TEXT(1).EQ.'$') GOTO 90
FORMAT(1:6)='(3A,0('
FORMAT(15:16)='))'
IF (R1.EQ.UNDEF) THEN
WRITE(LU2,'(3A)')
* '''',TEXT(1)(1:LENGTH(TEXT(1))),''' /'
ELSEIF (R2.EQ.UNDEF) THEN
CALL FORM1(R1,R1,FORMAT(7:14))
FORMAT(5:5)='1'
WRITE(LU2,FORMAT)
* '''',TEXT(1)(1:LENGTH(TEXT(1))),''' ',R1,' /'
ELSEIF (R3.EQ.UNDEF) THEN
CALL FORM1(AMIN1(R1,R2),AMAX1(R1,R2),FORMAT(7:14))
FORMAT(5:5)='2'
WRITE(LU2,FORMAT)
* '''',TEXT(1)(1:LENGTH(TEXT(1))),''' ',R1,' ',R2,' /'
ELSE
CALL FORM1(AMIN1(R1,R2,R3),AMAX1(R1,R2,R3),FORMAT(7:14))
FORMAT(5:5)='3'
WRITE(LU2,FORMAT)
* '''',TEXT(1)(1:LENGTH(TEXT(1))),''' ',R1,' ',R2,' ',R3,' /'
ENDIF
C Reading the line points
X1=UNDEF
X2=0.
X3=0.
READ(LU1,*,END=80) X1,X2,X3,(V(I1),I1=1,100)
IF (X1.EQ.UNDEF) GOTO 80
FORMAT(1:3)='(3('
FORMAT(12:13)='))'
CALL FORM1(AMIN1(X1,X2,X3),AMAX1(X1,X2,X3),FORMAT(4:11))
WRITE(LU2,FORMAT) X1,' ',X2,' ',X3,' /'
70 CONTINUE
Y1=UNDEF
Y2=0.
Y3=0.
READ(LU1,*,END=80) Y1,Y2,Y3,(V(I1),I1=1,100)
IF (Y1.EQ.UNDEF) GOTO 80
IF (NDEN1.NE.0) THEN
DX1=(Y1-X1)/DEN
DX2=(Y2-X2)/DEN
DX3=(Y3-X3)/DEN
DO 75, I1=1,NDEN1
Z1=X1+I1*DX1
Z2=X2+I1*DX2
Z3=X3+I1*DX3
CALL FORM1(AMIN1(Z1,Z2,Z3),AMAX1(Z1,Z2,Z3),FORMAT(4:11))
WRITE(LU2,FORMAT) Z1,' ',Z2,' ',Z3,' /'
75 CONTINUE
ENDIF
CALL FORM1(AMIN1(Y1,Y2,Y3),AMAX1(Y1,Y2,Y3),FORMAT(4:11))
WRITE(LU2,FORMAT) Y1,' ',Y2,' ',Y3,' /'
X1=Y1
X2=Y2
X3=Y3
GOTO 70
80 CONTINUE
C End of line.
WRITE(LU2,'(A)') ' /'
GOTO 60
90 CONTINUE
C End of file.
WRITE(LU2,'(A)') ' /'
CLOSE(LU1)
CLOSE(LU2)
WRITE(*,'(A)') '+LINDEN: Done. '
STOP
END
C
C=======================================================================
C
INCLUDE 'error.for'
C error.for
INCLUDE 'sep.for'
C sep.for
INCLUDE 'length.for'
C length.for
INCLUDE 'forms.for'
C forms.for
C
C=======================================================================
C