0036# STRING LIBRARY	FILE=STRLIB.RAT0064# PCN #47, 4 APR 79, ADD ALLDIG,FOLD,SHELL,INDEX,TYPE,UNFOLD0057# PCN #89, 10 FEB 80, SPEED UP SCOPY,SPAD,SCOMPR,TYPE0005#0073# EDITED TO PUT SUBPROGRAM DECLARATIONS IN FRONT OF COMMENTS FOR THAT0075# SUBPROGRAM.  THIS ALLOWS F4 V2.2 TO KEEP COMMENTS IN THE RIGHT PLACE.0015# BOB DENNY0015# 25-MAR-800005#0005#0032## ALLDIG - I   =ALLDIG(STR)0032## FOLD   - CALL FOLD  (STR)0040## EQLS   - I   =EQLS  (VEC, PATSTR)0038## INDEX  - COL =INDEX (STR, CHAR)^^^^^^^^^^^^^^^^^^^^0039## SCOMPR - I   =SCOMPR(STR1, STR2)0045## SCOMPX - I   =SCOMPX(STR1, STR2, CHAR)0051## SCOPY  - LEN2=SCOPY (STR1, STR2, MAX, ERROR)0038## SCTOI  - NUM =SCTOI (STR, NCOL)0051## SDECAT - CALL SDECAT(STR1, STR2, STR3, STR4)0039## SEQL   - I   =SEQL  (STR1, STR2)0051## SFIND  - COL =SFIND (VEC, START, STOP, CHAR)0049## SHELL  - CALL SHELL (LASTP, NAMPTR, TABLE)0039## SINDX  - COL =SINDX (STR1, STR2)0039## SINSRT - CALL SINSRT(STR1, STR2)0042## SITOC  - LEN =SITOC (NUM, STR, MAX)^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0051## SJOIN  - LEN2=SJOIN (STR1, STR2, MAX, ERROR)0032## SLEN   - LEN =SLEN  (STR)0063## SMIDV  - LEN4=SMIDV (STR1, STR2, STR3, STR4, MAX, ERROR)0055## SMOVE  - I   =SMOVE (STR1, FROM, TO, VEC, START)0056## SNUMBR - NUM =SNUMBR(STR, START, STOP, NUM, NCOL)0037## SPAD   - CALL SPAD  (STR, LEN)0057## SPOSTV - LEN3=SPOSTV(STR1, STR2, STR3, MAX, ERROR)0051## SPREFX - CALL SPREFX(STR1, STR2, STR3, STR4)0057## SPREV  - LEN3=SPREV (STR1, STR2, STR3, MAX, ERROR)^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0056## SREPT  - LEN2=SREPT (STR1, NUM, STR2, MAX, ERROR)0045## SSAME  - ICOL=SSAME (STR1, STR2, LORR)0045## SSAMEX - ICOL=SSAMEX(STR1, STR2, LOOR)0051## SSUFX  - CALL SSUFX (STR1, STR2, STR3, STR4)0063## SSWAP  - LEN4=SSWAP (STR1, STR2, STR3, STR4, MAX, ERROR)0041## STRGET - LEN =STRGET(LUN STR, MAX)0045## STRPUT - ERR =STRPUT(LUN, STR, FMTCHR)0032## STRIM  - LEN =STRIM (STR)0033## TYPE   - C   =TYPE  (CHAR)0033## UNFOLD - CALL UNFOLD (STR)00050030INCLUDE/NL DEFIN			#PCN 470005#0022#GENERAL COMMENTS:^^^^^^0085## NOTE: SOME OF THESE ROUTINES ARE SET UP TO WORK WITH ASCII CHARACTER SET ONLY.0077##THEREFORE, IF THE MACHINE'S NATIVE CHARACTER SET IS NOT ASCII, YOU MUST0082##USE 'INMAP' TO CONVERT TO ASCII BEFORE USING THESE ROUTINES. OR ELSE REWRITE0022##THESE ROUTINES. 0073##ROUTINES THAT PRODUCE AN OUTPUT STRING GENERALY ALLOW A 'MAX' SIZE 0073# FOR THE OUTPUT STRING TO BE SPECIFIED. THE OUTPUT  IS CUT TO 'MAX' 0076# CHARACTERS IF NECESSARY; IF IT IS,THE INTEGER 'ERROR' IS SET TO 'YES' ^^^^^^^^^^^^^^^^^^^^^^^^0065# (OTHERWISE TO 'NO') TO ALERT THAT TRUNCATION WAS NECESSARY.0076# ONE EXTRA ARRAY ELEMENT AT THE END OF THE STRING IS ALWAYS NECESSARY  0033# (BEYOND MAX) FOR THE 'EOS'.0076#SUBROUTINE CALLS SPECIFYING A SPECIFIC ARRAY ELEMENT (EG. STR(I)) CAUSE0075#   ACTION TO BE TAKEN (AND RETURN VALUES AND MAX TO BE CALCULATED,  IF0082#  APPROPRIATE FROM THE SPECIFIED ELEMENT,  NOT THE WHOLE STRING (FROM ELEMENT0075#  1) SINCE ONLY THE STRING STARTING AT THE SPECIFIED ELEMENT IS KNOWN ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0076#  TO THE SUBROUTINE. EG J=SLEN(STRI)) SETS J TO THE NUMBER OF ELEMENTS 0026# BETWEEN I AND 'EOS'.0078#THESE ROUTINES REQUIRE THAT THE COMPILER MAKE CORRECT COMPARES OF INTEGER0081# VALUES BETWEEN INTEGERS AND WHATEVER DATA TYPE 'CHARACTER' IS DEFINED TO BE0030# (LOGICAL*1 IN DEC-LAND).0064#"STRINGS" ARE VECTORS OF CHARACTERS TERMINATED BY AN 'EOS'.0088# THE LENGTH OF A STRING IS THE NUMBER OF CHARACTERS IN IT, NOT INCLUDING THE 'EOS'.0065#"CHARACTERS" ARE SINGLE CHARACTERS, ONE PER STORAGE ELEMENT.^^^^0082#"CHARACTER VECTORS" ARE VECTORS (OR ARRAYS) CONTAINING CHARACTERS BUT WITHOUT0080# THE TERMINATING 'EOS'. THUS, A PART OF A STRING WHICH DOES NOT INCLUDE THE0074# 'EOS' IS A CHARACTER VECTOR, AND A VECTOR WITH AN 'EOS' IS A STRING.0005#00050035   INTEGER FUNCTION ALLDIG(STR)0046# ALLDIG - RETURN YES IF STR IS ALL DIGITS0005#0005#0037   CHARACTER STR(DUMMYSIZE), TYPE0016   INTEGER I0005#0025   IF (STR(1) == EOS)0021      RETURN (NO)0020   DO I=1,HUGE [0028      IF (STR(I) == EOS)^^^^^^^^^^^^^^^^^^^^^^^0025         RETURN (YES)0041      ELSE IF (TYPE(STR(I)) != DIGIT)0024         RETURN (NO)0011      ]0005#0010   END00050042   INTEGER FUNCTION EQLS (VEC, PATSTR)0005#0072# EQLS - FUNCTION TO DO ANCHORED COMPARE OF STRING WITH CHAR VECTOR.0075# STARTING AT BEGINNING OF VEC, COMPARE IT WITH PATSTR (WHICH MUST BE A0077#  STRING). IF THE NEXT CHARACTERS OF VEC MATCH 1 FOR 1 THE CHARACTERS OF0068#  PATSTR, RETURN THE VALUE OF THE FUNCTION AS 'YES', ELSE 'NO'.0005#0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0050   CHARACTER VEC(DUMMYSIZE), PATSTR(DUMMYSIZE)0005#0048   FOR (I=1; PATSTR(I) != EOS; INCREMENT(I))0034      IF (PATSTR(I) != VEC(I))0044         RETURN (NO)				#MIS MATCH FOUND0060   RETURN (YES)				#STR MATCHED ALL WAY TO END OF PATSTR0010   END00050027   SUBROUTINE FOLD(STR)0005#0066# FOLD - CONVERT UPPER CASE LETTERS IN A STRING TO LOWER CASE.0012#15MAY770041#  **** ASCII CHARACTER SET ONLY ****0005#0005#0031   CHARACTER STR(DUMMYSIZE)0016   INTEGER I0005#0020   DO I=1,HUGE [^^^^^^^^^^^^^^^^^^^^^^^0028      IF (STR(I) == EOS)0019         RETURN0051      ELSE IF (STR(I) >= BIGA & STR(I) <= BIGZ)0046         STR(I)=STR(I)+32			#ASCII ONLY!!!0011      ]0005#0013   RETURN0010   END00050037   INTEGER FUNCTION INDEX(STR, C)0005#0063# INDEX - FIND THE LOCATION OF A CHARACTER WITHIN A STRING.0012#15MAY770072# THE VALUE OF THE FUNCTION IS RETURNED AS THE NUMBER OF THE ELEMENT0068#  IN 'STR' WHERE THE FIRST OCCURRENCE OF CHARACTER 'C' IS FOUND0065#  (STARTING AT THE LEFT END), OR AS 0, IF C IS NOT IN 'STR'.^^0005#0005#0034   CHARACTER C, STR(DUMMYSIZE)0005#0024   DO INDEX=1,HUGE [0032      IF (STR(INDEX) == EOS)0036         RETURN (0)			#NOT FOUND0035      ELSE IF (STR(INDEX) == C)0047         RETURN				#INDEX = COL WHERE FOUND0011      ]0005#0010   END00050045   SUBROUTINE SCOMM (I, STR1, STR3, STR4)0005#0043# SCOMM - USED BY SDECAT, SSUFX, SPREFX0005#0005#0026   INTEGER I, SMOVE, J0066   CHARACTER STR1(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)0005#0049   J=SMOVE(STR1, 1, I-1, STR3, 1)		#LEFT PART^^^^^^^^^0020   STR3(J+1)=EOS0050   J=SMOVE(STR1, I, HUGE, STR4,1)		#RIGHT PART0020   STR4(J+1)=EOS0005#0013   RETURN0010   END00050043   INTEGER FUNCTION SCOMPR (STR1, STR2)0005#0049# SCOMPR - COMPARE TWO STRINGS ALPHABETICALY.0064# PCN #89, 10 FEB 80, SPEED UP 50%, REPLACE 'FOR' WITH 'DO'.0053#RETURN 0 IF EQUAL. (STRINGS MUST BE SAME LENGTH)0049#RETURN -1 IF STR1 IS CLOSER TO 'A' THEN STR20049#RETURN +1 IF STR1 IS CLOSER TO 'Z' THEN STR20041#  **** ASCII CHARACTER SET ONLY ****0005#0005#0019   INTEGER I, J^^^^^^^0049   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)0005#0033   DO I=1,HUGE				#***PCN #890037      IF (STR1(I) == STR2(I))   [0033         IF (STR1(I) == EOS) 0035            RETURN (0)			#MATCH0014         ]0014      ELSE0018         BREAK0005#0029   IF (STR1(I) < STR2(I))0039      RETURN (-1)			#STR1 IS HIGHER0011   ELSE0038      RETURN (+1)			#STR1 IS LOWER0005#0010   END00050049   INTEGER FUNCTION SCOMPX (STR1, STR2, CHAR)0005#0056# SCOMPX - COMPARE 2 SPECIAL STRINGS ALPHABETICALLY.^^^^^^^^^^^^^^^^^^^^^^0075#COMPAR THE SECTIONS OF 2 STRINGS BEFORE AND AFTER THE 'CHAR' SEPERATOR0075#  INDEPENDENTLY. 0 IS RETURNED IF THE FIRST PART (UP TO 'CHAR')MATCHES0058#  AND THE SECOND PART (FROM 'CHAR' TO 'EOS') MATCHES.0079#FOR 1ST PART (BEFORE 'CHAR'), THE COMPARE ENDS WHEN EITHER STRING CONTAINS0076# A 'CHAR'. IT THEN LINES UP THE 'CHAR' IN BOTH STRINGS AND COMPARES THE0073# SECOND PART OF BOTH STRINGS UNTIL AN EOS IS FOUND IN EITHER STRING.^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0079# THE STRINGS DO NOT HAVE TO BE THE SAME LENGTH (EITHER BEFORE OR AFTER THE0039# 'CHAR') TO BE CONSIDERED A MATCH.0041#  **** ASCII CHARACTER SET ONLY ****0058#RETURNS -1 IF STR1 IS HIGHER ALPHABETICALLY THEN STR20065#RETURNS  0 IF STR1 IS EQUAL TO STR2, PIVOTING AROUND 'CHAR'.0057#RETURNS +1 IF STR1 IS LOWER ALPHABETICALLY THEN STR20038#	IF	STR1="FIRST PART<SECOND PART"0015#		CHAR='<"0052#   THEN IF	STR2="FIRST<SECOND"	SCOMPX RETURNS 00035#		STR2="F<S"		SCOMPX RETURNS 0^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0038#		STR2="AA<BB"		SCOMPX RETURNS +10005#0005#0019   INTEGER I, J0055   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), CHAR0005#0010   J=10065   FOR (I=1; STR1(I) != EOS & STR2(J) != EOS; INCREMENT(I)) [0030      IF (STR1(I) == CHAR)0055         WHILE (STR2(J) != CHAR & STR2(J+1) != EOS)0061            INCREMENT (J)			#SLIDE ALONG 2 TO REGAIN SYNC0036      ELSE IF (STR2(J) ==  CHAR)0055         WHILE (STR1(I) != CHAR & STR1(I+1) != EOS)0029            INCREMENT (I)0040      ELSE IF (STR1(I) != STR2(J)) [^^^^0051         IF (STR1(I) < STR2(J))		#ASCII ONLY!!!0027            RETURN (-1)0017         ELSE0027            RETURN (+1)0014         ]0045      INCREMENT (J)		#ELSE TRY NEXT CHAR.0011      ]0049   RETURN (0)		#THEY MATCHED ALL THE WAY THRU0005#0010   END00050054   INTEGER FUNCTION SCOPY (STR1, STR2, MAX, ERROR)0005#0049# SCOPY - COPY ONE STRING INTO ANOTHER STRING0040# PCN 89, 10FEB 80, MAKE 30% FASTER.0059#COPYING STOPS WHEN THE END OF STR1 IS REACHED, OR WHEN^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0054# STR2 GETS TO BE 'MAX' CHAR. LONG (ERROR IS SET).0061# VALUE OF THE FUCTION IS RETURNED AS THE LENGTH OF STR2.0005#0005#0028   INTEGER MAX, ERROR, I0049   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)0005#0015   ERROR=NO0020   DO I=1,HUGE [0029      IF (STR1(I) == EOS)0018         BREAK0029      ELSE IF (I > MAX) [0022         ERROR=YES0018         BREAK0014         ]0015      ELSE 0047         STR2(I)=STR1(I)		#MOVE A CHARACTER0011      ]0005#0042   STR2(I)=EOS			#MAKE OUTPUT A STRING0005#^^^^^^^^^^^^^^^0019   RETURN (I-1)0010   END00050036   INTEGER FUNCTION SCTOI(IN, I)0005#0062# SCTOI - CONVERT STRING AT IN(I) TO INTEGER, INCREMENT I.0078#STARTING AT LOCATION 'I' IN STRING 'IN', LEADING BLANKS/TABS ARE SKIPPED;0065# THEN ALL DIGITS UP TO THE NEXT NON-DIGIT (INCLUDING BLANKS)0066# ARE CONVERTED TO A POSITIVE OR NEGATIVE INTEGER AND RETURNED0070# AS THE VALUE OF THE FUNCTION. 'I' IS INCREMENTED AND UPON RETURN0052# POINTS TO THE LOCATION OF THE FIRST NON-DIGIT.0005#0005#0030   CHARACTER IN(DUMMYSIZE)^^^^0030   INTEGER D, I, SFIND, PM0033   STRING DIGITS "0123456789"0005#0065   WHILE (IN(I) == BLANK \ IN(I) == TAB)	#SKIP LEADING BLANKS0023      INCREMENT (I)0058   IF (IN(I) == MINUS) [		#ALLOW FOR NEGATIVE INTEGERS0023      INCREMENT (I)0015      PM=-10011      ]0011   ELSE0015      PM=+10005#0053   FOR (SCTOI = 0; IN(I) != EOS; INCREMENT (I)) [0042      D = SFIND (DIGITS, 1, 10, IN(I))0049      IF (D == 0)   			# NON-DIGIT STOPS SCAN0018         BREAK0037      SCTOI = 10 *  SCTOI + D - 10012      ] 0005#^^0018   IF (PM < 0)0022      SCTOI=-SCTOI0013   RETURN0010   END00050049   SUBROUTINE SDECAT (STR1, STR2, STR3, STR4)0005#0065# SDECAT - BREAK A STRING INTO TWO SUBSTRINGS AT A CHARACTER.0068#STR1 IS BROKEN INTO STR3 AND STR4 AT THE LEFTMOST OCCURRENCE OF0073# ANY CHARACTER  THAT IS ALSO ANYWHERE IN STR2. THE "BREAK CHARACTER"0075# GOES INTO STR4. ALTHOUGH STR2 IS A STRING, IT IS USED AS A COLLECTION0048# OF 1 OR MORE CHARACTERS TO BE CHECKED FOR.0028#	IF	STR1="FILENAME.EXT"0017#		STR2=":.;"^^^^^^^^^^^^^^^^0026#	THEN SDECAT RETURNS:0022#		STR3="FILENAME"0018#		STR4=".EXT"0005#0005#0032   INTEGER I, J, SSAME, SLEN0083   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)0005#0030   I=SSAME(STR1, STR2, +1)0046   IF (I <= 0)				#SEPERATOR WAS NOT THERE0052      I=SLEN(STR1)+1			#SO IT ALL GOES INTO STR30066   CALL SCOMM (I, STR1, STR3, STR4)	#MOVE LEFT AND RIGHT PARTS0005#0013   RETURN0010   END00050040   INTEGER FUNCTION SEQL(STR1, STR2)0005#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0055# SEQL - COMPARE STR1 TO STR2; RETURN YES IF EQUAL,0079#STR1 IS COMPARED CHARACTER BY CHARACTER TO STR2; IF THEY MATCH ALL THE WAY0069# THRU, THE FUNCTION VALUE IS RETURNED AS 'YES', IF NOT, AS 'NO'.0057#  THEY MUST BOTH BE STRINGS, AND OF THE SAME LENGTH.0005#0005#0049   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)0016   INTEGER I0005#0018   DO I=1,HUGE0033      IF (STR1(I) != STR2(I))0024         RETURN (NO)0035      ELSE IF (STR1(I) == EOS) 0025         RETURN (YES)0005#0010   END0005^^^^^^^^^^^^^^^^^0046   SUBROUTINE SHELL (LASTP, NAMPTR, TABLE)0005#0069# SHELL - TO SORT DEFINE TABLE INTO ALPHABETICAL ORDER FOR RATFOR0028#SYKES 18 OCT 76,14MAR770005#0005#0042   INTEGER GAP, I, IG, J, K, SCOMPR, N0039   INTEGER LASTP, NAMPTR(DUMMYSIZE)0033   CHARACTER TABLE(DUMMYSIZE)0005#0044   FOR (GAP=LASTP/2; GAP > 0; GAP=GAP/2)0049      FOR (J=GAP+1; J <= LASTP; INCREMENT(J))0044         FOR (I=J-GAP; I > 0; I=I-GAP) [0024            IG=I+GAP^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0077            IF (SCOMPR(TABLE(NAMPTR(I)), TABLE(NAMPTR(IG))) <= 0)	#PCN 470024               BREAK0048            N=NAMPTR(I)		#ELSE SWAP POINTERS0036            NAMPTR(I)=NAMPTR(IG)0028            NAMPTR(IG)=N0017            ]0005#0013   RETURN0010   END00050054   INTEGER FUNCTION SFIND (VEC, START, STOP, CHAR)0005#0072# SFIND - BOUNDED FAST SEARCH OF A CHARACTER VECTOR FOR A CHARACTER.0067#SEARCHES A VECTOR, EITHER FROM LEFT TO RIGHT OR RIGHT TO LEFT,^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0074#  DEPENDING ON THE RELATIVE VALUES OF START AND STOP, FOR A SPECIFIED0078#  CHARACTER, AND RETURNS AS THE FUNCTION VALUE THE ELEMENT IN 'VEC' WHERE0080#  THE FIRST MATCH IS FOUND; OR AS 0, IF NO CHARACTER IN VEC MATCHES 'CHAR'.0080# THIS IS NOT ANSII FORTRAN BECAUSE OF THE BACKWARD INCREMENT ON THE DO LOOP0059# BUT IN F4P IS SOMEWHAT FASTER THEN STANDARD ROUTINES.0024#	IF	VEC="ABCDEAFGH"0038#		I=SFIND(VEC,1,8,BIGC)	RETURNS 30038#		I=SFIND(VEC,8,1,BIGC)	RETURNS 30038#		I=SFIND(VEC,1,8,BIGZ)	RETURNS 0^^^0038#		I=SFIND(VEC,2,7,BIGA)	RETURNS 60005#0005#0029   INTEGER START, STOP, I0037   CHARACTER VEC(DUMMYSIZE), CHAR0005#0024   IF (START > STOP)0014      I=-10011   ELSE0014      I=+10055   DO SFIND=START,STOP,I		#RSX!!! NEGATIVE INCREMNT0033      IF (VEC(SFIND) == CHAR)0041         RETURN			#WITH THE LOCATION 0031   RETURN (0)				#NOT THERE0005#0010   END00050041   INTEGER FUNCTION SINDX (STR, PATN)0005#0079# SINDX - FIND THE LOCATION OF A SPECIFIED SUBSTRING WITHIN ANOTHER STRING.^^^^^^^^^^^^^^^^^^^^^^^^^0070#THE FUNCTION VALUE IS RETURNED AS THE LOCATION WITHIN 'STR' WHERE0065#  'PATN ' STARTS; OR AS 0, IF 'PATN' DOES NOT OCCUR IN'STR'.0066#  IF 'PATN' IS NULL, IT IS CONSIDERED TO MATCH AT LOCATION 1.0026#	IF	STR1="ABADAFABCD"0017#		PATN="ABC"0005#0005#0019   INTEGER J, K0048   CHARACTER STR(DUMMYSIZE), PATN(DUMMYSIZE)0005#0059   FOR (SINDX=1; STR(SINDX) != EOS; INCREMENT(SINDX)) [0017      K=SINDX0049      FOR (J=1; PATN(J) != EOS; INCREMENT(J))0035         IF (PATN(J) != STR(K))0021            BREAK^^^^^0017         ELSE0029            INCREMENT (K)0029      IF (PATN(J) == EOS)0045         RETURN			#THEY MATCHED AFTER ALL0033      ELSE IF (STR(K) == EOS)0040         BREAK				#NO MATCH POSSIBLE0029      ]				#ELSE CONTINUE0039   RETURN (0)				#THEY DO NOT MATCH0005#0010   END00050037   SUBROUTINE SINSRT (STR1, STR2)0005#0050# SINSRT - INSERT A STRING INTO ANOTHER STRING0066#COPY ALL OF STR1 INTO STR2; IF THIS OVERRUNS THE END OF STR2,^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0077#   MAKE STR2 LONGER TO HOLD ALL OF STR1.  OTHERWISE, NO 'EOS' AT THE END0027#   OF THE COPIED PART.0005#0005#0022   INTEGER I, ENDS0049   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)0005#0014   ENDS=NO0048   FOR (I=1; STR1(I) != EOS; INCREMENT(I)) [0029      IF (STR2(I) == EOS)0021         ENDS=YES0025      STR2(I)=STR1(I)0011      ]0055   IF (ENDS == YES)		#IF WE OVERRAN THE END OF STR20049      STR2(I)=EOS		#IT IS NOW A LONGER STRING0005#0013   RETURN0010   END0005^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0045   INTEGER FUNCTION SITOC(INT, STR, SIZE)0005#0070# SITOC - CONVERT INTEGER  INT  TO STRING IN  STR, LEFT JUSTIFIED.0073#CONVERT THE POSITIVE OR NEGATIVE INTEGER 'INT' TO A CHARACTER STRING0072# IN 'STR'. TRUNCATE THE STRING IF IT GOES BEYOND 'SIZE' CHARACTERS.0083# RETURN THE ACTUAL NUMBER OF CHARACTERS IN 'STR' AS THE VALUE OF THE FUNCTION.0005#0005#0024   INTEGER IABS, MOD0044   INTEGER D, I, INT, INTVAL, J, K, SIZE0026   CHARACTER STR(SIZE)0033   STRING DIGITS "0123456789"0005#^^^^^^^^^^^^^^^^^^^^^^0025   INTVAL = IABS(INT)0019   STR(1) = EOS0012   I = 10046   REPEAT [           			# GENERATE DIGITS0023      INCREMENT (I)0029      D = MOD(INTVAL, 10)0030      STR(I) = DIGITS(D+1)0030      INTVAL = INTVAL / 100044      ]  UNTIL (INTVAL == 0 \ I >= SIZE)0050   IF (INT < 0 & I < SIZE) [     		# THEN SIGN0023      INCREMENT (I)0024      STR(I) = MINUS0011      ]0020   SITOC = I - 10059   FOR (J = 1; J < I; INCREMENT (J)) [  	# THEN REVERSE0020      K = STR(I)0025      STR(I) = STR(J)0020      STR(J) = K^^0023      DECREMENT (I)0012      ] 0005#0013   RETURN0010   END00050054   INTEGER FUNCTION SJOIN (STR1, STR2, MAX, ERROR)0005#0064# SJOIN - CONCATINATE A STRING TO THE END OF ANOTHER STRING,0069#ADD STR2 TO THE END OF STR1 (IN STR1). MOVE ALL OF STR2 OR UNTIL0062#  STR1 IS 'MAX' CHARS LONG (IN WHICH CASE, SET ERROR=YES)0066#  RETURN THE VALUE OF THE FUNCTION AS THE NEW LENGTH OF STR1.0005#0005#0041   INTEGER MAX, ERROR, I, SLEN, SCOPY0049   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)0005#^^^^^^^^^^^^^^^^^^^0043   I=SLEN(STR1)				#FIND WHERE TO START0053   SJOIN=SCOPY(STR2, STR1(I+1), MAX-I, ERROR) + I0005#0013   RETURN0010   END00050033   INTEGER FUNCTION SLEN(STR)0005#0076# SLEN - FUNCTION TO RETURN THE LENGTH OF STRING (NOT INCLUDING THE EOS)0005#0005#0031   CHARACTER STR(DUMMYSIZE)0005#0018   DO I=1,HUGE0028      IF (STR(I) == EOS)0025         RETURN (I-1)0005#0010   END00050066   INTEGER FUNCTION SMIDV (STR1, STR2, STR3, STR4, MAX, ERROR)0005#0061# SMIDV - SELECT A SUBSTRING FROM THE MIDDLE OF A STRING.0073#MOVE THE CHARACTERS IN STR1 THAT ARE BETWEEN STR2 AND STR3 (IN STR1)0076#  INTO STR4. TRUNCATE STR4 TO 'MAX' CHARS (AND SET ERROR) IF NECESSARY.0074#  THE VALUE OF THE FUNCTION IS RETURNED AS THE ACTUAL LENGTH OF STR4.0060#  IF EITHER STR2 OR STR3 ARE NOT IN STR1, STR4 IS NULL.0028#	IF	STR1="DEV:FILE.EXT"0015#		STR2=":"0015#		STR3="."0025#	THEN SMIDV RETURNS:0029#		I=4,        ERROR='NO'0018#		STR4="FILE"0005#0005#0025   INTEGER MAX, ERROR0039   INTEGER SLEN, SINDX, SMOVE, J, I^^^^^^^^^^^^^^^^^^^^^^^^^0083   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)0005#0047   I=SINDX (STR1, STR2)		#FIND STR2 IN STR10019   IF (I > 0) [0024      I=I+SLEN(STR2)0074      J=SINDX (STR1(I), STR3)		#FIND STR3 IN STR1 TO THE RIGHT OF STR20011      ]0061   IF (I > 0 & J > 0) [		#BOTH STR2  & STR3 MUST BE THERE0025      IF (J <= MAX) [0020         J=I+J-20021         ERROR=NO0014         ]0016      ELSE [0022         ERROR=YES0022         J=I+MAX-10014         ]^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0042      SMIDV=SMOVE(STR1, I, J, STR4, 1)0027      STR4(SMIDV+1)=EOS0011      ]0013   ELSE [0018      ERROR=NO0060      SMIDV=0			#IF BOTH STR2 AND STR3 WERE NOT IN STR1,0060      STR4(1)=EOS		#NO MIDDLE EXISTS TO BE PUT INTO STR40011      ]0005#0013   RETURN0010   END00050058   INTEGER FUNCTION SMOVE (STR1, FROM, TO, VEC, START)0005#0077# SMOVE - BOUNDED MOVE OF CHARACTERS FROM A STRING OR VECTOR TO A VECTOR.0066#MOVE THE CHARACTERS IN STR1 BETWEEN 'FROM' & 'TO' (INCLUSIVE)^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0070#  TO VEC, STARTING AT LOCATION 'START'. NO 'EOS' IS PLACED AT THE0035#  END OF THE MOVED CHARACTERS.0071#  IF THE END OF STR1 IS REACHED BEFORE LOCATION 'TO', THE TRANSFER0069#  IS STOPPED.  THE VALUE OF THE FUNCTION IS RETURNED AS THE LAST0044#  (RIGHTMOST) LOCATION IN VEC MODIFIED.0005#0005#0033   INTEGER FROM, TO, START, I0048   CHARACTER STR1(DUMMYSIZE), VEC(DUMMYSIZE)0005#0020   SMOVE=START-10020   DO I=FROM, TO0029      IF (STR1(I) == EOS)0053         BREAK		#EARLY TERMINATION FOR SHORT STR1^^^^^0016      ELSE [0030         INCREMENT (SMOVE)0031         VEC(SMOVE)=STR1(I)0014         ]0025   IF (SMOVE < START)0052      RETURN (0)		#NOTHING WAS REALLY TRANSFERED0005#0013   RETURN0010   END00050060   INTEGER FUNCTION SNUMBR (STR, START, STOP, NUM, NCOL)0005#0068# SNUMBR - FUNCTION TO CONVERT A CHARACTER VECTOR TO AN INTEGER.0065#STARTING AT 'START', EXTRACT A INTEGER FROM 'STR' AND RETURN0083#  IT AS THE VALUE OF THE FUNCTION AND AS 'NUM'; IGNORE BLANKS, BUT QUIT AT THE^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0081#  FIRST NON-DIGIT/BLANK FOUND, BUT IN ANY CASE DO NOT GO PAST COLUMN 'STOP'.0076#  RETURN IN 'NCOL' THE NUMBER OF THE NEXT COLUMN TO THE RIGHT IN 'STR'.0005#0005#0050   INTEGER START, STOP, NUM, I, J, SCTOI, NCOL0045   CHARACTER STR(DUMMYSIZE), TOK(7), TYPE0005#0010   J=10054   FOR (I=START; J <= 7 & I <= STOP; INCREMENT(I))0030      IF (STR(I) == BLANK)0055         NEXT					#SKIP LEADING AND IMBEDDED BLANKS0060      ELSE IF (TYPE(STR(I)) != DIGIT &  STR(I) != MINUS)^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0047         BREAK					#STOP AT FIRST NON-DIGIT0016      ELSE [0026         TOK(J)=STR(I)0026         INCREMENT (J)0014         ]0017   TOK(J)=EOS0055   NCOL=I			#NEXT COL IN STR AFTER THE FOUND NUMBER0010   I=10049   NUM=SCTOI (TOK, I)		#CONVERT TO AN INTEGER0005#0019   RETURN (NUM)0010   END00050033   SUBROUTINE SPAD (STR, LEN)0005#0063# SPAD - FILL A STRING UP TO A SPECIFIED LENGTH WITH BLANKS0065# PCN # 89, 10 FEB 80, SPEED UP 13%, REPLACE 'FOR' WITH 'DO'.^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0059#PAD THE RIGHTHAND END OF STR WITH BLANKS OUT TO 'LEN'.0044#  STR BECOMES A STRING OF LENGTH 'LEN'.0005#0005#0027   INTEGER LEN, SLEN, I0031   CHARACTER STR(DUMMYSIZE)0005#0020   I=SLEN(STR)+10020   IF (I <= LEN)0020      DO J=I,LEN0025         STR(J)=BLANK0067   STR(LEN+1)=EOS	#TRUNCATED IF STR IS LONGER THEN LEN TO START0005#0013   RETURN0010   END00050061   INTEGER FUNCTION SPOSTV (STR1, STR2, STR3, MAX, ERROR)0005#0066# SPOSTV - SELECT A SUBSTRING FROM  THE RIGHT END OF A STRING.^^^^^^^^^^^^^^^^^^^0076#MOVE INTO STR3 ALL OF STR1 TO THE RIGHT OF THE END OF STR2(WITHIN STR1)0069#  BUT TRUNCATE STR3 TO 'MAX' CHARS (AND SET ERROR) IF NECESSARY.0077#  THE VALUE OF THE FUNCTION IS RETURNED AS THE ACUTAL NEW LENGTH OF STR30053#  STR3 IS NULL IF STR2 IS NOT FOUND WITHIN STR1.0049#  IF STR2 IS NULL, ALL OF STR1 GOES TO STR3.0028#	IF	STR1="FILENAME.EXT"0015#		STR2="."0050#	THEN SPOSTV RETURNS     I=3,      ERROR='NO'0017#		STR3="EXT"0005#0005#0048   INTEGER MAX, ERROR, I, SCOPY, SINDX, SLEN^^^^^^^^^^^^^^^^^^^^0066   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE)0005#0047   I=SINDX (STR1, STR2)		#FIND STR2 IN STR10042   IF (I <= 0) [			#IF IT'S NOT THERE,0051      STR3(1)=EOS			#STR3 IS NULL BY DEFINITION0018      ERROR=NO0020      RETURN (0)0011      ]0013   ELSE [0024      I=I+SLEN(STR2)0049      SPOSTV=SCOPY(STR1(I), STR3, MAX, ERROR)0011      ]0005#0013   RETURN0010   END00050049   SUBROUTINE SPREFX (STR1, STR2, STR3, STR4)0005#0057# SPREFX - SEPERATE A PREFIX SUBSTRING FROM A STRING.^^^^^^^^^^^0082#MOVE INTO STR3 THAT PART OF STR1 WHICH IS TO THE LEFT OF THE FIRST CHAR ALSO 0082# FOUND (ANYWHERE) IN STR2. MOVE INTO STR4 THE REST OF STR1. STR3 AND STR4 ARE0077# NEW STRINGS. THE LEFTMOST OCCURRANCE IN STR1 OF ANY CHAR IN STR2 IS THE0056# "BREAK POINT". THE BREAK CHARACTER GOES INTO STR4.0078# IF NONE OF THE CHARACTERS IN STR2 IS FOUND IN STR1, ALL OF STR1 IS MOVED0034#  INTO STR4 AND STR3 IS NULL.0077#ALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE^^^^^^^^^^^^^^^^^^^^^^^^^^0076# CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE0016# IMPORTANT.0028#	IF	STR1="FILENAME.EXT"0017#		STR2=":.;"0026#	THEN SPREFX RETURNS:0022#		STR3="FILENAME"0018#		STR4=".EXT"0005#0005#0023   INTEGER I, SSAME0083   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)0005#0062   I=SSAME (STR1, STR2, +1)		#FIND CHAR. IN STR2 FROM LEFT0018   IF (I <= 0)0050      I=1				#NOT THERE, SO ALL GOES INTO STR4^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0066   CALL SCOMM (I, STR1, STR3, STR4)	#MOVE LEFT AND RIGHT PARTS0005#0013   RETURN0010   END00050060   INTEGER FUNCTION SPREV (STR1, STR2, STR3, MAX, ERROR)0005#0063# SPREV - SELECT A SUBSTRING FROM THE LEFT END OF A STRING.0070#MOVE THE PART OF STR1 TO THE LEFT OF THE START OF STR2 INTO STR3.0065#  TRUNCATE STR3 TO 'MAX' CHARS (AND SET ERROR) IF NECESSARY.0067#  THE VALUE OF THE FUNCTION IS RETURNED AS THE LENGTH OF STR3.0053#  STR3 IS NULL IF STR2 IS NOT FOUND WITHIN STR1.^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0049#  IF STR2 IS NULL, ALL OF STR1 GOES TO STR3.0030#	IF	STR1="FILENAME.EXT;2"0018#		STR2=".EXT"0025#	THEN SPREV RETURNS:0028#		I=8,       ERROR='NO'0022#		STR3="FILENAME"0005#0005#0042   INTEGER MAX, ERROR, I, SINDX, SMOVE0066   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE)0005#0028   I=SINDX (STR1, STR2) 0041   IF (I <= 0) [		#STR2 MUST BE THERE0039      STR3(1)=EOS		#OR STR3 IS NULL0018      ERROR=NO0020      RETURN (0)0011      ]0013   ELSE [0023      DECREMENT (I)0023      IF (I <= MAX)^0021         ERROR=NO0016      ELSE [0048         I=MAX		#TRUNCATE LENGTH OF TRANSFER0022         ERROR=YES0014         ]0043      SPREV=SMOVE (STR1, 1, I, STR3, 1)0027      STR3(SPREV+1)=EOS0011      ]0005#0013   RETURN0010   END00050059   INTEGER FUNCTION SREPT (STR1, NUM, STR2, MAX, ERROR)0005#0067# SREPT - DUPLICATE A STRING INTO ANOTHER STRING SEVERAL TIMES.0067#FILL STR2 WITH 'NUM' CONCATINATED COPIES OF STR1, BUT TRUNCATE0055#  STR2 AT 'MAX' CHAR (AND SET ERROR) IF NECESSARY.^^^^^^^^^^^^^^^^^^^^^^^^0062#  THE VALUE OF THE FUNCTION IS RETURNED AS THE ACUTAL NEW0022#  LENGTH OF STR2.0019#	IF	STR1="*-*"0014#		STR2=""0048#	THEN	I=SREPT(STR1,5,STR2,9,ERROR)	RETURNS:0029#		I=9,       ERROR='YES'0023#		STR2="*-**-**-*"0005#0005#0040   INTEGER NUM, MAX, ERROR, SCOPY, I0049   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)0005#0014   SREPT=00042   FOR (I=1; I <= NUM; INCREMENT(I)) [0070      SREPT=SCOPY (STR1, STR2(SREPT+1), MAX-SREPT, ERROR) + SREPT 0027      IF (ERROR == YES)0018         BREAK0011      ]0005#^^^^0013   RETURN0010   END00050048   INTEGER FUNCTION SSAME (STR1, STR2, LORR)0005#0069# SSAME - RETURN LOCATION OF FIRST CHARACTER IN STR1 ALSO IN STR20071#SCAN STR1 FROM LEFT TO RIGHT (IF LORR IS >0) OR FROM RIGHT TO LEFT0075#  (IF LORR IS <0) AND RETURN THE VALUE OF THE FUNCTION AS THE POSITION0080#  IN STR1 WHERE THE FIRST CHARACTER IS FOUND THAT IS ALSO ANYWHERE IN STR2,0059#  OR AS 0, IF NO CHARACTERS IN STR1 ARE FOUND IN STR2.0077#ALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE0076# CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE0016# IMPORTANT.0025#	IF	STR1="ABCDE7FGH"0024#		STR2="0123456789"0042#	THEN 	I=SSAME(STR1,STR2,+1) RETURNS:0010#		I=60005#0005#0028   INTEGER LORR, SLEN, I0049   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)0005#0020   IF (LORR > 0)0017      SSAME=10011   ELSE0026      SSAME=SLEN(STR1)0047   WHILE (SSAME > 0 & STR1(SSAME) != EOS) [0049      FOR (I=1; STR2(I) != EOS; INCREMENT(I))0040         IF (STR1(SSAME) == STR2(I))^^^^^^^^^^^^^^^^^0060            RETURN			#WITH POSITION IN STR1 OF 1ST MATCH0023      IF (LORR > 0)0030         INCREMENT (SSAME)0014      ELSE0030         DECREMENT (SSAME)0011      ]0033   RETURN (0)			#NONE MATCHED0005#0010   END00050049   INTEGER FUNCTION SSAMEX (STR1, STR2, LOOR)0005#0075# SSAMEX - RETURN LOCATION OF FIRST CHARACTER IN STR1 NOT ALSO IN STR2.0073#SCAN STR1 FROM THE LEFT (IF LORR > 0) OR FROM THE RIGHT (IF LOOR <0)0074#  AND RETURN THE VALUE OF THE FUNCTION AS THE LOCATION WITHIN STR1 OF^^^^^^^^^^^^^^^0066#  THE FIRST CHARACTER NOT FOUND (ANYWHERE) IN STR2 , OR AS 0,0040#  IF EVERYTHING IN STR1 IS IN STR2.0077#ALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE0076# CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE0016# IMPORTANT.0025#	IF	STR1="123456ABC"0024#		STR2="0123456789"0042#	THEN	I=SSAMEX(STR1,STR2,+1)	RETURNS:0010#		I=70005#0005#0028   INTEGER I, LOOR, SLEN0049   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE)0005#0020   IF (LORR > 0)0018      SSAMEX=1^^^^^^0011   ELSE0027      SSAMEX=SLEN(STR1)0049   WHILE (SSAMEX > 0 & STR1(SSAMEX) != EOS) [0049      FOR (I=1; STR2(I) != EOS; INCREMENT(I))0041         IF (STR1(SSAMEX) == STR2(I))0041            BREAK			#FOUND THIS CHAR.0050      IF (STR2(I) == EOS)		#IT WAS NOT IN STR20040         RETURN			#SO RETURN WITH IT0027      ELSE				#CONTINUE0026         IF (LORR > 0)0034            INCREMENT (SSAMEX)0017         ELSE0034            DECREMENT (SSAMEX)0011      ]0050   RETURN (0)			#EVERYTHING IN STR1 IS IN STR20005#0010   END00050048   SUBROUTINE SSUFX (STR1, STR2, STR3, STR4)0005#0046# SSUFX - SEPERATE OUT A SUFFEX SUBSTRING.0076#MOVE CHARACTERS FROM STR1 INTO STR3 WHICH ARE TO THE RIGHT OF THE FIRST0076#  OCCURENCE OF ANY CHARACTER FROM STR2 IN STR1, SCANNING RIGHT-TO-LEFT.0077#  MOVE THE REMAINDER OF STR1 INTO STR4. FIRST CHARACTER IN STR1 TO MATCH0072#  ANY CHARACTER IN STR2 IS THE "BREAK CHAR", AND IT GOES INTO STR4.0079#IF NONE OF THE CHARACTERS IN STR2 IS FOUND IS STR1, ALL OF STR1 GOES INTO ^^^^^^^^^^^^^^^^^^0028# STR4 AND STR3 IS NULL.0077#ALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE0076# CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE0016# IMPORTANT.0028#	IF	STR1="FILENAME.EXT"0017#		STR2=":.;"0025#	THEN SSUFX RETURNS:0017#		STR3="EXT"0023#		STR4="FILENAME."0005#0005#0029   INTEGER I, SSAME, SLEN0083   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)0005#0053   I=SSAME (STR1, STR2, -1) 		#SEARCH FROM RIGHT 0018   IF (I <= 0)^^^^^^^0054      I=SLEN(STR1)			#NO MATCH FOUND, STR3 IS NULL0020   INCREMENT (I)0005#0068   CALL SCOMM(I, STR1, STR4, STR3)		#TRANSFER RIGHT & LEFT PARTS0005#0013   RETURN0010   END00050066   INTEGER FUNCTION SSWAP (STR1, STR2, STR3, STR4, MAX, ERROR)0005#0059# SSWAP - EXCHANGE PART OF A STRING FOR ANOTHER STRING.0072#MOVE STR1 INTO STR4, EXCEPT THAT THE PART OF STR1 THAT MATCHES STR20072#  IS REPLACED BY STR3. THE VALUE OF THE FUNCTION IS RETURNED AS THE^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0082#  ACTUAL LENGTH OF STR4, OR AS 0, IF STR2 CANNOT BE FOUND. STR4 IS TRUNCATED 0080#  TO 'MAX' (AND ERROR IS SET) IF NECESSARY. STR2 AND STR3 NEED NOT BE SAME 0014#  LENGTH.0030#	IF	STR1="FILENAME.FTN;3"0017#		STR2="FTN"0017#		STR3="OBJ"0025#	THEN SSWAP RETURNS:0011#		I=140028#		STR4="FILENAME.OBJ;3"0005#0005#0055   INTEGER MAX, ERROR, SINDX, SJOIN, SMOVE, I, SLEN0083   CHARACTER STR1(DUMMYSIZE), STR2(DUMMYSIZE), STR3(DUMMYSIZE), STR4(DUMMYSIZE)0005#0049   I=SINDX(STR1, STR2)	#FIND LOCATION OF STR2^^^^^^0020   IF (I <= 0) [0058      STR4(1)=EOS		#STR2 WAS NOT THERE SO STR4 IS NULL0018      ERROR=NO0020      RETURN (0)0011      ]0013   ELSE [0037      IF (I > MAX) [		# TOO LONG?0022         ERROR=YES0020         I=MAX+10014         ]0014      ELSE0021         ERROR=NO0057      SSWAP=SMOVE (STR1, 1, I-1, STR4, 1)		#LEFT PART0045      STR4(SSWAP+1)=EOS				#MAKE A STRING0065      SSWAP=SJOIN (STR4, STR3, MAX, ERROR)		#REPLACEMENT PART0024      I=I+SLEN(STR2)^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0061      SSWAP=SJOIN(STR4, STR1(I), MAX, ERROR)		#RIGHT PART0064#  ONCE STR4 REACHES 'MAX' LENGTH, SJOIN WILL NOT ADD TO IT.0011      ]0005#0043   RETURN		#WITH SSWAP = LENGTH OF STR40010   END0046   INTEGER FUNCTION STRGET (LUN, STR, MAX)0005#0050# STRGET - READ A STRING FROM A SPECIFIED LUN.0058# PCN #77, 6 JAN 80, ALLOW FOR SKIP-RECORD DUMMY READS0072# PCN #81, 13 JAN 80, FIX SUBSCRIPT ERROR F4P GENERATES IF MAX IS 0.0078# **CAUTION: THIS ROUTINE TRUSTS FORTRAN TO MOVE INTO THE BUFFER ONLY THAT^^^^^^^^^0080# **PART OF THE RECORD CALLED FOR BY 'MAX'. DEC'S FORTRAN IV V2.1 (AT LEAST)0082# **HAS A BUG WHICH CAUSES IT TO ALWAYS READ A FULL RECORD. THEREFORE, IF YOUR0080# **BUFFER IS SMALLER THEN THE RECORD SIZE, IT READS MORE INTO THE BUFR THEN0080# **IT HAS ROOM FOR, KLOBBERING GOD-KNOWS-WHAT IN YOUR PROGRAM. BEST TO TEST0082# **THIS OR ALWAYS GIVE STRGET A BUFFER AS BIG AS THE LARGEST POSSIBLE RECORD.0005#0005#0026   INTEGER LUN, MAX, N0041   CHARACTER STR(DUMMYSIZE)		#PCN #810005#0021   IF (MAX > 0) [^^^^^0071      READ (LUN,1,END=100,ERR=101) STRGET, (STR(N),N=1,MAX)	#RSX!!!0041      1 FORMAT (Q, 132A1)					#RSX!!!0027      STR(STRGET+1)=EOS0016      RETURN0011      ]0013   ELSE [0054      READ (LUN,1,END=100,ERR=101)		#SKIP A RECORD0020      STR(1)=EOS0020      RETURN (0)0011      ]0005#0021   100 STR(1)=EOS0019   RETURN (EOF)0005#0021   101 STR(1)=EOS0019   RETURN (BAD)0005#0010   END00050049   INTEGER FUNCTION STRPUT (LUN, STR, FMTCHR)0005#0049# STRPUT - WRITE A STRING TO A SPECIFIED LUN.^^^^^^^^^^^^^^^0069# PCN 77, 5 JAN 80, ADD A FORMAT CONTROL CHAR TO CALLING SEQUENCE0005#0005#0036   INTEGER LUN, I, N, SLEN, MIN00039   CHARACTER STR(DUMMYSIZE), FMTCHR0005#0029   I=MIN0 (132,SLEN(STR))0017   IF (I > 0)0059      IF (FMTCHR == NO)				#EXPLICIT CARRIAGE CONTROL??0080         WRITE (LUN, 1, ERR=11, END=11) (STR(N),N=1,I)		#USE 1ST CHAR OF STR0014      ELSE0078         WRITE (LUN, 1, ERR=11, END=11) FMTCHR, (STR(N),N=1,I)	#USE FMTCHR0011   ELSE0052      WRITE (LUN, 1, ERR=11, END=11)		#NULL LINE^^^^^^^^^^^^^0024   1 FORMAT ( 133A1)0029   RETURN (YES)		#SUCCESS0005#0035   11 RETURN (BAD)		#ALL ERRORS0010   END00050035   INTEGER FUNCTION STRIM (STR)0005#0067# STRIM - REMOVE TRAILING BLANKS FROM THE RIGHT END OF A STRING0071#REMOVE ANY TRAILING BLANKS FROM THE RIGHT OF STR. THE VALUE OF THE0005#0053#  FUNCTION IS RETURNED AS THE NEW LENGTH OF STR.0005#0019   INTEGER SLEN0031   CHARACTER STR(DUMMYSIZE)0005#0022   STRIM=SLEN(STR)0046   WHILE (STRIM > 0 & STR(STRIM) == BLANK)0027      DECREMENT (STRIM)^^^^^^^^^^^^^0023   STR(STRIM+1)=EOS0005#0013   RETURN0010   END00050042   CHARFUNC FUNCTION TYPE FUNCSIZE (C)0005#0072# TYPE - DETERMINE IF A CHARACTER IS LETTER, DIGIT, OR SPECIAL CHAR.0037# SYKES 14 OCT 76, FASTER VERSION0067# PCN # 89, 10 FEB 80, SPEED UP 50% BY USING ONLY TABLE LOOKUP.0041#  **** ASCII CHARACTER SET ONLY ****0005#0005#0030   CHARACTER C, TYPES(127)0065   DATA TYPES /47*0,10*DIGIT,7*0,26*LETTER,6*0,26*LETTER,5*0/0005#0013   TYPE=00017   IF (C > 0)0023      TYPE=TYPES(C)0021   IF (TYPE == 0)^^^^^^^^0018      TYPE = C0005#0013   RETURN0010   END00050030   SUBROUTINE UNFOLD (STR)0005#0082# UNFOLD - CONVERT LOWER CASE ALPHABETIC CHARACTERS IN A STRING TO UPPER CASE.0018#SYKES 15MAY770041#  **** ASCII CHARACTER SET ONLY ****0005#0005#0031   CHARACTER STR(DUMMYSIZE)0016   INTEGER I0005#0019   DO I=1,HUGE 0028      IF (STR(I) == EOS)0019         RETURN0051      ELSE IF (STR(I) >= LETA & STR(I) <= LETZ)0029         STR(I)=STR(I)-320005#0013   RETURN0010   END^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^