This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / giopa / gget.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:16  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.20  by  S.Giani
11 *-- Author :
12       SUBROUTINE GGET (LUN,KEYSU,NUKEYS,IDENT,IER)
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *       Routine to read in data structures                       *
17 C.    *                                                                *
18 C.    *       LUN      Logical unit number                             *
19 C.    *       KEYSU    Keywords to select data structures              *
20 C.    *       NKEYS    Number of keywords                              *
21 C.    *       IER      Error flag                                      *
22 C.    *                                                                *
23 C.    *    ==>Called by : <USER>, UGINIT,GUKINE                        *
24 C.    *       Author    R.Brun  *********                              *
25 C.    *                                                                *
26 C.    ******************************************************************
27 C.
28 #include "geant321/gcbank.inc"
29 #include "geant321/gcunit.inc"
30 #include "geant321/gcflag.inc"
31 #include "geant321/gcnum.inc"
32 #include "geant321/gcdraw.inc"
33 #include "geant321/gccuts.inc"
34       COMMON/QUEST/IQUEST(100)
35 C
36       CHARACTER*4 KLEY(22)
37       CHARACTER*4 KEYSU(1)
38       DIMENSION KEYS(22),IUHEAD(2)
39       DIMENSION KSEL(14),LKEY(22),LKNUM(22),LINK(14),JLINK(17)
40       EQUIVALENCE (JLINK(1),JDIGI)
41       SAVE IFIRST,LKEY
42       DATA LINK/7,6,13,16,8,10,2,9,3,15,5,17,4,1/
43       DATA KLEY/'PART','MATE','TMED','VOLU','ROTM','SETS','DRAW','RUNG'
44      +         ,'INIT','INIT','INIT','INIT','INIT','INIT','INIT','INIT'
45      +         ,'HEAD','KINE','KINE','JXYZ','HITS','DIGI'/
46       DATA LKNUM/1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8,9,10,11,12,13,14/
47       DATA IFIRST/0/
48 C.
49 C.    ------------------------------------------------------------------
50 C.
51       IF(IFIRST.EQ.0)THEN
52          IFIRST=1
53          CALL UCTOH(KLEY,LKEY,4,88)
54       ENDIF
55 *
56       WRITE(CHMAIL,10000)
57       CALL GMAIL(0,0)
58 10000 FORMAT(' *** GGET *** Obsolete routine. Please use GFIN')
59 C
60       IDENT=-1
61       IER    = 0
62       NKEYS=IABS(NUKEYS)
63       IF (NKEYS.LE.0)                                 GO TO 99
64       CALL UCTOH(KEYSU,KEYS,4,4*NKEYS)
65 C
66       IF(NUKEYS.LT.0)THEN
67         I1=1
68         I2=15
69         K1=1
70         K2=7
71       ELSE
72         I1=18
73         I2=22
74         K1=10
75         K2=14
76       ENDIF
77 C
78       NKT=0
79       DO 10 K=K1,K2
80   10  KSEL(K)=0
81       DO 20 I=I1,I2
82       N=LKNUM(I)
83       DO 20 IK=1,NKEYS
84       IF(KEYS(IK).EQ.LKEY(I))THEN
85          KSEL(N)=1
86          NKT=NKT+1
87       ENDIF
88   20  CONTINUE
89       IF(NKT.EQ.0)GO TO 99
90       NUH=2
91 C
92 C               Go for next start of event data structure
93 C
94       IF(NUKEYS.LT.0)THEN
95          IF(JRUNG.NE.0)CALL MZDROP(IXCONS,JRUNG,' ')
96          CALL FZIN(LUN,IXCONS,JRUNG,1,'E',NUH,IUHEAD)
97          IF(IQUEST(1).GT.2)GO TO 90
98          IDIV=IXCONS
99       ELSE
100          IF(JHEAD.NE.0)CALL MZDROP(IXDIV,JHEAD,' ')
101          CALL FZIN(LUN,IXDIV,JHEAD,1,'E',NUH,IUHEAD)
102          IF(IQUEST(1).GT.2)GO TO 90
103          IDIV=IXDIV
104       ENDIF
105 C
106       IDENT= IUHEAD(1)
107       NK   = IUHEAD(2)
108       IF(NK.LE.0)GO TO 99
109       IF(NK.GT.10)GO TO 99
110       DO 30 I=1,NK
111 C
112 C              Read next header
113 C
114          NUH=2
115          CALL FZIN(LUN,IDIV,0,0,'S',NUH,IUHEAD)
116          IF(IQUEST(1).GT.2)GO TO 90
117          KS=IUHEAD(1)
118          IF(KS.LE.0)GO TO 30
119          IF(KS.GT.14)GO TO 30
120          IF(KSEL(KS).EQ.0)GO TO 30
121          IL=LINK(KS)
122          IF(JLINK(IL).NE.0)CALL MZDROP(IDIV,JLINK(IL),' ')
123 C
124 C              Read pending data structure
125 C
126          CALL FZIN(LUN,IDIV,JLINK(IL),1,'A',NUH,IUHEAD)
127          IF(IQUEST(1).GT.2)GO TO 90
128   30  CONTINUE
129 C
130 C             Fill header bank
131 C             Reconstruct NKVIEW,NVOLUM,NVERTX,NTRACK
132 C             Reconstruct NMATE, NTMED, NPART
133 C
134       IF(NUKEYS.LT.0)THEN
135          IF(KSEL(1).NE.0.AND.JPART.GT.0) NPART=IQ(JPART-2)
136          IF(KSEL(2).NE.0.AND.JMATE.NE.0) NMATE=IQ(JMATE-2)
137          IF(KSEL(3).NE.0.AND.JTMED.NE.0) THEN
138             CALL UCOPY(Q(JTMED+1),CUTGAM,10)
139             NTMED=IQ(JTMED-2)
140          ENDIF
141          IF(KSEL(4).NE.0.AND.JVOLUM.GT.0) THEN
142             NVOLUM=0
143             DO 40 J=1, IQ(JVOLUM-2)
144                IF(LQ(JVOLUM-J).EQ.0) GO TO 50
145                NVOLUM=NVOLUM+1
146   40        CONTINUE
147   50        CONTINUE
148          END IF
149          IF(KSEL(7).NE.0.AND.JDRAW.GT.0) NKVIEW=IQ(JDRAW-2)
150       ENDIF
151 C
152       IF(JHEAD.GT.0)THEN
153          IDRUN=IQ(JHEAD+1)
154          IDEVT=IQ(JHEAD+2)
155       ENDIF
156 C
157       IF(KSEL(10).GT.0)THEN
158          NVERTX=0
159          NTRACK=0
160          IF(JVERTX.GT.0)NVERTX=IQ(JVERTX+1)
161          IF(JKINE .GT.0)NTRACK=IQ(JKINE +1)
162       ENDIF
163       GO TO 99
164 C
165 C             Error, EOF,etc
166 C
167   90  IER=IQUEST(1)
168 C
169   99  RETURN
170       END