#
#$ ****STRING LIBRARY	FILE=STRLIB.RAT
# PCN #47, 4 APR 79, ADD ALLDIG,FOLD,SHELL,INDEX,TYPE,UNFOLD
# PCN #89, 10 FEB 80, SPEED UP SCOPY,SPAD,SCOMPR,TYPE
#
# ****CALLING SEQUENCE SUMMARY ****
## ALLDIG - I   =ALLDIG(STR)
## FOLD   - CALL FOLD  (STR)
## EQLS   - I   =EQLS  (VEC, PATSTR)
## INDEX  - COL =INDEX (STR, CHAR)
## SCOMPR - I   =SCOMPR(STR1, STR2)
## SCOMPX - I   =SCOMPX(STR1, STR2, CHAR)
## SCOPY  - LEN2=SCOPY (STR1, STR2, MAX, ERROR)
## SCTOI  - NUM =SCTOI (STR, NCOL)
## SDECAT - CALL SDECAT(STR1, STR2, STR3, STR4)
## SEQL   - I   =SEQL  (STR1, STR2)
## SFIND  - COL =SFIND (VEC, START, STOP, CHAR)
## SHELL  - CALL SHELL (LASTP, NAMPTR, TABLE)
## SINDX  - COL =SINDX (STR1, STR2)
## SINSRT - CALL SINSRT(STR1, STR2)
## SITOC  - LEN =SITOC (NUM, STR, MAX)
## SJOIN  - LEN2=SJOIN (STR1, STR2, MAX, ERROR)
## SLEN   - LEN =SLEN  (STR)
## SMIDV  - LEN4=SMIDV (STR1, STR2, STR3, STR4, MAX, ERROR)
## SMOVE  - I   =SMOVE (STR1, FROM, TO, VEC, START)
## SNUMBR - NUM =SNUMBR(STR, START, STOP, NUM, NCOL)
## SPAD   - CALL SPAD  (STR, LEN)
## SPOSTV - LEN3=SPOSTV(STR1, STR2, STR3, MAX, ERROR)
## SPREFX - CALL SPREFX(STR1, STR2, STR3, STR4)
## SPREV  - LEN3=SPREV (STR1, STR2, STR3, MAX, ERROR)
## SREPT  - LEN2=SREPT (STR1, NUM, STR2, MAX, ERROR)
## SSAME  - ICOL=SSAME (STR1, STR2, LORR)
## SSAMEX - ICOL=SSAMEX(STR1, STR2, LOOR)
## SSUFX  - CALL SSUFX (STR1, STR2, STR3, STR4)
## SSWAP  - LEN4=SSWAP (STR1, STR2, STR3, STR4, MAX, ERROR)
## STRGET - LEN =STRGET(LUN STR, MAX)
## STRPUT - ERR =STRPUT(LUN, STR, FMTCHR)
## STRIM  - LEN =STRIM (STR)
## TYPE   - C   =TYPE  (CHAR)
## UNFOLD - CALL UNFOLD (STR)

INCLUDE/NL DEFIN			#PCN 47
#
#$ ****GENERAL COMMENTS:
## NOTE: SOME OF THESE ROUTINES ARE SET UP TO WORK WITH ASCII CHARACTER SET ONLY.
##THEREFORE, IF THE MACHINE'S NATIVE CHARACTER SET IS NOT ASCII, YOU MUST
##USE 'INMAP' TO CONVERT TO ASCII BEFORE USING THESE ROUTINES. OR ELSE REWRITE
##THESE ROUTINES. 
##ROUTINES THAT PRODUCE AN OUTPUT STRING GENERALY ALLOW A 'MAX' SIZE 
# FOR THE OUTPUT STRING TO BE SPECIFIED. THE OUTPUT  IS CUT TO 'MAX' 
# CHARACTERS IF NECESSARY; IF IT IS,THE INTEGER 'ERROR' IS SET TO 'YES' 
# (OTHERWISE TO 'NO') TO ALERT THAT TRUNCATION WAS NECESSARY.
# ONE EXTRA ARRAY ELEMENT AT THE END OF THE STRING IS ALWAYS NECESSARY  
# (BEYOND MAX) FOR THE 'EOS'.
#SUBROUTINE CALLS SPECIFYING A SPECIFIC ARRAY ELEMENT (EG. STR(I)) CAUSE
#   ACTION TO BE TAKEN (AND RETURN VALUES AND MAX TO BE CALCULATED,  IF
#  APPROPRIATE FROM THE SPECIFIED ELEMENT,  NOT THE WHOLE STRING (FROM ELEMENT
#  1) SINCE ONLY THE STRING STARTING AT THE SPECIFIED ELEMENT IS KNOWN 
#  TO THE SUBROUTINE. EG J=SLEN(STRI)) SETS J TO THE NUMBER OF ELEMENTS 
# BETWEEN I AND 'EOS'.
#THESE ROUTINES REQUIRE THAT THE COMPILER MAKE CORRECT COMPARES OF INTEGER
# VALUES BETWEEN INTEGERS AND WHATEVER DATA TYPE 'CHARACTER' IS DEFINED TO BE
# (LOGICAL*1 IN DEC-LAND).
#"STRINGS" ARE VECTORS OF CHARACTERS TERMINATED BY AN 'EOS'.
# THE LENGTH OF A STRING IS THE NUMBER OF CHARACTERS IN IT, NOT INCLUDING THE 'EOS'.
#"CHARACTERS" ARE SINGLE CHARACTERS, ONE PER STORAGE ELEMENT.
#"CHARACTER VECTORS" ARE VECTORS (OR ARRAYS) CONTAINING CHARACTERS BUT WITHOUT
# THE TERMINATING 'EOS'. THUS, A PART OF A STRING WHICH DOES NOT INCLUDE THE
# 'EOS' IS A CHARACTER VECTOR, AND A VECTOR WITH AN 'EOS' IS A STRING.
#

#$ ALLDIG	- RETURN YES IF STR IS ALL DIGITS
#
   INTEGER FUNCTION ALLDIG(STR)
#
   CHARACTER STR(DUMMYSIZE), TYPE
   INTEGER I
