
C STRING LIBRARY	FILE=STRLIB.RAT
C PCN #47, 4 APR 79, ADD ALLDIG,FOLD,SHELL,INDEX,TYPE,UNFOLD
C PCN #89, 10 FEB 80, SPEED UP SCOPY,SPAD,SCOMPR,TYPE
C
C EDITED TO PUT SUBPROGRAM DECLARATIONS IN FRONT OF COMMENTS FOR THAT
C SUBPROGRAM.  THIS ALLOWS F4 V2.2 TO KEEP COMMENTS IN THE RIGHT PLACE.
C BOB DENNY
C 25-MAR-80
C
C
C# ALLDIG - I   =ALLDIG(STR)
C# FOLD   - CALL FOLD  (STR)
C# EQLS   - I   =EQLS  (VEC, PATSTR)
C# INDEX  - COL =INDEX (STR, CHAR)
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 (VEC, START, STOP, CHAR)
C# SHELL  - CALL SHELL (LASTP, NAMPTR, TABLE)
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, VEC, 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, FMTCHR)
C# STRIM  - LEN =STRIM (STR)
C# TYPE   - C   =TYPE  (CHAR)
C# UNFOLD - CALL UNFOLD (STR)
CFILE=DEFIN.RAT  ===== GENERAL CHARACTER SET DEFINITIONS ===============
C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT.
C
C
CGENERAL COMMENTS:
C# NOTE: SOME OF THESE ROUTINES ARE SET UP TO WORK WITH ASCII CHARACTER SET ONLY.
C#THEREFORE, IF THE MACHINE'S NATIVE CHARACTER SET IS NOT ASCII, YOU MUST
C#USE 'INMAP' TO CONVERT TO ASCII BEFORE USING THESE ROUTINES. OR ELSE REWRITE
C#THESE ROUTINES.
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'.
CTHESE ROUTINES REQUIRE THAT THE COMPILER MAKE CORRECT COMPARES OF INTEGER
C VALUES BETWEEN INTEGERS AND WHATEVER DATA TYPE 'CHARACTER' IS DEFINED TO BE
C (LOGICAL*1 IN DEC-LAND).
C"STRINGS" ARE VECTORS OF CHARACTERS TERMINATED BY AN 'EOS'.
C THE LENGTH OF A STRING IS THE NUMBER OF CHARACTERS IN IT, NOT INCLUDING THE 'EOS'.
C"CHARACTERS" ARE SINGLE CHARACTERS, ONE PER STORAGE ELEMENT.
C"CHARACTER VECTORS" ARE VECTORS (OR ARRAYS) CONTAINING CHARACTERS BUT WITHOUT
C THE TERMINATING 'EOS'. THUS, A PART OF A STRING WHICH DOES NOT INCLUDE THE
C 'EOS' IS A CHARACTER VECTOR, AND A VECTOR WITH AN 'EOS' IS A STRING.
C
      INTEGER FUNCTION ALLDIG ( STR )
C ALLDIG - RETURN YES IF STR IS ALL DIGITS
C
C
      LOGICAL * 1 STR ( 1 ), TYPE
      INTEGER I
C
      IF (.NOT.( STR ( 1 ) .EQ. 0 )) GOTO 20000
      ALLDIG = ( 0 )
      RETURN
20000 CONTINUE
      DO 20002  I = 1, 32767
      IF (.NOT.( STR ( I ) .EQ. 0 )) GOTO 20004
      ALLDIG = ( 1 )
      RETURN
20004 CONTINUE
      IF (.NOT.( TYPE ( STR ( I ) ) .NE. - 20 )) GOTO 20006
      ALLDIG = ( 0 )
      RETURN
20006 CONTINUE
20005 CONTINUE
C
20002 CONTINUE
20003 CONTINUE
      END

      INTEGER FUNCTION EQLS ( VEC, PATSTR )
C
C EQLS - FUNCTION TO DO ANCHORED COMPARE OF STRING WITH CHAR VECTOR.
C STARTING AT BEGINNING OF VEC, COMPARE IT WITH PATSTR (WHICH MUST BE A
C  STRING). IF THE NEXT CHARACTERS OF VEC MATCH 1 FOR 1 THE CHARACTERS OF
C  PATSTR, RETURN THE VALUE OF THE FUNCTION AS 'YES', ELSE 'NO'.
C
C
      LOGICAL * 1 VEC ( 1 ), PATSTR ( 1 )
C
       I = 1
20008 IF (.NOT.( PATSTR ( I ) .NE. 0)) GOTO 20010
      IF (.NOT.( PATSTR ( I ) .NE. VEC ( I ) )) GOTO 20011
      EQLS = ( 0 )
      RETURN
20011 CONTINUE
20009 I = I + 1 
      GOTO 20008
20010 CONTINUE
      EQLS = ( 1 )
      RETURN
      END

      SUBROUTINE FOLD ( STR )
C
C FOLD - CONVERT UPPER CASE LETTERS IN A STRING TO LOWER CASE.
C15MAY77
C  **** ASCII CHARACTER SET ONLY ****
C
C
      LOGICAL * 1 STR ( 1 )
      INTEGER I
C
      DO 20013  I = 1, 32767
      IF (.NOT.( STR ( I ) .EQ. 0 )) GOTO 20015
      RETURN
