MINICERN/packlib/kernlib/kerngen/tcgen/icnthl.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:46  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       FUNCTION ICNTHL (TEXT,POSS,NPOSS)
  11 C
  12 C CERN PROGLIB# M432    ICNTHL          .VERSION KERNFOR  4.36  930602
  13 C ORIG. 04/10/88, JZ
  14 C
  15 C-    Match TEXT against lower case POSS(NPOSS), case insensitive
  16
  17       CHARACTER*(*)  TEXT,POSS(99)
  18       CHARACTER*1    CHP, CHT
  19
  20 #include "kerngen/qnatch.inc"
  21 * Ignoring t=pass
  22
  23       NTX = LEN(TEXT)
  24       NPO = LEN(POSS(1))
  25       JPOSS  = 0
  26
  27    11 JPOSS = JPOSS + 1
  28       IF (JPOSS.GT.NPOSS)    GO TO 98
  29       JC = 1
  30       CHP = POSS(JPOSS)(1:1)
  31    12 CHT = TEXT(JC:JC)
  32       IF (CHT.NE.CHP)  THEN
  33           IVT = ICHAR(CHT)
  34           IVP = ICHAR(CHP)
  35 #if defined(CERNLIB_QASCII)
  36           IF (IVP-IVT.NE.32) GO TO 11
  37           IF (IVT.LT.65)     GO TO 11
  38           IF (IVT.GT.90)     GO TO 11
  39 #endif
  40 #if defined(CERNLIB_QEBCDIC)
  41           IF (IVT-IVP.NE.64)      GO TO 11
  42           IF (NATCH(IVT+1).NE.4)  GO TO 11
  43 #endif
  44         ENDIF
  45       JC = JC + 1
  46       IF (JC.GT.NPO)         GO TO 99
  47       CHP = POSS(JPOSS)(JC:JC)
  48       IF (CHP.EQ.'*')        GO TO 41
  49       IF (CHP.EQ.' ')        GO TO 31
  50       IF (JC.LE.NTX)         GO TO 12
  51       GO TO 11
  52
  53 C--                POSS blank terminated
  54
  55    31 IF (JC.GT.NTX)         GO TO 99
  56       CHT = TEXT(JC:JC)
  57       IF (CHT.EQ.' ')        GO TO 99
  58       GO TO 11
  59
  60 C--                Check continuation after '*'
  61
  62    41 IF (JC.GT.NTX)         GO TO 99
  63       CHT = TEXT(JC:JC)
  64       IF (CHT.EQ.' ')        GO TO 99
  65       JC = JC + 1
  66       IF (JC.GT.NPO)         GO TO 99
  67       CHP = POSS(JPOSS)(JC:JC)
  68       IF (CHP.EQ.' ')        GO TO 11
  69       IF (CHP.EQ.'*')        GO TO 99
  70       IF (CHT.EQ.CHP)        GO TO 41
  71       IVT = ICHAR(CHT)
  72       IVP = ICHAR(CHP)
  73 #if defined(CERNLIB_QASCII)
  74       IF (IVP-IVT.NE.32) GO TO 11
  75       IF (IVT.LT.65)     GO TO 11
  76       IF (IVT.GT.90)     GO TO 11
  77 #endif
  78 #if defined(CERNLIB_QEBCDIC)
  79       IF (IVT-IVP.NE.64)      GO TO 11
  80       IF (NATCH(IVT+1).NE.4)  GO TO 11
  81 #endif
  82       GO TO 41
  83
  84    98 JPOSS = 0
  85    99 ICNTHL = JPOSS
  86       RETURN
  87       END