GEANT321/geocad/greucl.F

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