C
C Subroutine file 'length.for' to facilitate string manipulation. C C Version: 6.20 C Date: 2008, April 23 C C Coded by: Ludek Klimes C Department of Geophysics, Charles University Prague, C Ke Karlovu 3, 121 16 Praha 2, Czech Republic, C E-mail: klimes@seis.karlov.mff.cuni.cz C C....................................................................... C C This file consists of the following external procedures: C LOWER...Subroutine changing a given character string to lowercase. C LOWER C UPPER...Subroutine changing a given character string to uppercase. C UPPER C LENGTH..Integer function to determine the length of a string C without trailing blanks. C LENGTH C STRIND..Character function to supplement a given string with C a given index. C STRIND C C======================================================================= C C C SUBROUTINE LOWER(TEXT) CHARACTER*(*) TEXT C C Subroutine changing a given character string to lowercase. C C Input: C TEXT... A given string. C C Output: C TEXT... The given string converted to lowercase. C C----------------------------------------------------------------------- C EXTERNAL LENGTH INTEGER LENGTH C C----------------------------------------------------------------------- C CHARACTER*1 LETTER INTEGER ISHIFT,I C ISHIFT=ICHAR('a')-ICHAR('A') DO 10 I=1,LENGTH(TEXT) LETTER=TEXT(I:I) IF('A'.LE.LETTER.AND.LETTER.LE.'Z') THEN TEXT(I:I)=CHAR(ICHAR(LETTER)+ISHIFT) END IF 10 CONTINUE RETURN END C C======================================================================= C C C SUBROUTINE UPPER(TEXT) CHARACTER*(*) TEXT C C Subroutine changing a given character string to uppercase. C C Input: C TEXT... A given string. C C Output: C TEXT... The given string converted to uppercase. C C----------------------------------------------------------------------- C EXTERNAL LENGTH INTEGER LENGTH C C----------------------------------------------------------------------- C CHARACTER*1 LETTER INTEGER ISHIFT,I C ISHIFT=ICHAR('A')-ICHAR('a') DO 10 I=1,LENGTH(TEXT) LETTER=TEXT(I:I) IF('a'.LE.LETTER.AND.LETTER.LE.'z') THEN TEXT(I:I)=CHAR(ICHAR(LETTER)+ISHIFT) END IF 10 CONTINUE RETURN END C C======================================================================= C C C INTEGER FUNCTION LENGTH(TEXT) CHARACTER*(*) TEXT C C Subroutine to determine the length of a string without trailing C blanks. C C Input: C TEXT... Character string. C C Output: C LENGTH..Length of the string without trailing blanks. C LENGTH=1 for a blank string. C C No subroutines and external functions required. C C Date: 1995, August 18 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C INTEGER I C C....................................................................... C DO 1 I=LEN(TEXT),1,-1 IF(TEXT(I:I).NE.' ') THEN GO TO 2 END IF 1 CONTINUE I=1 2 CONTINUE LENGTH=I C RETURN END C C======================================================================= C C CHARACTER*(*) FUNCTION STRIND(STR,IND) CHARACTER*(*) STR INTEGER IND C C Character function to supplement a given string with a given index. C C Input: C STR... Character string. C IND... Non-negative integer. C C Output: C STRIND..String composed of string STR (without trailing blanks) C and of the string representing integer IND (without C leading zeros or blanks). C Examples: STR='abc', IND=0, STRIND='abc0'; C STR='abc', IND=1, STRIND='abc1'; C STR='abc', IND=234, STRIND='abc234'. C C Subroutines and external functions required: EXTERNAL LENGTH INTEGER LENGTH C C Date: 2005, June 19 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C CHARACTER*4 FORMAT INTEGER I,L C C....................................................................... C STRIND=STR FORMAT='(I0)' L=LENGTH(STR) I=INT(ALOG10(FLOAT(IND)+0.5))+1 FORMAT(3:3)=CHAR(ICHAR('0')+I) WRITE(STRIND(L+1:L+I),FORMAT) IND RETURN END C C======================================================================= C