]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 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 |