]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.1.1.1 1996/02/15 17:50:23 mclareni | |
6 | * Kernlib | |
7 | * | |
8 | * | |
9 | FUNCTION IUCOMH (ISTR1, ISTR2, NCH) | |
10 | C | |
11 | C CERN PROGLIB# IUCOMH .VERSION KERNVAX 2.39 930112 | |
12 | C ORIG. FCA+JZ, 20/02/90 | |
13 | C | |
14 | C Compare the two Hollerith strings of NCH bytes length and return | |
15 | C -1 if STRING1 < STRING2 | |
16 | C 0 = | |
17 | C +1 > | |
18 | C which is determined by the first non-identical character. | |
19 | C | |
20 | DIMENSION ISTR1(9), ISTR2(9) | |
21 | PARAMETER (NCHAPW=4,NBITPC=8) | |
22 | C | |
23 | NDO = NCH | |
24 | IF (NDO.LE.0) GO TO 30 | |
25 | NWD = (NDO-1)/NCHAPW + 1 | |
26 | ||
27 | DO 29 JW=1,NWD | |
28 | IWD1 = ISTR1(JW) | |
29 | IWD2 = ISTR2(JW) | |
30 | NL = MIN(NDO,4) | |
31 | ||
32 | DO 28 J=1,NL | |
33 | ICHAR1 = IAND (IWD1,255) | |
34 | ICHAR2 = IAND (IWD2,255) | |
35 | IF (ICHAR1-ICHAR2) 32, 26, 31 | |
36 | 26 IWD1 = ISHFT (IWD1,-8) | |
37 | 28 IWD2 = ISHFT (IWD2,-8) | |
38 | 29 NDO = NDO - 4 | |
39 | ||
40 | 30 IUCOMH = 0 | |
41 | RETURN | |
42 | ||
43 | 31 IUCOMH = 1 | |
44 | RETURN | |
45 | 32 IUCOMH = -1 | |
46 | RETURN | |
47 | END |