Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gcons / gpparx.F
CommitLineData
fe4da5cc 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 )
13C.
14C. ******************************************************************
15C. * *
16C. * Routine to print particle definition JPART *
17C. * NUMB Particle number *
18C. * *
19C. * ==>Called by : <USER>, GPRINT *
20C. * Author R.Brun S.Giani ********* *
21C. * *
22C. ******************************************************************
23C.
24#include "geant321/gcbank.inc"
25#include "geant321/gcunit.inc"
26 CHARACTER*32 CHLINE,CHSTRI(50)
27 CHARACTER*20 NAME
28 DIMENSION ITITLE(5)
29C.
30C. ------------------------------------------------------------------
31C.
32 IF (JPART.LE.0) GO TO 999
33C
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
43C
44* IF(NUMB.GE.0) THEN
45* WRITE (CHMAIL,1001)
46* CALL GMAIL(0,1)
47* ENDIF
48C
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
103C
10410000 FORMAT ('0',51('='),3X,'Particle Types',3X,50('='))
10510100 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))
10810200 FORMAT (E11.4)
10910300 FORMAT (E12.5)
110 999 END