20015 CONTINUE
      IF (.NOT.( STR ( I ) .GE. 65 .AND. STR ( I ) .LE. 90 )) GOTO 
     $20017
      STR ( I ) = STR ( I ) + 32
20017 CONTINUE
20016 CONTINUE
C
20013 CONTINUE
20014 CONTINUE
      RETURN
      END

      INTEGER FUNCTION INDEX ( STR, C )
C
C INDEX - FIND THE LOCATION OF A CHARACTER WITHIN A STRING.
C15MAY77
C THE VALUE OF THE FUNCTION IS RETURNED AS THE NUMBER OF THE ELEMENT
C  IN 'STR' WHERE THE FIRST OCCURRENCE OF CHARACTER 'C' IS FOUND
C  (STARTING AT THE LEFT END), OR AS 0, IF C IS NOT IN 'STR'.
C
C
      LOGICAL * 1 C, STR ( 1 )
C
      DO 20019  INDEX = 1, 32767
      IF (.NOT.( STR ( INDEX ) .EQ. 0 )) GOTO 20021
      INDEX = ( 0 )
      RETURN
20021 CONTINUE
      IF (.NOT.( STR ( INDEX ) .EQ. C )) GOTO 20023
      RETURN
20023 CONTINUE
20022 CONTINUE
C
20019 CONTINUE
20020 CONTINUE
      END

      SUBROUTINE SCOMM ( I, STR1, STR3, STR4 )
C
C SCOMM - USED BY SDECAT, SSUFX, SPREFX
C
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

      INTEGER FUNCTION SCOMPR ( STR1, STR2 )
C
C SCOMPR - COMPARE TWO STRINGS ALPHABETICALY.
C PCN #89, 10 FEB 80, SPEED UP 50%, REPLACE 'FOR' WITH 'DO'.
CRETURN 0 IF EQUAL. (STRINGS MUST BE SAME LENGTH)
CRETURN -1 IF STR1 IS CLOSER TO 'A' THEN STR2
CRETURN +1 IF STR1 IS CLOSER TO 'Z' THEN STR2
C  **** ASCII CHARACTER SET ONLY ****
C
C
      INTEGER I, J
      LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 )
C
      DO 20025  I = 1, 32767
      IF (.NOT.( STR1 ( I ) .EQ. STR2 ( I ) )) GOTO 20027
      IF (.NOT.( STR1 ( I ) .EQ. 0 )) GOTO 20029
      SCOMPR = ( 0 )
      RETURN
20029 CONTINUE
      GOTO 20028
20027 CONTINUE
      GOTO 20026
C
20028 CONTINUE
20025 CONTINUE
20026 CONTINUE
      IF (.NOT.( STR1 ( I ) .LT. STR2 ( I ) )) GOTO 20031
      SCOMPR = ( - 1 )
      RETURN
20031 CONTINUE
      SCOMPR = ( + 1 )
      RETURN
C
20032 CONTINUE
      END

      INTEGER FUNCTION SCOMPX ( STR1, STR2, CHAR )
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.
CFOR 1ST PART (BEFORE 'CHAR'), THE COMPARE ENDS WHEN EITHER STRING CONTAINS
C A 'CHAR'. IT THEN LINES UP THE 'CHAR' IN BOTH STRINGS AND COMPARES THE
C SECOND PART OF BOTH STRINGS UNTIL AN EOS IS FOUND IN EITHER STRING.
C THE STRINGS DO NOT HAVE TO BE THE SAME LENGTH (EITHER BEFORE OR AFTER THE
C 'CHAR') TO BE CONSIDERED A MATCH.
C  **** ASCII CHARACTER SET ONLY ****
CRETURNS -1 IF STR1 IS HIGHER ALPHABETICALLY THEN STR2
CRETURNS  0 IF STR1 IS EQUAL TO STR2, PIVOTING AROUND 'CHAR'.
CRETURNS +1 IF STR1 IS LOWER ALPHABETICALLY THEN STR2
C	IF	STR1="FIRST PART<SECOND PART"
C		CHAR='<"
C   THEN IF	STR2="FIRST<SECOND"	SCOMPX RETURNS 0
C		STR2="F<S"		SCOMPX RETURNS 0
C		STR2="AA<BB"		SCOMPX RETURNS +1
C
C
      INTEGER I, J
      LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 ), CHAR
C
      J = 1
       I = 1
20033 IF (.NOT.( STR1 ( I ) .NE. 0 .AND. STR2 ( J ) .NE. 0)) GOTO 20035
      IF (.NOT.( STR1 ( I ) .EQ. CHAR )) GOTO 20036
      CONTINUE
20038 IF (.NOT.( STR2 ( J ) .NE. CHAR .AND. STR2 ( J + 1 ) .NE. 0 )) 
     $GOTO 20039
      J = J + 1
      GOTO 20038
20039 CONTINUE
      GOTO 20037
20036 CONTINUE
      IF (.NOT.( STR2 ( J ) .EQ. CHAR )) GOTO 20040
      CONTINUE
20042 IF (.NOT.( STR1 ( I ) .NE. CHAR .AND. STR1 ( I + 1 ) .NE. 0 )) 
     $GOTO 20043
      I = I + 1
      GOTO 20042
