MINICERN/packlib/kernlib/kerngen/tcgens/sungs/pkbyt.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:50:21  mclareni
   6 * Kernlib
   7 *
   8 *
   9       SUBROUTINE PKBYT (MIV,MBV,JTHP,NINTP,NBITS)
  10 C
  11 C CERN PROGLIB# M422    PKBYT           .VERSION KERNSUN  1.06  920511
  12 C ORIG. 22/09/88, JZ
  13 C
  14       DIMENSION    MIV(99), MBV(99), JTHP(9), NINTP(9), NBITS(2)
  15
  16
  17       JTH  = JTHP(1)
  18       NINT = NINTP(1)
  19       IF (NINT.LE.0)         RETURN
  20
  21       NZB  = NBITS(1)
  22       IF (NZB.GT.0)          GO TO 11
  23       NZB  = 1
  24       NPWD = 32
  25       MASK = 1
  26       GO TO 12
  27
  28    11 NPWD = NBITS(2)
  29 #if defined(CERNLIB_BUGLRSHFT)
  30       MASK = ishft (-1, NZB-32)
  31 #endif
  32 #if !defined(CERNLIB_BUGLRSHFT)
  33       MASK = lrshft (-1, 32-NZB)
  34 #endif
  35
  36    12 JBV  = 1
  37       JIV  = 0
  38       IF (JTH.LT.2)          GO TO 21
  39       JBV  = (JTH-1)/NPWD + 1
  40       JPOS = JTH - (JBV-1)*NPWD - 1
  41       IF (JPOS.EQ.0)         GO TO 21
  42       NL   = JPOS*NZB
  43       MSKU = LSHIFT (MASK,NL)
  44       JIVE = NPWD - JPOS
  45       GO TO 22
  46
  47 C--                PACK EACH WORD
  48
  49    21 NL   = 0
  50       MSKU = MASK
  51       JIVE = JIV + NPWD
  52    22 JIVE = MIN0 (NINT,JIVE)
  53       IZW  = MBV(JBV)
  54
  55    24 JIV  = JIV + 1
  56       IZW  = OR (AND(NOT(MSKU),IZW),
  57      +           AND(MSKU,LSHIFT(MIV(JIV),NL)))
  58       IF (JIV.EQ.JIVE)       GO TO 27
  59       NL   = NL + NZB
  60       MSKU = LSHIFT (MSKU,NZB)
  61       GO TO 24
  62
  63    27 MBV(JBV) = IZW
  64       IF (JIV.EQ.NINT)       RETURN
  65       JBV  = JBV + 1
  66       GO TO 21
  67       END