This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gcons / gpmatx.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:20:15  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 GPMATX (NUMB)
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *       Routine to print material data structures JMATE          *
17 C.    *       NUMB     Material number                                 *
18 C.    *                                                                *
19 C.    *      Changed by S.Egli at 8.5.90: also show mixture contents   *
20 C.    *                                                                *
21 C.    *    ==>Called by : <USER>, GPRINT                               *
22 C.    *       Author    R.Brun  S.Giani *****                          *
23 C.    *                                                                *
24 C.    ******************************************************************
25 C.
26 #include "geant321/gcbank.inc"
27 #include "geant321/gcunit.inc"
28 #include "geant321/gcnum.inc"
29       CHARACTER CHMIXT*17
30       CHARACTER NAME*20
31       CHARACTER*32 CHLINE,CHSTRI(50)
32 C.
33 C.    ------------------------------------------------------------------
34 C.
35       IF (JMATE.LE.0) GO TO 999
36       IF (NUMB .EQ.0) THEN
37          WRITE (CHMAIL,10000)
38          CALL GMAIL(0,0)
39          N1     = 1
40          N2     = NMATE
41       ELSE
42          N1     = ABS(NUMB)
43          N2     = ABS(NUMB)
44       ENDIF
45 *      IF(NUMB.GE.0) THEN
46 *         WRITE (CHMAIL,10100)
47 *         CALL GMAIL(0,1)
48 *      ENDIF
49 C
50       DO 20 I=N1,N2
51          JMA = LQ(JMATE-I)
52          IF (JMA.LE.0) GO TO 20
53 C
54          NMIXT=Q(JMA+11)
55          CHMIXT=' '
56 *         IF(NMIXT.GT.1) CHMIXT='   A      Z     W'
57 *         WRITE (CHMAIL,10200) I,(Q(JMA + J),J = 1,10),NMIXT,CHMIXT
58 *         CALL GMAIL(0,0)
59  
60          CHLINE='Material Number='
61          ILEN=LENOCC(CHLINE)+1
62          CALL IZITOC(I,CHLINE(ILEN:))
63          CHSTRI(1)=CHLINE
64          CALL UHTOC(IQ(JMA+1),4,NAME,20)
65          CHLINE='Name='
66          ILEN=LENOCC(CHLINE)+1
67          CHLINE(ILEN:)=NAME
68          CHSTRI(2)=CHLINE
69          CHLINE='A='
70          ILEN=LENOCC(CHLINE)+1
71          CALL IZRTOC(Q(JMA+6),CHLINE(ILEN:))
72          CHSTRI(3)=CHLINE
73          CHLINE='Z='
74          ILEN=LENOCC(CHLINE)+1
75          CALL IZRTOC(Q(JMA+7),CHLINE(ILEN:))
76          CHSTRI(4)=CHLINE
77          CHLINE='Dens='
78          ILEN=LENOCC(CHLINE)+1
79          CALL IZRTOC(Q(JMA+8),CHLINE(ILEN:))
80          CHSTRI(5)=CHLINE
81          CHLINE='RadLeng='
82          ILEN=LENOCC(CHLINE)+1
83 *      CALL IZRTOC(Q(JMA+9),CHLINE(ILEN:))
84          WRITE(CHLINE(ILEN:),10300)Q(JMA+9)
85          CHSTRI(6)=CHLINE
86          CHLINE='AbsLeng='
87          ILEN=LENOCC(CHLINE)+1
88 *      CALL IZRTOC(Q(JMA+10),CHLINE(ILEN:))
89          WRITE(CHLINE(ILEN:),10300)Q(JMA+10)
90          CHSTRI(7)=CHLINE
91          CHLINE='Nmixt='
92          ILEN=LENOCC(CHLINE)+1
93          CALL IZRTOC(Q(JMA+11),CHLINE(ILEN:))
94          CHSTRI(8)=CHLINE
95  
96          JJJ=8
97          IF(NMIXT.GT.1)THEN
98             JMX=LQ(JMA-5)
99             DO 10 JJ=1,NMIXT
100                CHLINE='A('
101                ILEN=LENOCC(CHLINE)+1
102                CALL IZITOC(JJ,CHLINE(ILEN:))
103                ILEN=LENOCC(CHLINE)+1
104                CHLINE(ILEN:)=')='
105                ILEN=LENOCC(CHLINE)+1
106                CALL IZRTOC(Q(JMX+JJ),CHLINE(ILEN:))
107                JJJ=JJJ+1
108                CHSTRI(JJJ)=CHLINE
109                CHLINE='Z('
110                ILEN=LENOCC(CHLINE)+1
111                CALL IZITOC(JJ,CHLINE(ILEN:))
112                ILEN=LENOCC(CHLINE)+1
113                CHLINE(ILEN:)=')='
114                ILEN=LENOCC(CHLINE)+1
115                CALL IZRTOC(Q(JMX+NMIXT+JJ),CHLINE(ILEN:))
116                JJJ=JJJ+1
117                CHSTRI(JJJ)=CHLINE
118                CHLINE='W('
119                ILEN=LENOCC(CHLINE)+1
120                CALL IZITOC(JJ,CHLINE(ILEN:))
121                ILEN=LENOCC(CHLINE)+1
122                CHLINE(ILEN:)=')='
123                ILEN=LENOCC(CHLINE)+1
124                CALL IZRTOC(Q(JMX+2*NMIXT+JJ),CHLINE(ILEN:))
125                JJJ=JJJ+1
126                CHSTRI(JJJ)=CHLINE
127    10       CONTINUE
128 *            DO 10 J=1,NMIXT
129 *               WRITE(CHMAIL,10300)Q(JMX+J),Q(JMX+NMIXT+J),
130 *     +         Q(JMX+2*NMIXT+J)
131 *               CALL GMAIL(0,0)
132 *   10       CONTINUE
133          ENDIF
134          CALL IGMESS(JJJ,CHSTRI,'PRINT','P')
135    20 CONTINUE
136 C
137 10000 FORMAT ('0',51('='),5X,'MATERIALS',6X,50('='))
138 10100 FORMAT ('0','MATERIAL',27X,'A',9X,'Z',5X,'DENSITY'
139      +,2X,'RADIAT L',2X,'ABSORP L',' NMIXT')
140 10200 FORMAT (' ',I8,1X,5A4,3F10.3,2E10.3,I4,2X,A17)
141 10300 FORMAT (E12.5)
142 10400 FORMAT (' ',85X,2F7.2,F7.3)
143   999 END