20043 CONTINUE
      GOTO 20041
20040 CONTINUE
      IF (.NOT.( STR1 ( I ) .NE. STR2 ( J ) )) GOTO 20044
      IF (.NOT.( STR1 ( I ) .LT. STR2 ( J ) )) GOTO 20046
      SCOMPX = ( - 1 )
      RETURN
20046 CONTINUE
      SCOMPX = ( + 1 )
      RETURN
20047 CONTINUE
20044 CONTINUE
20041 CONTINUE
20037 CONTINUE
      J = J + 1
20034 I = I + 1 
      GOTO 20033
20035 CONTINUE
      SCOMPX = ( 0 )
      RETURN
C
      END

      INTEGER FUNCTION SCOPY ( STR1, STR2, MAX, ERROR )
C
C SCOPY - COPY ONE STRING INTO ANOTHER STRING
C PCN 89, 10FEB 80, MAKE 30% FASTER.
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
C
      INTEGER MAX, ERROR, I
      LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 )
C
      ERROR = 0
      DO 20048  I = 1, 32767
      IF (.NOT.( STR1 ( I ) .EQ. 0 )) GOTO 20050
      GOTO 20049
20050 CONTINUE
      IF (.NOT.( I .GT. MAX )) GOTO 20052
      ERROR = 1
      GOTO 20049
20052 CONTINUE
      STR2 ( I ) = STR1 ( I )
20053 CONTINUE
20051 CONTINUE
C
20048 CONTINUE
20049 CONTINUE
      STR2 ( I ) = 0
C
      SCOPY = ( I - 1 )
      RETURN
      END

      INTEGER FUNCTION SCTOI ( IN, I )
C
C SCTOI - CONVERT STRING AT IN(I) TO INTEGER, INCREMENT I.
CSTARTING AT LOCATION 'I' IN STRING 'IN', 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
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/
20054 IF (.NOT.( IN ( I ) .EQ. 32 .OR. IN ( I ) .EQ. 9 )) GOTO 20055
      I = I + 1
      GOTO 20054
20055 CONTINUE
      IF (.NOT.( IN ( I ) .EQ. 45 )) GOTO 20056
      I = I + 1
      PM = - 1
      GOTO 20057
20056 CONTINUE
      PM = + 1
C
20057 CONTINUE
       SCTOI = 0
20058 IF (.NOT.( IN ( I ) .NE. 0)) GOTO 20060
      D = SFIND ( DIGITS, 1, 10, IN ( I ) )
      IF (.NOT.( D .EQ. 0 )) GOTO 20061
      GOTO 20060
20061 CONTINUE
      SCTOI = 10 * SCTOI + D - 1
C
20059 I = I + 1 
      GOTO 20058
20060 CONTINUE
      IF (.NOT.( PM .LT. 0 )) GOTO 20063
      SCTOI = - SCTOI
20063 CONTINUE
      RETURN
      END

      SUBROUTINE SDECAT ( STR1, STR2, STR3, STR4 )
C
C SDECAT - BREAK A STRING INTO TWO SUBSTRINGS AT A CHARACTER.
CSTR1 IS BROKEN INTO STR3 AND STR4 AT THE LEFTMOST OCCURRENCE OF
C ANY CHARACTER  THAT IS ALSO ANYWHERE IN STR2. THE "BREAK CHARACTER"
C GOES INTO STR4. ALTHOUGH STR2 IS A STRING, IT IS USED AS A COLLECTION
C OF 1 OR MORE CHARACTERS TO BE CHECKED FOR.
C	IF	STR1="FILENAME.EXT"
C		STR2=":.;"
C	THEN SDECAT RETURNS:
C		STR3="FILENAME"
C		STR4=".EXT"
C
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 20065
      I = SLEN ( STR1 ) + 1
20065 CONTINUE
      CALL SCOMM ( I, STR1, STR3, STR4 )
C
      RETURN
      END

      INTEGER FUNCTION SEQL ( STR1, STR2 )
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  THEY MUST BOTH BE STRINGS, AND OF THE SAME LENGTH.
C
C
      LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 )
      INTEGER I
C
      DO 20067  I = 1, 32767
      IF (.NOT.( STR1 ( I ) .NE. STR2 ( I ) )) GOTO 20069
      SEQL = ( 0 )
      RETURN
20069 CONTINUE
      IF (.NOT.( STR1 ( I ) .EQ. 0 )) GOTO 20071
      SEQL = ( 1 )
      RETURN
C
20071 CONTINUE
20070 CONTINUE
20067 CONTINUE
20068 CONTINUE
      END

      SUBROUTINE SHELL ( LASTP, NAMPTR, TABLE )
C
C SHELL - TO SORT DEFINE TABLE INTO ALPHABETICAL ORDER FOR RATFOR
CSYKES 18 OCT 76,14MAR77
C
C
      INTEGER GAP, I, IG, J, K, SCOMPR, N
      INTEGER LASTP, NAMPTR ( 1 )
      LOGICAL * 1 TABLE ( 1 )
C
       GAP = LASTP / 2
20073 IF (.NOT.( GAP .GT. 0)) GOTO 20075
      CONTINUE
       J = GAP + 1
20076 IF (.NOT.( J .LE. LASTP)) GOTO 20078
      CONTINUE
       I = J - GAP
