This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gcons / gptmex.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 GPTMEX (NUMB  )
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *       Routine to print tracking media data structure JTMED     *
17 C.    *       NUMB     medium 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 #include "geant321/gcnum.inc"
27       CHARACTER*32 CHLINE,CHSTRI(50)
28       CHARACTER*20 NAME
29       DIMENSION ITITLE(5)
30 C.
31 C.    ------------------------------------------------------------------
32 C.
33       IF (JTMED.LE.0) GO TO 999
34 C
35       IF (NUMB  .EQ.0)THEN
36          WRITE (CHMAIL,10000)
37          CALL GMAIL(0,0)
38          N1     = 1
39          N2     = NTMED
40       ELSE
41          N1     = ABS(NUMB)
42          N2     = ABS(NUMB)
43       ENDIF
44 *      IF(NUMB.GE.0) THEN
45 *         WRITE (CHMAIL,1001)
46 *         CALL GMAIL(0,1)
47 *      ENDIF
48 C
49       DO 10 I=N1,N2
50          JTM = LQ(JTMED-I)
51          IF (JTM.NE.0)THEN
52             IMAT = Q(JTM+6)
53             ISVOL = Q(JTM+7)
54             IFIELD = Q(JTM+8)
55             CALL UCOPY(IQ(JTM+1),ITITLE,5)
56             CHLINE='T. Med. Number='
57             ILEN=LENOCC(CHLINE)+1
58             CALL IZITOC(I,CHLINE(ILEN:))
59             CHSTRI(1)=CHLINE
60             CALL UHTOC(IQ(JTM+1),4,NAME,20)
61             CHLINE='Name='
62             ILEN=LENOCC(CHLINE)+1
63             CHLINE(ILEN:)=NAME
64             CHSTRI(2)=CHLINE
65             CHLINE='Material='
66             ILEN=LENOCC(CHLINE)+1
67             CALL IZITOC(IMAT,CHLINE(ILEN:))
68             CHSTRI(3)=CHLINE
69             CHLINE='Isvol='
70             ILEN=LENOCC(CHLINE)+1
71             CALL IZITOC(ISVOL,CHLINE(ILEN:))
72             CHSTRI(4)=CHLINE
73             CHLINE='Ifield='
74             ILEN=LENOCC(CHLINE)+1
75             CALL IZITOC(IFIELD,CHLINE(ILEN:))
76             CHSTRI(5)=CHLINE
77             CHLINE='Fieldm='
78             ILEN=LENOCC(CHLINE)+1
79             CALL IZRTOC(Q(JTM+9),CHLINE(ILEN:))
80             CHSTRI(6)=CHLINE
81             CHLINE='Tmaxfd='
82             ILEN=LENOCC(CHLINE)+1
83             CALL IZRTOC(Q(JTM+10),CHLINE(ILEN:))
84             CHSTRI(7)=CHLINE
85             CHLINE='Stepmax='
86             ILEN=LENOCC(CHLINE)+1
87 *      CALL IZRTOC(Q(JTM+11),CHLINE(ILEN:))
88             WRITE(CHLINE(ILEN:),10200)Q(JTM+11)
89             CHSTRI(8)=CHLINE
90             CHLINE='Deemax='
91             ILEN=LENOCC(CHLINE)+1
92             CALL IZRTOC(Q(JTM+12),CHLINE(ILEN:))
93             CHSTRI(9)=CHLINE
94             CHLINE='Epsil='
95             ILEN=LENOCC(CHLINE)+1
96 *      CALL IZRTOC(Q(JTM+13),CHLINE(ILEN:))
97             WRITE(CHLINE(ILEN:),10200)Q(JTM+13)
98             CHSTRI(10)=CHLINE
99             CHLINE='Stmin='
100             ILEN=LENOCC(CHLINE)+1
101             CALL IZRTOC(Q(JTM+14),CHLINE(ILEN:))
102             CHSTRI(11)=CHLINE
103             CALL IGMESS(11,CHSTRI,'PRINT','P')
104  
105 *            WRITE(CHMAIL,1002)I,ITITLE,IMAT,ISVOL,IFIELD,
106 *     +                        (Q(JTM+J),J=9,14)
107 *            CALL GMAIL(0,0)
108          ENDIF
109    10 CONTINUE
110 C
111 10000 FORMAT ('0',51('='),3X,'TRACKING MEDIA',3X,50('='))
112 10100 FORMAT ('0','TMED',26X,'MATERIAL ','ISVOL',' IFIELD  FIELDM'
113      +, '  TMAXFD','  STEMAX','    DEEMAX','   EPSIL','   STMIN')
114 10200 FORMAT (E12.5)
115   999 END