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

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:45  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       FUNCTION ICINQ (TEXT,POSS,NPOSS)
  11 C
  12 C CERN PROGLIB# M432    ICINQ           .VERSION KERNFOR  4.36  930602
  13 C ORIG. 24/05/93, JZ
  14 C
  15 C-    Match TEXT against POSS(NPOSS), case sensitive
  16
  17       CHARACTER*(*)  TEXT, POSS(99)
  18       CHARACTER*1    CHT,  CHP
  19
  20
  21       NTX = LEN(TEXT)
  22       NPO = LEN(POSS(1))
  23
  24       JPOSS = 0
  25    11 JPOSS = JPOSS + 1
  26       IF (JPOSS.GT.NPOSS)    GO TO 98
  27       CHP = POSS(JPOSS)(1:1)
  28       CHT = TEXT(1:1)
  29       JC  = 1
  30    12 IF (CHT.NE.CHP)        GO TO 11
  31       JC = JC + 1
  32       IF (JC.GT.NPO)         GO TO 99
  33       CHP = POSS(JPOSS)(JC:JC)
  34       IF (CHP.EQ.' ')        GO TO 71
  35       IF (JC.GT.NTX)         GO TO 11
  36       CHT = TEXT(JC:JC)
  37       IF (CHT.NE.'*')        GO TO 12
  38
  39 C----         First '*' seen on TEXT
  40
  41    61 JC = JC + 1
  42       IF (JC.GT.NTX)         GO TO 99
  43       CHT = TEXT(JC:JC)
  44       IF (CHT.EQ.'*')        GO TO 99
  45       IF (CHT.EQ.' ')        GO TO 99
  46       IF (CHP.NE.CHT)        GO TO 11
  47       IF (JC.GT.NPO)         GO TO 99
  48       CHP = POSS(JPOSS)(JC:JC)
  49       IF (CHP.NE.' ')        GO TO 61
  50       GO TO 99
  51
  52 C----         POSS blank terminated
  53
  54    71 IF (JC.GT.NTX)         GO TO 99
  55       CHT = TEXT(JC:JC)
  56       IF (CHT.EQ.' ')        GO TO 99
  57       IF (CHT.EQ.'*')        GO TO 99
  58       GO TO 11
  59
  60    98 JPOSS = 0
  61    99 ICINQ = JPOSS
  62       RETURN
  63       END