MINICERN/packlib/kernlib/kerngen/tcgens/allgs/ubunch.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:50:23  mclareni
   6 * Kernlib
   7 *
   8 *
   9       SUBROUTINE UBUNCH (MS,MT,NCHP)
  10 C
  11 C CERN PROGLIB# M409    UBUNCH          .VERSION KERNVMI  1.01  891208
  12 C ORIG. 03/02/89 K.M.STORR
  13 C
  14
  15       DIMENSION    MS(99), MT(99), NCHP(9)
  16       DATA IBLAN1  /x'20202020'/
  17       DATA MASK1   /x'000000ff'/
  18
  19       NCH = NCHP(1)
  20       IF   (NCH)             91,39,11
  21    11 NWT    = ishft (NCH,-2)
  22       NTRAIL = IAND (NCH,3)
  23       JS     = 0
  24       IF (NWT.EQ.0)          GO TO 31
  25
  26 C--                Pack the initial complete words
  27
  28       DO 24  JT=1,NWT
  29       MT(JT) = IOR (IOR (IOR (
  30      +                  IAND(MS(JS+1),MASK1),
  31      +           ishft (IAND(MS(JS+2),MASK1), 8)),
  32      +           ishft (IAND(MS(JS+3),MASK1),16)),
  33      +           ishft      (MS(JS+4),       24) )
  34    24 JS = JS + 4
  35
  36       IF (NTRAIL.EQ.0)       RETURN
  37
  38 C--                Pack the trailing word
  39
  40    31 MWD = IBLAN1
  41       JS  = NCH
  42
  43       DO 34 JT=1,NTRAIL
  44       MWD = IOR (ishft(MWD,8), IAND(MS(JS),MASK1))
  45    34 JS  = JS - 1
  46       MT(NWT+1) = MWD
  47    39 RETURN
  48
  49    91 CALL ABEND
  50       END