#
   IF (STR(1) == EOS)
      RETURN (NO)
   DO I=1,HUGE [
      IF (STR(I) == EOS)
         RETURN (YES)
      ELSE IF (TYPE(STR(I)) != DIGIT)
         RETURN (NO)
      ]
#
   END
#
#$ EQLS	- DO ANCHORED COMPARE OF STRING WITH CHAR VECTOR
# STARTING AT BEGINNING OF VEC, COMPARE IT WITH PATSTR (WHICH MUST BE A
#  STRING). IF THE NEXT CHARACTERS OF VEC MATCH 1 FOR 1 THE CHARACTERS OF
#  PATSTR, RETURN THE VALUE OF THE FUNCTION AS 'YES', ELSE 'NO'.
#
   INTEGER FUNCTION EQLS (VEC, PATSTR)
#
   CHARACTER VEC(DUMMYSIZE), PATSTR(DUMMYSIZE)
#
   FOR (I=1; PATSTR(I) != EOS; INCREMENT(I))
      IF (PATSTR(I) != VEC(I))
         RETURN (NO)				#MIS MATCH FOUND
   RETURN (YES)				#STR MATCHED ALL WAY TO END OF PATSTR
   END
#
#$ FOLD	- CONVERT UPPER CASE LETTERS IN A STRING TO LOWER CASE
#15MAY77
#  **** ASCII CHARACTER SET ONLY ****
#
   SUBROUTINE FOLD(STR)
#
   CHARACTER STR(DUMMYSIZE)
   INTEGER I
#
   DO I=1,HUGE [
      IF (STR(I) == EOS)
         RETURN
      ELSE IF (STR(I) >= BIGA & STR(I) <= BIGZ)
         STR(I)=STR(I)+32			#ASCII ONLY!!!
      ]
#
   RETURN
   END
#
#$ INDEX	- FIND THE LOCATION OF A CHARACTER WITHIN A STRING
#15MAY77
# PCN #95, 11 MAR 80, DON'T USE 'INDEX' AS DO-LOOP INDEX SO F4P IS HAPPY.
# THE VALUE OF THE FUNCTION IS RETURNED AS THE NUMBER OF THE ELEMENT
#  IN 'STR' WHERE THE FIRST OCCURRENCE OF CHARACTER 'C' IS FOUND
#  (STARTING AT THE LEFT END), OR AS 0, IF C IS NOT IN 'STR'.
#
   INTEGER FUNCTION INDEX(STR, C)
#
   CHARACTER C, STR(DUMMYSIZE)
#
   DO I=1,HUGE [
      IF (STR(I) == EOS)
         RETURN (0)			#NOT FOUND
      ELSE IF (STR(I) == C)
         RETURN (I)				#I = COL WHERE FOUND
      ]
#
   END
#
#$ SCOMM	- USED BY SDECAT, SSUFX, SPREFX
#
   SUBROUTINE SCOMM (I, STR1, STR3, STR4)
#
   INTEGER I, SMOVE, J
   CHARACTER STR1(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)
#
   J=SMOVE(STR1, 1, I-1, STR3, 1)		#LEFT PART
   STR3(J+1)=EOS
   J=SMOVE(STR1, I, HUGE, STR4,1)		#RIGHT PART
   STR4(J+1)=EOS
#
   RETURN
   END
#
#$ SCOMPR	- COMPARE TWO STRINGS ALPHABETICALY
# PCN #89, 10 FEB 80, SPEED UP 50%, REPLACE 'FOR' WITH 'DO'.
#RETURN 0 IF EQUAL. (STRINGS MUST BE SAME LENGTH)
#RETURN -1 IF STR1 IS CLOSER TO 'A' THEN STR2
#RETURN +1 IF STR1 IS CLOSER TO 'Z' THEN STR2
#  **** ASCII CHARACTER SET ONLY ****
#
   INTEGER FUNCTION SCOMPR (STR1, STR2)
#
   INTEGER I, J
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)
#
   DO I=1,HUGE				#***PCN #89
      IF (STR1(I) == STR2(I))   [
         IF (STR1(I) == EOS) 
            RETURN (0)			#MATCH
         ]
      ELSE
         BREAK
#
   IF (STR1(I) < STR2(I))
      RETURN (-1)			#STR1 IS HIGHER
   ELSE
      RETURN (+1)			#STR1 IS LOWER
#
   END
#
#$ SCOMPX	- COMPARE 2 SPECIAL STRINGS ALPHABETICALLY
#COMPAR THE SECTIONS OF 2 STRINGS BEFORE AND AFTER THE 'CHAR' SEPERATOR
#  INDEPENDENTLY. 0 IS RETURNED IF THE FIRST PART (UP TO 'CHAR')MATCHES
#  AND THE SECOND PART (FROM 'CHAR' TO 'EOS') MATCHES.
#FOR 1ST PART (BEFORE 'CHAR'), THE COMPARE ENDS WHEN EITHER STRING CONTAINS
# A 'CHAR'. IT THEN LINES UP THE 'CHAR' IN BOTH STRINGS AND COMPARES THE
# SECOND PART OF BOTH STRINGS UNTIL AN EOS IS FOUND IN EITHER STRING.
# THE STRINGS DO NOT HAVE TO BE THE SAME LENGTH (EITHER BEFORE OR AFTER THE
# 'CHAR') TO BE CONSIDERED A MATCH.
#  **** ASCII CHARACTER SET ONLY ****
#RETURNS -1 IF STR1 IS HIGHER ALPHABETICALLY THEN STR2
#RETURNS  0 IF STR1 IS EQUAL TO STR2, PIVOTING AROUND 'CHAR'.
#RETURNS +1 IF STR1 IS LOWER ALPHABETICALLY THEN STR2
#	IF	STR1="FIRST PART<SECOND PART"
#		CHAR='<"
#   THEN IF	STR2="FIRST<SECOND"	SCOMPX RETURNS 0
#		STR2="F<S"		SCOMPX RETURNS 0
#		STR2="AA<BB"		SCOMPX RETURNS +1
#
   INTEGER FUNCTION SCOMPX (STR1, STR2, CHAR)
