[u/mrichter/AliRoot.git] / GEANT321 / erdecks / erprop.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/03/06 15:37:35  mclareni
* Add geane321 source directories
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.49  by  S.Giani
*-- Author :
      SUBROUTINE ERPROP
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       Performs the error propagation in a step                 *
C.    *                                                                *
C.    *    ==>Called by : ERTRCH / ERTRNT                              *
C.    *       Author    E.Nagy  *********                              *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gctmed.inc"
#include "geant321/gckine.inc"
#include "geant321/gctrak.inc"
#include "geant321/gcunit.inc"
#include "geant321/erwork.inc"
#include "geant321/ertrio.inc"
#include "geant321/trcom3.inc"
*
      DIMENSION DUM(15)
*
* *** Prepares the end-point
*
      DO 11 I = 1,3
         XF(I) = VECT(I)
         PF(I) = VECT(7)*VECT(3+I)
         HF(I) = 0.
   11 CONTINUE
*
      IF (IFIELD.EQ.3) THEN
         HF(3) = FIELDM
      ELSEIF (IFIELD.NE.0) THEN
         CALL GUFLD (VECT, HF)
      ENDIF
*
* *** Propagates the error (in SC-variables)
*
      MVAR  = 0
      IFLAG = 0
      ITRAN = 0
      IF (.NOT.LEEXAC) THEN
         CALL TRPROP (XI ,PPI, HI, XF, PF, HF, CHTR, STEP, DUM,
     &                MVAR, IFLAG, ITRAN, IERR)
      ELSE
         CALL TRPRFN (XI ,PPI, HI, XF, PF, HF, CHTR, STEP, DUM,
     &                MVAR, IFLAG, ITRAN, IERR)
      ENDIF
*
      IF(IERR.NE.0) THEN
         WRITE (LOUT, 778) IERR
         RETURN
      ENDIF
*
* *** Transport the matrix
*
      CALL SSMT5T (A, EF, EF)
*
      IF (CHARGE.NE.0.) THEN
*
* ***    Add multiple scattering
*
         CALL ERMCSC (EF)
*
* ***    Add fluctuation due to ionization to the error matrix
*          (and (later) due to bremsstrahlung and pair-production)
*
          EF(1) = EF(1) + (GETOT*GETOT*DEDX2)/(VECT(7)**6)
*
      ENDIF
*
* *** Copy variables for the next step
*
      CALL UCOPY (XF, XI, 3)
      CALL UCOPY (PF, PPI, 3)
      CALL UCOPY (HF, HI, 9)
*
*
  778 FORMAT(//4X,' *** Error in subr. TRPROP',I4,'  called by',
     &                'subr. ERPROP'//)
*
      END
Commit	Line	Data
fe4da5cc	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 ERPROP
	13	C.
	14	C. ******************************************************************
	15	C. * *
	16	C. * Performs the error propagation in a step *
	17	C. * *
	18	C. * ==>Called by : ERTRCH / ERTRNT *
	19	C. * Author E.Nagy ********* *
	20	C. * *
	21	C. ******************************************************************
	22	C.
	23	#include "geant321/gctmed.inc"
	24	#include "geant321/gckine.inc"
	25	#include "geant321/gctrak.inc"
	26	#include "geant321/gcunit.inc"
	27	#include "geant321/erwork.inc"
	28	#include "geant321/ertrio.inc"
	29	#include "geant321/trcom3.inc"
	30	*
	31	DIMENSION DUM(15)
	32	*
	33	* *** Prepares the end-point
	34	*
	35	DO 11 I = 1,3
	36	XF(I) = VECT(I)
	37	PF(I) = VECT(7)*VECT(3+I)
	38	HF(I) = 0.
	39	11 CONTINUE
	40	*
	41	IF (IFIELD.EQ.3) THEN
	42	HF(3) = FIELDM
	43	ELSEIF (IFIELD.NE.0) THEN
	44	CALL GUFLD (VECT, HF)
	45	ENDIF
	46	*
	47	* *** Propagates the error (in SC-variables)
	48	*
	49	MVAR = 0
	50	IFLAG = 0
	51	ITRAN = 0
	52	IF (.NOT.LEEXAC) THEN
	53	CALL TRPROP (XI ,PPI, HI, XF, PF, HF, CHTR, STEP, DUM,
	54	& MVAR, IFLAG, ITRAN, IERR)
	55	ELSE
	56	CALL TRPRFN (XI ,PPI, HI, XF, PF, HF, CHTR, STEP, DUM,
	57	& MVAR, IFLAG, ITRAN, IERR)
	58	ENDIF
	59	*
	60	IF(IERR.NE.0) THEN
	61	WRITE (LOUT, 778) IERR
	62	RETURN
	63	ENDIF
	64	*
65	* *** Transport the matrix
66	*
67	CALL SSMT5T (A, EF, EF)
68	*
69	IF (CHARGE.NE.0.) THEN
70	*
71	* *** Add multiple scattering
72	*
73	CALL ERMCSC (EF)
74	*
75	* *** Add fluctuation due to ionization to the error matrix
76	* (and (later) due to bremsstrahlung and pair-production)
77	*
78	EF(1) = EF(1) + (GETOTGETOTDEDX2)/(VECT(7)**6)
79	*
80	ENDIF
81	*
82	* *** Copy variables for the next step
83	*
84	CALL UCOPY (XF, XI, 3)
85	CALL UCOPY (PF, PPI, 3)
86	CALL UCOPY (HF, HI, 9)
87	*
88	*
89	778 FORMAT(//4X,' *** Error in subr. TRPROP',I4,' called by',
90	& 'subr. ERPROP'//)
91	*
92	END