GEANT321/gtrak/gpcxyz.F

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