MINICERN/packlib/kernlib/kerngen/tcgens/dosgs/iucomh.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1997/09/02 14:27:02  mclareni
   6 * WINNT correction
   7 *
   8 * Revision 1.1.1.1  1996/02/15 17:50:24  mclareni
   9 * Kernlib
  10 *
  11 *
  12       FUNCTION IUCOMH (ISTR1, ISTR2, NCH)
  13 C
  14 C CERN PROGLIB#         IUCOMH          .VERSION KERNDOS  1.00  920624
  15 C ORIG.  FCA+JZ, 20/02/90
  16 C
  17 C Compare the two Hollerith strings of NCH bytes length and return
  18 C         -1  if  STRING1  < STRING2
  19 C          0               =
  20 C         +1               >
  21 C which is determined by the first non-identical character.
  22 C
  23       DIMENSION ISTR1(9), ISTR2(9)
  24 C
  25       NDO = NCH
  26       IF (NDO.LE.0)                GO TO 30
  27       NWD = (NDO-1)/4 + 1
  28
  29       DO 29  JW=1,NWD
  30       IWD1 = ISTR1(JW)
  31       IWD2 = ISTR2(JW)
  32       NL   = MIN(NDO,4)
  33       IF (IWD1. NE. IWD2)    THEN
  34
  35         DO 28  J=1,NL
  36 #ifndef CERNLIB_QF2C
  37           ICHAR1 = IAND (IWD1,255)
  38           ICHAR2 = IAND (IWD2,255)
  39 #else
  40           ICHAR1 = AND (IWD1,255)
  41           ICHAR2 = AND (IWD2,255)
  42 #endif
  43           IF (ICHAR1-ICHAR2)           32, 26, 31
  44 #ifndef CERNLIB_QF2C
  45    26     IWD1 = ISHFT (IWD1,-8)
  46    28   IWD2 = ISHFT (IWD2,-8)
  47 #else
  48    26   IWD1 = rshift (IWD1,8)
  49    28   IWD2 = rshift (IWD2,8)
  50 #endif
  51       END IF
  52    29 NDO  = NDO - 4
  53
  54    30 IUCOMH = 0
  55       RETURN
  56
  57    31 IUCOMH = 1
  58       RETURN
  59    32 IUCOMH = -1
  60       RETURN
  61       END