20079 IF (.NOT.( I .GT. 0)) GOTO 20081
      IG = I + GAP
      IF (.NOT.( SCOMPR ( TABLE ( NAMPTR ( I ) ), TABLE ( NAMPTR ( IG )
     $ ) ) .LE. 0 )) GOTO 20082
      GOTO 20081
20082 CONTINUE
      N = NAMPTR ( I )
      NAMPTR ( I ) = NAMPTR ( IG )
      NAMPTR ( IG ) = N
C
20080 I = I - GAP 
      GOTO 20079
20081 CONTINUE
20077 J = J + 1 
      GOTO 20076
20078 CONTINUE
20074 GAP = GAP / 2 
      GOTO 20073
20075 CONTINUE
      RETURN
      END

      INTEGER FUNCTION SFIND ( VEC, START, STOP, CHAR )
C
C SFIND - BOUNDED FAST SEARCH OF A CHARACTER VECTOR FOR A CHARACTER.
CSEARCHES A VECTOR, 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 ELEMENT IN 'VEC' WHERE
C  THE FIRST MATCH IS FOUND; OR AS 0, IF NO CHARACTER IN VEC MATCHES 'CHAR'.
C THIS IS NOT ANSII FORTRAN BECAUSE OF THE BACKWARD INCREMENT ON THE DO LOOP
C BUT IN F4P IS SOMEWHAT FASTER THEN STANDARD ROUTINES.
C	IF	VEC="ABCDEAFGH"
C		I=SFIND(VEC,1,8,BIGC)	RETURNS 3
C		I=SFIND(VEC,8,1,BIGC)	RETURNS 3
C		I=SFIND(VEC,1,8,BIGZ)	RETURNS 0
C		I=SFIND(VEC,2,7,BIGA)	RETURNS 6
C
C
      INTEGER START, STOP, I
      LOGICAL * 1 VEC ( 1 ), CHAR
C
      IF (.NOT.( START .GT. STOP )) GOTO 20084
      I = - 1
      GOTO 20085
20084 CONTINUE
      I = + 1
20085 CONTINUE
      DO 20086  SFIND = START, STOP, I
      IF (.NOT.( VEC ( SFIND ) .EQ. CHAR )) GOTO 20088
      RETURN
20088 CONTINUE
20086 CONTINUE
20087 CONTINUE
      SFIND = ( 0 )
      RETURN
C
      END

      INTEGER FUNCTION SINDX ( STR, PATN )
C
C SINDX - FIND THE LOCATION OF A SPECIFIED SUBSTRING WITHIN ANOTHER STRING.
CTHE FUNCTION 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	IF	STR1="ABADAFABCD"
C		PATN="ABC"
C
C
      INTEGER J, K
      LOGICAL * 1 STR ( 1 ), PATN ( 1 )
C
       SINDX = 1
20090 IF (.NOT.( STR ( SINDX ) .NE. 0)) GOTO 20092
      K = SINDX
      CONTINUE
       J = 1
20093 IF (.NOT.( PATN ( J ) .NE. 0)) GOTO 20095
      IF (.NOT.( PATN ( J ) .NE. STR ( K ) )) GOTO 20096
      GOTO 20095
20096 CONTINUE
      K = K + 1
20097 CONTINUE
20094 J = J + 1 
      GOTO 20093
20095 CONTINUE
      IF (.NOT.( PATN ( J ) .EQ. 0 )) GOTO 20098
      RETURN
20098 CONTINUE
      IF (.NOT.( STR ( K ) .EQ. 0 )) GOTO 20100
      GOTO 20092
20100 CONTINUE
20099 CONTINUE
20091 SINDX = SINDX + 1 
      GOTO 20090
20092 CONTINUE
      SINDX = ( 0 )
      RETURN
C
      END

      SUBROUTINE SINSRT ( STR1, STR2 )
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.  OTHERWISE, NO 'EOS' AT THE END
C   OF THE COPIED PART.
C
C
      INTEGER I, ENDS
      LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 )
C
      ENDS = 0
       I = 1
20102 IF (.NOT.( STR1 ( I ) .NE. 0)) GOTO 20104
      IF (.NOT.( STR2 ( I ) .EQ. 0 )) GOTO 20105
      ENDS = 1
20105 CONTINUE
      STR2 ( I ) = STR1 ( I )
20103 I = I + 1 
      GOTO 20102
20104 CONTINUE
      IF (.NOT.( ENDS .EQ. 1 )) GOTO 20107
      STR2 ( I ) = 0
C
20107 CONTINUE
      RETURN
      END

      INTEGER FUNCTION SITOC ( INT, STR, SIZE )
C
C SITOC - CONVERT INTEGER  INT  TO 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
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
20109 CONTINUE
      I = I + 1
      D = MOD ( INTVAL, 10 )
      STR ( I ) = DIGITS ( D + 1 )
      INTVAL = INTVAL / 10
20110 IF (.NOT.( INTVAL .EQ. 0 .OR. I .GE. SIZE )) GOTO 20109
20111 CONTINUE
      IF (.NOT.( INT .LT. 0 .AND. I .LT. SIZE )) GOTO 20112
      I = I + 1
      STR ( I ) = 45
20112 CONTINUE
      SITOC = I - 1
       J = 1
