MINICERN/packlib/kernlib/kerngen/tcgens/sungs/ublow.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 UBLOW (MS,MT,NCHP)
  10 C
  11 C CERN PROGLIB# M409    UBLOW           .VERSION KERNSUN  1.00  880922
  12 C ORIG. 22/09/88, JZ
  13 C
  14
  15       DIMENSION    MS(99), MT(99), NCHP(9)
  16 C-  - PARAMETER    (IBLAN1 = X'00202020')
  17       PARAMETER    (IBLAN1 =    2105376 )
  18 C-  - PARAMETER    (MASK1  = X'FF000000')
  19       PARAMETER    (MASK1  =  -16777216 )
  20
  21
  22       NCH = NCHP(1)
  23       IF   (NCH)             91, 29, 11
  24    11 NWS    = RSHIFT (NCH,2)
  25       NTRAIL = AND (NCH,3)
  26       JT     = 0
  27       IF (NWS.EQ.0)          GO TO 26
  28
  29 C--                Unpack the initial complete words
  30
  31       DO 24 JS=1,NWS
  32       MWD      = MS(JS)
  33       MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
  34       MT(JT+2) = OR (IBLAN1,AND(MASK1,LSHIFT(MWD, 8)))
  35       MT(JT+3) = OR (IBLAN1,AND(MASK1,LSHIFT(MWD,16)))
  36       MT(JT+4) = OR (IBLAN1,          LSHIFT(MWD,24) )
  37    24 JT = JT + 4
  38
  39       IF (NTRAIL.EQ.0)       RETURN
  40
  41 C--                Unpack the trailing word
  42
  43    26 MWD = MS(NWS+1)
  44
  45       DO 28 JS=1,NTRAIL
  46       MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
  47       MWD = LSHIFT (MWD,8)
  48    28 JT = JT + 1
  49    29 RETURN
  50
  51    91 CALL ABEND
  52       END