c
c--- strings.for
c
c	Subroutines for manipulating character strings
c
c		ridbl - remove blanks within a string
c		slen - find the length of a string without padding
c		caps - convert a string to all capital letters
c		lows - convert a string to all lower case letters
c
c
c
c
c----- Remove blanks within a string leaving IWORD spaces between
c	words and IEQUAL spaces after an equal sign
c
	SUBROUTINE RIDBL(STRING,IWORD,IEQUAL)
C
	CHARACTER STRING*(*),TEMP*144
	LOGICAL FLAG
C
C----- Get and check string length
C
	ILEN = LEN (STRING)
	IF (ILEN.GT.144) THEN
	  WRITE(6,1000)
 1000	  FORMAT(' SUBROUTINE RIDBL -- Error: string length too large')
	  RETURN
	ENDIF
C
C----- Presets
C
	FLAG = .TRUE.
	J = 0
	I = 1
C
C----- Check current index for blank
C
   10	IF (STRING(I:I).EQ.' ') GOTO 30
C
C----- Special handling of equal signs
C
   15	IF (STRING(I:I+1).EQ.'= ') FLAG = .FALSE.
C
C----- Advance index, save character
C
	J = J + 1
	TEMP(J:J) = STRING(I:I)
	I = I + 1
	IF (I .GT. ILEN) GO TO 50
	GO TO 10
C
C----- Deal with blanks
C
   30 	IF (FLAG) THEN
C
C------- Advance IWORD indices  (0 - no blanks between words)
C	  saving characters	(1 - one blank between words)
C
	  DO 32 K=1,IWORD
	    J = J + 1
	    TEMP(J:J) = STRING(I:I)
	    I = I + 1
   32	  CONTINUE
C
	  IF (I.GT.ILEN) GO TO 50
C
C------- Check for further blanks and do not save them
C
   35	  IF (STRING(I:I).NE.' ') GO TO 15
	  I = I + 1
	  IF (I.GT.ILEN) GO TO 50
	  GOTO 35
C
	ELSE		
C
C------- Reset flag and advance IEQUAL indices  (0 - no blanks after =)
C	  saving characters			(1 - one blank after =)
C
	  FLAG = .TRUE.
	  DO 37 K=1,IEQUAL
	    J = J + 1
	    TEMP(J:J) = STRING(I:I)
	    I = I + 1
   37	  CONTINUE
C
	  IF (I.GT.ILEN) GOTO 50
C
C------- Check for further blanks and do not save them
C
   40	  IF (STRING(I:I).NE.' ') GOTO 15
	  I = I + 1
	  IF (I.GT.ILEN) GOTO 50
	  GOTO 40
C
	ENDIF
C
C----- Assign new string value, left justified, right padded with blanks
C
   50	STRING = TEMP(1:J)
C
	RETURN
	END
c
c
c
c
c--- Function to find the length of a character string, not counting the
c     right padded blanks -- finds the last non-blank character
c
	INTEGER FUNCTION SLEN(STRING)
c
	CHARACTER STRING*(*)
c
	LENGTH = LEN(STRING)
c
	IF (LENGTH.EQ.0) THEN
	  SLEN = 0
	  RETURN
	ENDIF
c
	LDUMMY = LENGTH
	DO K=LENGTH,1,-1
	  IF (STRING(K:K).NE.' ') GOTO 11
	  LDUMMY = LDUMMY - 1
	ENDDO
c
   11	SLEN = LDUMMY
c
	END
c
c
c
c
c----- Ensures that all letters in a string are capitals
c
	SUBROUTINE CAPS(STRING)
C
	CHARACTER STRING*(*)
C
	length = len(string)
c
	DO I=1,LENGTH
C
	  INT = ICHAR(STRING(I:I))
	  IF (INT.GE.97.AND.INT.LE.122) STRING(I:I) = CHAR(INT-32)
C
	ENDDO
C
	END
c
c
c----- Ensures that all letters in a string are lower case
c
	subroutine lows(string)
C
	CHARACTER STRING*(*)
C
	length = len(string)
c
	DO I=1,LENGTH
C
	  INT = ICHAR(STRING(I:I))
	  IF (INT.GE.65.AND.INT.LE.90) STRING(I:I) = CHAR(INT+32)
C
	ENDDO
C
	END