20114 IF (.NOT.( J .LT. I)) GOTO 20116
      K = STR ( I )
      STR ( I ) = STR ( J )
      STR ( J ) = K
      I = I - 1
C
20115 J = J + 1 
      GOTO 20114
20116 CONTINUE
      RETURN
      END

      INTEGER FUNCTION SJOIN ( STR1, STR2, MAX, ERROR )
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
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

      INTEGER FUNCTION SLEN ( STR )
C
C SLEN - FUNCTION TO RETURN THE LENGTH OF STRING (NOT INCLUDING THE EOS)
C
C
      LOGICAL * 1 STR ( 1 )
C
      DO 20117  I = 1, 32767
      IF (.NOT.( STR ( I ) .EQ. 0 )) GOTO 20119
      SLEN = ( I - 1 )
      RETURN
C
20119 CONTINUE
20117 CONTINUE
20118 CONTINUE
      END

      INTEGER FUNCTION SMIDV ( STR1, STR2, STR3, STR4, MAX, ERROR )
C
C SMIDV - SELECT A SUBSTRING FROM 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	IF	STR1="DEV:FILE.EXT"
C		STR2=":"
C		STR3="."
C	THEN SMIDV RETURNS:
C		I=4,        ERROR='NO'
C		STR4="FILE"
C
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 20121
      I = I + SLEN ( STR2 )
      J = SINDX ( STR1 ( I ), STR3 )
20121 CONTINUE
      IF (.NOT.( I .GT. 0 .AND. J .GT. 0 )) GOTO 20123
      IF (.NOT.( J .LE. MAX )) GOTO 20125
      J = I + J - 2
      ERROR = 0
      GOTO 20126
20125 CONTINUE
      ERROR = 1
      J = I + MAX - 1
20126 CONTINUE
      SMIDV = SMOVE ( STR1, I, J, STR4, 1 )
      STR4 ( SMIDV + 1 ) = 0
      GOTO 20124
20123 CONTINUE
      ERROR = 0
      SMIDV = 0
      STR4 ( 1 ) = 0
C
20124 CONTINUE
      RETURN
      END

      INTEGER FUNCTION SMOVE ( STR1, FROM, TO, VEC, START )
C
C SMOVE - BOUNDED MOVE OF CHARACTERS FROM A STRING OR VECTOR TO A VECTOR.
CMOVE THE CHARACTERS IN STR1 BETWEEN 'FROM' & 'TO' (INCLUSIVE)
C  TO VEC, STARTING AT LOCATION 'START'. NO 'EOS' IS PLACED AT THE
C  END OF THE MOVED CHARACTERS.
C  IF THE END OF STR1 IS REACHED BEFORE LOCATION 'TO', THE TRANSFER
C  IS STOPPED.  THE VALUE OF THE FUNCTION IS RETURNED AS THE LAST
C  (RIGHTMOST) LOCATION IN VEC MODIFIED.
C
C
      INTEGER FROM, TO, START, I
      LOGICAL * 1 STR1 ( 1 ), VEC ( 1 )
C
      SMOVE = START - 1
      DO 20127  I = FROM, TO
      IF (.NOT.( STR1 ( I ) .EQ. 0 )) GOTO 20129
      GOTO 20128
20129 CONTINUE
      SMOVE = SMOVE + 1
      VEC ( SMOVE ) = STR1 ( I )
20130 CONTINUE
20127 CONTINUE
20128 CONTINUE
      IF (.NOT.( SMOVE .LT. START )) GOTO 20131
      SMOVE = ( 0 )
      RETURN
C
20131 CONTINUE
      RETURN
      END

      INTEGER FUNCTION SNUMBR ( STR, START, STOP, NUM, NCOL )
C
C SNUMBR - FUNCTION TO CONVERT A CHARACTER VECTOR TO AN INTEGER.
CSTARTING AT 'START', EXTRACT A INTEGER FROM 'STR' AND RETURN
C  IT AS THE VALUE OF THE FUNCTION AND AS 'NUM'; IGNORE BLANKS, BUT QUIT AT THE
C  FIRST NON-DIGIT/BLANK FOUND, BUT IN ANY CASE DO NOT GO PAST COLUMN 'STOP'.
C  RETURN IN 'NCOL' THE NUMBER OF THE NEXT COLUMN TO THE RIGHT IN 'STR'.
C
C
      INTEGER START, STOP, NUM, I, J, SCTOI, NCOL
      LOGICAL * 1 STR ( 1 ), TOK ( 7 ), TYPE
C
      J = 1
       I = START
20133 IF (.NOT.( J .LE. 7 .AND. I .LE. STOP)) GOTO 20135
      IF (.NOT.( STR ( I ) .EQ. 32 )) GOTO 20136
      GOTO 20134
20136 CONTINUE
      IF (.NOT.( TYPE ( STR ( I ) ) .NE. - 20 .AND. STR ( I ) .NE. 45 )
     $) GOTO 20138
      GOTO 20135
20138 CONTINUE
      TOK ( J ) = STR ( I )
      J = J + 1
20139 CONTINUE
20137 CONTINUE
20134 I = I + 1 
      GOTO 20133
20135 CONTINUE
      TOK ( J ) = 0
      NCOL = I
      I = 1
      NUM = SCTOI ( TOK, I )
