MINICERN/packlib/kernlib/kerngen/tcgens/ublow.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.4  1998/09/25 09:32:02  mclareni
   6 * Modifications for the Mklinux port flagged by CERNLIB_PPC
   7 *
   8 * Revision 1.3  1997/09/02 14:27:00  mclareni
   9 * WINNT correction
  10 *
  11 * Revision 1.2  1997/02/04 17:36:25  mclareni
  12 * Merge Winnt and 97a versions
  13 *
  14 * Revision 1.1.1.1.2.1  1997/01/21 11:31:40  mclareni
  15 * All mods for Winnt 96a on winnt branch
  16 *
  17 * Revision 1.1.1.1  1996/02/15 17:50:15  mclareni
  18 * Kernlib
  19 *
  20 *
  21 #include "kerngen/pilot.h"
  22 #if defined(CERNLIB_QFMSOFT)
  23 #include "wntgs/ublow.F"
  24 #elif defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
  25 #include "dosgs/ublow.F"
  26 #elif defined(CERNLIB_QMMPW)
  27 #include "mpwgs/ublow.F"
  28 #elif defined(CERNLIB_QMVAOS)||defined(CERNLIB_QMVMI)
  29 #include "allgs/ublow.F"
  30 #elif (defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))
  31 #include "lnxgs/ublow.F"
  32 #elif (defined(CERNLIB_QMLNX) && defined(CERNLIB_PPC))
  33 #include "lnxppcgs/ublow.F"
  34 #elif defined(CERNLIB_QMSUN)
  35 #include "sungs/ublow.F"
  36 #elif defined(CERNLIB_QMVAX)
  37 #include "vaxgs/ublow.F"
  38 #elif defined(CERNLIB_B32)||defined(CERNLIB_B64)
  39       SUBROUTINE UBLOW (MS,MT,NCHP)
  40 C
  41 C CERN PROGLIB# M409    UBLOW           .VERSION KERNFOR  4.30  910819
  42 C ORIG. 05/12/89, FCA+JZ
  43 C
  44
  45       DIMENSION    MS(99), MT(99), NCHP(9)
  46 #include "kerngen/iallbl.inc"
  47 #include "kerngen/ublowx1.inc"
  48
  49       NCH = NCHP(1)
  50       IF   (NCH)             91, 29, 11
  51 #if defined(CERNLIB_B64)
  52    11 NWS    = ISHFT (NCH,-3)
  53       NTRAIL = IAND (NCH,7)
  54 #endif
  55 #if defined(CERNLIB_B32)
  56    11 NWS    = ISHFT (NCH,-2)
  57       NTRAIL = IAND (NCH,3)
  58 #endif
  59       JT     = 0
  60       IF (NWS.EQ.0)          GO TO 26
  61
  62 C--                Unpack the initial complete words
  63
  64       DO 24 JS=1,NWS
  65       MWD      = MS(JS)
  66       MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
  67       MT(JT+2) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD, 8)))
  68       MT(JT+3) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,16)))
  69 #if defined(CERNLIB_B64)
  70       MT(JT+4) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,24)))
  71       MT(JT+5) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,32)))
  72       MT(JT+6) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,40)))
  73       MT(JT+7) = IOR (IBLAN1,IAND(MASK1,ISHFT(MWD,48)))
  74       MT(JT+8) = IOR (IBLAN1,           ISHFT(MWD,56) )
  75    24 JT = JT + 8
  76 #endif
  77 #if defined(CERNLIB_B32)
  78       MT(JT+4) = IOR (IBLAN1,           ISHFT(MWD,24) )
  79    24 JT = JT + 4
  80 #endif
  81
  82       IF (NTRAIL.EQ.0)       RETURN
  83
  84 C--                Unpack the trailing word
  85
  86    26 MWD = MS(NWS+1)
  87
  88       DO 28 JS=1,NTRAIL
  89       MT(JT+1) = IOR (IBLAN1,IAND(MASK1,MWD))
  90       MWD = ISHFT (MWD,8)
  91    28 JT = JT + 1
  92    29 RETURN
  93
  94    91 CALL ABEND
  95       END
  96 #endif