*
* $Id$
*
* $Log$
* Revision 1.1  1995/10/24 10:20:29  cernlib
* Initial revision
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
*-- Author :
      SUBROUTINE GDRACK
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       RAY-TRACING                                              *
C.    *       Computation and tracking of all the light rays.          *
C.    *                                                                *
C.    *       Author: S.Giani                                          *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcflag.inc"
********************************************************************************
#include "geant321/gcdraw.inc"
#include "geant321/gconst.inc"
#include "geant321/gcmutr.inc"
#include "geant321/pawc.inc"
********************************************************************************
#include "geant321/gcbank.inc"
#include "geant321/gccuts.inc"
#include "geant321/gcjloc.inc"
#include "geant321/gckine.inc"
#include "geant321/gcking.inc"
#include "geant321/gcmate.inc"
#include "geant321/gcphys.inc"
#include "geant321/gcparm.inc"
#include "geant321/gcsets.inc"
#include "geant321/gcstak.inc"
#include "geant321/gctmed.inc"
#include "geant321/gctrak.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcnum.inc"
#if defined(CERNLIB_USRJMP)
#include "geant321/gcjump.inc"
#endif
********************************************************************************
#include "geant321/gcfdim.inc"
#include "geant321/gcpixe.inc"
#include "geant321/gcrayt.inc"
#include "geant321/gcvdma.inc"
 
      CHARACTER*4 NAME
      DIMENSION VVVMIN(80),VVVMAX(80)
      SAVE VVVMIN,VVVMAX,ZIMPRE
********************************************************************************
      COMMON/GCCHAN/LSAMVL
      LOGICAL LSAMVL
*
      DIMENSION CUTS(10),MECA(5,13)
      EQUIVALENCE (CUTS(1),CUTGAM),(MECA(1,1),IPAIR)
      SAVE PRECOR
#if !defined(CERNLIB_SINGLE)
      PARAMETER (EPSMAC=1.E-6)
#endif
#if defined(CERNLIB_SINGLE)
      PARAMETER (EPSMAC=1.E-11)
#endif
C.
C.    ------------------------------------------------------------------
         FINVIS=1./ISFILL
         LLL=1
         ZLN=0.
         IF(IMAP.EQ.1)ZIMPRE=LIMPRE
         IF(IMAP.EQ.2)THEN
           ZRATIO=LIMPRE/ZIMPRE
         ENDIF
         DO 21 IIIJ=1,LIMPRE
           IF(IMAP.EQ.1)THEN
            VVVMIN(IIIJ)=10000.
            VVVMAX(IIIJ)=0.
           ELSEIF(IMAP.EQ.2)THEN
            ZLN=ZLN+1
            IF((ZLN-ZRATIO).GT.0.001)THEN
              ZLN=ZLN-ZRATIO
              LLL=LLL+1
            ENDIF
           ENDIF
           VVV=FINVIS
           IYYY=1
           IF(IIIJ.NE.1)THEN
             UUU=UUU+FINVIS
             IXXX=IXXX+1
           ENDIF
          DO 23 JJJI=1,LIMPRE
           IF(IMAP.EQ.2)THEN
            IF(LLL.EQ.1)THEN
             VVMA=VVVMAX(LLL)
             VVMI=VVVMIN(LLL)
            ELSE
             VVMA=MAX(VVVMAX(LLL-1),VVVMAX(LLL))
             VVMI=MIN(VVVMIN(LLL-1),VVVMIN(LLL))
            ENDIF
            IF(((VVV-(VVMA+ZNMAP1)).GT.0.001).OR.
     +        ((VVV-(VVMI-ZNMAP1)).LT.-0.001))GOTO 22
           ENDIF
            IF(IIIJ.EQ.1.AND.JJJI.EQ.1)THEN
               MYTRME=NUMED
               ime=0