#
   INTEGER I, J
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), CHAR
#
   J=1
   FOR (I=1; STR1(I) != EOS & STR2(J) != EOS; INCREMENT(I)) [
      IF (STR1(I) == CHAR)
         WHILE (STR2(J) != CHAR & STR2(J+1) != EOS)
            INCREMENT (J)			#SLIDE ALONG 2 TO REGAIN SYNC
      ELSE IF (STR2(J) ==  CHAR)
         WHILE (STR1(I) != CHAR & STR1(I+1) != EOS)
            INCREMENT (I)
      ELSE IF (STR1(I) != STR2(J)) [
         IF (STR1(I) < STR2(J))		#ASCII ONLY!!!
            RETURN (-1)
         ELSE
            RETURN (+1)
         ]
      INCREMENT (J)		#ELSE TRY NEXT CHAR.
      ]
   RETURN (0)		#THEY MATCHED ALL THE WAY THRU
#
   END
#
#$ SCOPY	- COPY ONE STRING INTO ANOTHER STRING
# PCN 89, 10FEB 80, MAKE 30% FASTER.
#COPYING STOPS WHEN THE END OF STR1 IS REACHED, OR WHEN
# STR2 GETS TO BE 'MAX' CHAR. LONG (ERROR IS SET).
# VALUE OF THE FUCTION IS RETURNED AS THE LENGTH OF STR2.
#
   INTEGER FUNCTION SCOPY (STR1, STR2, MAX, ERROR)
#
   INTEGER MAX, ERROR, I
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)
#
   ERROR=NO
   DO I=1,HUGE [
      IF (STR1(I) == EOS)
         BREAK
      ELSE IF (I > MAX) [
         ERROR=YES
         BREAK
         ]
      ELSE 
         STR2(I)=STR1(I)		#MOVE A CHARACTER
      ]
#
   STR2(I)=EOS			#MAKE OUTPUT A STRING
#
   RETURN (I-1)
   END
#
#$ SCTOI	- CONVERT STRING AT IN(I) TO INTEGER, INCREMENT I
#STARTING AT LOCATION 'I' IN STRING 'IN', LEADING BLANKS/TABS ARE SKIPPED;
# THEN ALL DIGITS UP TO THE NEXT NON-DIGIT (INCLUDING BLANKS)
# ARE CONVERTED TO A POSITIVE OR NEGATIVE INTEGER AND RETURNED
# AS THE VALUE OF THE FUNCTION. 'I' IS INCREMENTED AND UPON RETURN
# POINTS TO THE LOCATION OF THE FIRST NON-DIGIT.
#
   INTEGER FUNCTION SCTOI(IN, I)
#
   CHARACTER IN(DUMMYSIZE)
   INTEGER D, I, SFIND, PM
   STRING DIGITS "0123456789"
#
   WHILE (IN(I) == BLANK \ IN(I) == TAB)	#SKIP LEADING BLANKS
      INCREMENT (I)
   IF (IN(I) == MINUS) [		#ALLOW FOR NEGATIVE INTEGERS
      INCREMENT (I)
      PM=-1
      ]
   ELSE
      PM=+1
#
   FOR (SCTOI = 0; IN(I) != EOS; INCREMENT (I)) [
      D = SFIND (DIGITS, 1, 10, IN(I))
      IF (D == 0)   			# NON-DIGIT STOPS SCAN
         BREAK
      SCTOI = 10 *  SCTOI + D - 1
      ] 
#
   IF (PM < 0)
      SCTOI=-SCTOI
   RETURN
   END
#
#$ SDECAT	- BREAK A STRING INTO TWO SUBSTRINGS AT A CHARACTER
#STR1 IS BROKEN INTO STR3 AND STR4 AT THE LEFTMOST OCCURRENCE OF
# ANY CHARACTER  THAT IS ALSO ANYWHERE IN STR2. THE "BREAK CHARACTER"
# GOES INTO STR4. ALTHOUGH STR2 IS A STRING, IT IS USED AS A COLLECTION
# OF 1 OR MORE CHARACTERS TO BE CHECKED FOR.
#	IF	STR1="FILENAME.EXT"
#		STR2=":.;"
#	THEN SDECAT RETURNS:
#		STR3="FILENAME"
#		STR4=".EXT"
#
   SUBROUTINE SDECAT (STR1, STR2, STR3, STR4)
#
   INTEGER I, J, SSAME, SLEN
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)
#
   I=SSAME(STR1, STR2, +1)
   IF (I <= 0)				#SEPERATOR WAS NOT THERE
      I=SLEN(STR1)+1			#SO IT ALL GOES INTO STR3
   CALL SCOMM (I, STR1, STR3, STR4)	#MOVE LEFT AND RIGHT PARTS
#
   RETURN
   END
#
#$ SEQL	- COMPARE STR1 TO STR2; RETURN YES IF EQUAL
#STR1 IS COMPARED CHARACTER BY CHARACTER TO STR2; IF THEY MATCH ALL THE WAY
# THRU, THE FUNCTION VALUE IS RETURNED AS 'YES', IF NOT, AS 'NO'.
#  THEY MUST BOTH BE STRINGS, AND OF THE SAME LENGTH.
#
   INTEGER FUNCTION SEQL(STR1, STR2)
#
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)
   INTEGER I
#
   DO I=1,HUGE
      IF (STR1(I) != STR2(I))
         RETURN (NO)
      ELSE IF (STR1(I) == EOS) 
         RETURN (YES)
#
   END
#
#$ SHELL	- SORT DEFINE TABLE INTO ALPHABETICAL ORDER
#SYKES 18 OCT 76,14MAR77
#
   SUBROUTINE SHELL (LASTP, NAMPTR, TABLE)
#
   INTEGER GAP, I, IG, J, K, SCOMPR, N
   INTEGER LASTP, NAMPTR(DUMMYSIZE)
   CHARACTER TABLE(DUMMYSIZE)
