SUBROUTINE STRING (OUT, IN)
C
C
C David Villeneuve
C Division of Physics M23A
C National Research Council
C Ottawa Ont. K1A 0R6
C 613-993-1288
C
C [CREATE STRING]
C TAKES THE ASCIZ STRING <IN> AND COPIES IT TO <OUT>.  <IN> MUST END WITH
C A ZERO BYTE.  THIS SUBROUTINE IS USED TO EITHER COPY AN EXISTING STRING,
C OR TO PUT A QUOTED STRING INTO A STRING.  FOR EXAMPLE,
C	CALL STRING (STR, 'THIS IS A STRING.')
C WILL INITIALIZE <STR> TO THE QUOTED VALUE, WHICH COULDN'T BE DONE WITH
C A FORTRAN ASSIGNEMENT STATEMENT.
C
	BYTE IN(1), OUT(1)
	DO 10 J=1,30000
		OUT(J) = IN(J)
		IF (OUT(J) .EQ. 0) GO TO 20
10		CONTINUE
20	OUT(J) = 0
	RETURN
	END
	FUNCTION LENGTH (STR)
C
C [LENGTH OF STRING]
C THIS IS AN INTEGER FUNCTION WHICH RETURN THE LENGTH IN BYTES OF A STRING.
C THIS STRING MUST BE DELIMITED BY A 0 BYTE AT THE END.
C
	BYTE STR(1)
	DO 10 J=1,30000
		IF (STR(J) .EQ. 0) GO TO 20
10		CONTINUE
20	LENGTH = J-1
	RETURN
	END
	SUBROUTINE CONCAT (OUT, IN)
C
C [CONCATENATE STRINGS]
C THIS TAKES A STRING <IN>, AND CONCATENATES IT ON THE END OF AN EXISTING
C STRING <OUT>.
C
	BYTE OUT(1), IN(1)

	LOUT = LENGTH(OUT(1))
	DO 10 J=1,30000
		OUT(LOUT+J) = IN(J)
		IF (IN(J) .EQ. 0) RETURN
10		CONTINUE
	RETURN
	END
	SUBROUTINE SUBSTR (OUT, IN, START, LEN)
C
C [SUBSTRING]
C THIS TAKES AN EXISTING STRING <IN>, EXTRACTS THE SUBSTRING STARTING AT
C CHARACTER POSITION <START> AND OF LENGTH <LEN>, AND PLACES IT IN THE
C NEW STRING <OUT>.
C
	BYTE OUT(1), IN(1)
	INTEGER START, LEN
	IF (START .LT. 1 .OR. LEN .LT. 1) RETURN

	DO 10 J=1,START
		IF (IN(J) .EQ. 0) GO TO 40
10		CONTINUE

	DO 20 J=START, START+LEN-1
		OUT(J-START+1) = IN(J)
		IF (IN(J) .EQ. 0) GO TO 30
20		CONTINUE

30	OUT(J-START+1) = 0
	RETURN

40	OUT(1) = 0
	RETURN
	END
	INTEGER FUNCTION COMPAR (I, STR1, STR2)
C
C [COMPARE TWO STRINGS LEXICALLY]
C
C THIS COMPARES THE TWO STRINGS STR1 AND STR2, AND SETS <I>
C DEPENDING ON THEIR LEXICAL ORDERING (ALPHABETIC).
C THE SHORTER OF THE TWO IS PADDED TO THE RIGHT WITH NULLS
C SO THAT 'ABC  ' IS GREATER THAN 'ABC'.
C THIS ALSO RETURNS I AS AN INTEGER FUNCTION VALUE, BUT
C THE ARGUMENT I MUST ALWAYS BE CODED.
C IF USED AS AN INTEGER FUNCTION, DON'T FORGET TO DECLARE
C COMPAR AS INTEGER IN THE CALLING PROGRAM.
C
C I =  1 IF STR1 > STR2.
C I =  0 IF STR1 = STR2.
C I = -1 IF STR1 < STR2.
C
	BYTE STR1(1), STR2(1)
C
	I = 0
	COMPAR = 0
	DO 100 J=1,30000
		IF (STR1(J) .NE. STR2(J)) GO TO 200	!MISMATCH
		IF (STR1(J) .EQ. 0) RETURN		!IDENTICAL
100	CONTINUE
C
C DETERMINE WHICH DIRECTION THE MISMATCH IS
C
200	I = 1
	IWORD1 = STR1(J)
	IWORD2 = STR2(J)
	IF (IWORD1 .LT. 0) IWORD1 = IWORD1+256		!CONVERT TO WORDS
	IF (IWORD2 .LT. 0) IWORD2 = IWORD2+256
	IF (IWORD1 .LT. IWORD2) I = -1
	COMPAR = I
	RETURN
	END
	LOGICAL FUNCTION CMPLEF (EQUAL, REFSTR, LONSTR)
