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