C                                                            <HTML><PRE>
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                                                    <A NAME="data"></A>
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     <A HREF="writ.for#out1">Description of files CRT-R</A>
C
C Unformatted files CRT-I:
C     See the description within source code file 'writ.for'.
C     <A HREF="writ.for#outi">Description of files CRT-I</A>
C
C Formatted files CRT-T:
C     See the description within source code file 'writ.for'.
C     <A HREF="writ.for#outt">Description of files CRT-T</A>
C
C-----------------------------------------------------------------------
C
C Memory management:
      INCLUDE 'ram.inc'
C     <A HREF="../forms/ram.inc">ram.inc</A>
      INTEGER IRAM(MRAM)
      EQUIVALENCE (IRAM,RAM)
C
C Common block /POINTC/ to store the results of complete ray tracing:
      INCLUDE 'pointc.inc'
C     <A HREF="pointc.inc">pointc.inc</A>
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         <A NAME="error01"></A><FONT COLOR="RED">CRT2D3D-01</FONT>
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         <A NAME="error02"></A><FONT COLOR="RED">CRT2D3D-02</FONT>
C         PAUSE 'Error CRT2D3D-02: Too small array RAM to store a ray'
          STOP
C         Dimension MRAM of array RAM in include file
C         <A HREF="../forms/ram.inc">ram.inc</A>
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     <A HREF="ap.for">ap.for</A>
C
C=======================================================================
C                                                                 </PRE>
