C+
C	Title:	PATMAT
C	Author:	T. R. Wyant
C	Date:	11-Sep-1987
C	Modified:
C	Remarks:
C		INTEGER*2 FUNCTION PATMAT performs a generic match of
C		a pattern against a template. Neither pattern nor
C		template may be null. If a match occurs, the value
C		.TRUE. is returned; otherwise, .FALSE. is returned.
C
C		The arguments are a template and a pattern to be matched
C		against that template, and three "special" characters:
C		  - A character to be interpreted as a multicharacter
C			wildcard if it appears in the template. This
C			character matches any number of characters in
C			the pattern (including zero). This would
C			normally be an asterisk ('*').
C		  - A character to be interpreted as a single character
C			wildcard if it appears in the template. This
C			character matches any one character in the
C			pattern. This would normally be a percent sign
C			('%').
C		  - A character to be ignored if it appears as the
C			trailing string in the pattern. This would
C			normally be a space (' ').
C-
	FUNCTION PATMAT (PATLEN, PATTRN, TMPLEN, TMPLAT, BUG, PCT, BLK)

	INTEGER*2	PATMAT		! .TRUE. if pattern matches.
	INTEGER*2	PATLEN		! Length of pattern.
	LOGICAL*1	PATTRN (PATLEN)	! Pattern.
	INTEGER*2	TMPLEN		! Length of template.
	LOGICAL*1	TMPLAT (TMPLEN)	! Template.
	LOGICAL*1	BUG		! Multicharacter wildcard.
	LOGICAL*1	PCT		! Single character wildcard.
	LOGICAL*1	BLK		! Character to ignore at end.

	INTEGER*2	PATLOC		! Location in pattern.
	INTEGER*2	TMPLOC		! Location in template.
	INTEGER*2	PATBCK		! Pattern backtrack location.
	INTEGER*2	TMPBCK		! Template backtrack location.

C
C	Initialize the pointers;
C
	PATLOC = 0
	TMPLOC = 0
	PATBCK = 0
	TMPBCK = 0

CC
CC
C Try_again:
C
2000	CONTINUE

CC
C	Go to the next location in both pattern and template;
C
	PATLOC = PATLOC + 1
	TMPLOC = TMPLOC + 1

C
C	IF (we have used up the template) THEN
C		GO TO Check_for_end;
C
	IF (TMPLOC .GT. TMPLEN) GO TO 3000

C
C	IF (the current template character is a
C			multi-character wildcard) THEN
C		BEGIN
C		Save our current context in both pattern and template;
C		Back up a character in the pattern (to compensate for
C			the spurious advance we get at Try_again);
C		GO TO Try_again;
C		END;
C
	IF (TMPLAT (TMPLOC) .NE. BUG) GO TO 2400
	PATBCK = PATLOC
	TMPBCK = TMPLOC
	PATLOC = PATLOC - 1
	GO TO 2000

C
C	IF (we have used up all of the pattern) THEN
C		GO TO Exit_with_error;
C
2400	IF (PATLOC .GT. PATLEN) GO TO 9000

C
C	IF (the current template character is a
C			single-character wildcard) THEN
C		GO TO Try_again;
C
	IF (TMPLAT (TMPLOC) .EQ. PCT) GO TO 2000

C
C	IF (the current template character matches the
C			current pattern character) THEN
C		GO TO Try_again;
C
	IF (TMPLAT (TMPLOC) .EQ. PATTRN (PATLOC)) GO TO 2000

C
C	GO TO Check_for_backtrack;
C
	GO TO 3600

CC
CC
C Check_for_end:
C
3000	CONTINUE

CC
C	IF (we have used up all the pattern) THEN
C		GO TO Exit_with_success;
C
	IF (PATLOC .GT. PATLEN) GO TO 9100

C
C	IF (the pattern character is not the null character) THEN
C		GO TO Check_for_backtrack;
C
	IF (PATTRN (PATLOC) .NE. BLK) GO TO 3600

C
C	Increment pattern pointer;
C
	PATLOC = PATLOC + 1

C
C	GO TO Check_for_end;
C
	GO TO 3000

CC
CC
C Check_for_backtrack;
C
3600	CONTINUE

CC
C	IF (we have no location to backtrack to) THEN
C		GO TO Exit_with_error;
C
	IF (TMPBCK .LE. 0) GO TO 9000

C
C	Restore current pattern and template locations to the
C		last backtrack point;
C
	PATLOC = PATBCK
	TMPLOC = TMPBCK

C
C	Increment the pattern backtrack point;
C
	PATBCK = PATBCK + 1

C
C	GO TO Try_again;
C
	GO TO 2000

CC
CC
C Exit_with_error:
C
9000	CONTINUE

CC
C	STATUS = failure;
C	GO TO Exit_subroutine;
C
	PATMAT = .FALSE.
	GO TO 9900

CC
CC
C Exit_with_success:
C
9100	CONTINUE

CC
C	STATUS = success;
C	GO TO Exit_subroutine;
C
	PATMAT = .TRUE.
	GO TO 9900

CC
CC
C Exit_subroutine:
C
9900	CONTINUE

CC
C	END.
C
	RETURN
	END