This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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