C
      SNUMBR = ( NUM )
      RETURN
      END

      SUBROUTINE SPAD ( STR, LEN )
C
C SPAD - FILL A STRING UP TO A SPECIFIED LENGTH WITH BLANKS
C PCN # 89, 10 FEB 80, SPEED UP 13%, REPLACE 'FOR' WITH 'DO'.
CPAD THE RIGHTHAND END OF STR WITH BLANKS OUT TO 'LEN'.
C  STR BECOMES A STRING OF LENGTH 'LEN'.
C
C
      INTEGER LEN, SLEN, I
      LOGICAL * 1 STR ( 1 )
C
      I = SLEN ( STR ) + 1
      IF (.NOT.( I .LE. LEN )) GOTO 20140
      DO 20142  J = I, LEN
      STR ( J ) = 32
20142 CONTINUE
20143 CONTINUE
20140 CONTINUE
      STR ( LEN + 1 ) = 0
C
      RETURN
      END

      INTEGER FUNCTION SPOSTV ( STR1, STR2, STR3, MAX, ERROR )
C
C SPOSTV - SELECT A SUBSTRING FROM  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	IF	STR1="FILENAME.EXT"
C		STR2="."
C	THEN SPOSTV RETURNS     I=3,      ERROR='NO'
C		STR3="EXT"
C
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 20144
      STR3 ( 1 ) = 0
      ERROR = 0
      SPOSTV = ( 0 )
      RETURN
20144 CONTINUE
      I = I + SLEN ( STR2 )
      SPOSTV = SCOPY ( STR1 ( I ), STR3, MAX, ERROR )
C
20145 CONTINUE
      RETURN
      END

      SUBROUTINE SPREFX ( STR1, STR2, STR3, STR4 )
C
C SPREFX - SEPERATE A PREFIX SUBSTRING FROM A STRING.
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 BREAK CHARACTER GOES INTO STR4.
C IF NONE OF THE CHARACTERS IN STR2 IS FOUND IN STR1, ALL OF STR1 IS MOVED
C  INTO STR4 AND STR3 IS NULL.
CALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE
C CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE
C IMPORTANT.
C	IF	STR1="FILENAME.EXT"
C		STR2=":.;"
C	THEN SPREFX RETURNS:
C		STR3="FILENAME"
C		STR4=".EXT"
C
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 20146
      I = 1
20146 CONTINUE
      CALL SCOMM ( I, STR1, STR3, STR4 )
C
      RETURN
      END

      INTEGER FUNCTION SPREV ( STR1, STR2, STR3, MAX, ERROR )
C
C SPREV - SELECT A SUBSTRING FROM THE LEFT END OF A STRING.
CMOVE THE PART OF STR1 TO THE LEFT OF 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	IF	STR1="FILENAME.EXT;2"
C		STR2=".EXT"
C	THEN SPREV RETURNS:
C		I=8,       ERROR='NO'
C		STR3="FILENAME"
C
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 20148
      STR3 ( 1 ) = 0
      ERROR = 0
      SPREV = ( 0 )
      RETURN
20148 CONTINUE
      I = I - 1
      IF (.NOT.( I .LE. MAX )) GOTO 20150
      ERROR = 0
      GOTO 20151
20150 CONTINUE
      I = MAX
      ERROR = 1
20151 CONTINUE
      SPREV = SMOVE ( STR1, 1, I, STR3, 1 )
      STR3 ( SPREV + 1 ) = 0
C
20149 CONTINUE
      RETURN
      END

      INTEGER FUNCTION SREPT ( STR1, NUM, STR2, MAX, ERROR )
C
C SREPT - DUPLICATE A STRING INTO ANOTHER STRING SEVERAL TIMES.
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	IF	STR1="*-*"
C		STR2=""
C	THEN	I=SREPT(STR1,5,STR2,9,ERROR)	RETURNS:
C		I=9,       ERROR='YES'
C		STR2="*-**-**-*"
C
C
      INTEGER NUM, MAX, ERROR, SCOPY, I
      LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 )
C
      SREPT = 0
       I = 1
20152 IF (.NOT.( I .LE. NUM)) GOTO 20154
      SREPT = SCOPY ( STR1, STR2 ( SREPT + 1 ), MAX - SREPT, ERROR ) + 
     $SREPT
      IF (.NOT.( ERROR .EQ. 1 )) GOTO 20155
      GOTO 20154
20155 CONTINUE
C
20153 I = I + 1 
      GOTO 20152
20154 CONTINUE
      RETURN
      END

      INTEGER FUNCTION SSAME ( STR1, STR2, LORR )
C
C SSAME - RETURN LOCATION OF FIRST CHARACTER IN STR1 ALSO IN STR2
CSCAN STR1 FROM LEFT TO RIGHT (IF LORR IS >0) OR FROM RIGHT TO LEFT
C  (IF LORR 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.
CALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE
C CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE
C IMPORTANT.
C	IF	STR1="ABCDE7FGH"
C		STR2="0123456789"
C	THEN 	I=SSAME(STR1,STR2,+1) RETURNS:
C		I=6
C
C
      INTEGER LORR, SLEN, I
      LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 )
C
      IF (.NOT.( LORR .GT. 0 )) GOTO 20157
      SSAME = 1
      GOTO 20158
