]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/ghits/gpdigi.F
Larger BOX in case CRT is present.
[u/mrichter/AliRoot.git] / GEANT321 / ghits / gpdigi.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:21:10 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 GPDIGI(IUSET,IUDET)
13C.
14C. **************************************************************************
15C. * *
16C. * Print DIGIts in detector IUDET of set IUSET *
17C. * (in case IUSET/IUDET = *, take all sets/detectors) *
18C. * *
19C. * JDI=LQ(JDIGI-ISET) *
20C. * JDID=LQ(JDI-IDET) *
21C. * IQ(JDI+IDET)= pointer to LAST USED word in JDID *
22C. * *
23C. * Each digit is packed in JDID in the following format *
24C. * -- Track numbers packed *
25C. * -- Volume numbers packed *
26C. * -- Digits packed *
27C. * *
28C. * ==>Called by : <USER>, GPRINT *
29C. * Author W.Gebel ********* *
30C. * *
31C. **************************************************************************
32C.
33#include "geant321/gcbank.inc"
34#include "geant321/gcunit.inc"
35 PARAMETER (NDEMX=100,NVMAX=20)
36 DIMENSION KDIGI(NDEMX),NUMBV(NVMAX),KWS(130),LTR(3)
37 EQUIVALENCE (WS(1),NUMBV(1)),(WS(101),KDIGI(1))
38 CHARACTER*4 IUSET,IUDET
39C. ------------------------------------------------------------------
40C.
41 IF(JDIGI.LE.0)GO TO 999
42 NSET=IQ(JSET-1)
43 NS1=1
44 NS2=NSET
45 IF(IUSET(1:1).NE.'*')THEN
46 CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET)
47 IF(ISET.LE.0)GO TO 999
48 NS1=ISET
49 NS2=ISET
50 ENDIF
51C
52C Loop on all selected sets
53C
54 DO 230 ISET=NS1,NS2
55 JS=LQ(JSET-ISET)
56 JDI=LQ(JDIGI-ISET)
57 IF(JDI.LE.0)GO TO 230
58 NDET=IQ(JS-1)
59 ND1=1
60 ND2=NDET
61 IF(IUDET(1:1).NE.'*')THEN
62 CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET)
63 IF(IDET.EQ.0)GO TO 230
64 ND1=IDET
65 ND2=IDET
66 ENDIF
67C
68C Loop on selected detectors for this set
69C
70 DO 220 IDET=ND1,ND2
71 JD=LQ(JS-IDET)
72 JDID=LQ(JDI-IDET)
73 IF(JDID.LE.0)GO TO 220
74 JDDI=LQ(JD-2)
75C
76 WRITE(CHMAIL,1000)IQ(JS+IDET),IQ(JSET+ISET)
77 CALL GMAIL(0,0)
78C
79C Get volumes / digitisings names and print header line
80C
81 ILAST=IQ(JDI+IDET)
82 IF(ILAST.EQ.0)GO TO 220
83 NV=IQ(JD+2)
84 ND=IQ(JD+6)
85C
86 CALL VBLANK(KWS,130)
87 K=3
88 IF(NV.GT.0)THEN
89C Number of printed elements limited to 15
90 NVM=MIN(NV,15)
91 DO 22 I=1,NVM
92 CALL UBLOW(IQ(JD+2*I+9),KWS(K),4)
93 22 K=K+5
94 K=K+5
95 ENDIF
96 IF(ND.GT.0)THEN
97 DO 26 I=1,ND
98 IF(K.LE.101) CALL UBLOW(IQ(JDDI+2*I-1),KWS(K),4)
99 K=K+8
100 26 CONTINUE
101 IF(K.GT.104)K=104
102 ENDIF
103 WRITE(CHMAIL,2000)(KWS(I),I=1,K)
104 CALL GMAIL(0,1)
105C
106C Now loop on all digits
107C to get track numbers, volume numbers and digits
108C
109 IDIG=0
110 I=0
111 NWDI=0
112C
113 30 CONTINUE
114 I=I+NWDI
115 IF(I.GE.ILAST)GO TO 220
116 NK=2
117 IDIG=IDIG+1
118 CALL VZERO (LTR(1),3)
119C
120C Get unpacked (first 3) tracks producing this digit
121C (2 tracks packed in 1 word; 1st half of 1st word: NTRA-1)
122C
123 NWDI=IQ(JDID+I+1)
124 NTRM1=IBITS(IQ(JDID+I+NK), 0,16)
125 NTRA=NTRM1+1
126 IF(NTRA.GE.1)LTR(1)=IBITS(IQ(JDID+I+NK),16,16)
127 NK=NK+1
128 IF(NTRA.GE.2)LTR(2)=IBITS(IQ(JDID+I+NK), 0,16)
129 IF(NTRA.GE.3)LTR(3)=IBITS(IQ(JDID+I+NK),16,16)
130 NWTR=NTRA/2+1
131 NK=NWTR+2
132C
133C Get unpacked volume numbers
134C
135 IF(NV.GT.0)THEN
136 K=1
137 DO 50 IV=1,NV
138 NB=IQ(JD+2*IV+10)
139 IF(NB.LE.0)THEN
140 IF(K.GT.1)THEN
141 NK=NK+1
142 ENDIF
143 NUMBV(IV)=IQ(JDID+I+NK)
144 K=1
145 NK=NK+1
146 ELSE
147 IF(K+NB.GT.33)THEN
148 K=1
149 NK=NK+1
150 ENDIF
151 NUMBV(IV)=IBITS(IQ(JDID+I+NK),K-1,NB)
152 K=K+NB
153 ENDIF
154 50 CONTINUE
155 IF(K.NE.1)NK=NK+1
156 ENDIF
157C
158C Get unpacked digits
159C
160 IF(ND.GT.0)THEN
161 K=1
162 DO 90 ID=1,ND
163 NB=IQ(JDDI+2*ID)
164 IF(NB.LE.0)THEN
165 IF(K.GT.1)THEN
166 NK=NK+1
167 ENDIF
168 IF(ID.LE.NDEMX) KDIGI(ID)=IQ(JDID+I+NK)
169 K=1
170 NK=NK+1
171 ELSE
172 IF(K+NB.GT.33)THEN
173 K=1
174 NK=NK+1
175 ENDIF
176 IF(ID.LE.NDEMX) KDIGI(ID)=IBITS(IQ(JDID+I+NK),K-1,NB)
177 K=K+NB
178 ENDIF
179 90 CONTINUE
180 ENDIF
181C
182C Do the printout
183C (fitting in 1 line of 128 characters per each digit)
184C
185 IF(NV.EQ.0)GO TO 119
186 IF(NV.GT.15)NV=15
187 GO TO (101,102,103,104,105,106,107,108,109,110
188 +, 111,112,113,114,115), NV
189C
190 101 NDP=MIN(ND,12)
191 WRITE(CHMAIL,3001)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
192 +, (KDIGI(L),L=1,NDP)
193 CALL GMAIL(0,0)
194 GO TO 30
195 102 NDP=MIN(ND,11)
196 WRITE(CHMAIL,3002)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
197 +, (KDIGI(L),L=1,NDP)
198 CALL GMAIL(0,0)
199 GO TO 30
200 103 NDP=MIN(ND,10)
201 WRITE(CHMAIL,3003)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
202 +, (KDIGI(L),L=1,NDP)
203 CALL GMAIL(0,0)
204 GO TO 30
205 104 NDP=MIN(ND,10)
206 WRITE(CHMAIL,3004)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
207 +, (KDIGI(L),L=1,NDP)
208 CALL GMAIL(0,0)
209 GO TO 30
210 105 NDP=MIN(ND, 9)
211 WRITE(CHMAIL,3005)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
212 +, (KDIGI(L),L=1,NDP)
213 CALL GMAIL(0,0)
214 GO TO 30
215 106 NDP=MIN(ND, 8)
216 WRITE(CHMAIL,3006)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
217 +, (KDIGI(L),L=1,NDP)
218 CALL GMAIL(0,0)
219 GO TO 30
220 107 NDP=MIN(ND, 8)
221 WRITE(CHMAIL,3007)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
222 +, (KDIGI(L),L=1,NDP)
223 CALL GMAIL(0,0)
224 GO TO 30
225 108 NDP=MIN(ND, 7)
226 WRITE(CHMAIL,3008)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
227 +, (KDIGI(L),L=1,NDP)
228 CALL GMAIL(0,0)
229 GO TO 30
230 109 NDP=MIN(ND, 7)
231 WRITE(CHMAIL,3009)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
232 +, (KDIGI(L),L=1,NDP)
233 CALL GMAIL(0,0)
234 GO TO 30
235 110 NDP=MIN(ND, 6)
236 WRITE(CHMAIL,3010)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
237 +, (KDIGI(L),L=1,NDP)
238 CALL GMAIL(0,0)
239 GO TO 30
240 111 NDP=MIN(ND, 5)
241 WRITE(CHMAIL,3011)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
242 +, (KDIGI(L),L=1,NDP)
243 CALL GMAIL(0,0)
244 GO TO 30
245 112 NDP=MIN(ND, 5)
246 WRITE(CHMAIL,3012)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
247 +, (KDIGI(L),L=1,NDP)
248 CALL GMAIL(0,0)
249 GO TO 30
250 113 NDP=MIN(ND, 4)
251 WRITE(CHMAIL,3013)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
252 +, (KDIGI(L),L=1,NDP)
253 CALL GMAIL(0,0)
254 GO TO 30
255 114 NDP=MIN(ND, 4)
256 WRITE(CHMAIL,3014)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
257 +, (KDIGI(L),L=1,NDP)
258 CALL GMAIL(0,0)
259 GO TO 30
260 115 NDP=MIN(ND, 3)
261 WRITE(CHMAIL,3015)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV)
262 +, (KDIGI(L),L=1,NDP)
263 CALL GMAIL(0,0)
264 GO TO 30
265 119 NDP=MIN(ND,12)
266 WRITE(CHMAIL,3000)IDIG,(LTR(J),J=1,3)
267 +, (KDIGI(L),L=1,NDP)
268 CALL GMAIL(0,0)
269 GO TO 30
270C
271 220 CONTINUE
272 230 CONTINUE
273C
274C
275 1000 FORMAT(' =====>DIGITS OF DETECTOR ** ',A4,
276 +' ** OF SET ** ',A4,' **')
277 2000 FORMAT(' DIGIT TR1 TR2 TR3 ',104A1)
278 3000 FORMAT(1X,I5,2X,3I5,3X, 12(1X,I7))
279 3001 FORMAT(1X,I5,2X,3I5,3X, 1(1X,I4),2X,12(1X,I7))
280 3002 FORMAT(1X,I5,2X,3I5,3X, 2(1X,I4),2X,11(1X,I7))
281 3003 FORMAT(1X,I5,2X,3I5,3X, 3(1X,I4),2X,10(1X,I7))
282 3004 FORMAT(1X,I5,2X,3I5,3X, 4(1X,I4),2X,10(1X,I7))
283 3005 FORMAT(1X,I5,2X,3I5,3X, 5(1X,I4),2X, 9(1X,I7))
284 3006 FORMAT(1X,I5,2X,3I5,3X, 6(1X,I4),2X, 8(1X,I7))
285 3007 FORMAT(1X,I5,2X,3I5,3X, 7(1X,I4),2X, 8(1X,I7))
286 3008 FORMAT(1X,I5,2X,3I5,3X, 8(1X,I4),2X, 7(1X,I7))
287 3009 FORMAT(1X,I5,2X,3I5,3X, 9(1X,I4),2X, 7(1X,I7))
288 3010 FORMAT(1X,I5,2X,3I5,3X,10(1X,I4),2X, 6(1X,I7))
289 3011 FORMAT(1X,I5,2X,3I5,3X,11(1X,I4),2X, 5(1X,I7))
290 3012 FORMAT(1X,I5,2X,3I5,3X,12(1X,I4),2X, 5(1X,I7))
291 3013 FORMAT(1X,I5,2X,3I5,3X,13(1X,I4),2X, 4(1X,I7))
292 3014 FORMAT(1X,I5,2X,3I5,2X,14(1X,I4),2X, 4(1X,I7))
293 3015 FORMAT(1X,I5,2X,3I5,3X,15(1X,I4),2X, 3(1X,I7))
294 999 RETURN
295 END