#
   FOR (GAP=LASTP/2; GAP > 0; GAP=GAP/2)
      FOR (J=GAP+1; J <= LASTP; INCREMENT(J))
         FOR (I=J-GAP; I > 0; I=I-GAP) [
            IG=I+GAP
            IF (SCOMPR(TABLE(NAMPTR(I)), TABLE(NAMPTR(IG))) <= 0)	#PCN 47
               BREAK
            N=NAMPTR(I)		#ELSE SWAP POINTERS
            NAMPTR(I)=NAMPTR(IG)
            NAMPTR(IG)=N
            ]
#
   RETURN
   END
#
#$ SFIND	- BOUNDED FAST SEARCH OF A CHARACTER VECTOR FOR A CHARACTER
#SEARCHES A VECTOR, EITHER FROM LEFT TO RIGHT OR RIGHT TO LEFT,
#  DEPENDING ON THE RELATIVE VALUES OF START AND STOP, FOR A SPECIFIED
#  CHARACTER, AND RETURNS AS THE FUNCTION VALUE THE ELEMENT IN 'VEC' WHERE
#  THE FIRST MATCH IS FOUND; OR AS 0, IF NO CHARACTER IN VEC MATCHES 'CHAR'.
# THIS IS NOT ANSII FORTRAN BECAUSE OF THE BACKWARD INCREMENT ON THE DO LOOP
# BUT IN F4P IS SOMEWHAT FASTER THEN STANDARD ROUTINES.
#	IF	VEC="ABCDEAFGH"
#		I=SFIND(VEC,1,8,BIGC)	RETURNS 3
#		I=SFIND(VEC,8,1,BIGC)	RETURNS 3
#		I=SFIND(VEC,1,8,BIGZ)	RETURNS 0
#		I=SFIND(VEC,2,7,BIGA)	RETURNS 6
#
   INTEGER FUNCTION SFIND (VEC, START, STOP, CHAR)
#
   INTEGER START, STOP, I
   CHARACTER VEC(DUMMYSIZE), CHAR
#
   IF (START > STOP)
      I=-1
   ELSE
      I=+1
   DO SFIND=START,STOP,I		#RSX!!! NEGATIVE INCREMNT
      IF (VEC(SFIND) == CHAR)
         RETURN			#WITH THE LOCATION 
   RETURN (0)				#NOT THERE
#
   END
#
#$ SINDX	- FIND THE LOCATION OF A SPECIFIED SUBSTRING WITHIN ANOTHER STRING
#THE FUNCTION VALUE IS RETURNED AS THE LOCATION WITHIN 'STR' WHERE
#  'PATN ' STARTS; OR AS 0, IF 'PATN' DOES NOT OCCUR IN'STR'.
#  IF 'PATN' IS NULL, IT IS CONSIDERED TO MATCH AT LOCATION 1.
#	IF	STR1="ABADAFABCD"
#		PATN="ABC"
#	THEN SINDX RETURNS A FUNCTION VALUE OF 7.
#
   INTEGER FUNCTION SINDX (STR, PATN)
#
   INTEGER J, K
   CHARACTER STR(DUMMYSIZE), PATN(DUMMYSIZE)
#
   FOR (SINDX=1; STR(SINDX) != EOS; INCREMENT(SINDX)) [
      K=SINDX
      FOR (J=1; PATN(J) != EOS; INCREMENT(J))
         IF (PATN(J) != STR(K))
            BREAK
         ELSE
            INCREMENT (K)
      IF (PATN(J) == EOS)
         RETURN			#THEY MATCHED AFTER ALL
      ELSE IF (STR(K) == EOS)
         BREAK				#NO MATCH POSSIBLE
      ]				#ELSE CONTINUE
   RETURN (0)				#THEY DO NOT MATCH
#
   END
#
#$ SINSRT	- INSERT A STRING INTO ANOTHER STRING
#COPY ALL OF STR1 INTO STR2; IF THIS OVERRUNS THE END OF STR2,
#   MAKE STR2 LONGER TO HOLD ALL OF STR1.  OTHERWISE, NO 'EOS' AT THE END
#   OF THE COPIED PART.
#
   SUBROUTINE SINSRT (STR1, STR2)
#
   INTEGER I, ENDS
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)
#
   ENDS=NO
   FOR (I=1; STR1(I) != EOS; INCREMENT(I)) [
      IF (STR2(I) == EOS)
         ENDS=YES
      STR2(I)=STR1(I)
      ]
   IF (ENDS == YES)		#IF WE OVERRAN THE END OF STR2
      STR2(I)=EOS		#IT IS NOW A LONGER STRING
#
   RETURN
   END
#
#$ SITOC	- CONVERT INTEGER  TO STRING, LEFT JUSTIFIED
#CONVERT THE POSITIVE OR NEGATIVE INTEGER 'INT' TO A CHARACTER STRING
# IN 'STR'. TRUNCATE THE STRING IF IT GOES BEYOND 'SIZE' CHARACTERS.
# RETURN THE ACTUAL NUMBER OF CHARACTERS IN 'STR' AS THE VALUE OF THE FUNCTION.
#
   INTEGER FUNCTION SITOC(INT, STR, SIZE)
#
   INTEGER IABS, MOD
   INTEGER D, I, INT, INTVAL, J, K, SIZE
   CHARACTER STR(SIZE)
   STRING DIGITS "0123456789"
#
   INTVAL = IABS(INT)
   STR(1) = EOS
   I = 1
   REPEAT [           			# GENERATE DIGITS
      INCREMENT (I)
      D = MOD(INTVAL, 10)
      STR(I) = DIGITS(D+1)
      INTVAL = INTVAL / 10
      ]  UNTIL (INTVAL == 0 \ I >= SIZE)
   IF (INT < 0 & I < SIZE) [     		# THEN SIGN
      INCREMENT (I)
      STR(I) = MINUS
      ]
   SITOC = I - 1
   FOR (J = 1; J < I; INCREMENT (J)) [  	# THEN REVERSE
      K = STR(I)
      STR(I) = STR(J)
      STR(J) = K
      DECREMENT (I)
      ] 
#
   RETURN
   END
