GEANT321/ggeom/gpvolx.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:54  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/04 13/12/94  15.26.36  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GPVOLX(NUMB)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Routine to print VOLUMES data structures JVOLUM          *
  17 C.    *       NUMB     Volume 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       COMMON/FMOTH/INGLOB,IVOMGL
  28       CHARACTER*32 CHLINE,CHSTRI(50)
  29       CHARACTER*4 ISHAP(30),NAME,MOTHER
  30       DIMENSION PAR(50),ATT(20)
  31       SAVE ISHAP
  32       DATA ISHAP/'BOX ','TRD1','TRD2','TRAP','TUBE','TUBS','CONE',
  33      +           'CONS','SPHE','PARA','PGON','PCON','ELTU','HYPE',
  34      +13*'    ', 'GTRA','CTUB','    '/
  35 C.
  36 C.    ------------------------------------------------------------------
  37       IF (JVOLUM.LE.0) GO TO 999
  38       IF (NUMB  .GT.0) GO TO 10
  39 C
  40       WRITE (CHMAIL,10000)
  41       CALL GMAIL(0,0)
  42       WRITE (CHMAIL,10100)
  43       CALL GMAIL(0,1)
  44 C
  45       N1     = 1
  46       N2     = NVOLUM
  47       GO TO 20
  48 C
  49 *   10 WRITE (CHMAIL,1001)
  50 *      CALL GMAIL(0,1)
  51    10 CONTINUE
  52 C
  53       N1     = NUMB
  54       N2     = NUMB
  55 C
  56    20 DO 40 I=N1,N2
  57          JVO = LQ(JVOLUM-I)
  58          IF (JVO.LE.0) GO TO 40
  59 C
  60          CALL UHTOC(IQ(JVOLUM+I),4,NAME,4)
  61       CALL GFMOTH(NAME,MOTHER,KONLY)
  62       JVOMOT=LQ(JVOLUM-IVOMGL)
  63       MNIN=Q(JVOMOT+3)
  64       IF(MNIN.LE.0)THEN
  65         NMBR=1
  66       ELSE
  67         JIN = LQ(JVOMOT-INGLOB)
  68         NMBR=Q(JIN+3)
  69       ENDIF
  70          IS = Q(JVO+2)
  71          NMED = Q(JVO+4)
  72 C
  73          CALL GFPARA(NAME,1,1,NPAR,NATT,PAR,ATT)
  74 *      IEND10=10
  75 *      IF(NPAR.LT.IEND10)IEND10=NPAR
  76 *      WRITE(CHMAIL,1002)I,NAME,NMED,ISHAP(IS),NPAR,(PAR(J),J=1,IEND10)
  77 *      CALL GMAIL(0,0)
  78          CHLINE='Volume Number='
  79          ILEN=LENOCC(CHLINE)+1
  80          CALL IZITOC(I,CHLINE(ILEN:))
  81          CHSTRI(1)=CHLINE
  82          CHLINE='Name='
  83          ILEN=LENOCC(CHLINE)+1
  84          CHLINE(ILEN:)=NAME
  85          CHSTRI(2)=CHLINE
  86          CHLINE='Nmed='
  87          ILEN=LENOCC(CHLINE)+1
  88          CALL IZITOC(NMED,CHLINE(ILEN:))
  89          CHSTRI(3)=CHLINE
  90          CHLINE='Shape='
  91          ILEN=LENOCC(CHLINE)+1
  92          CHLINE(ILEN:)=ISHAP(IS)
  93          CHSTRI(4)=CHLINE
  94          CHLINE='Npar='
  95          ILEN=LENOCC(CHLINE)+1
  96          CALL IZITOC(NPAR,CHLINE(ILEN:))
  97          CHSTRI(5)=CHLINE
  98          DO 30 JJ=1,NPAR
  99             CHLINE='Par('
 100             ILEN=LENOCC(CHLINE)+1
 101             CALL IZITOC(JJ,CHLINE(ILEN:))
 102             ILEN=LENOCC(CHLINE)+1
 103             CHLINE(ILEN:)=')='
 104             ILEN=LENOCC(CHLINE)+1
 105 *       CALL IZRTOC(PAR(JJ),CHLINE(ILEN:))
 106             WRITE(CHLINE(ILEN:),10300)PAR(JJ)
 107             CHSTRI(5+JJ)=CHLINE
 108    30    CONTINUE
 109          NLINE=5+NPAR
 110          CALL IGMESS(NLINE,CHSTRI,'PRINT','P')
 111
 112 *      DO 25 I10=11,NPAR,10
 113 *        IEND10=I10+9
 114 *        IF (NPAR.LT.IEND10) IEND10=NPAR
 115 *        WRITE (CHMAIL,1003) (PAR(J),J = I10,IEND10)
 116 *        CALL GMAIL(0,0)
 117 *   25 CONTINUE
 118    40 CONTINUE
 119 C
 120 10000 FORMAT ('0',51('='),5X,' VOLUMES ',6X,50('='))
 121 10100 FORMAT ('0','VOLUME NAME  NUMED SHAPE NPAR  PARAMETERS')
 122 10200 FORMAT (' ',I6,1X,A4,2X,I3,3X,A4,I5,2X,10E10.3)
 123 10300 FORMAT (E12.5)
 124   999 END