GEANT321/ggeom/gpvolu.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.17  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GPVOLU(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  *********                              *
  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*4 ISHAP(30),NAME,MOTHER
  29       DIMENSION PAR(50),ATT(20)
  30       SAVE ISHAP
  31       DATA ISHAP/'BOX ','TRD1','TRD2','TRAP','TUBE','TUBS','CONE',
  32      +           'CONS','SPHE','PARA','PGON','PCON','ELTU','HYPE',
  33      +13*'    ', 'GTRA','CTUB','    '/
  34 C.
  35 C.    ------------------------------------------------------------------
  36       IF (JVOLUM.LE.0) GO TO 99
  37       IF (NUMB  .GT.0) GO TO 10
  38 C
  39       WRITE (CHMAIL,1000)
  40       CALL GMAIL(0,0)
  41       WRITE (CHMAIL,1001)
  42       CALL GMAIL(0,1)
  43 C
  44       N1     = 1
  45       N2     = NVOLUM
  46       GO TO 20
  47 C
  48    10 WRITE (CHMAIL,1001)
  49       CALL GMAIL(0,1)
  50 C
  51       N1     = NUMB
  52       N2     = NUMB
  53 C
  54    20 DO 30 I=N1,N2
  55       JVO = LQ(JVOLUM-I)
  56       NIN=Q(JVO+3)
  57       IF (JVO.LE.0)   GO TO 30
  58 C
  59       CALL UHTOC(IQ(JVOLUM+I),4,NAME,4)
  60       CALL GFMOTH(NAME,MOTHER,KONLY)
  61       JVOMOT=LQ(JVOLUM-IVOMGL)
  62       MNIN=Q(JVOMOT+3)
  63       IF(MNIN.LE.0)THEN
  64         NMBR=1
  65       ELSE
  66         JIN = LQ(JVOMOT-INGLOB)
  67         NMBR=Q(JIN+3)
  68       ENDIF
  69
  70       IS   = Q(JVO+2)
  71       NMED = Q(JVO+4)
  72 C
  73       CALL GFPARA(NAME,NMBR,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       DO 25 I10=11,NPAR,10
  79         IEND10=I10+9
  80         IF (NPAR.LT.IEND10) IEND10=NPAR
  81         WRITE (CHMAIL,1003) (PAR(J),J = I10,IEND10)
  82         CALL GMAIL(0,0)
  83    25 CONTINUE
  84    30 CONTINUE
  85 C
  86  1000 FORMAT ('0',51('='),5X,' VOLUMES ',6X,50('='))
  87  1001 FORMAT ('0','VOLUME NAME  NUMED SHAPE NPAR  PARAMETERS')
  88  1002 FORMAT (' ',I6,1X,A4,2X,I3,3X,A4,I5,2X,10E10.3)
  89  1003 FORMAT (31X,10E10.3)
  90   99  END