C
C Program BNDLIN to write 12 lines forming edges of the model box
C
C Version: 5.40
C Date: 2000, May 10
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 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 Data specifying the input model file:
C MODEL='string'... Input data file describing the model.
C Description of file MODEL
C Default: 'MODEL'='model.dat'
C Data specifying the output file:
C LIN='string'... Name of the output file. It is recommended to
C specify it rather than to use the default name.
C Format of file LIN
C Default: LIN='lin.out'
C
C=======================================================================
C
C Common block /MODELC/:
INCLUDE 'model.inc'
C None of the storage locations of the common block are altered.
C
C-----------------------------------------------------------------------
C
CHARACTER*80 FILE1
PARAMETER (LU1=1)
C
C Reading main input data:
WRITE(*,'(A)') '+BNDLIN: Enter input filename: '
FILE1=' '
READ(*,*) FILE1
IF(FILE1.EQ.' ') THEN
C BNDLIN-01
CALL ERROR('BNDLIN-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.
END IF
WRITE(*,'(A)') '+BNDLIN: Working... '
CALL RSEP1(LU1,FILE1)
C
C Reading the model description file:
CALL RSEP3T('MODEL',FILE1,'model.dat')
OPEN(LU1,FILE=FILE1,STATUS='OLD')
CALL MODEL1(LU1)
CLOSE(LU1)
C
C Step along the lines (presently non-documented feature)
CALL RSEP3R('BNDSTEP',STEP,999999.)
C
C Reading output filename and opening the output file:
CALL RSEP3T('LIN',FILE1,'lin.out')
OPEN(LU1,FILE=FILE1)
C
WRITE(LU1,'(A)') '/'
CALL WLINE(LU1,BOUNDM(1),BOUNDM(3),BOUNDM(5),
* BOUNDM(2),BOUNDM(3),BOUNDM(5),STEP)
CALL WLINE(LU1,BOUNDM(2),BOUNDM(3),BOUNDM(5),
* BOUNDM(2),BOUNDM(4),BOUNDM(5),STEP)
CALL WLINE(LU1,BOUNDM(2),BOUNDM(4),BOUNDM(5),
* BOUNDM(1),BOUNDM(4),BOUNDM(5),STEP)
CALL WLINE(LU1,BOUNDM(1),BOUNDM(4),BOUNDM(5),
* BOUNDM(1),BOUNDM(3),BOUNDM(5),STEP)
CALL WLINE(LU1,BOUNDM(1),BOUNDM(3),BOUNDM(6),
* BOUNDM(2),BOUNDM(3),BOUNDM(6),STEP)
CALL WLINE(LU1,BOUNDM(2),BOUNDM(3),BOUNDM(6),
* BOUNDM(2),BOUNDM(4),BOUNDM(6),STEP)
CALL WLINE(LU1,BOUNDM(2),BOUNDM(4),BOUNDM(6),
* BOUNDM(1),BOUNDM(4),BOUNDM(6),STEP)
CALL WLINE(LU1,BOUNDM(1),BOUNDM(4),BOUNDM(6),
* BOUNDM(1),BOUNDM(3),BOUNDM(6),STEP)
CALL WLINE(LU1,BOUNDM(1),BOUNDM(3),BOUNDM(5),
* BOUNDM(1),BOUNDM(3),BOUNDM(6),STEP)
CALL WLINE(LU1,BOUNDM(2),BOUNDM(3),BOUNDM(5),
* BOUNDM(2),BOUNDM(3),BOUNDM(6),STEP)
CALL WLINE(LU1,BOUNDM(2),BOUNDM(4),BOUNDM(5),
* BOUNDM(2),BOUNDM(4),BOUNDM(6),STEP)
CALL WLINE(LU1,BOUNDM(1),BOUNDM(4),BOUNDM(5),
* BOUNDM(1),BOUNDM(4),BOUNDM(6),STEP)
WRITE(LU1,'(A)') '/'
CLOSE(LU1)
WRITE(*,'(A)') '+BNDLIN: Done. '
STOP
END
C
C=======================================================================
C
SUBROUTINE WLINE(LU1,X1,X2,X3,Y1,Y2,Y3,STEP)
C
WRITE(LU1,'(A)') '''MODEL BOUNDARY'''
WRITE(LU1,'(A)') '/'
DIST=SQRT((X1-Y1)**2+(X2-Y2)**2+(X3-Y3)**2)
DO 10 S=0.,0.999999,STEP/AMAX1(DIST,STEP)
Z=AMIN1(S+STEP/AMAX1(DIST,STEP),1.)
S1=X1+(Y1-X1)*S
S2=X2+(Y2-X2)*S
S3=X3+(Y3-X3)*S
Z1=X1+(Y1-X1)*Z
Z2=X2+(Y2-X2)*Z
Z3=X3+(Y3-X3)*Z
WRITE(LU1,'(3(G12.6,X),A)') S1,S2,S3,' /'
WRITE(LU1,'(3(G12.6,X),A)') Z1,Z2,Z3,' /'
WRITE(LU1,'(A)') '/'
10 CONTINUE
RETURN
END
C
C=======================================================================
C
INCLUDE 'error.for'
C error.for
INCLUDE 'sep.for'
C sep.for
INCLUDE 'length.for'
C length.for
INCLUDE 'model.for'
C model.for
INCLUDE 'metric.for'
C metric.for
INCLUDE 'srfc.for'
C srfc.for
INCLUDE 'parm.for'
C parm.for
INCLUDE 'val.for'
C val.for
INCLUDE 'fit.for'
C fit.for
C
C=======================================================================
C