C
C Program CRT for complete ray tracing
C
C Version: 7.00
C Date: 2013, February 17
C
C Coded by: Ludek Klimes
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     http://sw3d.cz/staff/klimes.htm
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             File 'SEP' will be read by subroutine CRTIN, and the
C             parameters used by program CRT are described within
C             source code file
C             'crtin.for'.
C     No default, 'SEP' must be specified and cannot be blank.
C
C.......................................................................
C
C This file consists of:
C     CRT...  Main program controlling the complete ray tracing.
C             CRT
C
C=======================================================================
C
C     
C
      PROGRAM CRT
C
C Main program for complete ray tracing.  This program reads the input
C data and then controls the complete ray tracing of the specified
C elementary waves.
C
C Input data: Main input data set containing the names of other input
C files and the name of the output log file is read in by the subroutine
C CRTIN of the file 'crtin.for'.  Thus, the structure of the main input
C data set is described in the file 'crtin.for'.
C The name of the main input data file is given by the first actual
C argument of the subroutine crtin called in the first executive
C statement of the main program.  It is blank in the original version.
C
C Subroutines referenced:
      EXTERNAL ERROR,CRTIN,RAY2,INIT2,CODE1,RPAR1,RPAR2,RPAR4
      EXTERNAL LUWARN,WRIT1,WRIT2,WRIT4,WRIT5
      INTEGER  LUWARN
C     ERROR,LUWARN...File  'error.for' of package FORMS.
C     MODEL1...File  'model.for' of package MODEL.
C     CRTIN,UNIT... File 'crtin.for'.
C     RAY1,RAY2... File 'ray.for'.
C     INIT1,INIT2... File 'init.for'.
C     CODE1... File 'code.for'.
C     RPAR1,RPAR2,RPAR4... File 'rpar.for'.
C     WRIT1,WRIT2,WRIT4, WRIT5... File 'writ.for'.
C Note that the above subroutines reference many other external
C procedures from various subroutine files.  These indirectly
C referenced procedures are not named here, but are listed in the
C particular subroutine files.
C
C Date: 2013, February 15
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Storage locations:
C
C     Input data:
      CHARACTER*80 FCRT,FRPAR,FWRIT
C
C     FCRT... Name of the main input data file for the complete ray
C             tracing program.
C     FRPAR.. Name of optional file
C             RPAREW
C             containing data RPAR-(4) corresponding to individual
C             elementary waves.
C     FWRIT.. Name of optional file
C             WRITEW
C             containing data WRIT-(6) corresponding to individual
C             elementary waves.
C
C     Logical unit numbers:
      INTEGER LUCODE,LURPAR,LUWRIT,LULOG
C
C     LUCODE..The logical unit connected to the file with the CODE data.
C     LURPAR..The logical unit connected to the file with the RPAR data.
C     LUWRIT..The logical unit connected to the file with the WRIT data.
C     LULOG...The logical unit connected to the output LOG file.
C
C     Quantities describing elementary waves and their rays:
      REAL PAR1,PAR2,YL(6),Y(44),YY(5)
      INTEGER IWAVE,IWAVE0,IKODE,IRAY,IY(13),IEND,ISHEET,IREC
C
C     IWAVE...Index of the computed elementary wave.
C     IWAVE0..Index of the already computed elementary wave having the
C             most numerous common elements with the current elementary
C             wave.
C     IKODE...The length of the common part of the codes of the IWAVE-th
C             and IWAVE0-th elementary waves.
C     IRAY... Index of the computed ray.
C     PAR1,PAR2... Ray take-off parameters.
C     YL...   Array containing local quantities at a point of a ray, see
C             C.R.T.5.5.4.
C             
C             Description of YL
C     Y...    Array containing basic quantities computed along a ray,
C             see
C             C.R.T.5.2.1.
C             Description of Y
C     YY...   Array containing real auxiliary quantities computed along
C             a ray, see
C             C.R.T.5.2.2.
C             
C             Description of YY
C     IY...   Array containing integer auxiliary quantities computed
C             along a ray, see
C             C.R.T.5.2.2.
C             
C             Description of IY
C     IEND... Reason of the termination of the computation of a ray, see
C             C.R.T.5.4.
C             
C             Description of IEND in RAY2
C             
C             Description of IEND in INIT2
C     ISHEET..Ray-history index.  The different ray histories are
C             consecutively indexed by positive integers 1,2,3,...
C             According to their appearance during ray tracing.
C             The ray histories are indexed independently within each
C             elementary wave.
C             The ray-history indices are complemented with sign:
C             Positive - successful ray (crossing reference surface),
C             negative - unsuccessful ray (terminating before crossing
C             reference surface).
C     IREC... Index of the receiver for a two-point ray, determined in
C             subroutine
C             RPAR4.
C
C.......................................................................
C
C     Opening data files and reading the input data:
C
      WRITE(*,'(A)') '+CRT: Enter input filename: '
      FCRT=' '
      READ(*,*) FCRT
      WRITE(*,'(A)') '+CRT: Reading input data.   '
      IF(FCRT.EQ.' ') THEN
