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