[u/mrichter/AliRoot.git] / MINICERN / packlib / kernlib / kerngen / tcgen / icnthu.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/02/15 17:49:46  mclareni
* Kernlib
*
*
#include "kerngen/pilot.h"
      FUNCTION ICNTHU (TEXT,POSS,NPOSS)
C
C CERN PROGLIB# M432    ICNTHU          .VERSION KERNFOR  4.36  930602
C ORIG. 04/10/88, JZ
C
C-    Match TEXT against upper case POSS(NPOSS), case insensitive

      CHARACTER*(*)  TEXT,POSS(99)
      CHARACTER*1    CHP, CHT

#include "kerngen/qnatch.inc"
* Ignoring t=pass

      NTX = LEN(TEXT)
      NPO = LEN(POSS(1))
      JPOSS  = 0

   11 JPOSS = JPOSS + 1
      IF (JPOSS.GT.NPOSS)    GO TO 98
      JC = 1
      CHP = POSS(JPOSS)(1:1)
   12 CHT = TEXT(JC:JC)
      IF (CHT.NE.CHP)  THEN
          IVT = ICHAR(CHT)
          IVP = ICHAR(CHP)
#if defined(CERNLIB_QASCII)
          IF (IVT-IVP.NE.32) GO TO 11
          IF (IVT.LT.97)     GO TO 11
          IF (IVT.GT.122)    GO TO 11
#endif
#if defined(CERNLIB_QEBCDIC)
          IF (IVP-IVT.NE.64)      GO TO 11
          IF (NATCH(IVT+1).NE.3)  GO TO 11
#endif
        ENDIF
      JC = JC + 1
      IF (JC.GT.NPO)         GO TO 99
      CHP = POSS(JPOSS)(JC:JC)
      IF (CHP.EQ.'*')        GO TO 41
      IF (CHP.EQ.' ')        GO TO 31
      IF (JC.LE.NTX)         GO TO 12
      GO TO 11

C--                POSS blank terminated

   31 IF (JC.GT.NTX)         GO TO 99
      CHT = TEXT(JC:JC)
      IF (CHT.EQ.' ')        GO TO 99
      GO TO 11

C--                Check continuation after '*'

   41 IF (JC.GT.NTX)         GO TO 99
      CHT = TEXT(JC:JC)
      IF (CHT.EQ.' ')        GO TO 99
      JC = JC + 1
      IF (JC.GT.NPO)         GO TO 99
      CHP = POSS(JPOSS)(JC:JC)
      IF (CHP.EQ.' ')        GO TO 11
      IF (CHP.EQ.'*')        GO TO 99
      IF (CHT.EQ.CHP)        GO TO 41
      IVT = ICHAR(CHT)
      IVP = ICHAR(CHP)
#if defined(CERNLIB_QASCII)
      IF (IVT-IVP.NE.32)     GO TO 11
      IF (IVT.LT.97)         GO TO 11
      IF (IVT.GT.122)        GO TO 11
#endif
#if defined(CERNLIB_QEBCDIC)
      IF (IVP-IVT.NE.64)     GO TO 11
      IF (NATCH(IVT+1).NE.3) GO TO 11
#endif
      GO TO 41

   98 JPOSS = 0
   99 ICNTHU = JPOSS
      RETURN
      END
Commit	Line	Data
fe4da5cc	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 ICNTHU (TEXT,POSS,NPOSS)
	11	C
	12	C CERN PROGLIB# M432 ICNTHU .VERSION KERNFOR 4.36 930602
	13	C ORIG. 04/10/88, JZ
	14	C
	15	C- Match TEXT against upper 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 (IVT-IVP.NE.32) GO TO 11
	37	IF (IVT.LT.97) GO TO 11
	38	IF (IVT.GT.122) GO TO 11
	39	#endif
	40	#if defined(CERNLIB_QEBCDIC)
	41	IF (IVP-IVT.NE.64) GO TO 11
	42	IF (NATCH(IVT+1).NE.3) 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 (IVT-IVP.NE.32) GO TO 11
75	IF (IVT.LT.97) GO TO 11
76	IF (IVT.GT.122) GO TO 11
77	#endif
78	#if defined(CERNLIB_QEBCDIC)
79	IF (IVP-IVT.NE.64) GO TO 11
80	IF (NATCH(IVT+1).NE.3) GO TO 11
81	#endif
82	GO TO 41
83
84	98 JPOSS = 0
85	99 ICNTHU = JPOSS
86	RETURN
87	END