MINICERN/packlib/kernlib/kerngen/tcgens/allgs/ublow.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 UBLOW (MS,MT,NCHP)
  10 C
  11 C CERN PROGLIB# M409    UBLOW           .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'20202000'/
  17       DATA MASK1   /x'000000ff'/
  18
  19       NCH = NCHP(1)
  20       IF   (NCH)             91, 29, 11
  21    11 NWS    = ishft (NCH,-2)
  22       NTRAIL = IAND (NCH,3)
  23       JT     = 0
  24       IF (NWS.EQ.0)          GO TO 26
  25
  26 C--                Unpack the initial complete words
  27
  28       DO 24 JS=1,NWS
  29       MWD      = MS(JS)
  30       MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
  31       MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, -8)))
  32       MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,-16)))
  33       MT(JT+4) = IOR (IBLAN1,           ISHFT(MWD,-24) )
  34    24 JT = JT + 4
  35
  36       IF (NTRAIL.EQ.0)       RETURN
  37
  38 C--                Unpack the trailing word
  39
  40    26 MWD = MS(NWS+1)
  41
  42       DO 28 JS=1,NTRAIL
  43       MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
  44       MWD = ISHFT (MWD,-8)
  45    28 JT = JT + 1
  46    29 RETURN
  47
  48    91 CALL ABEND
  49       END