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