module string_utils 17
implicit none
private
! Public interface methods
public ::&
to_upper, & ! Convert character string to upper case
to_lower, & ! Convert character string to lower case
INCSTR, & ! increments a string
GLC ! Position of last significant character in string
contains
function to_upper(str) 13,2
!-----------------------------------------------------------------------
! Purpose:
! Convert character string to upper case.
!
! Method:
! Use achar and iachar intrinsics to ensure use of ascii collating sequence.
!
! Author: B. Eaton, July 2001
!
! $Id$
!-----------------------------------------------------------------------
implicit none
character(len=*), intent(in) :: str ! String to convert to upper case
character(len=len(str)) :: to_upper
! Local variables
integer :: i ! Index
integer :: aseq ! ascii collating sequence
integer :: lower_to_upper ! integer to convert case
character(len=1) :: ctmp ! Character temporary
!-----------------------------------------------------------------------
lower_to_upper = iachar("A") - iachar("a")
do i = 1, len(str)
ctmp = str(i:i)
aseq = iachar(ctmp)
if ( aseq >= iachar("a") .and. aseq <= iachar("z") ) &
ctmp = achar(aseq + lower_to_upper)
to_upper
(i:i) = ctmp
end do
end function to_upper
function to_lower(str) 7,1
!-----------------------------------------------------------------------
! Purpose:
! Convert character string to lower case.
!
! Method:
! Use achar and iachar intrinsics to ensure use of ascii collating sequence.
!
! Author: B. Eaton, July 2001
!
! $Id$
!-----------------------------------------------------------------------
implicit none
character(len=*), intent(in) :: str ! String to convert to lower case
character(len=len(str)) :: to_lower
! Local variables
integer :: i ! Index
integer :: aseq ! ascii collating sequence
integer :: upper_to_lower ! integer to convert case
character(len=1) :: ctmp ! Character temporary
!-----------------------------------------------------------------------
upper_to_lower = iachar("a") - iachar("A")
do i = 1, len(str)
ctmp = str(i:i)
aseq = iachar(ctmp)
if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) &
ctmp = achar(aseq + upper_to_lower)
to_lower
(i:i) = ctmp
end do
end function to_lower
integer function INCSTR( s, inc ) 2,2
!-----------------------------------------------------------------------
! ... Increment a string whose ending characters are digits.
! The incremented integer must be in the range [0 - (10**n)-1]
! where n is the number of trailing digits.
! Return values:
!
! 0 success
! -1 error: no trailing digits in string
! -2 error: incremented integer is out of range
!-----------------------------------------------------------------------
implicit none
!-----------------------------------------------------------------------
! ... Dummy variables
!-----------------------------------------------------------------------
integer, intent(in) :: &
inc ! value to increment string (may be negative)
character(len=*), intent(inout) :: &
s ! string with trailing digits
!-----------------------------------------------------------------------
! ... Local variables
!-----------------------------------------------------------------------
integer :: &
i, & ! index
lstr, & ! number of significant characters in string
lnd, & ! position of last non-digit
ndigit, & ! number of trailing digits
ival, & ! integer value of trailing digits
pow, & ! power of ten
digit ! integer value of a single digit
lstr = GLC
( s )
lnd = LASTND
( s )
ndigit = lstr - lnd
if( ndigit == 0 ) then
INCSTR = -1
return
end if
!-----------------------------------------------------------------------
! ... Calculate integer corresponding to trailing digits.
!-----------------------------------------------------------------------
ival = 0
pow = 0
do i = lstr,lnd+1,-1
digit = ICHAR(s(i:i)) - ICHAR('0')
ival = ival + digit * 10**pow
pow = pow + 1
end do
!-----------------------------------------------------------------------
! ... Increment the integer
!-----------------------------------------------------------------------
ival = ival + inc
if( ival < 0 .or. ival > 10**ndigit-1 ) then
INCSTR = -2
return
end if
!-----------------------------------------------------------------------
! ... Overwrite trailing digits
!-----------------------------------------------------------------------
pow = ndigit
do i = lnd+1,lstr
digit = MOD( ival,10**pow ) / 10**(pow-1)
s(i:i) = CHAR( ICHAR('0') + digit )
pow = pow - 1
end do
INCSTR = 0
end function INCSTR
integer function LASTND( cs ) 1,1
!-----------------------------------------------------------------------
! ... Position of last non-digit in the first input token.
! Return values:
! > 0 => position of last non-digit
! = 0 => token is all digits (or empty)
!-----------------------------------------------------------------------
implicit none
!-----------------------------------------------------------------------
! ... Dummy arguments
!-----------------------------------------------------------------------
character(len=*), intent(in) :: cs ! Input character string
!-----------------------------------------------------------------------
! ... Local variables
!-----------------------------------------------------------------------
integer :: n, nn, digit
n = GLC
( cs )
if( n == 0 ) then ! empty string
LASTND = 0
return
end if
do nn = n,1,-1
digit = ICHAR( cs(nn:nn) ) - ICHAR('0')
if( digit < 0 .or. digit > 9 ) then
LASTND = nn
return
end if
end do
LASTND = 0 ! all characters are digits
end function LASTND
integer function GLC( cs ) 2
!-----------------------------------------------------------------------
! ... Position of last significant character in string.
! Here significant means non-blank or non-null.
! Return values:
! > 0 => position of last significant character
! = 0 => no significant characters in string
!-----------------------------------------------------------------------
implicit none
!-----------------------------------------------------------------------
! ... Dummy arguments
!-----------------------------------------------------------------------
character(len=*), intent(in) :: cs ! Input character string
!-----------------------------------------------------------------------
! ... Local variables
!-----------------------------------------------------------------------
integer :: l, n
l = LEN( cs )
if( l == 0 ) then
GLC = 0
return
end if
do n = l,1,-1
if( cs(n:n) /= ' ' .and. cs(n:n) /= CHAR(0) ) then
exit
end if
end do
GLC = n
end function GLC
end module string_utils