| fe4da5cc |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 5 | * Revision 1.1 1998/09/25 09:32:14 mclareni |
| 6 | * Modifications for the Mklinux port flagged by CERNLIB_PPC |
| 7 | * |
| 8 | * Revision 1.1.1.1 1996/02/15 17:50:20 mclareni |
| 9 | * Kernlib |
| 10 | * |
| 11 | * |
| 12 | SUBROUTINE UBUNCH (MS,MT,NCHP) |
| 13 | C |
| 14 | C CERN PROGLIB# M409 UBUNCH .VERSION KERNLNX 1.02 940511 |
| 15 | C ORIG. 03/02/89 K.M.STORR |
| 16 | C |
| 17 | |
| 18 | DIMENSION MS(99), MT(99), NCHP(9) |
| 19 | data iblan1/x'20202020'/ |
| 20 | data mask1/x'ff000000'/ |
| 21 | |
| 22 | NCH = NCHP(1) |
| 23 | IF (NCH) 91,39,11 |
| 24 | 11 NWT = ishftr (NCH,2) |
| 25 | NTRAIL = AND (NCH,3) |
| 26 | JS = 0 |
| 27 | IF (NWT.EQ.0) GO TO 31 |
| 28 | |
| 29 | C-- Pack the initial complete words |
| 30 | |
| 31 | DO 24 JT=1,NWT |
| 32 | MT(JT) = OR (OR (OR ( |
| 33 | + AND(MS(JS+1),MASK1), |
| 34 | + ISHFTR (AND(MS(JS+2),MASK1), 8)), |
| 35 | + ISHFTR (IAND(MS(JS+3),MASK1),16)), |
| 36 | + ISHFTR (MS(JS+4), 24) ) |
| 37 | 24 JS = JS + 4 |
| 38 | |
| 39 | IF (NTRAIL.EQ.0) RETURN |
| 40 | |
| 41 | C-- Pack the trailing word |
| 42 | |
| 43 | 31 MWD = IBLAN1 |
| 44 | JS = NCH |
| 45 | |
| 46 | DO 34 JT=1,NTRAIL |
| 47 | MWD = OR (ISHFTR(MWD,8), AND(MS(JS),MASK1)) |
| 48 | 34 JS = JS - 1 |
| 49 | MT(NWT+1) = MWD |
| 50 | 39 RETURN |
| 51 | |
| 52 | 91 CALL ABEND |
| 53 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame