GEANT321/geocad/greucl.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:47  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 *CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
  14 *-- Author :
  15       SUBROUTINE GREUCL (LUN,FILNAM)
  16 *
  17 *
  18 *     ******************************************************************
  19 *     *                                                                *
  20 *     *  Read in the geometry of the detector in EUCLID file format    *
  21 *     *                                                                *
  22 *     *                                                                *
  23 *     *       Author : M. Maire                                        *
  24 *     *                                                                *
  25 *     ******************************************************************
  26 *
  27       CHARACTER*(*) FILNAM
  28       CHARACTER*80  FILEXT
  29       CHARACTER    KEY*4, CARD*76
  30       CHARACTER*20 NATMED, NAMATE
  31       CHARACTER*4  NAME, MOTHER, SHAPE, KONLY
  32       REAL PAR(100)
  33 *
  34 #include "geant321/gcnum.inc"
  35 #include "geant321/gcunit.inc"
  36 *
  37       IT2=LNBLNK(FILNAM)
  38 #if !defined(CERNLIB_IBM)
  39       FILEXT=FILNAM
  40 #endif
  41 #if defined(CERNLIB_IBM)
  42       IT1=INDEX(FILNAM,'.')
  43       IF (IT1.GT.0) THEN
  44          FILEXT='/'//FILNAM(1:IT1-1)//' '//FILNAM(IT1+1:IT2)//' A1'
  45          CALL CLTOU(FILEXT)
  46       ELSE
  47          WRITE (CHMAIL,10000) FILNAM
  48          CALL GMAIL (0,0)
  49          RETURN
  50       ENDIF
  51 #endif
  52 *
  53       OPEN (UNIT=LUN,FILE=FILEXT,STATUS='UNKNOWN',FORM='FORMATTED')
  54 *
  55    10 READ (LUN,'(A4,A76)',END=20,ERR=20) KEY,CARD
  56 *
  57       IF (KEY.EQ.'TMED') THEN
  58          READ (CARD,*)    ITMED, NATMED
  59          CALL GCKMAT (ITMED, NATMED)
  60 *
  61       ELSE IF (KEY.EQ.'ROTM') THEN
  62          READ (CARD,*) IROT, TETA1, PHI1, TETA2, PHI2, TETA3, PHI3
  63          CALL GSROTM ( IROT, TETA1, PHI1, TETA2, PHI2, TETA3, PHI3 )
  64 *
  65       ELSE IF (KEY.EQ.'VOLU') THEN
  66          READ (CARD,*) NAME, SHAPE, NUMED, NPAR
  67          IF (NPAR.GT.0) READ (LUN, *) (PAR(I),I=1,NPAR)
  68          CALL GSVOLU ( NAME, SHAPE, NUMED, PAR, NPAR, IVOLU)
  69 *
  70       ELSE IF (KEY.EQ.'DIVN') THEN
  71          READ (CARD,*) NAME, MOTHER, NDIV, IAXE
  72          CALL GSDVN  ( NAME, MOTHER, NDIV, IAXE )
  73 *
  74       ELSE IF (KEY.EQ.'DVN2') THEN
  75          READ (CARD,*) NAME, MOTHER, NDIV, IAXE, ORIG, NUMED
  76          CALL GSDVN2 ( NAME, MOTHER, NDIV, IAXE, ORIG, NUMED )
  77 *
  78       ELSE IF (KEY.EQ.'DIVT') THEN
  79          READ (CARD,*) NAME, MOTHER, STEP, IAXE, NUMED, NDVMX
  80          CALL GSDVT  ( NAME, MOTHER, STEP, IAXE, NUMED, NDVMX )
  81 *
  82       ELSE IF (KEY.EQ.'DVT2') THEN
  83          READ (CARD,*) NAME, MOTHER, STEP, IAXE, ORIG, NUMED, NDVMX
  84          CALL GSDVT2 ( NAME, MOTHER, STEP, IAXE, ORIG, NUMED, NDVMX )
  85 *
  86       ELSE IF (KEY.EQ.'POSI') THEN
  87          READ (CARD,*) NAME, NR, MOTHER, XO, YO, ZO, IROT, KONLY
  88          CALL GSPOS  ( NAME, NR, MOTHER, XO, YO, ZO, IROT, KONLY )
  89 *
  90       ELSE IF (KEY.EQ.'POSP') THEN
  91          READ (CARD,*) NAME, NR, MOTHER, XO, YO, ZO, IROT, KONLY, NPAR
  92          IF (NPAR.GT.0) READ (LUN, *) (PAR(I),I=1,NPAR)
  93          CALL GSPOSP ( NAME, NR, MOTHER, XO,YO,ZO,IROT,KONLY,PAR,NPAR)
  94       ENDIF
  95 *
  96       IF (KEY.NE.'END') GO TO 10
  97       CLOSE (LUN)
  98 *
  99       WRITE (CHMAIL,10100) FILNAM(1:IT2)
 100       CALL GMAIL (1,1)
 101 *
 102       GOTO 999
 103 *
 104    20 CONTINUE
 105       WRITE (CHMAIL,10200)
 106       CALL GMAIL (1,1)
 107       CLOSE (LUN)
 108 *
 109 10000 FORMAT (' *** GREUCL *** ',A,' is not a valib IBM name')
 110 10100 FORMAT (' *** GREUCL *** file: ',A,' is now read in')
 111 10200 FORMAT (' *** GREUCL *** reading error or premature end of file')
 112 *
 113   999 END