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

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

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

#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
      CHP = POSS(JPOSS)(1:1)
      CHT = TEXT(1:1)
      JC  = 1
   12 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 71
      IF (JC.GT.NTX)         GO TO 11
      CHT = TEXT(JC:JC)
      IF (CHT.NE.'*')        GO TO 12

C----         First '*' seen on TEXT

   61 JC = JC + 1
      IF (JC.GT.NTX)         GO TO 99
      CHT = TEXT(JC:JC)
      IF (CHT.EQ.'*')        GO TO 99
      IF (CHT.EQ.' ')        GO TO 99
      IF (CHP.NE.CHT)  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
      IF (JC.GT.NPO)         GO TO 99
      CHP = POSS(JPOSS)(JC:JC)
      IF (CHP.NE.' ')        GO TO 61
      GO TO 99

C----         POSS blank terminated

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

   98 JPOSS = 0
   99 ICINQU = 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 ICINQU (TEXT,POSS,NPOSS)
	11	C
	12	C CERN PROGLIB# M432 ICINQU .VERSION KERNFOR 4.36 930602
	13	C ORIG. 24/05/93, JZ
	14	C
	15	C- Match TEXT against upper case POSS(NPOSS), case insensitive
	16
	17	CHARACTER() TEXT, POSS(99)
	18	CHARACTER*1 CHT, CHP
	19
	20	#include "kerngen/qnatch.inc"
	21	* Ignoring t=pass
	22
	23	NTX = LEN(TEXT)
	24	NPO = LEN(POSS(1))
	25
	26	JPOSS = 0
	27	11 JPOSS = JPOSS + 1
	28	IF (JPOSS.GT.NPOSS) GO TO 98
	29	CHP = POSS(JPOSS)(1:1)
	30	CHT = TEXT(1:1)
	31	JC = 1
	32	12 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 71
	49	IF (JC.GT.NTX) GO TO 11
	50	CHT = TEXT(JC:JC)
	51	IF (CHT.NE.'*') GO TO 12
	52
	53	C---- First '*' seen on TEXT
	54
	55	61 JC = JC + 1
	56	IF (JC.GT.NTX) GO TO 99
	57	CHT = TEXT(JC:JC)
	58	IF (CHT.EQ.'*') GO TO 99
	59	IF (CHT.EQ.' ') GO TO 99
	60	IF (CHP.NE.CHT) THEN
	61	IVT = ICHAR(CHT)
	62	IVP = ICHAR(CHP)
	63	#if defined(CERNLIB_QASCII)
	64	IF (IVT-IVP.NE.32) GO TO 11
65	IF (IVT.LT.97) GO TO 11
66	IF (IVT.GT.122) GO TO 11
67	#endif
68	#if defined(CERNLIB_QEBCDIC)
69	IF (IVP-IVT.NE.64) GO TO 11
70	IF (NATCH(IVT+1).NE.3) GO TO 11
71	#endif
72	ENDIF
73	IF (JC.GT.NPO) GO TO 99
74	CHP = POSS(JPOSS)(JC:JC)
75	IF (CHP.NE.' ') GO TO 61
76	GO TO 99
77
78	C---- POSS blank terminated
79
80	71 IF (JC.GT.NTX) GO TO 99
81	CHT = TEXT(JC:JC)
82	IF (CHT.EQ.' ') GO TO 99
83	IF (CHT.EQ.'*') GO TO 99
84	GO TO 11
85
86	98 JPOSS = 0
87	99 ICINQU = JPOSS
88	RETURN
89	END