C       100
        CALL ERROR('100 in CRT: 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
      CALL CRTIN(FCRT,LUCODE,LURPAR,LUWRIT,LULOG)
      LULOG=LUWARN(LULOG)
      WRITE(*,'(A)') '+CRT: Computing.            '
C
C.......................................................................
C
C     Complete ray tracing:
C
      CALL RPAR1(LURPAR,0)
      CALL WRIT1(LUWRIT,LULOG,0,0,0)
      CALL RSEP3T('RPAREW',FRPAR,' ')
      IF (FRPAR.NE.' ') THEN
        CLOSE(LURPAR)
        OPEN(LURPAR,FILE=FRPAR,STATUS='OLD',ERR=91)
      END IF
      CALL RSEP3T('WRITEW',FWRIT,' ')
      IF (FWRIT.NE.' ') THEN
        CLOSE(LUWRIT)
        OPEN(LUWRIT,FILE=FWRIT,STATUS='OLD',ERR=92)
      END IF
      IWAVE=0
      IRAY=0
C
C     Loop over elementary waves
   30 CONTINUE
C       Computation of a single elementary wave:
C       Reading the input data for the elementary wave
        CALL CODE1(LUCODE,IWAVE,IWAVE0,IKODE)
        IF(IWAVE.EQ.0) THEN
C         All required elementary waves are computed
          CALL INIT5(IRAY)
          IF(IRAY.EQ.0) THEN
C           One more source point - repeating loop over elementary waves
            REWIND(LUCODE)
            IF (FRPAR.NE.' ') THEN
              REWIND(LURPAR)
            END IF
            IF (FWRIT.NE.' ') THEN
              REWIND(LUWRIT)
            END IF
            GO TO 30
          ELSE
C           End of ray tracing
            GO TO 90
          END IF
        END IF
        CALL RPAR1(LURPAR,IWAVE)
        CALL WRIT1(LUWRIT,LULOG,IWAVE,IWAVE0,IKODE)
C       Loop over rays
   40   CONTINUE
C         Complete tracing of a single ray:
C         Determination of the take-off parameters
          CALL RPAR2(IRAY,PAR1,PAR2)
          IF(IRAY.EQ.0) THEN
C           All required rays of the elementary wave are computed
            GO TO 80
          END IF
C         Initial conditions for the ray
          CALL INIT2(PAR1,PAR2,YL,Y,YY,IY,IEND,IWAVE0,IKODE)
          CALL WRIT2(LULOG,IRAY)
          IF(IEND.EQ.0) THEN
C           Computation of the ray
            CALL RAY2(YL,Y,YY,IY,IEND)
          END IF
C         The ray is computed
          CALL RPAR4(IRAY,PAR1,PAR2,YL,Y,YY,IY,IEND,ISHEET,IREC)
          CALL WRIT4(LULOG,IRAY,YL,Y,YY,IY,IEND,ISHEET,IREC)
        GO TO 40
   80   CONTINUE
C       The elementary wave is computed
        CALL WRIT5(LULOG,IWAVE)
      GO TO 30
   90 CONTINUE
C
C     End of computation
      CALL WRIT5(LULOG,0)
      WRITE(*,'(A)') '+CRT: Done.                 '
      STOP
C
C     Open file errors:
   91 CONTINUE
C       101
        CALL ERROR('101 in CRT: Open file RPAREW error')
C       Error encountered when opening the file specified by input SEP
C       parameter
C       RPAREW.
      STOP
   92 CONTINUE
C       102
        CALL ERROR('102 in CRT: Open file WRITEW error')
C       Error encountered when opening the file specified by input SEP
C       parameter
C       WRITEW.
      STOP
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     error.for
      INCLUDE 'sep.for'
C     sep.for
      INCLUDE 'forms.for'
C     forms.for
      INCLUDE 'length.for'
C     length.for
      INCLUDE 'eigen.for'
C     eigen.for
      INCLUDE 'model.for'
C     model.for
      INCLUDE 'hder.for'
C     hder.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
      INCLUDE 'means.for'
C     means.for
      INCLUDE 'hpcg.for'
C     hpcg.for
      INCLUDE 'crtin.for'
C     crtin.for
      INCLUDE 'code.for'
C     code.for
      INCLUDE 'ray.for'
C     ray.for
      INCLUDE 'raycb.for'
C     raycb.for
      INCLUDE 'trans.for'
C     trans.for
      INCLUDE 'coef.for'
C     coef.for
      INCLUDE 'init.for'
C     init.for
      INCLUDE 'rpar.for'
C     rpar.for
      INCLUDE 'rp2d.for'
C     rp2d.for
      INCLUDE 'rp3d.for'
C     rp3d.for
      INCLUDE 'writ.for'
C     writ.for
      INCLUDE 'apw.for'
C     apw.for
      INCLUDE 'scro.for'
C     scro.for
C
C Screen graphics:
C     To enable screen graphics, link this program with CalComp graphics
C     subroutines PLOTS, PLOT and NEWPEN designed for your operating
C     system and compiler, and comment the following line:
      INCLUDE 'plotnul.for'
C     plotnul.for
C
C=======================================================================
C