20157 CONTINUE
      SSAME = SLEN ( STR1 )
20158 CONTINUE
20159 IF (.NOT.( SSAME .GT. 0 .AND. STR1 ( SSAME ) .NE. 0 )) GOTO 20160
      CONTINUE
       I = 1
20161 IF (.NOT.( STR2 ( I ) .NE. 0)) GOTO 20163
      IF (.NOT.( STR1 ( SSAME ) .EQ. STR2 ( I ) )) GOTO 20164
      RETURN
20164 CONTINUE
20162 I = I + 1 
      GOTO 20161
20163 CONTINUE
      IF (.NOT.( LORR .GT. 0 )) GOTO 20166
      SSAME = SSAME + 1
      GOTO 20167
20166 CONTINUE
      SSAME = SSAME - 1
20167 CONTINUE
      GOTO 20159
20160 CONTINUE
      SSAME = ( 0 )
      RETURN
C
      END

      INTEGER FUNCTION SSAMEX ( STR1, STR2, LOOR )
C
C SSAMEX - RETURN LOCATION OF 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.
CALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE
C CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE
C IMPORTANT.
C	IF	STR1="123456ABC"
C		STR2="0123456789"
C	THEN	I=SSAMEX(STR1,STR2,+1)	RETURNS:
C		I=7
C
C
      INTEGER I, LOOR, SLEN
      LOGICAL * 1 STR1 ( 1 ), STR2 ( 1 )
C
      IF (.NOT.( LORR .GT. 0 )) GOTO 20168
      SSAMEX = 1
      GOTO 20169
20168 CONTINUE
      SSAMEX = SLEN ( STR1 )
20169 CONTINUE
20170 IF (.NOT.( SSAMEX .GT. 0 .AND. STR1 ( SSAMEX ) .NE. 0 )) GOTO 
     $20171
      CONTINUE
       I = 1
20172 IF (.NOT.( STR2 ( I ) .NE. 0)) GOTO 20174
      IF (.NOT.( STR1 ( SSAMEX ) .EQ. STR2 ( I ) )) GOTO 20175
      GOTO 20174
20175 CONTINUE
20173 I = I + 1 
      GOTO 20172
20174 CONTINUE
      IF (.NOT.( STR2 ( I ) .EQ. 0 )) GOTO 20177
      RETURN
20177 CONTINUE
      IF (.NOT.( LORR .GT. 0 )) GOTO 20179
      SSAMEX = SSAMEX + 1
      GOTO 20180
20179 CONTINUE
      SSAMEX = SSAMEX - 1
20180 CONTINUE
20178 CONTINUE
      GOTO 20170
20171 CONTINUE
      SSAMEX = ( 0 )
      RETURN
C
      END

      SUBROUTINE SSUFX ( STR1, STR2, STR3, STR4 )
C
C SSUFX - SEPERATE OUT A SUFFEX SUBSTRING.
CMOVE CHARACTERS FROM STR1 INTO STR3 WHICH ARE TO THE RIGHT OF THE FIRST
C  OCCURENCE 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.
CIF NONE OF THE CHARACTERS IN STR2 IS FOUND IS STR1, ALL OF STR1 GOES INTO
C STR4 AND STR3 IS NULL.
CALTHOUGH STR2 IS A STRING, IT IS REALLY USED AS A COLLECTION OF SEPERATE
C CHARACTERS, NOT AS A STRING WHERE THE ORDER OF THE CHARACTERS WOULD BE
C IMPORTANT.
C	IF	STR1="FILENAME.EXT"
C		STR2=":.;"
C	THEN SSUFX RETURNS:
C		STR3="EXT"
C		STR4="FILENAME."
C
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 20181
      I = SLEN ( STR1 )
20181 CONTINUE
      I = I + 1
C
      CALL SCOMM ( I, STR1, STR4, STR3 )
C
      RETURN
      END

      INTEGER FUNCTION SSWAP ( STR1, STR2, STR3, STR4, MAX, ERROR )
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. STR2 AND STR3 NEED NOT BE SAME
C  LENGTH.
C	IF	STR1="FILENAME.FTN;3"
C		STR2="FTN"
C		STR3="OBJ"
C	THEN SSWAP RETURNS:
C		I=14
C		STR4="FILENAME.OBJ;3"
C
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 20183
      STR4 ( 1 ) = 0
      ERROR = 0
      SSWAP = ( 0 )
      RETURN
20183 CONTINUE
      IF (.NOT.( I .GT. MAX )) GOTO 20185
      ERROR = 1
      I = MAX + 1
      GOTO 20186
20185 CONTINUE
      ERROR = 0
20186 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  ONCE STR4 REACHES 'MAX' LENGTH, SJOIN WILL NOT ADD TO IT.
C
20184 CONTINUE
      RETURN
      END

      INTEGER FUNCTION STRGET ( LUN, STR, MAX )
