C
C Program LINDEN to densify lines 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 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 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 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 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, C but must be different from the value of UNDEF. C For the value of UNDEF see function UARRAY of file C forms.for. 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 For the value of UNDEF see function UARRAY of file C forms.for. 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'... Name of the line as in the file LIN. C X1,X2,X3... Optional coordinates as in the file LIN. C /... List of values is terminated by a 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. Points from file C LIN are repeated, NLINDEN-1 new points is added C equidistantly in between each pair of subsequent points C from file LIN. C /... List of values is terminated by a slash. 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,UARRAY REAL UARRAY INTEGER LENGTH C ERROR... File error.for. C RSEP1,RSEP3T,RSEP3I... 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) 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 UNDEF=UARRAY() 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