*               print *,vect(1),vect(2),vect(3),'vertex from gtrack'
*               print *,vect(4),vect(5),vect(6),'impulse from gtrack'
               GOTO 9
            ENDIF
                                 XPINTS=ZROTS(1,4)+ZROTS(1,1)*
     +                           UUU+ZROTS(1,2)*VVV+ZROTS(1,3)*
     +                           ZUV
                                 YPINTS=ZROTS(2,4)+ZROTS(2,1)*
     +                           UUU+ZROTS(2,2)*VVV+ZROTS(2,3)*
     +                           ZUV
                                 ZPINTS=ZROTS(3,4)+ZROTS(3,1)*
     +                           UUU+ZROTS(3,2)*VVV+ZROTS(3,3)*
     +                           ZUV
            JON=0
            ISSEEN=0
            IME=0
            SLENG=0.
            NUMED=MYTRME
            NSTEP=0
            INFROM=0
            nlevel=1
       CALL UCTOH('PERS',IPERS,4,4)
       XCOSXS=(SIN(GTHETA*DEGRAD))*(COS(GPHI*DEGRAD))
       YCOSYS=(SIN(GTHETA*DEGRAD))*(SIN(GPHI*DEGRAD))
       ZCOSZS=COS(GTHETA*DEGRAD)
       VDX=XCOSXS
       VDY=YCOSYS
       VDZ=ZCOSZS
       VECT(1)=XPINTS
       VECT(2)=YPINTS
       VECT(3)=ZPINTS
       IF(IPERS.EQ.IPRJ)THEN
        CONMOD=1./SQRT(((XPINTS-FPINTX)**2)+((YPINTS-FPINTY)**2)+
     +                 ((ZPINTS-FPINTZ)**2))
        XCOSXS=-(XPINTS-FPINTX)*CONMOD
        YCOSYS=-(YPINTS-FPINTY)*CONMOD
        ZCOSZS=-(ZPINTS-FPINTZ)*CONMOD
       ENDIF
       VECT(4) = -XCOSXS
       VECT(5) = -YCOSYS
       VECT(6) = -ZCOSZS
       IF(VECT(1).LE.XCUT.OR.VECT(2).LE.YCUT.OR.VECT(3).LE.ZCUT)THEN
         CALL GTMEDI (VECT, NUMED)
       ENDIF
 9    CONTINUE
 
      ISTOP = 0
      EPSCUR = EPSMAC
      NSTOUT = 0
      INWOLD = 0
      LSAMVL = .FALSE.
      NUMOLD=0
*
* *** Check validity of tracking medium and material parameters
*
   10 IF (NUMED.NE.NUMOLD) THEN
         NUMOLD = NUMED
         IUPD   = 0
         JTM    = LQ(JTMED- NUMED)
         EPSIL    = Q(JTM + 13)
         PRECOR   = MIN(0.1*EPSIL, 0.0010)
*
         NMAT     = Q(JTM + 6)
         JMA   = LQ(JMATE-NMAT)
         DENS = Q(JMA +8)
      ENDIF
        IF(ISCOLO.EQ.-10.OR.IMYSE.EQ.0)ISCOLO=MOD(NUMED,6)+2
        IF(ISLSTY.EQ.-10.OR.IMYSE.EQ.0)ISLSTY=4
        IF(ISSEEN.EQ.-10.OR.IMYSE.EQ.0)THEN
         IF(IME.EQ.1)THEN
         IF(DENS.LT.0.00130)THEN
          ISSEEN=0
         ELSE
          ISSEEN=1
         ENDIF
         ENDIF
        ENDIF
        IF(IME.EQ.0)IME=1
*
      IF(LSAMVL) THEN
*
*       If now the particle is entering in the same volume where
*       it was exiting from last step, and if it has done this for
*       more than 5 times, we decrease the precision of tracking
         NSTOUT=NSTOUT+1
         IF(MOD(NSTOUT,5).EQ.0) THEN
            EPSCUR=NSTOUT*EPSMAC
*            WRITE(CHMAIL,10000)ITRA,ISTAK,NTMULT,NAPART
*10000          FORMAT(' *** GTRACK *** Boundary loop: track ',
*     +         I4,' stack ',I4,' NTMULT ',I5,1X,5A4)
*            CALL GMAIL(1,0)
*            WRITE(CHMAIL,10100) EPSCUR
*10100          FORMAT('                Precision now set to ',G10.3)
*            CALL GMAIL(0,1)
         ENDIF
      ELSE
         NSTOUT = 0
         EPSCUR = EPSMAC
      ENDIF
*
      INWVOL = 1
*
* *** Compute SET and DET number if volume is sensitive
*
      IF (JSET.GT.0) CALL GFINDS
*
*    Clear step dependent variables
*
   80 NMEC   = 0
      STEP   = 0.
      DESTEL = 0.
      DESTEP = 0.
      NGKINE = 0
      IGNEXT = 0
      INWOLD = INWVOL
      PREC   = MAX(PRECOR,MAX(ABS(VECT(1)),ABS(VECT(2)),
     +                        ABS(VECT(3)),SLENG)*EPSCUR)