#
#$ SJOIN	- CONCATINATE A STRING TO THE END OF ANOTHER STRING
#ADD STR2 TO THE END OF STR1 (IN STR1). MOVE ALL OF STR2 OR UNTIL
#  STR1 IS 'MAX' CHARS LONG (IN WHICH CASE, SET ERROR=YES)
#  RETURN THE VALUE OF THE FUNCTION AS THE NEW LENGTH OF STR1.
#
   INTEGER FUNCTION SJOIN (STR1, STR2, MAX, ERROR)
#
   INTEGER MAX, ERROR, I, SLEN, SCOPY
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)
#
   I=SLEN(STR1)				#FIND WHERE TO START
   SJOIN=SCOPY(STR2, STR1(I+1), MAX-I, ERROR) + I
#
   RETURN
   END
#
#$ SLEN	- RETURN THE LENGTH OF STRING (NOT INCLUDING THE EOS)
#
   INTEGER FUNCTION SLEN(STR)
#
   CHARACTER STR(DUMMYSIZE)
#
   DO I=1,HUGE
      IF (STR(I) == EOS)
         RETURN (I-1)
#
   END
#
#$ SMIDV	- SELECT A SUBSTRING FROM THE MIDDLE OF A STRING
#MOVE THE CHARACTERS IN STR1 THAT ARE BETWEEN STR2 AND STR3 (IN STR1)
#  INTO STR4. TRUNCATE STR4 TO 'MAX' CHARS (AND SET ERROR) IF NECESSARY.
#  THE VALUE OF THE FUNCTION IS RETURNED AS THE ACTUAL LENGTH OF STR4.
#  IF EITHER STR2 OR STR3 ARE NOT IN STR1, STR4 IS NULL.
#	IF	STR1="DEV:FILE.EXT"
#		STR2=":"
#		STR3="."
#	THEN SMIDV RETURNS:
#		I=4,        ERROR='NO'
#		STR4="FILE"
#
   INTEGER FUNCTION SMIDV (STR1, STR2, STR3, STR4, MAX, ERROR)
#
   INTEGER MAX, ERROR
   INTEGER SLEN, SINDX, SMOVE, J, I
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)
#
   I=SINDX (STR1, STR2)		#FIND STR2 IN STR1
   IF (I > 0) [
      I=I+SLEN(STR2)
      J=SINDX (STR1(I), STR3)		#FIND STR3 IN STR1 TO THE RIGHT OF STR2
      ]
   IF (I > 0 & J > 0) [		#BOTH STR2  & STR3 MUST BE THERE
      IF (J <= MAX) [
         J=I+J-2
         ERROR=NO
         ]
      ELSE [
         ERROR=YES
         J=I+MAX-1
         ]
      SMIDV=SMOVE(STR1, I, J, STR4, 1)
      STR4(SMIDV+1)=EOS
      ]
   ELSE [
      ERROR=NO
      SMIDV=0			#IF BOTH STR2 AND STR3 WERE NOT IN STR1,
      STR4(1)=EOS		#NO MIDDLE EXISTS TO BE PUT INTO STR4
      ]
#
   RETURN
   END
#
#$ SMOVE	- BOUNDED MOVE OF CHARACTERS FROM A STRING OR VECTOR TO A VECTOR
#MOVE THE CHARACTERS IN STR1 BETWEEN 'FROM' & 'TO' (INCLUSIVE)
#  TO VEC, STARTING AT LOCATION 'START'. NO 'EOS' IS PLACED AT THE
#  END OF THE MOVED CHARACTERS.
#  IF THE END OF STR1 IS REACHED BEFORE LOCATION 'TO', THE TRANSFER
#  IS STOPPED.  THE VALUE OF THE FUNCTION IS RETURNED AS THE LAST
#  (RIGHTMOST) LOCATION IN VEC MODIFIED.
#
   INTEGER FUNCTION SMOVE (STR1, FROM, TO, VEC, START)
#
   INTEGER FROM, TO, START, I
   CHARACTER STR1(DUMMYSIZE), VEC(DUMMYSIZE)
#
   SMOVE=START-1
   DO I=FROM, TO
      IF (STR1(I) == EOS)
         BREAK		#EARLY TERMINATION FOR SHORT STR1
      ELSE [
         INCREMENT (SMOVE)
         VEC(SMOVE)=STR1(I)
         ]
   IF (SMOVE < START)
      RETURN (0)		#NOTHING WAS REALLY TRANSFERED
#
   RETURN
   END
#
#$ SNUMBR	- CONVERT A CHARACTER VECTOR TO AN INTEGER
#STARTING AT 'START', EXTRACT A INTEGER FROM 'STR' AND RETURN
#  IT AS THE VALUE OF THE FUNCTION AND AS 'NUM'; IGNORE BLANKS, BUT QUIT AT THE
#  FIRST NON-DIGIT/BLANK FOUND, BUT IN ANY CASE DO NOT GO PAST COLUMN 'STOP'.
#  RETURN IN 'NCOL' THE NUMBER OF THE NEXT COLUMN TO THE RIGHT IN 'STR'.
#
   INTEGER FUNCTION SNUMBR (STR, START, STOP, NUM, NCOL)
#
   INTEGER START, STOP, NUM, I, J, SCTOI, NCOL
   CHARACTER STR(DUMMYSIZE), TOK(7), TYPE
#
   J=1
   FOR (I=START; J <= 7 & I <= STOP; INCREMENT(I))
      IF (STR(I) == BLANK)
         NEXT					#SKIP LEADING AND IMBEDDED BLANKS
      ELSE IF (TYPE(STR(I)) != DIGIT &  STR(I) != MINUS)
         BREAK					#STOP AT FIRST NON-DIGIT
      ELSE [
         TOK(J)=STR(I)
         INCREMENT (J)
         ]
   TOK(J)=EOS
   NCOL=I			#NEXT COL IN STR AFTER THE FOUND NUMBER
   I=1
   NUM=SCTOI (TOK, I)		#CONVERT TO AN INTEGER
#
   RETURN (NUM)
   END
