GEANT321/gtrak/gpgkin.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:42  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GPGKIN
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *        Print kinematics of secondary tracks at the current     *
  17 C.    *        interaction point.                                      *
  18 C.    *                                                                *
  19 C.    *    ==>Called by : <USER>,GUSTEP,GDEBUG                         *
  20 C.    *       Author    R.Brun  *********                              *
  21 C.    *                                                                *
  22 C.    ******************************************************************
  23 C.
  24 #include "geant321/gcbank.inc"
  25 #include "geant321/gcking.inc"
  26 #include "geant321/gcunit.inc"
  27       CHARACTER*4 UNITK,UNITE,UNITSK,UNITSE
  28 C.
  29 C.    ------------------------------------------------------------------
  30 C.
  31       SEK=0.
  32       SET=0.
  33       DO 10 I=1,NGKINE
  34          ITY=GKIN(5,I)
  35          ET=GKIN(4,I)
  36          TOFDN=TOFD(I)*1.E+9
  37          JP=LQ(JPART-ITY)
  38          EK=ET-Q(JP+7)
  39          SEK=SEK+EK
  40          SET=SET+ET
  41          CALL GEVKEV(EK,EKU,UNITK)
  42          CALL GEVKEV(ET,ETU,UNITE)
  43          IF(I.LT.NGKINE)THEN
  44             WRITE(CHMAIL,1000)I,(IQ(JP+J),J=1,4),EKU,UNITK,ETU,UNITE
  45      +                         ,TOFDN
  46          ELSE
  47             CALL GEVKEV(SEK,SEKU,UNITSK)
  48             CALL GEVKEV(SET,SETU,UNITSE)
  49             WRITE(CHMAIL,2000)I,(IQ(JP+J),J=1,4),EKU,UNITK,ETU,UNITE
  50      +                         ,TOFDN,SEKU,UNITSK,SETU,UNITSE
  51          ENDIF
  52          CALL GMAIL(0,0)
  53   10  CONTINUE
  54 *
  55  1000 FORMAT(4X,'===>',I3,1X,4A4,' EK=',F7.3,A,' ET=',F7.3,A,
  56      +       ' TOFD=',F10.3,' ns')
  57  2000 FORMAT(4X,'===>',I3,1X,4A4,' EK=',F7.3,A,' ET=',F7.3,A,
  58      +       ' TOFD=',F10.3,' ns   SEK=',F7.3,A,' SET=',F7.3,A)
  59       END