GEANT321/erdecks/ertrak.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 15:37:34  mclareni
   6 * Add geane321 source directories
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.49  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE ERTRAK (X1, P1, X2, P2, IPA, CHOPT)
  13 *
  14 ************************************************************************
  15 *                                                                      *
  16 *          Perform the tracking of the track from point X1 to          *
  17 *                    point X2                                          *
  18 *          (Before calling this routine the user should also provide   *
  19 *                    the input informations in /EROPTS/ and /ERTRIO/   *
  20 *                    using subroutine EUFIL(L/P/V)                     *
  21 *                 X1       - Starting coordinates (Cartesian)          *
  22 *                 P1       - Starting 3-momentum  (Cartesian)          *
  23 *                 X2       - Final coordinates    (Cartesian)          *
  24 *                 P2       - Final 3-momentum     (Cartesian)          *
  25 *                 IPA      - Particle code (a la GEANT) of the track   *
  26 *                                                                      *
  27 *                 CHOPT                                                *
  28 *                     'B'   'Backward tracking' - i.e. energy loss     *
  29 *                                        added to the current energy   *
  30 *                     'E'   'Exact' calculation of errors assuming     *
  31 *                                        helix (i.e. pathlength not    *
  32 *                                        assumed as infinitesimal)     *
  33 *                     'L'   Tracking upto prescribed Lengths reached   *
  34 *                     'M'   'Mixed' prediction (not yet coded)         *
  35 *                     'O'   Tracking 'Only' without calculating errors *
  36 *                     'P'   Tracking upto prescribed Planes reached    *
  37 *                     'V'   Tracking upto prescribed Volumes reached   *
  38 *                     'X'   Tracking upto prescribed Point approached  *
  39 *                                                                      *
  40 *                Interface with GEANT :                                *
  41 *             Track parameters are in /CGKINE/ and /GCTRAK/            *
  42 *                                                                      *
  43 *          ==>Called by : USER                                         *
  44 *             Authors   M.Maire, E.Nagy  *********                     *
  45 *                                                                      *
  46 ************************************************************************
  47 *
  48 #include "geant321/gcbank.inc"
  49 #include "geant321/gcnum.inc"
  50 #include "geant321/gckine.inc"
  51 #include "geant321/gctmed.inc"
  52 #include "geant321/gctrak.inc"
  53 #include "geant321/gcunit.inc"
  54 #include "geant321/ertrio.inc"
  55 #include "geant321/erwork.inc"
  56 #include "geant321/trcom3.inc"
  57 *
  58       DIMENSION      P1(3), P2(3), X1(3), X2(3), DUM(15), IOPT(30)
  59       EQUIVALENCE    (IOPT(1),IOPTB), (IOPT(2),IOPTE), (IOPT(3),IOPTL),
  60      ,               (IOPT(4),IOPTM), (IOPT(5),IOPTO), (IOPT(6),IOPTP),
  61      ,               (IOPT(7),IOPTV), (IOPT(8),IOPTX)
  62       CHARACTER      CHOPT*(*)
  63 *
  64 *
  65 * *** Decode character option
  66 *
  67       CHOPTI = CHOPT
  68       CALL UOPTC (CHOPT, 'BELMOPVX', IOPT)
  69 *
  70       IF (IOPTB.EQ.0) THEN
  71          BACKTR = 1.
  72       ELSE
  73          BACKTR = -1.
  74       ENDIF
  75 *
  76       LEEXAC = IOPTE.NE.0
  77       LELENG = IOPTL.NE.0
  78       LEONLY = IOPTO.NE.0
  79       LEPLAN = IOPTP.NE.0
  80       LEVOLU = IOPTV.NE.0
  81       LEPOIN = IOPTX.NE.0
  82 *
  83 * *** Check consistency of the Ch-options
  84 *
  85          IF ((LELENG .AND. LEVOLU) .OR. (LELENG .AND. LEPLAN) .OR.
  86      +       (LEVOLU .AND. LEPLAN)) THEN
  87             WRITE (LOUT, 779)
  88             GO TO 99
  89          ENDIF
  90 *
  91 * *** Initialization
  92 *
  93       IF (NEPRED.LE.0) THEN
  94          WRITE (LOUT, 780)
  95          GO TO 99
  96       ENDIF
  97       ILPRED = 0
  98       TLGCM2 = 0.
  99       TLRAD  = 0.
 100       CALL VZERO (IEPRED ,   MXPRED)
 101       CALL VZERO (ERXOUT , 3*MXPRED)
 102       CALL VZERO (ERPOUT , 3*MXPRED)
 103       CALL VZERO (ERROUT ,15*MXPRED)
 104 *
 105       DO 10 I = 1, 3
 106          ERXIN(I) = X1(I)
 107    10 CONTINUE
 108 *
 109       PMOM2 = P1(1)**2 + P1(2)**2 + P1(3)**2
 110       IF(PMOM2.LE.1.E-20) THEN
 111          WRITE (LOUT, 778)
 112          GO TO 99
 113       ENDIF
 114       PABS = SQRT (PMOM2)
 115       ERPIN(1) = 1./PABS
 116       ERPIN(2) = ASIN (P1(3)*ERPIN(1))
 117       IF (ABS (P1(1)) .LT. 1.E-30) P1(1) = 1.E-30
 118       ERPIN(3) = ATAN2 (P1(2), P1(1))
 119 *
 120 * *** Initialize GCKINE common
 121 *
 122       IF((IPA.LE.0).OR.(IPA.GT.NPART)) THEN
 123           WRITE (LOUT, 777) IPA
 124           GO TO 99
 125       ENDIF
 126 *
 127       ITRA = 1
 128       ISTAK = 0
 129       IPART = IPA
 130       JPA = LQ(JPART-IPART)
 131       DO 26 I=1,5
 132          NAPART(I) = IQ(JPA+I)
 133    26 CONTINUE
 134       ITRTYP = Q(JPA+6)
 135       AMASS  = Q(JPA+7)
 136       CHARGE = Q(JPA+8)
 137       CHTR   = CHARGE*BACKTR
 138       TLIFE  = Q(JPA+9)
 139 *
 140 * *** Starting field
 141 *
 142       CALL VZERO (HI, 9)
 143       CALL VZERO (HF, 9)
 144 *
 145 * *** Error matrix into SC System
 146 *
 147       IF (LEPLAN) THEN
 148          IF (IFIELD.EQ.3) THEN
 149             HI(3) = FIELDM
 150          ELSEIF (IFIELD.NE.0) THEN
 151             CALL GUFLD (X1, HI)
 152          ENDIF
 153          CALL VZERO (DUM,15)
 154          CALL TRSCSD (ERPIN(1), DUM(1),   ERPIN(1), DUM(1),   HI(1),
 155      +                CHARGE, IERR, SPU, ERPLI(1,1), ERPLI(1,2))
 156          IF (LEONLY) GOTO 35
 157          CALL TRSDSC (ERPIN(1), ERRIN(1), DUM(1),   ERRIN(1), HI(1),
 158      +                CHARGE, IERR, SPU, ERPLI(1,1), ERPLI(1,2))
 159          DO 29 I = 1, 5
 160             DO 28 J = 1, 5
 161                ASDSC(I,J) = A(I,J)
 162    28       CONTINUE
 163    29    CONTINUE
 164       ENDIF
 165       IF (LEONLY) GOTO 35
 166 *
 167 * *** Error matrix into direction of tracking
 168 *
 169       IF (BACKTR .LT. 0.) CALL ERBCER (ERRIN(1))
 170 *
 171 * *** Error matrix into double precision
 172 *
 173       DO 30 I = 1,15
 174          EI(I) = ERRIN(I)
 175    30 CONTINUE
 176 *
 177    35 CONTINUE
 178       DO 41 I = 1, 3
 179          VERT(I)  = X1(I)
 180          PVERT(I) = P1(I)*BACKTR
 181    41 CONTINUE
 182 *
 183 * *** Initialize GCTRAK common
 184 *
 185       PVERT(4) = SQRT (PMOM2 + AMASS**2)
 186       VECT(7) = PABS
 187       DO 51 I=1,3
 188          VECT(I) = VERT(I)
 189          VECT(I+3) = PVERT(I)/VECT(7)
 190    51 CONTINUE
 191       GETOT = PVERT(4)
 192       GEKIN = GETOT - AMASS
 193       IF(GEKIN.LT.0.) GEKIN = 0.
 194       CALL GEKBIN
 195 *
 196 * *** Additional EMC initialization
 197 *
 198       IF (.NOT.LEONLY) CALL ERPINI
 199 *
 200 * *** Ready for tracking
 201 *
 202       CALL ERTRGO
 203 *
 204 * *** Copy the final point and momentum into the output buffer
 205 *
 206       DO 60 I = 1, 3
 207          X2(I) = VECT(I)
 208          P2(I) = VECT(7)*BACKTR*VECT(I+3)
 209    60 CONTINUE
 210 *
 211   777 FORMAT(/,4X,'Error in ERTRAK : particle type ', I4,
 212      *        '  unknown in GEANT' )
 213   778 FORMAT(/,4X,'Error in ERTRAK : Nul Momentum. Tracking stops now')
 214   779 FORMAT(/,4X,'Error in ERTRAK : Inconsistent character options',
 215      +                               '. Tracking stops now')
 216   780 FORMAT(/,4X,'Error in ERTRAK : No prediction. Tracking stops now')
 217 *                                                           END ERTRAK
 218   99  END