#
#$ SPAD	- FILL A STRING UP TO A SPECIFIED LENGTH WITH BLANKS
# PCN # 89, 10 FEB 80, SPEED UP 13%, REPLACE 'FOR' WITH 'DO'.
#PAD THE RIGHTHAND END OF STR WITH BLANKS OUT TO 'LEN'.
#  STR BECOMES A STRING OF LENGTH 'LEN'.
#
   SUBROUTINE SPAD (STR, LEN)
#
   INTEGER LEN, SLEN, I
   CHARACTER STR(DUMMYSIZE)
#
   I=SLEN(STR)+1
   IF (I <= LEN)
      DO J=I,LEN
         STR(J)=BLANK
   STR(LEN+1)=EOS	#TRUNCATED IF STR IS LONGER THEN LEN TO START
#
   RETURN
   END
#
#$ SPOSTV	- SELECT A SUBSTRING FROM THE RIGHT END OF A STRING
#MOVE INTO STR3 ALL OF STR1 TO THE RIGHT OF THE END OF STR2(WITHIN STR1)
#  BUT TRUNCATE STR3 TO 'MAX' CHARS (AND SET ERROR) IF NECESSARY.
#  THE VALUE OF THE FUNCTION IS RETURNED AS THE ACUTAL NEW LENGTH OF STR3
#  STR3 IS NULL IF STR2 IS NOT FOUND WITHIN STR1.
#  IF STR2 IS NULL, ALL OF STR1 GOES TO STR3.
#	IF	STR1="FILENAME.EXT"
#		STR2="."
#	THEN SPOSTV RETURNS     I=3,      ERROR='NO'
#		STR3="EXT"
#
   INTEGER FUNCTION SPOSTV (STR1, STR2, STR3, MAX, ERROR)
#
   INTEGER MAX, ERROR, I, SCOPY, SINDX, SLEN
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE)
#
   I=SINDX (STR1, STR2)		#FIND STR2 IN STR1
   IF (I <= 0) [			#IF IT'S NOT THERE,
      STR3(1)=EOS			#STR3 IS NULL BY DEFINITION
      ERROR=NO
      RETURN (0)
      ]
   ELSE [
      I=I+SLEN(STR2)
      SPOSTV=SCOPY(STR1(I), STR3, MAX, ERROR)
      ]
#
   RETURN
   END
#
#$ SPREFX	- SEPERATE A PREFIX SUBSTRING FROM A STRING
#MOVE INTO STR3 THAT PART OF STR1 WHICH IS TO THE LEFT OF THE FIRST CHAR ALSO 
# FOUND (ANYWHERE) IN STR2. MOVE INTO STR4 THE REST OF STR1. STR3 AND STR4 ARE
# NEW STRINGS. THE LEFTMOST OCCURRANCE IN STR1 OF ANY CHAR IN STR2 IS THE
# "BREAK POINT". THE BREAK CHARACTER GOES INTO STR4.
# IF NONE OF THE CHARACTERS IN STR2 IS FOUND IN STR1, ALL OF STR1 IS MOVED
#  INTO STR4 AND STR3 IS NULL.
#ALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE
# CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE
# IMPORTANT.
#	IF	STR1="FILENAME.EXT"
#		STR2=":.;"
#	THEN SPREFX RETURNS:
#		STR3="FILENAME"
#		STR4=".EXT"
#
   SUBROUTINE SPREFX (STR1, STR2, STR3, STR4)
#
   INTEGER I, SSAME
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)
#
   I=SSAME (STR1, STR2, +1)		#FIND CHAR. IN STR2 FROM LEFT
   IF (I <= 0)
      I=1				#NOT THERE, SO ALL GOES INTO STR4
   CALL SCOMM (I, STR1, STR3, STR4)	#MOVE LEFT AND RIGHT PARTS
#
   RETURN
   END
#
#$ SPREV	- SELECT A SUBSTRING FROM THE LEFT END OF A STRING
#MOVE THE PART OF STR1 TO THE LEFT OF THE START OF STR2 INTO STR3.
#  TRUNCATE STR3 TO 'MAX' CHARS (AND SET ERROR) IF NECESSARY.
#  THE VALUE OF THE FUNCTION IS RETURNED AS THE LENGTH OF STR3.
#  STR3 IS NULL IF STR2 IS NOT FOUND WITHIN STR1.
#  IF STR2 IS NULL, ALL OF STR1 GOES TO STR3.
#	IF	STR1="FILENAME.EXT;2"
#		STR2=".EXT"
#	THEN SPREV RETURNS:
#		I=8,       ERROR='NO'
#		STR3="FILENAME"
#
   INTEGER FUNCTION SPREV (STR1, STR2, STR3, MAX, ERROR)
#
   INTEGER MAX, ERROR, I, SINDX, SMOVE
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE)
#
   I=SINDX (STR1, STR2) 
   IF (I <= 0) [		#STR2 MUST BE THERE
      STR3(1)=EOS		#OR STR3 IS NULL
      ERROR=NO
      RETURN (0)
      ]
   ELSE [
      DECREMENT (I)
      IF (I <= MAX)
         ERROR=NO
      ELSE [
         I=MAX		#TRUNCATE LENGTH OF TRANSFER
         ERROR=YES
         ]
      SPREV=SMOVE (STR1, 1, I, STR3, 1)
      STR3(SPREV+1)=EOS
      ]
#
   RETURN
   END
#
#$ SREPT	- DUPLICATE A STRING INTO ANOTHER STRING SEVERAL TIMES
#FILL STR2 WITH 'NUM' CONCATINATED COPIES OF STR1, BUT TRUNCATE
#  STR2 AT 'MAX' CHAR (AND SET ERROR) IF NECESSARY.
#  THE VALUE OF THE FUNCTION IS RETURNED AS THE ACUTAL NEW
#  LENGTH OF STR2.
#	IF	STR1="*-*"
#		STR2=""
#	THEN	I=SREPT(STR1,5,STR2,9,ERROR)	RETURNS:
#		I=9,       ERROR='YES'
#		STR2="*-**-**-*"
#
   INTEGER FUNCTION SREPT (STR1, NUM, STR2, MAX, ERROR)
