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