]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/kernlib/kerngen/tcgens/lnxgs/ublow.F
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / MINICERN / packlib / kernlib / kerngen / tcgens / lnxgs / ublow.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1996/02/15 17:50:19 mclareni
6* Kernlib
7*
8*
9 SUBROUTINE UBLOW (MS,MT,NCHP)
10C
11C CERN PROGLIB# M409 UBLOW .VERSION KERNLNX 1.02 940511
12C ORIG. 03/02/89 K.M.STORR
13C
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 = ishftr (NCH,2)
22 NTRAIL = AND (NCH,3)
23 JT = 0
24 IF (NWS.EQ.0) GO TO 26
25
26C-- Unpack the initial complete words
27
28 DO 24 JS=1,NWS
29 MWD = MS(JS)
30 MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
31 MT(JT+2) = OR (IBLAN1,AND(MASK1,ishftr(MWD,8)))
32 MT(JT+3) = OR (IBLAN1,AND(MASK1,ishftr(MWD,16)))
33 MT(JT+4) = OR (IBLAN1, ishftr(MWD,24) )
34 24 JT = JT + 4
35
36 IF (NTRAIL.EQ.0) RETURN
37
38C-- Unpack the trailing word
39
40 26 MWD = MS(NWS+1)
41
42 DO 28 JS=1,NTRAIL
43 MT(JT+1) = OR (IBLAN1,AND(MASK1,MWD))
44 MWD = ishftr (MWD,8)
45 28 JT = JT + 1
46 29 RETURN
47
48 91 CALL ABEND
49 END