C
C STRGET - READ A STRING FROM A SPECIFIED LUN.
C PCN #77, 6 JAN 80, ALLOW FOR SKIP-RECORD DUMMY READS
C PCN #81, 13 JAN 80, FIX SUBSCRIPT ERROR F4P GENERATES IF MAX IS 0.
C **CAUTION: THIS ROUTINE TRUSTS FORTRAN TO MOVE INTO THE BUFFER ONLY THAT
C **PART OF THE RECORD CALLED FOR BY 'MAX'. DEC'S FORTRAN IV V2.1 (AT LEAST)
C **HAS A BUG WHICH CAUSES IT TO ALWAYS READ A FULL RECORD. THEREFORE, IF YOUR
C **BUFFER IS SMALLER THEN THE RECORD SIZE, IT READS MORE INTO THE BUFR THEN
C **IT HAS ROOM FOR, KLOBBERING GOD-KNOWS-WHAT IN YOUR PROGRAM. BEST TO TEST
C **THIS OR ALWAYS GIVE STRGET A BUFFER AS BIG AS THE LARGEST POSSIBLE RECORD.
C
C
      INTEGER LUN, MAX, N
      LOGICAL * 1 STR ( 1 )
C
      IF (.NOT.( MAX .GT. 0 )) GOTO 20187
      READ ( LUN, 1, END = 100, ERR = 101 ) STRGET, ( STR ( N ), N = 1,
     $ MAX )
1     FORMAT ( Q, 132A1 )
      STR ( STRGET + 1 ) = 0
      RETURN
20187 CONTINUE
      READ ( LUN, 1, END = 100, ERR = 101 )
      STR ( 1 ) = 0
      STRGET = ( 0 )
      RETURN
C
20188 CONTINUE
100   STR ( 1 ) = 0
      STRGET = ( - 3 )
      RETURN
C
101   STR ( 1 ) = 0
      STRGET = ( - 1 )
      RETURN
C
      END

      INTEGER FUNCTION STRPUT ( LUN, STR, FMTCHR )
C
C STRPUT - WRITE A STRING TO A SPECIFIED LUN.
C PCN 77, 5 JAN 80, ADD A FORMAT CONTROL CHAR TO CALLING SEQUENCE
C
C
      INTEGER LUN, I, N, SLEN, MIN0
      LOGICAL * 1 STR ( 1 ), FMTCHR
C
      I = MIN0 ( 132, SLEN ( STR ) )
      IF (.NOT.( I .GT. 0 )) GOTO 20189
      IF (.NOT.( FMTCHR .EQ. 0 )) GOTO 20191
      WRITE ( LUN, 1, ERR = 11, END = 11 ) ( STR ( N ), N = 1, I )
      GOTO 20192
20191 CONTINUE
      WRITE ( LUN, 1, ERR = 11, END = 11 ) FMTCHR, ( STR ( N ), N = 1, 
     $I )
20192 CONTINUE
      GOTO 20190
20189 CONTINUE
      WRITE ( LUN, 1, ERR = 11, END = 11 )
20190 CONTINUE
1     FORMAT ( 133A1 )
      STRPUT = ( 1 )
      RETURN
C
11    STRPUT = ( - 1 )
      RETURN
      END

      INTEGER FUNCTION STRIM ( STR )
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
C  FUNCTION IS RETURNED AS THE NEW LENGTH OF STR.
C
      INTEGER SLEN
      LOGICAL * 1 STR ( 1 )
C
      STRIM = SLEN ( STR )
20193 IF (.NOT.( STRIM .GT. 0 .AND. STR ( STRIM ) .EQ. 32 )) GOTO 20194
      STRIM = STRIM - 1
      GOTO 20193
20194 CONTINUE
      STR ( STRIM + 1 ) = 0
C
      RETURN
      END

      LOGICAL FUNCTION TYPE * 1 ( C )
C
C TYPE - DETERMINE IF A CHARACTER IS LETTER, DIGIT, OR SPECIAL CHAR.
C SYKES 14 OCT 76, FASTER VERSION
C PCN # 89, 10 FEB 80, SPEED UP 50% BY USING ONLY TABLE LOOKUP.
C  **** ASCII CHARACTER SET ONLY ****
C
C
      LOGICAL * 1 C, TYPES ( 127 )
      DATA TYPES / 47 * 0, 10 * - 20, 7 * 0, 26 * - 30, 6 * 0, 26 * - 
     $30, 5 * 0 /
C
      TYPE = 0
      IF (.NOT.( C .GT. 0 )) GOTO 20195
      TYPE = TYPES ( C )
20195 CONTINUE
      IF (.NOT.( TYPE .EQ. 0 )) GOTO 20197
      TYPE = C
C
20197 CONTINUE
      RETURN
      END

      SUBROUTINE UNFOLD ( STR )
C
C UNFOLD - CONVERT LOWER CASE ALPHABETIC CHARACTERS IN A STRING TO UPPER CASE.
CSYKES 15MAY77
C  **** ASCII CHARACTER SET ONLY ****
C
C
      LOGICAL * 1 STR ( 1 )
      INTEGER I
C
      DO 20199  I = 1, 32767
      IF (.NOT.( STR ( I ) .EQ. 0 )) GOTO 20201
      RETURN
20201 CONTINUE
      IF (.NOT.( STR ( I ) .GE. 97 .AND. STR ( I ) .LE. 122 )) GOTO 
     $20203
      STR ( I ) = STR ( I ) - 32
C
20203 CONTINUE
20202 CONTINUE
20199 CONTINUE
20200 CONTINUE
      RETURN
      END

