This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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