GEANT321/gcons/gpparx.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:16  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.19  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GPPARX (NUMB  )
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Routine to print particle definition JPART               *
  17 C.    *       NUMB     Particle number                                 *
  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/gcunit.inc"
  26       CHARACTER*32 CHLINE,CHSTRI(50)
  27       CHARACTER*20 NAME
  28       DIMENSION ITITLE(5)
  29 C.
  30 C.    ------------------------------------------------------------------
  31 C.
  32       IF (JPART.LE.0) GO TO 999
  33 C
  34       IF (NUMB  .EQ.0)THEN
  35          WRITE (CHMAIL,10000)
  36          CALL GMAIL(0,0)
  37          N1     = 1
  38          N2     = IQ(JPART-2)
  39       ELSE
  40          N1     = ABS(NUMB)
  41          N2     = ABS(NUMB)
  42       ENDIF
  43 C
  44 *      IF(NUMB.GE.0) THEN
  45 *         WRITE (CHMAIL,1001)
  46 *         CALL GMAIL(0,1)
  47 *      ENDIF
  48 C
  49       DO 20 I=N1,N2
  50          JP = LQ(JPART-I)
  51          IF (JP.NE.0)THEN
  52             IOPT = Q(JP+6)
  53             NL = IQ(JP-1)
  54             CALL UCOPY(IQ(JP+1),ITITLE,5)
  55 *            NW=MIN(NL,13)
  56 *            NW=NL
  57             CHLINE='Particle Number='
  58             ILEN=LENOCC(CHLINE)+1
  59             CALL IZITOC(I,CHLINE(ILEN:))
  60             CHSTRI(1)=CHLINE
  61             CALL UHTOC(IQ(JP+1),4,NAME,20)
  62             CHLINE='Name='
  63             ILEN=LENOCC(CHLINE)+1
  64             CHLINE(ILEN:)=NAME
  65             CHSTRI(2)=CHLINE
  66             CHLINE='Iopt='
  67             ILEN=LENOCC(CHLINE)+1
  68             CALL IZITOC(IOPT,CHLINE(ILEN:))
  69             CHSTRI(3)=CHLINE
  70             CHLINE='Mass='
  71             ILEN=LENOCC(CHLINE)+1
  72 *      CALL IZRTOC(Q(JP+7),CHLINE(ILEN:))
  73             WRITE(CHLINE(ILEN:),10200)Q(JP+7)
  74             CHSTRI(4)=CHLINE
  75             CHLINE='Charge='
  76             ILEN=LENOCC(CHLINE)+1
  77             CALL IZRTOC(Q(JP+8),CHLINE(ILEN:))
  78             CHSTRI(5)=CHLINE
  79             CHLINE='LifeTim='
  80             ILEN=LENOCC(CHLINE)+1
  81 *      CALL IZRTOC(Q(JP+9),CHLINE(ILEN:))
  82             WRITE(CHLINE(ILEN:),10300)Q(JP+9)
  83             CHSTRI(6)=CHLINE
  84             DO 10 JJ=7,NL
  85                CHLINE='User='
  86                ILEN=LENOCC(CHLINE)+1
  87 *       CALL IZRTOC(Q(JP+JJ),CHLINE(ILEN:))
  88                WRITE(CHLINE(ILEN:),10300)Q(JP+JJ)
  89                CHSTRI(JJ)=CHLINE
  90    10       CONTINUE
  91             CALL IGMESS(NL,CHSTRI,'PRINT','P')
  92 *            WRITE (CHMAIL,1002) I,ITITLE,IOPT,
  93 *     +                          (Q(JP + J),J = 7,NW)
  94 *    5       CALL GMAIL(0,0)
  95 *            IF(NL-NW.GT.0) THEN
  96 *               NS=NW+1
  97 *               NW=MIN(NL,NW+5)
  98 *               WRITE(CHMAIL,1003) (Q(JP + J),J = NS,NW)
  99 *               GO TO 5
 100 *            END IF
 101          ENDIF
 102    20 CONTINUE
 103 C
 104 10000 FORMAT ('0',51('='),3X,'Particle Types',3X,50('='))
 105 10100 FORMAT ('0','Part',25X,'Options',8X,'Mass',4X,'Charge'
 106      +,'    Life time                  User words')
 107 * 1002 FORMAT (' ',I4,1X,5A4,I8,6X,E11.4,F7.0,3X,5(E12.5,2X))
 108 10200 FORMAT (E11.4)
 109 10300 FORMAT (E12.5)
 110   999 END