GEANT321/erdecks/erstor.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 15:37:35  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 ERSTOR
  13 *
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Store error matrix informations                          *
  17 C.    *                                                                *
  18 C.    *    ==>Called by : ERTRGO , ERTRCH , ERTRNT                     *
  19 C.    *       Author    M.Maire, E.Nagy  *********                     *
  20 C.    *                                                                *
  21 C.    ******************************************************************
  22 *
  23 #include "geant321/gckine.inc"
  24 #include "geant321/gctrak.inc"
  25 #include "geant321/erwork.inc"
  26 #include "geant321/ertrio.inc"
  27 #include "geant321/trcom3.inc"
  28 *
  29       DOUBLE PRECISION  C(5,5), DUM(5,5)
  30 *
  31 * *** Write out results at intermediate points
  32 *
  33       ILPRED = ILPRED + 1
  34       IF (ILPRED.GE.NEPRED) ISTOP = 1
  35       IEPRED(ILPRED) = INLIST
  36 *
  37 * *** Leave B-matrix intact for eventual further tracking
  38 *
  39       IF (.NOT. LEONLY) THEN
  40          DO 6 I = 1, 5
  41             DO 5 J = 1, 5
  42                C(I,J) = B(I,J)
  43     5       CONTINUE
  44     6    CONTINUE
  45 *
  46 * ***    Error matrix into single precision
  47 *
  48          DO 10 I = 1, 15
  49             ERROUT(I,ILPRED) = EF(I)
  50    10    CONTINUE
  51 *
  52 * ***    If backtracking - vector, charge, error- and transport-matrix
  53 *        in original direction
  54 *
  55          IF (BACKTR.LT.0.) THEN
  56             CALL ERBCER (ERROUT(1,ILPRED))
  57             CALL ERBCTR (C)
  58          ENDIF
  59       ENDIF
  60 *
  61 * *** Back into SC variables
  62 *
  63       IF (VECT(7) .LT. 1.E-30) VECT(7) = 1.E-30
  64       PF(1) = 1./VECT(7)
  65       PF(2) = BACKTR*ASIN (VECT(6))
  66       IF (ABS (VECT(4)) .LT. 1.E-30) VECT(4) = 1.E-30
  67       PF(3) = ATAN2 (BACKTR*VECT(5), BACKTR*VECT(4))
  68 *
  69 * *** Transform error matrix in the variables of the plane where
  70 *         tracking terminates
  71 *
  72       IF (LEPLAN) THEN
  73          CALL TRSCSD (PF, ERROUT(1,ILPRED), PF ,ERROUT(1,ILPRED), HF,
  74      +                CHARGE, IER ,SPU, ERPLO(1,1,INLIST),
  75      +                ERPLO(1,2,INLIST))
  76          IF (LEONLY) GOTO 25
  77          CALL DMM55 (A, C, DUM)
  78          CALL DMM55 (DUM, ASDSC, C)
  79       ENDIF
  80 *
  81 * *** Transport matrix in single precision
  82 *
  83       DO 20 I = 1,5
  84          DO 15 J = 1,5
  85             ERDTRP(I,J,ILPRED) = C(I,J)
  86             ERTRSP(I,J,ILPRED) = C(I,J)
  87    15    CONTINUE
  88    20 CONTINUE
  89 *
  90    25 CONTINUE
  91       DO 30 I = 1, 3
  92          ERXOUT(I,ILPRED) = VECT(I)
  93          ERPOUT(I,ILPRED) = PF(I)
  94    30 CONTINUE
  95 *
  96       END