C
C This compares two ASCIZ strings and returns a logical value
C (both as a function return and as an argument EQUAL) which is
C true if the string are equal, false otherwise.  This differs
C from COMPAR in that upper and lower case letters are considered
C the same, and that the comparison stops at the end of REFSTR.
C If LONSTR is shorter than REFSTR, it returns false.
C If LONSTR is longer than REFSTR, as is usually the case, then
C it returns true if the first L characters are the same, where
C L is the length of REFSTR.
C  This is used in looking for keywords and command names which
C are at the left of a string.
C
	BYTE C1, C2, REFSTR(1), LONSTR(1)
	LOGICAL EQUAL
C
	CMPLEF = .FALSE.		!ASSUME NO MATCH FOUND
	EQUAL = .FALSE.
C
	DO 100 J=1,10000
		C1 = REFSTR(J)
		C2 = LONSTR(J)
		IF (C1 .GE. 'a' .AND. C1 .LE. 'z') C1 = C1-32
		IF (C2 .GE. 'a' .AND. C2 .LE. 'z') C2 = C2-32
		IF (C1 .EQ. 0) GO TO 200	!END OF REFSTR
		IF (C1 .NE. C2) RETURN		!MISMATCH
100	CONTINUE
C
C MATCHED UP TO END OF REFSTR
C
200	EQUAL = .TRUE.
	CMPLEF = .TRUE.
	RETURN
	END
	FUNCTION INDEXC (INDEX, SUB, STR)
C
C [INDEX OF SUBSTRING]
C
C FINDS THE FIRST OCCURRENCE OF STRING <SUB> IN STRING <STR>.
C SETS <INDEX> TO THE INDEX OF THE BEGINNING OF THE OCCURRENCE.
C IF <SUB> IS NOT FOUND IN <STR>, IT SETS <INDEX> TO ZERO..
C ALSO RETURNS INDEX AS AN INTEGER FUNCTION VALUE, BUT
C INDEX MUST ALWAYS BE CODED AS AN ARGUMENT.
C
	BYTE SUB(1), STR(1)
	INDEX = 0
	INDEXC = 0
	IF (SUB(1) .EQ. 0) RETURN	!EMPTY SUBSTRING
C
	K = 1
	DO 100 J=1,30000
		IF (SUB(K) .NE. STR(J)) GO TO 50
		IF (K .EQ. 1) INDEX = J	!START OF POTENTIAL MATCH
		INDEXC = INDEX
		K = K+1
		IF (SUB(K) .EQ. 0) RETURN	!COMPLETE MATCH
		GO TO 100
C
50		IF (STR(J) .EQ. 0) GO TO 200	!END OF STRING
		K = 1
100	CONTINUE
C
200	INDEX = 0				!NO MATCH
	INDEXC = INDEX
	RETURN
	END
	SUBROUTINE SKIPSP (STR, K)
C
C [SKIP SPACES]
C
C SKIPS SPACES AND TABS AT AND AFTER LOCATION <K> IN STRING <STR>.
C SETS K TO THE NEXT NON-SPACE CHARACTER AFTER ORIGINAL K.
C
	BYTE STR(1)
	K1 = K
C
	DO 100 K=K1,30000
		IF (STR(K) .EQ. "40) GO TO 100	!SKIP SPACE
		IF (STR(K) .EQ. "11) GO TO 100	!SKIP TAB
		RETURN
100	CONTINUE
	RETURN
	END
	SUBROUTINE UPCASE (STR)
C
C [UPPERCASE]
C
C CONVERTS VARIABLE LENGTH STRING <STR> TO UPPERCASE LETTERS.
C ALL OTHER CHARACTERS ARE UNCHANGED.
C
	BYTE STR(1)
	DO 100 J=1,30000
		IF (STR(J) .EQ. 0) RETURN
		IF (STR(J) .GT. "140 .AND. STR(J) .LT. "173)
	1		STR(J) = STR(J) - "40		!UPPERCASE
100	CONTINUE
	RETURN
	END
	SUBROUTINE CMPRES (STR1, STR2)
C
C [COMPRESS MULTIPLE BLANKS, UPPERCASE]
C
C TAKES STRING <STR1>, CONVERTS ALL LOWERCASE LETTERS TO UPPERCASE,
C CONVERTS MULTIPLE OCCURRENCES OF SPACES AND TABS TO A SINGLE SPACE.
C
	BYTE STR1(1), STR2(1)
	K = 1
C
	DO 100 J=1,30000
		STR2(K) = STR1(J)
		IF (STR1(J) .EQ. 0) RETURN
		IF (STR2(K) .EQ. "11) STR2(K) = "40	!TAB TO SPACE
		IF (STR2(K) .NE. "40) GO TO 50
		IF (STR2(K-1) .EQ. "40 .AND. K .GT. 1) K = K-1	!MULTIPLE BLANKS
50		IF (STR2(K) .GT. "140 .AND. STR2(K) .LT. "173)
	1		STR2(K) = STR2(K) - "40		!UPPERCASE
		K = K+1
100	CONTINUE
	RETURN
	END