5de55bf8ec0b2fd3c54e36763e9b5fed7bff0d05
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / gpcxyz.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:41  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/04 06/12/94  16.50.58  by  S.Ravndal
11 *-- Author :
12       SUBROUTINE GPCXYZ
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *        Print track and volume parameters at current point      *
17 C.    *                                                                *
18 C.    *    ==>Called by : <USER>                                       *
19 C.    *       Author    R.Brun  *********                              *
20 C.    *                                                                *
21 C.    ******************************************************************
22 C.
23 #include "geant321/gcflag.inc"
24 #include "geant321/gckine.inc"
25 #include "geant321/gcvolu.inc"
26 #include "geant321/gctrak.inc"
27 #include "geant321/gcnum.inc"
28 #include "geant321/gcunit.inc"
29       DIMENSION MECNAM(20)
30       CHARACTER*4 KUN1,KUN2
31       SAVE IEVOLD,NTMOLD
32       DATA IEVOLD,NTMOLD/-1,-1/
33 C.
34 C.    ------------------------------------------------------------------
35 C.
36       IF(IFINIT(9).EQ.0)THEN
37          IFINIT(9)=1
38          IEVOLD=-1
39          NTMOLD=-1
40       ENDIF
41 C
42       NM=NMEC
43       IF(NM.EQ.0)THEN
44          MECNAM(1)=NAMEC(29)
45          NM=1
46       ELSE
47          DO 10 I=1,NMEC
48             MEC=LMEC(I)
49             IF(MEC.LE.MAXMEC) THEN
50                MECNAM(I)=NAMEC(MEC)
51             ELSEIF(MEC-100.LE.MAXME1.AND.MEC-100.GT.0) THEN
52                MECNAM(I)=NAMEC1(MEC-100)
53             ENDIF
54   10     CONTINUE
55       ENDIF
56 C
57       IF(IEVENT.EQ.IEVOLD.AND.NTMULT.EQ.NTMOLD)GO TO 20
58 C
59 C
60       TOFGN=TOFG*1.E+9
61       WRITE(CHMAIL,1000)ITRA,ISTAK,NTMULT,(NAPART(I),I=1,5),TOFGN
62       CALL GMAIL(0,0)
63       WRITE(CHMAIL,1100)
64       CALL GMAIL(0,0)
65       IEVOLD=IEVENT
66       NTMOLD=NTMULT
67 C
68   20  R=SQRT(VECT(1)**2+VECT(2)**2)
69       CALL GEVKEV(DESTEP,DESU,KUN1)
70       CALL GEVKEV(GEKIN ,GEKU,KUN2)
71       NS = 1
72       NW = MIN(NS+5,NM)
73       WRITE(CHMAIL,2000)(VECT(I),I=1,3),R,NAMES(NLEVEL),NUMBER(NLEVEL)
74      +      ,SLENG,STEP,DESU,KUN1,GEKU,KUN2,(MECNAM(I),I=NS,NW)
75   30  CALL GMAIL(0,0)
76       IF(NM.GT.NW) THEN
77          NS = NW + 1
78          NW = MIN(NS+5,NM)
79          WRITE(CHMAIL,3000) (MECNAM(I),I=NS,NW)
80          GOTO 30
81       ENDIF
82 C
83  1000 FORMAT(' =====> TRACK ',I4,' STACK NR',I4,' NTMULT=',I5,5X,
84      +5A4,5X,'TOFG =',F10.3,' NS')
85  1100 FORMAT('       X          Y          Z          R   ',
86      +'  NAME  NUMBER',
87      +'   SLENG      STEP      DESTEP     GEKIN   MECHANISMS')
88  2000 FORMAT(1X,4F11.4,1X,A4,1X,I4,1X,2F10.4,F7.1,A4,F9.3,A4,1X,
89      +          6(A4,1X))
90  3000 FORMAT(101X,6(A4,1X))
91 C
92       END