*
*     Give control to user at entrance of volume (INWVOL=1)
*
      IF (INWVOL.EQ.1) THEN
         CALL GDSTEP
         IF (ISTOP.NE.0) GO TO 22
         INWVOL = 0
      ENDIF
*
* *** Propagate particle up to next volume boundary or end of track
*
      INGOTO = 0
      NLEVIN = NLEVEL
      IF (IPARAM.NE.0) THEN
         IF (GEKIN.LE.PACUTS(ITRTYP)) THEN
            NMEC = NMEC+1
            LMEC(NMEC) = 26
            ISTOP = 2
#if !defined(CERNLIB_USRJMP)
            CALL GUPARA
#endif
#if defined(CERNLIB_USRJMP)
            CALL JUMPT0(JUPARA)
#endif
            GO TO 90
         ENDIF
      ENDIF
 
         CALL GDNINO
 
      STLOSS=STEP
*
*     Check for possible endless loop
*
   90 NSTEP = NSTEP +1
 
      IF (NSTEP.GT.MAXNST) THEN
         IF (ISTOP.EQ.0) THEN
            ISTOP = 99
            NMEC  = NMEC +1
            LMEC(NMEC) = 30
*            WRITE(CHMAIL,10200) MAXNST
*            CALL GMAIL(1,0)
*            WRITE(CHMAIL,10300)ITRA,ISTAK,NTMULT,(NAPART(I),I=1,5),
*     +      TOFG*1.E9
*            CALL GMAIL(0,1)
*10200       FORMAT(' *** GTRACK *** More than ',I6,
*     +             ' steps, tracking abandoned!')
*10300       FORMAT('                Track ',I4,' stack ',I4,' NTMULT ',
*     +             I5,1X,5A4,1X,'Time of flight ',F10.3,' ns')
         ENDIF
      ENDIF
*
* *** Give control to user at end of each tracking step
*
      SAFETY = SAFETY -STEP
      CALL GDSTEP
*
      IF (ISTOP.NE.0) GO TO 22
*
*      Renormalize direction cosines
*
      CMOD = 1./SQRT(VECT(4)*VECT(4)+VECT(5)*VECT(5)+VECT(6)*VECT(6))
      VECT(4) = VECT(4)*CMOD
      VECT(5) = VECT(5)*CMOD
      VECT(6) = VECT(6)*CMOD
*
      IF (INWVOL.EQ.0) GO TO 80
*
      IF (NJTMAX.GT.0) THEN
         CALL GSTRAC
         IF (NLEVIN.EQ.0) GO TO 100
         GO TO 22
      ELSE
         IF (NLEVIN.GE.NLEVEL) THEN
            INFROM = 0
         ELSE
            IF (NLEVIN.EQ.0) GO TO 100
            INFROM = LINDEX(NLEVIN+1)
         ENDIF
         IF (NLEVIN.NE.NLEVEL) INGOTO = 0
         NLEVEL = NLEVIN
*
         CALL GTMEDI (VECT, NUMED)
         IF (NUMED.NE.0) THEN
            SAFETY = 0.
            CALL UHTOC(NAMES(NLEVEL),4,NAME,4)
*            print *,NAME
           IF(IMYSE.EQ.1)THEN
            CALL GFIND(NAME,'SEEN',ISSEEN)
            CALL GFIND(NAME,'COLO',ISCOLO)
            CALL GFIND(NAME,'LSTY',ISLSTY)
           ENDIF
*            print *,isseen,iscolo,islsty
            GO TO 10
         ELSE
            ISSEEN=1
         ENDIF
      ENDIF
*
*     Track outside setup, give control to user (INWVOL=3)
*
  100 INWVOL = 3
      ISTOP  = 1
      ISET   = 0
      IDET   = 0
      NMEC   = 0
      STEP   = 0.
      DESTEL = 0.
      DESTEP = 0.
      NGKINE = 0
      NLCUR  = NLEVEL
      NLEVEL = 1
      CALL GDSTEP
      NLEVEL = NLCUR
 22        CONTINUE
          IF(IMAP.EQ.1)THEN
           IF(JON.EQ.1)THEN
             IF(VVV.LT.VVVMIN(IIIJ))THEN
               VVVMIN(IIIJ)=VVV
             ELSEIF(VVV.GT.VVVMAX(IIIJ))THEN
               VVVMAX(IIIJ)=VVV
             ENDIF
           ENDIF
          ENDIF
           VVV=VVV+FINVIS
           IYYY=IYYY+1
   23     CONTINUE
   21    CONTINUE
*                                                             END GTRACK
  999 END
