GEANT321/ggeom/gpvolx.F

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