MINICERN/packlib/kernlib/kerngen/tcgen/icnth.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 ICNTH (TEXT,POSS,NPOSS)
  11 C
  12 C CERN PROGLIB# M432    ICNTH           .VERSION KERNFOR  4.36  930602
  13 C ORIG. 04/10/88, JZ
  14 C
  15 C-    Match TEXT against POSS(NPOSS), case sensitive
  16
  17       CHARACTER*(*)  TEXT,POSS(99)
  18       CHARACTER*1    CHP, CHT
  19
  20
  21       NTX = LEN(TEXT)
  22       NPO = LEN(POSS(1))
  23       JPOSS  = 0
  24 C     PRINT 9009, NTX,NPO, TEXT
  25 C9009 FORMAT ('NTX,NPO=',2I4,' find >',A,'<')
  26
  27    11 JPOSS = JPOSS + 1
  28       IF (JPOSS.GT.NPOSS)    GO TO 98
  29       JC = 1
  30 C     PRINT 9011, JPOSS,POSS(JPOSS)
  31 C9011 FORMAT ('JPOSS=',I3,' take >',A,'<')
  32       CHP = POSS(JPOSS)(1:1)
  33    12 CHT = TEXT(JC:JC)
  34 C     PRINT 9012, CHT,CHP
  35 C9012 FORMAT ('@12 CHT/CHP= ',A,1X,A)
  36       IF (CHT.NE.CHP)        GO TO 11
  37       JC = JC + 1
  38       IF (JC.GT.NPO)         GO TO 99
  39       CHP = POSS(JPOSS)(JC:JC)
  40       IF (CHP.EQ.'*')        GO TO 41
  41       IF (CHP.EQ.' ')        GO TO 31
  42       IF (JC.LE.NTX)         GO TO 12
  43       GO TO 11
  44
  45 C--                POSS blank terminated
  46
  47    31 IF (JC.GT.NTX)         GO TO 99
  48       CHT = TEXT(JC:JC)
  49 C     PRINT 9031, JC,CHT
  50 C9031 FORMAT('at col. JC',I3,' >',A,'<')
  51       IF (CHT.EQ.' ')        GO TO 99
  52       GO TO 11
  53
  54 C--                Check continuation after '*'
  55
  56    41 IF (JC.GT.NTX)         GO TO 99
  57       CHT = TEXT(JC:JC)
  58       IF (CHT.EQ.' ')        GO TO 99
  59       JC = JC + 1
  60       IF (JC.GT.NPO)         GO TO 99
  61       CHP = POSS(JPOSS)(JC:JC)
  62 C     PRINT 9044, CHT,CHP
  63 C9044 FORMAT ('@44 CHT/CHP= ',A,1X,A)
  64       IF (CHP.EQ.' ')        GO TO 11
  65       IF (CHP.EQ.'*')        GO TO 99
  66       IF (CHT.EQ.CHP)        GO TO 41
  67       GO TO 11
  68
  69    98 JPOSS = 0
  70    99 ICNTH = JPOSS
  71       RETURN
  72       END