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

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:50:22  mclareni
   6 * Kernlib
   7 *
   8 *
   9       SUBROUTINE UPKBYT (MBV,JTHP,MIV,NINTP,NBITS)
  10 C
  11 C CERN PROGLIB# M422    UPKBYT          .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       JTH  = JTHP(1)
  17       NINT = NINTP(1)
  18       IF (NINT.LE.0)         RETURN
  19
  20       NZB  = NBITS(1)
  21       IF (NZB.GT.0)          GO TO 11
  22       NZB  = 1
  23       NPWD = 32
  24       MASK = 1
  25       GO TO 12
  26
  27    11 NPWD = NBITS(2)
  28 #if defined(CERNLIB_BUGLRSHFT)
  29       MASK = ishft (-1,NZB-32)
  30 #endif
  31 #if !defined(CERNLIB_BUGLRSHFT)
  32       MASK = lrshft (-1,32-NZB)
  33 #endif
  34
  35    12 JBV  = 1
  36       JIV  = 0
  37       IF (JTH.LT.2)          GO TO 21
  38       JBV  = (JTH-1)/NPWD + 1
  39       JPOS = JTH - (JBV-1)*NPWD - 1
  40       IF (JPOS.EQ.0)         GO TO 21
  41       NR   = JPOS*NZB
  42       JIVE = NPWD - JPOS
  43 #if defined(CERNLIB_BUGLRSHFT)
  44       IZW  =  ishft (MBV(JBV), -NR)
  45 #endif
  46 #if !defined(CERNLIB_BUGLRSHFT)
  47       IZW  = lrshft (MBV(JBV), NR)
  48 #endif
  49       GO TO 22
  50
  51 C--                UNPACK EACH WORD
  52
  53    21 JIVE = JIV + NPWD
  54       IZW  = MBV(JBV)
  55    22 JIVE = MIN0 (NINT,JIVE)
  56
  57    24 JIV  = JIV + 1
  58       MIV(JIV) = AND (MASK,IZW)
  59       IF (JIV.EQ.JIVE)       GO TO 27
  60 #if defined(CERNLIB_BUGLRSHFT)
  61       IZW  =  ishft (IZW,-NZB)
  62 #endif
  63 #if !defined(CERNLIB_BUGLRSHFT)
  64       IZW  = lrshft (IZW, NZB)
  65 #endif
  66       GO TO 24
  67
  68    27 IF (JIV.EQ.NINT)       RETURN
  69       JBV  = JBV + 1
  70       GO TO 21
  71       END