#
   INTEGER NUM, MAX, ERROR, SCOPY, I
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)
#
   SREPT=0
   FOR (I=1; I <= NUM; INCREMENT(I)) [
      SREPT=SCOPY (STR1, STR2(SREPT+1), MAX-SREPT, ERROR) + SREPT 
      IF (ERROR == YES)
         BREAK
      ]
#
   RETURN
   END
#
#$ SSAME	- RETURN LOCATION OF FIRST CHARACTER IN STR1 ALSO IN STR2
#SCAN STR1 FROM LEFT TO RIGHT (IF LORR IS >0) OR FROM RIGHT TO LEFT
#  (IF LORR IS <0) AND RETURN THE VALUE OF THE FUNCTION AS THE POSITION
#  IN STR1 WHERE THE FIRST CHARACTER IS FOUND THAT IS ALSO ANYWHERE IN STR2,
#  OR AS 0, IF NO CHARACTERS IN STR1 ARE FOUND IN STR2.
#ALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE
# CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE
# IMPORTANT.
#	IF	STR1="ABCDE7FGH"
#		STR2="0123456789"
#	THEN 	I=SSAME(STR1,STR2,+1) RETURNS:
#		I=6
#
   INTEGER FUNCTION SSAME (STR1, STR2, LORR)
#
   INTEGER LORR, SLEN, I
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)
#
   IF (LORR > 0)
      SSAME=1
   ELSE
      SSAME=SLEN(STR1)
   WHILE (SSAME > 0 & STR1(SSAME) != EOS) [
      FOR (I=1; STR2(I) != EOS; INCREMENT(I))
         IF (STR1(SSAME) == STR2(I))
            RETURN			#WITH POSITION IN STR1 OF 1ST MATCH
      IF (LORR > 0)
         INCREMENT (SSAME)
      ELSE
         DECREMENT (SSAME)
      ]
   RETURN (0)			#NONE MATCHED
#
   END
#
#$ SSAMEX	- RETURN LOCATION OF FIRST CHARACTER IN STR1 NOT ALSO IN STR2
#SCAN STR1 FROM THE LEFT (IF LORR > 0) OR FROM THE RIGHT (IF LOOR <0)
#  AND RETURN THE VALUE OF THE FUNCTION AS THE LOCATION WITHIN STR1 OF
#  THE FIRST CHARACTER NOT FOUND (ANYWHERE) IN STR2 , OR AS 0,
#  IF EVERYTHING IN STR1 IS IN STR2.
#ALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE
# CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE
# IMPORTANT.
#	IF	STR1="123456ABC"
#		STR2="0123456789"
#	THEN	I=SSAMEX(STR1,STR2,+1)	RETURNS:
#		I=7
#
   INTEGER FUNCTION SSAMEX (STR1, STR2, LOOR)
#
   INTEGER I, LOOR, SLEN
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)
#
   IF (LORR > 0)
      SSAMEX=1
   ELSE
      SSAMEX=SLEN(STR1)
   WHILE (SSAMEX > 0 & STR1(SSAMEX) != EOS) [
      FOR (I=1; STR2(I) != EOS; INCREMENT(I))
         IF (STR1(SSAMEX) == STR2(I))
            BREAK			#FOUND THIS CHAR.
      IF (STR2(I) == EOS)		#IT WAS NOT IN STR2
         RETURN			#SO RETURN WITH IT
      ELSE				#CONTINUE
         IF (LORR > 0)
            INCREMENT (SSAMEX)
         ELSE
            DECREMENT (SSAMEX)
      ]
   RETURN (0)			#EVERYTHING IN STR1 IS IN STR2
#
   END
#
#$ SSUFX	- SEPERATE OUT A SUFFEX SUBSTRING
#MOVE CHARACTERS FROM STR1 INTO STR3 WHICH ARE TO THE RIGHT OF THE FIRST
#  OCCURENCE OF ANY CHARACTER FROM STR2 IN STR1, SCANNING RIGHT-TO-LEFT.
#  MOVE THE REMAINDER OF STR1 INTO STR4. FIRST CHARACTER IN STR1 TO MATCH
#  ANY CHARACTER IN STR2 IS THE "BREAK CHAR", AND IT GOES INTO STR4.
#IF NONE OF THE CHARACTERS IN STR2 IS FOUND IS STR1, ALL OF STR1 GOES INTO 
# STR4 AND STR3 IS NULL.
#ALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE
# CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE
# IMPORTANT.
#	IF	STR1="FILENAME.EXT"
#		STR2=":.;"
#	THEN SSUFX RETURNS:
#		STR3="EXT"
#		STR4="FILENAME."
#
   SUBROUTINE SSUFX (STR1, STR2, STR3, STR4)
#
   INTEGER I, SSAME, SLEN
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)
#
   I=SSAME (STR1, STR2, -1) 		#SEARCH FROM RIGHT 
   IF (I <= 0)
      I=SLEN(STR1)			#NO MATCH FOUND, STR3 IS NULL
   INCREMENT (I)
#
   CALL SCOMM(I, STR1, STR4, STR3)		#TRANSFER RIGHT & LEFT PARTS
#
   RETURN
   END
#
#$ SSWAP	- EXCHANGE PART OF A STRING FOR ANOTHER STRING
#MOVE STR1 INTO STR4, EXCEPT THAT THE PART OF STR1 THAT MATCHES STR2
#  IS REPLACED BY STR3. THE VALUE OF THE FUNCTION IS RETURNED AS THE
#  ACTUAL LENGTH OF STR4, OR AS 0, IF STR2 CANNOT BE FOUND. STR4 IS TRUNCATED 
#  TO 'MAX' (AND ERROR IS SET) IF NECESSARY. STR2 AND STR3 NEED NOT BE SAME 
#  LENGTH.
#	IF	STR1="FILENAME.FTN;3"
#		STR2="FTN"
#		STR3="OBJ"
#	THEN SSWAP RETURNS:
#		I=14
#		STR4="FILENAME.OBJ;3"
#
   INTEGER FUNCTION SSWAP (STR1, STR2, STR3, STR4, MAX, ERROR)
#
   INTEGER MAX, ERROR, SINDX, SJOIN, SMOVE, I, SLEN
   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)
