C STRING LIBRARY FILE=STRLIB.RAT C#SCOMPR - I =SCOMPR(STR1, STR2) C#SCOMPX - I =SCOMPX(STR1, STR2, CHAR) C#SCOPY - LEN2=SCOPY (STR1, STR2, MAX, ERROR) C#SCTOI - NUM =SCTOI (STR, NCOL) C#SDECAT - CALL SDECAT(STR1, STR2, STR3, STR4) C#SEQL - I =SEQL (STR1, STR2) C#SFIND - COL =SFIND (STR, START, STOP, CHAR) C#SINDX - COL =SINDX (STR1, STR2) C#SINSRT - CALL SINSRT(STR1, STR2) C#SITOC - LEN =SITOC (NUM, STR, MAX) C#SJOIN - LEN2=SJOIN (STR1, STR2, MAX, ERROR) C#SLEN - LEN =SLEN (STR) C#SMIDV - LEN4=SMIDV (STR1, STR2, STR3, STR4, MAX, ERROR) C#SMOVE - I =SMOVE (STR1, FROM, TO, STR2, START) C#SNUMBR - NUM =SNUMBR(STR, START, STOP, NUM, NCOL) C#SPAD - CALL SPAD (STR, LEN) C#SPOSTV - LEN3=SPOSTV(STR1, STR2, STR3, MAX, ERROR) C#SPREFX - CALL SPREFX(STR1, STR2, STR3, STR4) C#SPREV - LEN3=SPREV (STR1, STR2, STR3, MAX, ERROR) C#SREPT - LEN2=SREPT (STR1, NUM, STR2, MAX, ERROR) C#SSAME - ICOL=SSAME (STR1, STR2, LORR) C#SSAMEX - ICOL=SSAMEX(STR1, STR2, LOOR) C#SSUFX - CALL SSUFX (STR1, STR2, STR3, STR4) C#SSWAP - LEN4=SSWAP (STR1, STR2, STR3, STR4, MAX, ERROR) C#STRGET - LEN =STRGET(LUN STR, MAX) C#STRPUT - ERR =STRPUT(LUN, STR) C#STRIM - LEN =STRIM (STR) CFILE=DEFIN.RAT GENERAL CHARACTER SET DEFINITIONS FOR RATFOR C C CGENERAL COMMENTS: C#ROUTINES THAT PRODUCE AN OUTPUT STRING GENERALY ALLOW A 'MAX' SIZE C FOR THE OUTPUT STRING TO BE SPECIFIED. THE OUTPUT IS CUT TO 'MAX' C CHARACTERS IF NECESSARY; IF IT IS,THE INTEGER 'ERROR' IS SET TO YES C (OTHERWISE TO NO) TO ALERT THAT TRUNCATION WAS NECESSARY. C ONE EXTRA ARRAY ELEMENT AT THE END OF THE STRING IS ALWAYS NECESSARY C (BEYOND MAX) FOR THE EOS. CSUBROUTINE CALLS SPECIFYING A SPECIFIC ARRAY ELEMENT (EG. STR(I)) CAUSE C ACTION TO BE TAKEN (AND RETURN VALUES AND MAX TO BE CALCULATED, IF C APPROPRIATE FROM THE SPECIFIED ELEMENT, NOT THE WHOLE STRING (FROM ELEMENT C 1) SINCE ONLY THE STRING STARTING AT THE SPECIFIED ELEMENT IS KNOWN C TO THE SUBROUTINE. EG J=SLEN(STRI)) SETS J TO THE NUMBER OF ELEMENTS C BETWEEN I AND EOS. C C SCOMM - USED BY SDECAT, SSUFX, SPREFX C SUBROUTINE SCOMM ( I, STR1, STR3, STR4 ) C INTEGER I, SMOVE, J LOGICAL * 1 STR1 ( 1 ), STR3 ( 1 ), STR4 ( 1 ) C J = SMOVE ( STR1, 1, I - 1, STR3, 1 ) STR3 ( J + 1 ) = 0 J = SMOVE ( STR1, I, 32767, STR4, 1 ) STR4 ( J + 1 ) = 0 C RETURN END C C SCOMPR - COMPARE TWO STRINGS ALPHABETICALY CRETURN 0 IF EQUAL CRETURN -1 IF STR1 IS CLOSER TO 'A' THEN STR2 CRETURN +1 IF STR1 IS CLOSER TO 'Z' THEN STR2 C INTEGER FUNCTION SCOMPR ( STR1, STR2 ) C INTEGER I, J LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ) C J = 1 I = 1 20000 IF (.NOT.( STR1 ( I ) .EQ. STR2 ( J ))) GOTO 20002 IF (.NOT.( STR1 ( I ) .EQ. 0 )) GOTO 20003 SCOMPR = 0 RETURN 20003 CONTINUE J = J + 1 C 20004 CONTINUE 20001 I = I + 1 GOTO 20000 20002 CONTINUE IF (.NOT.( STR1 ( I ) .LT. STR2 ( J ) )) GOTO 20005 SCOMPR = - 1 GOTO 20006 20005 CONTINUE SCOMPR = + 1 C 20006 CONTINUE RETURN END C C SCOMPX - COMPARE 2 SPECIAL STRINGS ALPHABETICALLY CCOMPAR THE SECTIONS OF 2 STRINGS BEFORE AND AFTER THE 'CHAR' SEPERATOR C INDEPENDENTLY. 0 IS RETURNED IF THE FIRST PART (UP TO 'CHAR')MATCHES C AND THE SECOND PART (FROM 'CHAR' TO EOS) MATCHES. C INTEGER FUNCTION SCOMPX ( STR1, STR2, CHAR ) C CRETURNS -1 IF STR1 IS HIGHER ALPHABETICALLY THEN STR2 CRETURNS 0 IF STR1 IS EQUAL TO STR2 CRETURNS +1 IF STR1 IS LOWER ALPHABETICALLY THEN STR2 C INTEGER I, J LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ), CHAR C J = 1 I = 1 20007 IF (.NOT.( STR1 ( I ) .NE. 0 .AND. STR2 ( J ) .NE. 0)) GOTO 20009 IF (.NOT.( STR1 ( I ) .EQ. CHAR )) GOTO 20010 CONTINUE 20012 IF (.NOT.( STR2 ( J ) .NE. CHAR .AND. STR2 ( J + 1 ) .NE. 0 )) $GOTO 20013 J = J + 1 GOTO 20012 20013 CONTINUE GOTO 20011 20010 CONTINUE IF (.NOT.( STR2 ( J ) .EQ. CHAR )) GOTO 20014 CONTINUE 20016 IF (.NOT.( STR1 ( I ) .NE. CHAR .AND. STR1 ( I + 1 ) .NE. 0 )) $GOTO 20017 I = I + 1 GOTO 20016 20017 CONTINUE GOTO 20015 20014 CONTINUE IF (.NOT.( STR1 ( I ) .NE. STR2 ( J ) )) GOTO 20018 IF (.NOT.( STR1 ( I ) .LT. STR2 ( J ) )) GOTO 20020 SCOMPX = - 1 GOTO 20021 20020 CONTINUE SCOMPX = 1 20021 CONTINUE RETURN 20018 CONTINUE 20015 CONTINUE 20011 CONTINUE J = J + 1 20008 I = I + 1 GOTO 20007 20009 CONTINUE SCOMPX = 0 C RETURN END C C SCOPY - COPY ONE STRING INTO ANOTHER STRING CCOPYING STOPS WHEN THE END OF STR1 IS REACHED, OR WHEN C STR2 GETS TO BE 'MAX' CHAR. LONG (ERROR IS SET). C VALUE OF THE FUCTION IS RETURNED AS THE LENGTH OF STR2. C INTEGER FUNCTION SCOPY ( STR1, STR2, MAX, ERROR ) C INTEGER MAX, ERROR, I LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ) C SCOPY = 0 ERROR = 0 DO 20022 I = 1, 32767 IF (.NOT.( STR1 ( I ) .EQ. 0 )) GOTO 20024 GOTO 20023 20024 CONTINUE IF (.NOT.( SCOPY .GE. MAX )) GOTO 20026 ERROR = 1 GOTO 20023 20026 CONTINUE SCOPY = SCOPY + 1 STR2 ( SCOPY ) = STR1 ( I ) 20027 CONTINUE 20025 CONTINUE C 20022 CONTINUE 20023 CONTINUE STR2 ( SCOPY + 1 ) = 0 C RETURN END C C SCTOI - CONVERT STRING AT IN(I) TO INTEGER, INCREMENT I CSTARTING AT LOCATION 'I', LEADING BLANKS/TABS ARE SKIPPED; C THEN ALL DIGITS UP TO THE NEXT NON-DIGIT (INCLUDING BLANKS) C ARE CONVERTED TO A POSITIVE OR NEGATIVE INTEGER AND RETURNED C AS THE VALUE OF THE FUNCTION. 'I' IS INCREMENTED AND UPON RETURN C POINTS TO THE LOCATION OF THE FIRST NON-DIGIT. C INTEGER FUNCTION SCTOI ( IN, I ) C LOGICAL * 1 IN ( 1 ) INTEGER D, I, SFIND, PM LOGICAL * 1 DIGITS (11) C DATA DIGITS/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,0/ 20028 IF (.NOT.( IN ( I ) .EQ. 32 .OR. IN ( I ) .EQ. 9 )) GOTO 20029 I = I + 1 GOTO 20028 20029 CONTINUE IF (.NOT.( IN ( I ) .EQ. 45 )) GOTO 20030 I = I + 1 PM = - 1 GOTO 20031 20030 CONTINUE PM = + 1 C 20031 CONTINUE SCTOI = 0 20032 IF (.NOT.( IN ( I ) .NE. 0)) GOTO 20034 D = SFIND ( DIGITS, 1, 10, IN ( I ) ) IF (.NOT.( D .EQ. 0 )) GOTO 20035 GOTO 20034 20035 CONTINUE SCTOI = 10 * SCTOI + D - 1 C 20033 I = I + 1 GOTO 20032 20034 CONTINUE IF (.NOT.( PM .LT. 0 )) GOTO 20037 SCTOI = - SCTOI 20037 CONTINUE RETURN END C C SDECAT - BREAK A STRING INTO TWO SUBSTRINGS AT A CHARACTER CSTR1 IS BROKEN INTO STR3 AND STR4 AT THE LEFTMOST OCCURRANCE (IN STR1) OF C ANY CHARACTER THAT IS ALSO ANYWHERE IN STR2. THE "BREAK CHARACTER" C GOES INTO STR4. C SUBROUTINE SDECAT ( STR1, STR2, STR3, STR4 ) C INTEGER I, J, SSAME, SLEN LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ), STR3 ( 1 ), STR4 ( 1 ) C I = SSAME ( STR1, STR2, + 1 ) IF (.NOT.( I .LE. 0 )) GOTO 20039 I = SLEN ( STR1 ) + 1 20039 CONTINUE CALL SCOMM ( I, STR1, STR3, STR4 ) C RETURN END C C SEQL - COMPARE STR1 TO STR2; RETURN YES IF EQUAL, CSTR1 IS COMPARED CHARACTER BY CHARACTER TO STR2; IF THEY MATCH ALL THE WAY C THRU, THE FUNCTION VALUE IS RETURNED AS 'YES', IF NOT, AS 'NO'. C INTEGER FUNCTION SEQL ( STR1, STR2 ) C LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ) INTEGER I C DO 20041 I = 1, 32767 IF (.NOT.( STR1 ( I ) .NE. STR2 ( I ) )) GOTO 20043 GOTO 20042 20043 CONTINUE IF (.NOT.( STR1 ( I ) .EQ. 0 )) GOTO 20045 SEQL = 1 RETURN 20045 CONTINUE 20044 CONTINUE 20041 CONTINUE 20042 CONTINUE SEQL = 0 C RETURN END C C SINDX - FIND A STRING WITHIN ANOTHER STRING CFUNCTION VALUE IS RETURNED AS THE LOCATION WITHIN STR WHERE C PATN STARTS; OR AS 0, IF PATN DOES NOT OCCUR IN STR. C IF PATN IS NULL, IT IS CONSIDERED TO MATCH AT LOCATION 1. C INTEGER FUNCTION SINDX ( STR, PATN ) C INTEGER J, K LOGICAL * 1 STR ( 1 ), PATN ( 1 ) C SINDX = 1 20047 IF (.NOT.( STR ( SINDX ) .NE. 0)) GOTO 20049 K = SINDX CONTINUE J = 1 20050 IF (.NOT.( PATN ( J ) .NE. 0)) GOTO 20052 IF (.NOT.( PATN ( J ) .NE. STR ( K ) )) GOTO 20053 GOTO 20052 20053 CONTINUE K = K + 1 20054 CONTINUE 20051 J = J + 1 GOTO 20050 20052 CONTINUE IF (.NOT.( PATN ( J ) .EQ. 0 )) GOTO 20055 RETURN 20055 CONTINUE IF (.NOT.( STR ( K ) .EQ. 0 )) GOTO 20057 GOTO 20049 20057 CONTINUE 20056 CONTINUE 20048 SINDX = SINDX + 1 GOTO 20047 20049 CONTINUE SINDX = 0 C RETURN END C C SFIND - FAST SEARCH OF A STRING FOR A CHARACTER CSEARCHES A STRING EITHER FROM LEFT TO RIGHT OR RIGHT TO LEFT, C DEPENDING ON THE RELATIVE VALUES OF START AND STOP, FOR A SPECIFIED C CHARACTER AND RETURNS AS THE FUNCTION VALUE THE COLUMN IN STR WHERE C THE FIRST MATCH IS FOUND; OR AS 0, IF NO CHARACTER IN STR MATCHES CHAR. C THIS IS NOT ANSII FORTRAN BECAUSE OF THE BACKWARD INCREMENT ON THE DO LOOP C BUT IN F4P IS SOMEWHAT FASTER THE STANDARD ROUTINES. C INTEGER FUNCTION SFIND ( STR, START, STOP, CHAR ) C INTEGER START, STOP, I LOGICAL * 1 STR ( 1 ), CHAR C IF (.NOT.( START .GT. STOP )) GOTO 20059 I = - 1 GOTO 20060 20059 CONTINUE I = + 1 20060 CONTINUE DO 20061 SFIND = START, STOP, I IF (.NOT.( STR ( SFIND ) .EQ. CHAR )) GOTO 20063 RETURN 20063 CONTINUE 20061 CONTINUE 20062 CONTINUE SFIND = 0 C RETURN END C C SINSRT - INSERT A STRING INTO ANOTHER STRING CCOPY ALL OF STR1 INTO STR2; IF THIS OVERRUNS THE END OF STR2, C MAKE STR2 LONGER TO HOLD ALL OF STR1. C SUBROUTINE SINSRT ( STR1, STR2 ) C INTEGER I, ENDS LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ) C ENDS = 0 I = 1 20065 IF (.NOT.( STR1 ( I ) .NE. 0)) GOTO 20067 IF (.NOT.( STR2 ( I ) .EQ. 0 )) GOTO 20068 ENDS = 1 20068 CONTINUE STR2 ( I ) = STR1 ( I ) 20066 I = I + 1 GOTO 20065 20067 CONTINUE IF (.NOT.( ENDS .EQ. 1 )) GOTO 20070 STR2 ( I ) = 0 C 20070 CONTINUE RETURN END C C SITOC - CONVERT INTEGER INT TO CHAR STRING IN STR LEFT JUSTIFIED CCONVERT THE POSITIVE OR NEGATIVE INTEGER 'INT' TO A CHARACTER STRING C IN 'STR'. TRUNCATE THE STRING IF IT GOES BEYOND 'SIZE' CHARACTERS. C RETURN THE ACTUAL NUMBER OF CHARACTERS IN 'STR' AS THE VALUE OF THE FUNCTION. C INTEGER FUNCTION SITOC ( INT, STR, SIZE ) C INTEGER IABS, MOD INTEGER D, I, INT, INTVAL, J, K, SIZE LOGICAL * 1 STR ( SIZE ) LOGICAL * 1 DIGITS (11) C DATA DIGITS/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,0/ INTVAL = IABS ( INT ) STR ( 1 ) = 0 I = 1 20072 CONTINUE I = I + 1 D = MOD ( INTVAL, 10 ) STR ( I ) = DIGITS ( D + 1 ) INTVAL = INTVAL / 10 20073 IF (.NOT.( INTVAL .EQ. 0 .OR. I .GE. SIZE )) GOTO 20072 20074 CONTINUE IF (.NOT.( INT .LT. 0 .AND. I .LT. SIZE )) GOTO 20075 I = I + 1 STR ( I ) = 45 20075 CONTINUE SITOC = I - 1 J = 1 20077 IF (.NOT.( J .LT. I)) GOTO 20079 K = STR ( I ) STR ( I ) = STR ( J ) STR ( J ) = K I = I - 1 C 20078 J = J + 1 GOTO 20077 20079 CONTINUE RETURN END C C SJOIN - CONCATINATE A STRING TO THE END OF ANOTHER STRING, CADD STR2 TO THE END OF STR1 (IN STR1). MOVE ALL OF STR2 OR UNTIL C STR1 IS 'MAX' CHARS LONG (IN WHICH CASE, SET ERROR=YES) C RETURN THE VALUE OF THE FUNCTION AS THE NEW LENGTH OF STR1. C INTEGER FUNCTION SJOIN ( STR1, STR2, MAX, ERROR ) C INTEGER MAX, ERROR, I, SLEN, SCOPY LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ) C I = SLEN ( STR1 ) SJOIN = SCOPY ( STR2, STR1 ( I + 1 ), MAX - I, ERROR ) + I C RETURN END C C SLEN - COMPUTE LENGTH OF STRING (NOT INCLUDING THE EOS) C INTEGER FUNCTION SLEN ( STR ) C LOGICAL * 1 STR ( 1 ) C DO 20080 SLEN = 1, 32767 IF (.NOT.( STR ( SLEN ) .EQ. 0 )) GOTO 20082 GOTO 20081 20082 CONTINUE 20080 CONTINUE 20081 CONTINUE SLEN = SLEN - 1 C RETURN END C C SMIDV - SELECT THE MIDDLE OF A STRING CMOVE THE CHARACTERS IN STR1 THAT ARE BETWEEN STR2 AND STR3 (IN STR1) C INTO STR4. TRUNCATE STR4 TO 'MAX' CHARS (AND SET ERROR) IF NECESSARY. C THE VALUE OF THE FUNCTION IS RETURNED AS THE ACTUAL LENGTH OF STR4. C IF EITHER STR2 OR STR3 ARE NOT IN STR1, STR4 IS NULL. C INTEGER FUNCTION SMIDV ( STR1, STR2, STR3, STR4, MAX, ERROR ) C INTEGER MAX, ERROR INTEGER SLEN, SINDX, SMOVE, J, I LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ), STR3 ( 1 ), STR4 ( 1 ) C I = SINDX ( STR1, STR2 ) IF (.NOT.( I .GT. 0 )) GOTO 20084 I = I + SLEN ( STR2 ) J = SINDX ( STR1 ( I ), STR3 ) 20084 CONTINUE IF (.NOT.( I .GT. 0 .AND. J .GT. 0 )) GOTO 20086 IF (.NOT.( J .LE. MAX )) GOTO 20088 J = I + J - 2 ERROR = 0 GOTO 20089 20088 CONTINUE ERROR = 1 J = I + MAX - 1 20089 CONTINUE SMIDV = SMOVE ( STR1, I, J, STR4, 1 ) STR4 ( SMIDV + 1 ) = 0 GOTO 20087 20086 CONTINUE ERROR = 0 SMIDV = 0 STR4 ( 1 ) = 0 C 20087 CONTINUE RETURN END C C SMOVE - MOVE CHARACTERS FROM ONE STRING TO ANOTHER CMOVE THE CHARACTERS IN STR1 BETWEEN 'FROM' & 'TO' (INCLUSIVE) C TO STR2, STARTING AT LOCATION 'START'. NO EOS IS PLACED AT THE C END OF THE MOVED CHARACTERS, SO THEY MUST NOT EXTEND STR2. C IF THE END OF STR1 IS REACHED BEFORE LOCATION 'TO', THE TRANSFER C IS ABORTED. THE VALUE OF THE FUNCTION IS RETURNED AS THE LAST C (RIGHTMOST) LOCATION IN STR2 MODIFIED. C INTEGER FUNCTION SMOVE ( STR1, FROM, TO, STR2, START ) C INTEGER FROM, TO, START, I LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ) C SMOVE = START - 1 DO 20090 I = FROM, TO IF (.NOT.( STR1 ( I ) .EQ. 0 )) GOTO 20092 GOTO 20091 20092 CONTINUE SMOVE = SMOVE + 1 STR2 ( SMOVE ) = STR1 ( I ) 20093 CONTINUE 20090 CONTINUE 20091 CONTINUE IF (.NOT.( SMOVE .LT. START )) GOTO 20094 SMOVE = 0 C 20094 CONTINUE RETURN END C C SNUMBR - FUNCTION TO CONVERT A CHARACTER STRING TO AN INTEGER CSTARTING AT START, EXTRACT A INTEGER FROM STR AND RETURN C IT AS THE VALUE OF THE FUNCTION; IGNORE BLANKS, BUT QUIT AT THE C FIRST NON-DIGIT/BLANK FOUND, BUT IN ANY CASE DO NOT GO PAST COL. STOP. C RETURN IN NCOL AND AS THE VALUE OF THE FUNCTION THE NUMBER OF THE NEXT COL C TO THE RIGHT IN STR. C INTEGER FUNCTION SNUMBR ( STR, START, STOP, NUM, NCOL ) C INTEGER START, STOP, NUM, I, J, SCTOI, NCOL LOGICAL * 1 STR ( 1 ), TOK ( 7 ), TYPE C J = 1 I = START 20096 IF (.NOT.( J .LE. 7 .AND. I .LE. STOP)) GOTO 20098 IF (.NOT.( STR ( I ) .EQ. 32 )) GOTO 20099 GOTO 20097 20099 CONTINUE IF (.NOT.( TYPE ( STR ( I ) ) .NE. - 20 .AND. STR ( I ) .NE. 45 ) $) GOTO 20101 GOTO 20098 20101 CONTINUE TOK ( J ) = STR ( I ) J = J + 1 20102 CONTINUE 20100 CONTINUE 20097 I = I + 1 GOTO 20096 20098 CONTINUE TOK ( J ) = 0 NCOL = I I = 1 NUM = SCTOI ( TOK, I ) SNUMBR = NUM C RETURN END C C SPAD - FILL A STRING UP TO A SPECIFIED LENGTH WITH BLANKS CPAD THE RIGHTHAND END OF STR WITH BLANKS OUT TO 'LEN'. C STR BECOMES A STRING OF LENGTH 'LEN'. C SUBROUTINE SPAD ( STR, LEN ) C INTEGER LEN, SLEN, I LOGICAL * 1 STR ( 1 ) C I = SLEN ( STR ) + 1 20103 IF (.NOT.( I .LE. LEN)) GOTO 20105 STR ( I ) = 32 20104 I = I + 1 GOTO 20103 20105 CONTINUE STR ( LEN + 1 ) = 0 C RETURN END C C SPOSTV - SELECT THE RIGHT END OF A STRING CMOVE INTO STR3 ALL OF STR1 TO THE RIGHT OF THE END OF STR2(WITHIN STR1) C BUT TRUNCATE STR3 TO 'MAX' CHARS (AND SET ERROR) IF NECESSARY. C THE VALUE OF THE FUNCTION IS RETURNED AS THE ACUTAL NEW LENGTH OF STR3 C STR3 IS NULL IF STR2 IS NOT FOUND WITHIN STR1. C IF STR2 IS NULL, ALL OF STR1 GOES TO STR3. C INTEGER FUNCTION SPOSTV ( STR1, STR2, STR3, MAX, ERROR ) C INTEGER MAX, ERROR, I, SCOPY, SINDX, SLEN LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ), STR3 ( 1 ) C I = SINDX ( STR1, STR2 ) IF (.NOT.( I .LE. 0 )) GOTO 20106 STR3 ( 1 ) = 0 ERROR = 0 SPOSTV = 0 GOTO 20107 20106 CONTINUE I = I + SLEN ( STR2 ) SPOSTV = SCOPY ( STR1 ( I ), STR3, MAX, ERROR ) C 20107 CONTINUE RETURN END C C SPREFX - SEPERATE OUT A PREFIX CMOVE INTO STR3 THAT PART OF STR1 WHICH IS TO THE LEFT OF THE FIRST CHAR ALSO C FOUND (ANYWHERE) IN STR2. MOVE INTO STR4 THE REST OF STR1. STR3 AND STR4 ARE C NEW STRINGS. THE LEFTMOST OCCURRANCE IN STR1 OF ANY CHAR IN STR2 IS THE C "BREAK POINT". THE PIVOT CHARACTER GOES INTO STR4. C IF NONE IS FOUND IN STR2, ALL OF STR1 IS MOVED INTO STR4 AND STR3 IS NULL. C SUBROUTINE SPREFX ( STR1, STR2, STR3, STR4 ) C INTEGER I, SSAME LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ), STR3 ( 1 ), STR4 ( 1 ) C I = SSAME ( STR1, STR2, + 1 ) IF (.NOT.( I .LE. 0 )) GOTO 20108 I = 1 20108 CONTINUE CALL SCOMM ( I, STR1, STR3, STR4 ) C RETURN END C C SPREV - SELECT THE LEFT END OF A STRING CMOVE THE PART OF STR1 BEFORE THE START OF STR2 INTO STR3. C TRUNCATE STR3 TO 'MAX' CHARS (AND SET ERROR) IF NECESSARY. C THE VALUE OF THE FUNCTION IS RETURNED AS THE LENGTH OF STR3. C STR3 IS NULL IF STR2 IS NOT FOUND WITHIN STR1. C IF STR2 IS NULL, ALL OF STR1 GOES TO STR3. C INTEGER FUNCTION SPREV ( STR1, STR2, STR3, MAX, ERROR ) C INTEGER MAX, ERROR, I, SINDX, SMOVE LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ), STR3 ( 1 ) C I = SINDX ( STR1, STR2 ) IF (.NOT.( I .LE. 0 )) GOTO 20110 STR3 ( 1 ) = 0 ERROR = 0 SPREV = 0 GOTO 20111 20110 CONTINUE I = I - 1 IF (.NOT.( I .LE. MAX )) GOTO 20112 ERROR = 0 GOTO 20113 20112 CONTINUE I = MAX ERROR = 1 20113 CONTINUE SPREV = SMOVE ( STR1, 1, I, STR3, 1 ) STR3 ( SPREV + 1 ) = 0 C 20111 CONTINUE RETURN END C C SREPT - DUPLICATE A STRING INTO ANOTHER STRING CFILL STR2 WITH 'NUM' CONCATINATED COPIES OF STR1, BUT TRUNCATE C STR2 AT 'MAX' CHAR(AND SET ERROR) IF NECESSARY. C THE VALUE OF THE FUNCTION IS RETURNED AS THE ACUTAL NEW C LENGTH OF STR2. C INTEGER FUNCTION SREPT ( STR1, NUM, STR2, MAX, ERROR ) C INTEGER NUM, MAX, ERROR, SCOPY, I LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ) C SREPT = 0 I = 1 20114 IF (.NOT.( I .LE. NUM)) GOTO 20116 SREPT = SCOPY ( STR1, STR2 ( SREPT + 1 ), MAX - SREPT, ERROR ) + $SREPT IF (.NOT.( ERROR .EQ. 1 )) GOTO 20117 GOTO 20116 20117 CONTINUE C 20115 I = I + 1 GOTO 20114 20116 CONTINUE RETURN END C C SSAME - FIND FIRST CHARACTER IN STR1 ALSO IN STR2 CSCAN STR1 FROM LEFT TO RIGHT (IF LORR IS >0) OR FROM RIGHT TO LEFT C (IF LTOR IS <0) AND RETURN THE VALUE OF THE FUNCTION AS THE POSITION C IN STR1 WHERE THE FIRST CHARACTER IS FOUND THAT IS ALSO ANYWHERE IN STR2, C OR AS 0, IF NO CHARACTERS IN STR1 ARE FOUND IN STR2. C INTEGER FUNCTION SSAME ( STR1, STR2, LORR ) C INTEGER LORR, SLEN, I LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ) C IF (.NOT.( LORR .GT. 0 )) GOTO 20119 SSAME = 1 GOTO 20120 20119 CONTINUE SSAME = SLEN ( STR1 ) 20120 CONTINUE 20121 IF (.NOT.( SSAME .GT. 0 .AND. STR1 ( SSAME ) .NE. 0 )) GOTO 20122 CONTINUE I = 1 20123 IF (.NOT.( STR2 ( I ) .NE. 0)) GOTO 20125 IF (.NOT.( STR1 ( SSAME ) .EQ. STR2 ( I ) )) GOTO 20126 RETURN 20126 CONTINUE 20124 I = I + 1 GOTO 20123 20125 CONTINUE IF (.NOT.( LORR .GT. 0 )) GOTO 20128 SSAME = SSAME + 1 GOTO 20129 20128 CONTINUE SSAME = SSAME - 1 20129 CONTINUE GOTO 20121 20122 CONTINUE SSAME = 0 C RETURN END C C SSAMEX - FIND FIRST CHARACTER IN STR1 NOT ALSO IN STR2 CSCAN STR1 FROM THE LEFT (IF LORR > 0) OR FROM THE RIGHT (IF LOOR <0) C AND RETURN THE VALUE OF THE FUNCTION AS THE LOCATION WITHIN STR1 OF C THE FIRST CHARACTER NOT FOUND (ANYWHERE) IN STR2 , OR AS 0, C IF EVERYTHING IN STR1 IS IN STR2. C INTEGER FUNCTION SSAMEX ( STR1, STR2, LOOR ) C INTEGER I, LOOR, SLEN LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ) C IF (.NOT.( LORR .GT. 0 )) GOTO 20130 SSAMEX = 1 GOTO 20131 20130 CONTINUE SSAMEX = SLEN ( STR1 ) 20131 CONTINUE 20132 IF (.NOT.( SSAMEX .GT. 0 .AND. STR1 ( SSAMEX ) .NE. 0 )) GOTO $20133 CONTINUE I = 1 20134 IF (.NOT.( STR2 ( I ) .NE. 0)) GOTO 20136 IF (.NOT.( STR1 ( SSAMEX ) .EQ. STR2 ( I ) )) GOTO 20137 GOTO 20136 20137 CONTINUE 20135 I = I + 1 GOTO 20134 20136 CONTINUE IF (.NOT.( STR2 ( I ) .EQ. 0 )) GOTO 20139 RETURN 20139 CONTINUE IF (.NOT.( LORR .GT. 0 )) GOTO 20141 SSAMEX = SSAMEX + 1 GOTO 20142 20141 CONTINUE SSAMEX = SSAMEX - 1 20142 CONTINUE 20140 CONTINUE GOTO 20132 20133 CONTINUE SSAMEX = 0 C RETURN END C C SSUFX - SEPERATE OUT A SUFFEX CMOVE CHARACTERS FROM STR1 INTO STR3 WHICH ARE TO THE RIGHT OF THE FIRST C OCCURANCE OF ANY CHARACTER FROM STR2 IN STR1, SCANNING RIGHT-TO-LEFT. C MOVE THE REMAINDER OF STR1 INTO STR4. FIRST CHARACTER IN STR1 TO MATCH C ANY CHARACTER IN STR2 IS THE "BREAK CHAR", AND IT GOES INTO STR4. C IF NONE IS FOUND IS STR2, ALL OF STR1 GOES INTO STR4 AND STR3 IS NULL. C SUBROUTINE SSUFX ( STR1, STR2, STR3, STR4 ) C INTEGER I, SSAME, SLEN LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ), STR3 ( 1 ), STR4 ( 1 ) C I = SSAME ( STR1, STR2, - 1 ) IF (.NOT.( I .LE. 0 )) GOTO 20143 I = SLEN ( STR1 ) 20143 CONTINUE I = I + 1 C CALL SCOMM ( I, STR1, STR4, STR3 ) C RETURN END C C SSWAP - EXCHANGE PART OF A STRING FOR ANOTHER STRING CMOVE STR1 INTO STR4, EXCEPT THAT THE PART OF STR1 THAT MATCHES STR2 C IS REPLACED BY STR3. THE VALUE OF THE FUNCTION IS RETURNED AS THE C ACTUAL LENGTH OF STR4, OR AS 0, IF STR2 CANNOT BE FOUND. STR4 IS TRUNCATED C TO 'MAX' (AND ERROR IS SET) IF NECESSARY. C ONCE STR4 REACHES 'MAX' LENGTH, SJOIN WILL NOT ADD TO IT. C INTEGER FUNCTION SSWAP ( STR1, STR2, STR3, STR4, MAX, ERROR ) C INTEGER MAX, ERROR, SINDX, SJOIN, SMOVE, I, SLEN LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ), STR3 ( 1 ), STR4 ( 1 ) C I = SINDX ( STR1, STR2 ) IF (.NOT.( I .LE. 0 )) GOTO 20145 STR4 ( 1 ) = 0 ERROR = 0 SSWAP = 0 GOTO 20146 20145 CONTINUE IF (.NOT.( I .GT. MAX )) GOTO 20147 ERROR = 1 I = MAX + 1 GOTO 20148 20147 CONTINUE ERROR = 0 20148 CONTINUE SSWAP = SMOVE ( STR1, 1, I - 1, STR4, 1 ) STR4 ( SSWAP + 1 ) = 0 SSWAP = SJOIN ( STR4, STR3, MAX, ERROR ) I = I + SLEN ( STR2 ) SSWAP = SJOIN ( STR4, STR1 ( I ), MAX, ERROR ) C 20146 CONTINUE RETURN END C C STRGET - READ A STRING FROM A SPECIFIED LUN C INTEGER FUNCTION STRGET ( LUN, STR, MAX ) C INTEGER LUN, MAX, N LOGICAL * 1 STR ( MAX ) C READ ( LUN, 1, END = 100, ERR = 101 ) STRGET, ( STR ( N ), N = 1, $ MAX ) 1 FORMAT ( Q, 132A1 ) STR ( STRGET + 1 ) = 0 RETURN C 100 STRGET = - 3 STR ( 1 ) = 0 RETURN C 101 STRGET = - 1 STR ( 1 ) = 0 RETURN C END C C STRPUT - WRITE A STRING TO A SPECIFIED LUN C INTEGER FUNCTION STRPUT ( LUN, STR ) C INTEGER LUN, I, N, SLEN, MIN0 LOGICAL * 1 STR ( 1 ) C I = MIN0 ( 132, SLEN ( STR ) ) IF (.NOT.( I .GT. 0 )) GOTO 20149 WRITE ( LUN, 1, ERR = 11, END = 11 ) ( STR ( N ), N = 1, I ) 1 FORMAT ( 1X, 132A1 ) GOTO 20150 20149 CONTINUE WRITE ( LUN, 1, ERR = 11, END = 11 ) 20150 CONTINUE STRPUT = 1 RETURN C 11 STRPUT = - 1 RETURN END C C STRIM - REMOVE TRAILING BLANKS FROM THE RIGHT END OF A STRING CREMOVE ANY TRAILING BLANKS FROM THE RIGHT OF STR. THE VALUE OF THE C FUNCTION IS RETURNED AS THE NEW LENGTH OF STR. C INTEGER FUNCTION STRIM ( STR ) C INTEGER SLEN LOGICAL * 1 STR ( 1 ) C STRIM = SLEN ( STR ) 20151 IF (.NOT.( STRIM .GT. 0 .AND. STR ( STRIM ) .EQ. 32 )) GOTO 20152 STRIM = STRIM - 1 GOTO 20151 20152 CONTINUE STR ( STRIM + 1 ) = 0 C RETURN END C TYPE - RETURN LETTER, DIGIT, OR CHARACTER TYPE C SYKES 14 OCT 76, FASTER VERSION C THIS ONE WORKS IF INTERNAL CHAR. SET IS ASCII C LOGICAL FUNCTION TYPE * 1 ( C ) C LOGICAL * 1 C, TYPES ( 75 ) DATA TYPES / 10 * - 20, 7 * 0, 26 * - 30, 6 * 0, 26 * - 30 / C IF (.NOT.( C .LE. 122 .AND. C .GE. 48 )) GOTO 20039 TYPE = TYPES ( C - 47 ) GOTO 20040 20039 CONTINUE TYPE = 0 20040 CONTINUE IF (.NOT.( TYPE .EQ. 0 )) GOTO 20041 TYPE = C C 20041 CONTINUE RETURN END C INDEX - FIND CHARACTER C IN STRING STR C15MAY77 C INTEGER FUNCTION INDEX ( STR, C ) C LOGICAL * 1 C, STR ( 1 ) C DO 20020 INDEX = 1, 32767 IF (.NOT.( STR ( INDEX ) .EQ. 0 )) GOTO 20022 GOTO 20021 20022 CONTINUE IF (.NOT.( STR ( INDEX ) .EQ. C )) GOTO 20024 RETURN 20024 CONTINUE 20023 CONTINUE 20020 CONTINUE 20021 CONTINUE INDEX = 0 C RETURN END