GEANT321/ggeom/gschk.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:55  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.30  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GSCHK(NAME,KSHAPE,NPAR,ISHAPE)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *           CHECK SHAPE PARAMETERS                               *
  17 C.    *           RETURN SHAPE NUMBER CORRESPONDING TO 'KSHAPE'        *
  18 C.    *                                                                *
  19 C.    *    ==>Called by : GSVOLU                                       *
  20 C.    *         Author  R.Brun  *********                              *
  21 C.    *                                                                *
  22 C.    ******************************************************************
  23 C.
  24 #include "geant321/gcunit.inc"
  25       CHARACTER*4 NAME,KSHAP(30)
  26       CHARACTER*4    KSHAPE
  27       DIMENSION NPARS(30)
  28       SAVE KSHAP,NPARS
  29       DATA KSHAP/'BOX ','TRD1','TRD2','TRAP','TUBE','TUBS','CONE',
  30      +           'CONS','SPHE','PARA','PGON','PCON','ELTU','HYPE',
  31      + 13*'    ','GTRA','CTUB','    '/
  32       DATA NPARS/3,4,5,11,3,5,5,7,6,6,10,9,3,4,13*0,12,11,0/
  33 C.
  34 C.    ------------------------------------------------------------------
  35 C.
  36       ISHAPE = 0
  37       DO 10 JSH=1, 30
  38          IF(KSHAPE.EQ.KSHAP(JSH)) THEN
  39             ISHAPE=JSH
  40             GOTO 20
  41          ENDIF
  42    10 CONTINUE
  43 C
  44       WRITE(CHMAIL,10000)KSHAPE,NAME
  45       CALL GMAIL(1,0)
  46       GO TO 999
  47 C
  48 C              CHECK PARAMETERS
  49 C
  50    20 IF(NPAR.LT.NPARS(ISHAPE).AND.NPAR.NE.0) THEN
  51 C
  52          WRITE(CHMAIL,10100)KSHAPE,NAME,NPAR
  53          CALL GMAIL(1,0)
  54          ISHAPE=-1
  55          GO TO 999
  56       ENDIF
  57 C
  58 10000 FORMAT(' ***** SHAPE TYPE ',A4,' VOLUME ',A4,
  59      +       ' NOT VALID *****')
  60 10100 FORMAT(' ***** SHAPE ',A4,' VOLUME ',A4,
  61      +       ' INCONSISTENT NUMBER OF PARAMETERS ',I5,'*****')
  62   999 END