]>
Commit | Line | Data |
---|---|---|
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) | |
13 | C. | |
14 | C. ************************************************************************** | |
15 | C. * * | |
16 | C. * Print DIGIts in detector IUDET of set IUSET * | |
17 | C. * (in case IUSET/IUDET = *, take all sets/detectors) * | |
18 | C. * * | |
19 | C. * JDI=LQ(JDIGI-ISET) * | |
20 | C. * JDID=LQ(JDI-IDET) * | |
21 | C. * IQ(JDI+IDET)= pointer to LAST USED word in JDID * | |
22 | C. * * | |
23 | C. * Each digit is packed in JDID in the following format * | |
24 | C. * -- Track numbers packed * | |
25 | C. * -- Volume numbers packed * | |
26 | C. * -- Digits packed * | |
27 | C. * * | |
28 | C. * ==>Called by : <USER>, GPRINT * | |
29 | C. * Author W.Gebel ********* * | |
30 | C. * * | |
31 | C. ************************************************************************** | |
32 | C. | |
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 | |
39 | C. ------------------------------------------------------------------ | |
40 | C. | |
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 | |
51 | C | |
52 | C Loop on all selected sets | |
53 | C | |
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 | |
67 | C | |
68 | C Loop on selected detectors for this set | |
69 | C | |
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) | |
75 | C | |
76 | WRITE(CHMAIL,1000)IQ(JS+IDET),IQ(JSET+ISET) | |
77 | CALL GMAIL(0,0) | |
78 | C | |
79 | C Get volumes / digitisings names and print header line | |
80 | C | |
81 | ILAST=IQ(JDI+IDET) | |
82 | IF(ILAST.EQ.0)GO TO 220 | |
83 | NV=IQ(JD+2) | |
84 | ND=IQ(JD+6) | |
85 | C | |
86 | CALL VBLANK(KWS,130) | |
87 | K=3 | |
88 | IF(NV.GT.0)THEN | |
89 | C 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) | |
105 | C | |
106 | C Now loop on all digits | |
107 | C to get track numbers, volume numbers and digits | |
108 | C | |
109 | IDIG=0 | |
110 | I=0 | |
111 | NWDI=0 | |
112 | C | |
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) | |
119 | C | |
120 | C Get unpacked (first 3) tracks producing this digit | |
121 | C (2 tracks packed in 1 word; 1st half of 1st word: NTRA-1) | |
122 | C | |
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 | |
132 | C | |
133 | C Get unpacked volume numbers | |
134 | C | |
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 | |
157 | C | |
158 | C Get unpacked digits | |
159 | C | |
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 | |
181 | C | |
182 | C Do the printout | |
183 | C (fitting in 1 line of 128 characters per each digit) | |
184 | C | |
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 | |
189 | C | |
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 | |
270 | C | |
271 | 220 CONTINUE | |
272 | 230 CONTINUE | |
273 | C | |
274 | C | |
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 |