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