This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gheisha / setcur.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:20:59  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.38  by  S.Giani
11 *-- Author :
12       SUBROUTINE SETCUR(NTR)
13 C
14 C *** STORAGE OF CURRENT TRACK PARAMETERS ***
15 C *** NVE 16-MAR-1988 CERN GENEVA ***
16 C
17 C ORIGIN : H.FESEFELDT (26-JAN-1984)
18 C
19 #include "geant321/s_defcom.inc"
20       DIMENSION RNDM(1)
21 C
22       CALL LENGTX(NTR,P)
23       AMAS=PV(5,NTR)
24       AMASQ=AMAS*AMAS
25       NCH=PV(6,NTR)
26       TOF=PV(7,NTR)
27       IPART=IFIX(PV(8,NTR)+0.1)
28       IF(PV(10,NTR).NE.0.) USERW=PV(10,NTR)
29       PX=0.
30       PY=0.
31       PZ=0.
32       IF(P.LT.1.E-10) GOTO 4
33       PX=PV(1,NTR)/P
34       PY=PV(2,NTR)/P
35       PZ=PV(3,NTR)/P
36     4 EN=PV(4,NTR)
37       EK=EN-ABS(AMAS)
38       SINL=PZ
39       COSL=SQRT(ABS(1.-SINL*SINL))
40       IF(ABS(COSL).LT.1.E-10) GOTO 1
41       SINP=PY/COSL
42       COSP=PX/COSL
43       GOTO 2
44     1 CALL GRNDM(RNDM,1)
45       PHI=RNDM(1)*TWPI
46       SINP=SIN(PHI)
47       COSP=COS(PHI)
48     2 IF(NPRT(3).OR.NPRT(4).OR.NPRT(5))
49      *WRITE(NEWBCD,1001) XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
50      *USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND,LCALO,ICEL,
51      *SINL,COSL,SINP,COSP
52       RETURN
53  1001 FORMAT(1H ,'TRACK PARAMETER CHANGED:',3F8.2,1X,2F7.0,1X,F8.3,1X,
54      *F3.0,1X,F6.0,1X,3F6.3,1X,F10.0,1X,F5.0/10X,4F8.3,1X,F8.5,1X,6I5,
55      *4F8.3)
56       END