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

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:50:22  mclareni
   6 * Kernlib
   7 *
   8 *
   9       FUNCTION IUCOMH (ISTR1, ISTR2, NCH)
  10 C
  11 C CERN PROGLIB#         IUCOMH          .VERSION KERNVMI  1.02  900221
  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