C
C Program CRT2D3D transforming 2-D system of rays to 3-D system of rays C to be processed by program MTT which present version works only in 3-D C C Version: 5.10 C Date: 1997, October 21 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 C Description of data files: C C Main input data read from external interactive device (*): C The data consist of character strings, read by list directed (free C format) input. The strings have thus to be enclosed in C apostrophes. The interactive * external unit may be redirected to C the file containing the data. C (1) 'CRT-R-2D','CRT-I-2D','CRT-T-2D','CRT-R-3D','CRT-I-3D','CRT-T-3D', C DX1,DX2,DX3,/ C 'CRT-R-2D'... Input file CRT-R with the quantities stored along C rays (see C.R.T.5.5.1) resulting from 2-D ray tracing. C 'CRT-I-2D'... Input file CRT-I with the quantities at the initial C points of rays, corresponding to file CRT-R-2D (see C C.R.T.6.1). C 'CRT-T-2D'... Input file CRT-T with the homogeneous triangles in C the ray-parameter domain, corresponding to file CRT-R-2D. C 'CRT-R-3D'... Output file CRT-R containing 3-D sytem of rays C composed of two 2-D system of rays shifted by vectors C -(DX1,DX2,DX3) and +(DX1,DX2,DX3). C 'CRT-I-3D'... Output file CRT-I with the quantities at the initial C points, corresponding to file CRT-R-3D (see C.R.T.6.1). C 'CRT-T-3D'... Output file CRT-T with the homogeneous triangles in C the ray-parameter domain, corresponding to file CRT-R-3D. C DX1,DX2,DX3... Translation vector perpendicular to the 2-D system C of rays. C Default: 'CRT-R-2D'='r01.out', 'CRT-I-2D'='r01i.out', C 'CRT-T-2D'='t01.out', 'CRT-R-3D'='r01-3d.out', C 'CRT-I-3D'='r01i-3d.out', 'CRT-T-3D'='t01-3d.out', C DX1=0., DX2=0., DX3=0. C C Unformatted files CRT-R: C See the description within source code file 'writ.for'. C Description of files CRT-R C C Unformatted files CRT-I: C See the description within source code file 'writ.for'. C Description of files CRT-I C C Formatted files CRT-T: C See the description within source code file 'writ.for'. C Description of files CRT-T C C----------------------------------------------------------------------- C C Memory management: INCLUDE 'ram.inc' C ram.inc INTEGER IRAM(MRAM) EQUIVALENCE (IRAM,RAM) C C Common block /POINTC/ to store the results of complete ray tracing: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL AP00 C AP00... File 'ap.for'. C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER LU1,LU2,LU3,LU4,I,J,I1,I2,I3,I100,N100,NRAM PARAMETER (LU1=1,LU2=2,LU3=3,LU4=4) CHARACTER*80 FILE1,FILE2,FILE3,FILE4,FILE5,FILE6 REAL DX1,DX2,DX3,X1,X2,X3 C C Output format: INTEGER IFORM CHARACTER*10 FORMAT DATA IFORM/99999/,FORMAT/'(I6,I6,I6)'/ C C C....................................................................... C C Opening input and output files: FILE1='r01.out' FILE2='r01i.out' FILE3='t01.out' FILE4='r01-3d.out' FILE5='r01i-3d.out' FILE6='t01-3d.out' DX1=0. DX2=0. DX3=0. WRITE(*,'(2A)') ' Enter 6 filenames and 3 reals: ' READ(*,*) FILE1,FILE2,FILE3,FILE4,FILE5,FILE6,DX1,DX2,DX3 C C Triangles: WRITE(*,'(2A)') '+Writing triangles ' OPEN(LU1,FILE=FILE3,STATUS='OLD') OPEN(LU2,FILE=FILE6) N100=0 C C Loop for the triangles 10 CONTINUE C Reading the interval READ(LU1,*,END=20) I1,I2,I3 IF(I3.NE.0) THEN C CRT2D3D-01 C PAUSE 'Error CRT2D3D-01: Input data are not 2-D' STOP END IF N100=MAX0(I1,I2,N100) C Setting output format IF(2*I1.GT.IFORM.OR.2*I2.GT.IFORM) THEN IFORM1=IFORM1*10+9 FORMAT(3:3)=CHAR(ICHAR(FORMAT(3:3))+1) FORMAT(6:6)=FORMAT(3:3) FORMAT(9:9)=FORMAT(3:3) END IF C Writing the triangles WRITE(LU2,FORMAT) 2*I1-1,2*I1,2*I2-1 WRITE(LU2,FORMAT) 2*I1,2*I2-1,2*I2 GO TO 10 C 20 CONTINUE CLOSE(LU1) CLOSE(LU2) C C Writing rays: WRITE(*,'(2A)') '+ 0% of rays rewritten ' OPEN(LU1,FILE=FILE1,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU2,FILE=FILE2,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU3,FILE=FILE4,FORM='UNFORMATTED') OPEN(LU4,FILE=FILE5,FORM='UNFORMATTED') I100=0 C C Loop for the points of rays NRAM=0 50 CONTINUE C Reading the results of the complete ray tracing CALL AP00(0,LU1,LU2) IF(IPT.LE.1.AND.NRAM.GT.0) THEN C New ray - recording the duplication of the last ray J=0 51 CONTINUE WRITE(LU3) (IRAM(I),I=J+1,J+5),(RAM(I),I=J+6,J+12+IRAM(J+3)) J=J+12+IRAM(J+3) IF(J.LT.NRAM) GO TO 51 NRAM=0 END IF IF(IWAVE.LT.1) THEN C End of rays GO TO 60 END IF IF(IPT.LE.1)THEN C New ray - recording the initial points X1=YI(3)-DX1 X2=YI(4)-DX2 X3=YI(5)-DX3 WRITE(LU4) -IWAVE,2*IRAY-1,ICB1I,IEND,ISHEET,IREC,YLI, * YI(1),YI(2),X1,X2,X3,(YI(I),I=6,MYI) X1=YI(3)+DX1 X2=YI(4)+DX2 X3=YI(5)+DX3 WRITE(LU4) -IWAVE,2*IRAY ,ICB1I,IEND,ISHEET,IREC,YLI, * YI(1),YI(2),X1,X2,X3,(YI(I),I=6,MYI) END IF X1=Y(3)-DX1 X2=Y(4)-DX2 X3=Y(5)-DX3 WRITE(LU3) IWAVE,2*IRAY-1,NY,ICB1,ISRF,X,YL,Y(1),Y(2),X1,X2,X3, * (Y(I),I=6,NY) IF(NRAM+12+NY.GT.MRAM) THEN C CRT2D3D-02 C PAUSE 'Error CRT2D3D-02: Too small array RAM to store a ray' STOP C Dimension MRAM of array RAM in include file C ram.inc C should probably be increased to accommodate a long ray. END IF IRAM(NRAM+1)=IWAVE IRAM(NRAM+2)=2*IRAY IRAM(NRAM+3)=NY IRAM(NRAM+4)=ICB1 IRAM(NRAM+5)=ISRF RAM(NRAM+6)=X DO 56 I=1,6 RAM(NRAM+6+I)=YL(I) 56 CONTINUE RAM(NRAM+13)=Y(1) RAM(NRAM+14)=Y(2) RAM(NRAM+15)=Y(3)+DX1 RAM(NRAM+16)=Y(4)+DX2 RAM(NRAM+17)=Y(5)+DX3 DO 57 I=6,NY RAM(NRAM+12+I)=Y(I) 57 CONTINUE NRAM=NRAM+12+NY IF(100*IRAY.GE.I100*N100) THEN WRITE(*,'(A,I3)') '+',I100 I100=I100+1 END IF GO TO 50 C 60 CONTINUE CLOSE(LU1) CLOSE(LU2) CLOSE(LU3) CLOSE(LU4) WRITE(*,'(A,I3)') '+',100 C STOP END C C======================================================================= C INCLUDE 'ap.for' C ap.for C C======================================================================= C