GEANT321/gkine/gpkinx.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:18  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.21  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GPKINX(IT)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Prints kinematics bank JKINE for track number IT         *
  17 C.    *       If IT=0 Prints all kinematics banks                      *
  18 C.    *                                                                *
  19 C.    *    ==>Called by : <USER>, GPRINT                               *
  20 C.    *       Author    R.Brun  S.Giani *********                      *
  21 C.    *                                                                *
  22 C.    ******************************************************************
  23 C.
  24 #include "geant321/gcbank.inc"
  25 #include "geant321/gcnum.inc"
  26 #include "geant321/gcunit.inc"
  27       CHARACTER*20 NAME
  28       CHARACTER*32 CHLINE,CHSTRI(50)
  29 C.
  30 C.    ------------------------------------------------------------------
  31 C.
  32 *      WRITE(CHMAIL,1000)
  33 *      CALL GMAIL(1,0)
  34 C
  35       I1=1
  36       I2=NTRACK
  37       IF(IT.NE.0)I1=IT
  38       IF(IT.NE.0)I2=IT
  39       IF(I2.GT.NTRACK)GO TO 999
  40       IF(I1.LT.1)GO TO 999
  41       IF(JKINE.LE.0)GO TO 999
  42 C
  43       DO 40 ITRACK=I1,I2
  44          JK=LQ(JKINE-ITRACK)
  45          IF(JK.NE.0)THEN
  46             IPART=Q(JK+5)
  47             JPA=LQ(JPART-IPART)
  48             NL=IQ(JK-2)
  49             NG=Q(JK+7)+7
  50             NW=MIN(NG,16)
  51             CHLINE='Kine='
  52             ILEN=LENOCC(CHLINE)+1
  53             CALL IZITOC(ITRACK,CHLINE(ILEN:))
  54             CHSTRI(1)=CHLINE
  55             CALL UHTOC(IQ(JPA+1),4,NAME,20)
  56             CHLINE='Name='
  57             ILEN=LENOCC(CHLINE)+1
  58             CHLINE(ILEN:)=NAME
  59             CHSTRI(2)=CHLINE
  60             CHLINE='Type='
  61             ILEN=LENOCC(CHLINE)+1
  62             CALL IZITOC(IPART,CHLINE(ILEN:))
  63             CHSTRI(3)=CHLINE
  64             CHLINE='Px='
  65             ILEN=LENOCC(CHLINE)+1
  66             CALL IZRTOC(Q(JK+1),CHLINE(ILEN:))
  67             CHSTRI(4)=CHLINE
  68             CHLINE='Py='
  69             ILEN=LENOCC(CHLINE)+1
  70             CALL IZRTOC(Q(JK+2),CHLINE(ILEN:))
  71             CHSTRI(5)=CHLINE
  72             CHLINE='Pz='
  73             ILEN=LENOCC(CHLINE)+1
  74             CALL IZRTOC(Q(JK+3),CHLINE(ILEN:))
  75             CHSTRI(6)=CHLINE
  76             CHLINE='Energy='
  77             ILEN=LENOCC(CHLINE)+1
  78             CALL IZRTOC(Q(JK+4),CHLINE(ILEN:))
  79             CHSTRI(7)=CHLINE
  80             CHLINE='Vorigin='
  81             ILEN=LENOCC(CHLINE)+1
  82             CALL IZRTOC(Q(JK+6),CHLINE(ILEN:))
  83 *      WRITE(CHLINE(ILEN:),1002)Q(JK+6)
  84             CHSTRI(8)=CHLINE
  85             DO 10 JJ=8,NW
  86                CHLINE='Vgener='
  87                ILEN=LENOCC(CHLINE)+1
  88                CALL IZITOC(INT(Q(JK+JJ)),CHLINE(ILEN:))
  89 *       WRITE(CHLINE(ILEN:),1002)INT(Q(JK+JJ)
  90                CHSTRI(1+JJ)=CHLINE
  91    10       CONTINUE
  92             NLINE=8
  93             IF(NW.GE.8)NLINE=8+(NW-8+1)
  94             CALL IGMESS(NLINE,CHSTRI,'PICK','P')
  95 *            WRITE(CHMAIL,2000)ITRACK,IQ(JPA+1),IQ(JPA+2),IQ(JPA+3),IPART
  96 *     +       ,(Q(JK+I),I=1,4),Q(JK+6),(INT(Q(JK+L)),L=8,NW)
  97 *   10       CALL GMAIL(0,0)
  98    20       CONTINUE
  99             IF(NG-NW.GT.0) THEN
 100                NS=NW+1
 101                NW=MIN(NG,NW+9)
 102                WRITE(CHMAIL,10200) (INT(Q(JK+L)),L=NS,NW)
 103                CALL GMAIL(0,0)
 104                GO TO 20
 105             END IF
 106             IF(NL.GT.0) THEN
 107 *               WRITE(CHMAIL,10300)
 108 *               CALL GMAIL(0,0)
 109 *               JUK = LQ(JK-1)
 110 *               NL  = IQ(JUK-1)
 111 *               NW=MIN(NL,9)
 112 *               WRITE(CHMAIL,10400) (Q(JUK+L),L=1,NW)
 113 *   30          CALL GMAIL(0,0)
 114 *               IF(NL-NW.GT.0) THEN
 115 *                  NS=NW+1
 116 *                  NW=MIN(NL,NW+9)
 117 *                  WRITE(CHMAIL,10400) (Q(JUK+L),L=NS,NW)
 118 *                  GO TO 30
 119 *               END IF
 120             END IF
 121          ENDIF
 122    40 CONTINUE
 123 C
 124 10000 FORMAT(3X,'Kine',5X,'Name',10X,'Type',5X,'Px',9X,'Py',
 125      +       9X,'Pz',7X,'Energy',5X,'Vorigin',2X,'Vgener')
 126 10100 FORMAT(1X,I5,6X,3A4,I5,5(1X,F10.4),9(1X,I4))
 127 10200 FORMAT(84X,9(1X,I4))
 128 10300 FORMAT(62X,'User words')
 129 10400 FORMAT(1X,9(2X,E12.5))
 130 10500 FORMAT(E12.5)
 131 C
 132   999 END