#
   I=SINDX(STR1, STR2)	#FIND LOCATION OF STR2
   IF (I <= 0) [
      STR4(1)=EOS		#STR2 WAS NOT THERE SO STR4 IS NULL
      ERROR=NO
      RETURN (0)
      ]
   ELSE [
      IF (I > MAX) [		# TOO LONG?
         ERROR=YES
         I=MAX+1
         ]
      ELSE
         ERROR=NO
      SSWAP=SMOVE (STR1, 1, I-1, STR4, 1)		#LEFT PART
      STR4(SSWAP+1)=EOS				#MAKE A STRING
      SSWAP=SJOIN (STR4, STR3, MAX, ERROR)		#REPLACEMENT PART
      I=I+SLEN(STR2)
      SSWAP=SJOIN(STR4, STR1(I), MAX, ERROR)		#RIGHT PART
#  ONCE STR4 REACHES 'MAX' LENGTH, SJOIN WILL NOT ADD TO IT.
      ]
#
   RETURN		#WITH SSWAP = LENGTH OF STR4
   END
#
#$ STRGET	- READ A STRING FROM A SPECIFIED LUN
# PCN #77, 6 JAN 80, ALLOW FOR SKIP-RECORD DUMMY READS
# PCN #81, 13 JAN 80, FIX SUBSCRIPT ERROR F4P GENERATES IF MAX IS 0.
# **CAUTION: THIS ROUTINE TRUSTS FORTRAN TO MOVE INTO THE BUFFER ONLY THAT
# **PART OF THE RECORD CALLED FOR BY 'MAX'. DEC'S FORTRAN IV V2.1 (AT LEAST)
# **HAS A BUG WHICH CAUSES IT TO ALWAYS READ A FULL RECORD. THEREFORE, IF YOUR
# **BUFFER IS SMALLER THEN THE RECORD SIZE, IT READS MORE INTO THE BUFR THEN
# **IT HAS ROOM FOR, KLOBBERING GOD-KNOWS-WHAT IN YOUR PROGRAM. BEST TO TEST
# **THIS OR ALWAYS GIVE STRGET A BUFFER AS BIG AS THE LARGEST POSSIBLE RECORD.
#
   INTEGER FUNCTION STRGET (LUN, STR, MAX)
#
   INTEGER LUN, MAX, N
   CHARACTER STR(DUMMYSIZE)		#PCN #81
#
   IF (MAX > 0) [
      READ (LUN,1,END=100,ERR=101) STRGET, (STR(N),N=1,MAX)	#RSX!!!
      1 FORMAT (Q, 132A1)					#RSX!!!
      STR(STRGET+1)=EOS
      RETURN
      ]
   ELSE [
      READ (LUN,1,END=100,ERR=101)		#SKIP A RECORD
      STR(1)=EOS
      RETURN (0)
      ]
#
   100 STR(1)=EOS
   RETURN (EOF)
#
   101 STR(1)=EOS
   RETURN (BAD)
#
   END
#
#$ STRPUT	- WRITE A STRING TO A SPECIFIED LUN
# PCN 77, 5 JAN 80, ADD A FORMAT CONTROL CHAR TO CALLING SEQUENCE
#
   INTEGER FUNCTION STRPUT (LUN, STR, FMTCHR)
#
   INTEGER LUN, I, N, SLEN, MIN0
   CHARACTER STR(DUMMYSIZE), FMTCHR
#
   I=MIN0 (132,SLEN(STR))
   IF (I > 0)
      IF (FMTCHR == NO)				#EXPLICIT CARRIAGE CONTROL??
         WRITE (LUN, 1, ERR=11, END=11) (STR(N),N=1,I)		#USE 1ST CHAR OF STR
      ELSE
         WRITE (LUN, 1, ERR=11, END=11) FMTCHR, (STR(N),N=1,I)	#USE FMTCHR
   ELSE
      WRITE (LUN, 1, ERR=11, END=11)		#NULL LINE
   1 FORMAT ( 133A1)
   RETURN (YES)		#SUCCESS
#
   11 RETURN (BAD)		#ALL ERRORS
   END
#
#$ STRIM	- REMOVE TRAILING BLANKS FROM THE RIGHT END OF A STRING
#REMOVE ANY TRAILING BLANKS FROM THE RIGHT OF STR. THE VALUE OF THE
#  FUNCTION IS RETURNED AS THE NEW LENGTH OF STR.
#
   INTEGER FUNCTION STRIM (STR)
#
   INTEGER SLEN
   CHARACTER STR(DUMMYSIZE)
#
   STRIM=SLEN(STR)
   WHILE (STRIM > 0 & STR(STRIM) == BLANK)
      DECREMENT (STRIM)
   STR(STRIM+1)=EOS
#
   RETURN
   END
#
#$ TYPE	- DETERMINE IF A CHARACTER IS LETTER, DIGIT, OR SPECIAL CHAR
# SYKES 14 OCT 76, FASTER VERSION
# PCN # 89, 10 FEB 80, SPEED UP 50% BY USING ONLY TABLE LOOKUP.
#  **** ASCII CHARACTER SET ONLY ****
#
   CHARFUNC FUNCTION TYPE FUNCSIZE (C)
#
   CHARACTER C, TYPES(127)
   DATA TYPES /47*0,10*DIGIT,7*0,26*LETTER,6*0,26*LETTER,5*0/
#
   TYPE=0
   IF (C > 0)
      TYPE=TYPES(C)
   IF (TYPE == 0)
      TYPE = C
#
   RETURN
   END
#
#$ UNFOLD	- CONVERT LOWER CASE ALPHABETIC CHARACTERS IN A STRING TO UPPER CASE
#SYKES 15MAY77
#  **** ASCII CHARACTER SET ONLY ****
#
   SUBROUTINE UNFOLD (STR)
#
   CHARACTER STR(DUMMYSIZE)
   INTEGER I
#
   DO I=1,HUGE 
      IF (STR(I) == EOS)
         RETURN
      ELSE IF (STR(I) >= LETA & STR(I) <= LETZ)
         STR(I)=STR(I)-32
#
   RETURN
   END