Character Functions

[Anthony Iannetti]

Has anybody used Purple Sage Computing's character functions? I have
looked at them, but they seem a little complicated to set up. Does
anybody know of any other character functions for fortran?

Thanks,
Tony

[Richard Maine]

Anthony Iannetti <ai...@pike.grc.nasa.gov> writes:

> Does anybody know of any other character functions for fortran?

"Character functions" is a pretty broad categorization. Are there any
particulat functionalities you are looking for? A lot of basic
character manipulation is just built into the language syntax and
doesn't require or use functions. If it was you that posted right
after this the question about converting between integer and character
(I couldn't tell for sure as it was posted through yahoo and without a
name attached), that falls in this category. (Use internal I/O for
that, as shown by Clark Zahn's followup). The standard also includes
several intrinsic functions that relate to character manipulation.

There are also plenty of useful character utility functions that
aren't built into the language, but that people have written
themselves. I've got a few that I use a lot, but its hard to tell from
the broad term "character functions" whether these have anything to do
with what you are looking for.

For whatever its worth, below is my fdas_string module (fdas is Flight
Data Access System, which is what I was working on when I developed
this module, though I've since used it for other things). I've also
appended my precision.f90, which the string module uses. I've not
bothered to include the sysdep_io module, which would raise more
questions than it would answer in this context (particularly as it
isn't clear to me that any of this is of any use to you). I think the
only thing it is used for here is the error message subroutines, the
use of which should be pretty obvious from context.

--
Richard Maine
email: my last name at domain
domain: qnet dot com

!-- string.f90
!-- 29 Apr 92, Richard Maine: Version 1.0.
!-- 9 Sept 93, Richard Maine: changed module name
!-- 13 Mar 95, Richard Maine: added letters and digits parameters.

module fdas_string

!-- String handling routines.
!-- System-dependent. Generic version.
!-- All character case stuff applies only to U.S. characters.
!-- National ASCII characters are treated as non-alphabetic.
!-- 13 Mar 95, Richard Maine.

use precision
use sysdep_io

implicit none
private

character, public, parameter :: lc_letters*26 = 'abcdefghijklmnopqrstuvwxyz'
character, public, parameter :: uc_letters*26 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
character, public, parameter :: letters*52 = lc_letters // uc_letters
character, public, parameter :: digits*10 = '0123456789'

integer :: i_do
integer, parameter :: down_map_ascii(0:127) = &
(/ (i_do, i_do=0,64), (i_do+32, i_do=65,90), (i_do, i_do=91,127) /)
integer, parameter :: up_map_ascii(0:127) = &
(/ (i_do, i_do=0,96), (i_do-32, i_do=97,122), (i_do, i_do=123,127) /)

!-- Public procedures.
public string_index, string_eq, string_comp, upper_case, lower_case
public int_string, real_string, string_to_int, string_to_real, find_field

contains

subroutine find_field (string, field, position, delims, delim, found)

!-- Find a delimitted field in a string.
!-- 15 Nov 90, Richard Maine.

!-------------------- interface.
character*(*), intent(in) :: string !-- The string input.
character*(*), intent(out) :: field
!-- The returned field. Blank if no field found.
integer, optional, intent(inout) :: position
!-- On entry, the starting position for searching for the field.
!-- Default is 1 if the argument is not present.
!-- On exit, the starting position of the next field or
!-- len(string)+1 if there is no following field.
character*(*), optional, intent(in) :: delims
!-- String containing the characters to be accepted as delimitters.
!-- If this includes a blank character, then leading blanks are
!-- removed from the returned field and the end delimitter may
!-- optionally be preceeded by blanks. If this argument is
!-- not present, the default delimitter set is a blank.
character*(*), optional, intent(out) :: delim
!-- Returns the actual delimitter that terminated the field.
!-- Returns char(0) if the field was terminated by the end of
!-- the string or if no field was found.
!-- If blank is in delimitters and the field was terminated
!-- by one or more blanks, followed by a non-blank delimitter,
!-- the non-blank delimitter is returned.
logical, optional, intent(out) :: found
!-- True if a field was found.

!-------------------- local.
character :: delimitter*1
integer :: pos, field_start, field_end, i
logical :: trim_blanks

!-------------------- executable code.

field = ''
delimitter = char(0)
pos = 1
if (present(found)) found = .false.
if (present(position)) pos = position
if (pos > len(string)) goto 9000
if (pos < 1) call error_halt('Illegal position in find_field')

!-- Skip leading blanks if blank is a delimitter.
field_start = pos
trim_blanks = .true.
if (present(delims)) trim_blanks = index(delims,' ') /= 0
if (trim_blanks) then
i = verify(string(pos:),' ')
if (i == 0) then
pos = len(string) + 1
goto 9000
end if
field_start = pos + i - 1
end if
if (present(found)) found = .true.

!-- Find the end of the field.
if (present(delims)) then
i = scan(string(field_start:), delims)
else
i = scan(string(field_start:), ' ')
end if
if (i == 0) then
field_end = len(string)
delimitter = char(0)
pos = field_end + 1
else
field_end = field_start + i - 2
delimitter = string(field_end+1:field_end+1)
pos = field_end + 2
end if

!-- Return the field.
field = string(field_start:field_end)

!-- Skip trailing blanks if blank is a delimitter.
if (trim_blanks) then
i = verify(string(field_end+1:), ' ')
if (i == 0) then
pos = len(string) + 1
goto 9000
end if
pos = field_end + i

!-- If the first non-blank character is a delimitter,
!-- skip blanks after it.
i = 0
if (present(delims)) i = index(delims, string(pos:pos))
if (i /= 0) then
delimitter = string(pos:pos)
pos = pos + 1
i = verify(string(pos:), ' ')
if (i == 0) then
pos = len(string) + 1
else
pos = pos + i - 1
end if
end if
end if

!---------- Normal exit.
9000 continue
if (present(delim)) delim = delimitter
if (present(position)) position = pos
return
end subroutine find_field

function string_eq (string1, string2)

!-- Test if 2 strings are equal, ignoring case and trailing blanks.
!-- generic version.
!-- System-dependent versions might be more efficient.
!-- 15 Jun 90, Richard Maine.

!-------------------- interface.
character*(*), intent(in) :: string1, string2 !-- Strings to test.
logical :: string_eq !-- true if match.

!-------------------- local.
integer :: i, min_len

!-------------------- executable code.

string_eq = .false.

!-- Compare the common portion.
min_len = min(len(string1), len(string2))
do i = 1 , min_len
if (down_map_ascii(iachar(string1(i:i))) /= &
down_map_ascii(iachar(string2(i:i)))) return
end do

!-- Then check the remainders, one of which is empty.
string_eq = string1(min_len+1:) == string2(min_len+1:)
return
end function string_eq

function string_index (string, list)

!-- Find index of a string in a list of strings.
!-- Comparison is case-insensitive.
!-- The list need not be ordered.
!-- We may later want to add an option to allow abbreviations.
!-- 15 Jun 90, Richard Maine.

!-------------------- interface.
character*(*), intent(in) :: string !-- The string input.
character*(*), intent(in) :: list(:) !-- List to compare against.
integer :: string_index !-- Index of string in list. 0 if no match.

!-------------------- local.
integer :: i

!-------------------- executable code.

do i = 1 , size(list)
if (string_eq(string,list(i))) exit
end do
if (i > size(list)) i = 0
string_index = i
return
end function string_index

function string_comp (string1, string2)

!-- Compare 2 strings, ignoring case and trailing blanks.
!-- generic version.
!-- System-dependent versions might be more efficient.
!-- 29 Apr 92, Richard Maine.

!-------------------- interface.
character*(*), intent(in) :: string1, string2 !-- Strings to test.
integer :: string_comp
!-- Returns 0 if strings equal,
!-- -1 if string1 < string2, +1 if string1 > string2.

!-------------------- local.
integer :: i, min_len, ichar1, ichar2

!-------------------- executable code.

!-- Compare the common portion.
min_len = min(len(string1), len(string2))
do i = 1 , min_len
ichar1 = down_map_ascii(iachar(string1(i:i)))
ichar2 = down_map_ascii(iachar(string2(i:i)))

if (ichar1 == ichar2) cycle
if (ichar1 < ichar2) then
string_comp = -1
else
string_comp = 1
end if
return
end do

!-- Then check the remainders, one of which is empty.
if (string1(min_len+1:) == string2(min_len+1:)) then
string_comp = 0
else if (len(string1) > min_len) then
string_comp = 1
else
string_comp = -1
end if
return
end function string_comp

function upper_case (string) result(result)

!-- Change all lower case characters in a string to upper case.
!-- generic version.
!-- System-dependent versions might be more efficient.
!-- 29 Apr 92, Richard Maine.

!-------------------- interface.
character*(*), intent(in) :: string !-- An arbitrary string.
character*(len(string)) :: result !-- The converted string.

!-------------------- local.
integer :: i

!-------------------- executable code.

do i = 1 , len(string)
result(i:i) = achar(up_map_ascii(iachar(string(i:i))))
end do
return
end function upper_case

function lower_case (string) result(result)

!-- Change all upper case characters in a string to lower case.
!-- generic version.
!-- System-dependent versions might be more efficient.
!-- 29 Apr 92, Richard Maine.

!-------------------- interface.
character*(*), intent(in) :: string !-- An arbitrary string.
character*(len(string)) :: result !-- The converted string.

!-------------------- local.
integer :: i

!-------------------- executable code.

do i = 1 , len(string)
result(i:i) = achar(down_map_ascii(iachar(string(i:i))))
end do
return
end function lower_case

function int_string(int) result(string)

!-- Convert an integer to a string.
!-- Current implementation gives a fixed-length blank-padded string.
!-- 18 Oct 90, Richard Maine.

!-------------------- interface.
integer, intent(in) :: int !-- Integer value.
character :: string*12 !-- Converted value.

!-------------------- executable code.

write (string, *) int
return
end function int_string

function real_string(val) result(string)

!-- Convert a real to a string.
!-- Current implementation gives a fixed-length blank-padded string.
!-- 18 Oct 90, Richard Maine.

!-------------------- interface.
real(r_kind), intent(in) :: val !-- Real value.
character :: string*12 !-- Converted value.

!-------------------- executable code.

write (string, '(g12.5)') val
return
end function real_string

subroutine string_to_int (string, int, min_val, max_val, name, error)

!-- Convert a string to an integer, with error and range testing.
!-- 2 Jul 90, Richard Maine.

!-------------------- interface.
character*(*), intent(in) :: string
integer, intent(inout) :: int
!-- Input value left unchanged on errors.
integer, intent(in), optional :: min_val, max_val
!-- For compatability with old Fortran 77 codes,
!-- these are ignored if min_val>max_val.
character*(*), intent(in), optional :: name
!-- Used in error message. No error message if not present.
logical, intent(out), optional :: error
!-- Abort if there is an error and this is missing.

!-------------------- local.
character, save :: fmt*7 = '(i 1)'
integer :: temp_i, min_i, max_i
integer :: iostat

!-------------------- executable code.

!-- Convert string.
write (unit=fmt(3:6), fmt='(i4)') len(string)
read (unit=string, fmt=fmt, iostat=iostat) temp_i
if (iostat /= 0) then
if (present(name)) &
call write_error_msg('bad integer syntax for '//name//': '//string)
goto 8000
end if

!-- Test limits.
min_i = -big_int
if (present(min_val)) min_i = min_val
max_i = big_int
if (present(max_val)) max_i = max_val

if (max_i >= min_i) then
if (temp_i < min_i) then
if (present(name)) call write_error_msg( &
name//' value of '//int_string(temp_i)// &
' less than limit '//int_string(min_i))
goto 8000
end if

if (temp_i > max_i) then
if (present(name)) call write_error_msg( &
name//' value of '//int_string(temp_i)// &
' greater than limit '//int_string(max_i))
goto 8000
end if
end if

!-- Normal exit.
int = temp_i
if (present(error)) error = .false.
return

!---------- Error exit.
8000 continue
if (.not.present(error)) call error_halt('error in string_to_int')
error = .true.
return
end subroutine string_to_int

subroutine string_to_real (string, val, min_val, max_val, name, error)

!-- Convert a string to a real, with error and range testing.
!-- 2 Jul 90, Richard Maine.

!-------------------- interface.
character*(*), intent(in) :: string
real(r_kind), intent(inout) :: val
!-- Input value left unchanged on errors.
real(r_kind), intent(in), optional :: min_val, max_val
!-- For compatability with old Fortran 77 codes,
!-- these are ignored if min_val>max_val.
character*(*), intent(in), optional :: name
!-- Used in error message. No error message if not present.
logical, intent(out), optional :: error
!-- Abort if there is an error and this is missing.

!-------------------- local.
character, save :: fmt*9 = '(f 10.0)'
real(r_kind) :: temp_r, min_r, max_r
integer :: iostat

!-------------------- executable code.

!-- Convert string.
write (unit=fmt(3:6), fmt='(i4)') len(string)
read (unit=string, fmt=fmt, iostat=iostat) temp_r
if (iostat /= 0) then
if (present(name)) &
call write_error_msg('bad real syntax for '//name//': '//string)
goto 8000
end if

!-- Test limits.
min_r = -big_real
if (present(min_val)) min_r = min_val
max_r = big_real
if (present(max_val)) max_r = max_val

if (max_r >= min_r) then
if (temp_r < min_r) then
if (present(name)) call write_error_msg( &
name//' value of '//real_string(temp_r)// &
' less than limit '//real_string(min_r))
goto 8000
end if

if (temp_r > max_r) then
if (present(name)) call write_error_msg( &
name//' value of '//real_string(temp_r)// &
' greater than limit '//real_string(max_r))
goto 8000
end if
end if

!-- Normal exit.
val = temp_r
if (present(error)) error = .false.
return

!---------- Error exit.
8000 continue
if (.not.present(error)) call error_halt('error in string_to_real')
error = .true.
return
end subroutine string_to_real

end module fdas_string

!-- precision.f90
!-- 4 Mar 92, Richard Maine: Version 1.0.

module precision

!-- Kind constants for system-independent precision specification.
!-- 4 Mar 92, Richard Maine.

implicit none
public

!-- System default kinds.
integer, parameter :: i_kind = kind(0) !-- default integer
integer, parameter :: rs_kind = kind(0.) !-- real single precision
integer, parameter :: rd_kind = kind(0.d0) !-- real double precision

!-- Kinds for specified real precisions.
integer, parameter :: r4_kind = selected_real_kind(6,30) !-- 6 digits
integer, parameter :: r8_kind = selected_real_kind(12,30) !-- 12 digits

!-- Kinds for specified integer ranges.
integer, parameter :: i1_kind = selected_int_kind(2) !-- 99 max
integer, parameter :: i2_kind = selected_int_kind(4) !-- 9,999 max
integer, parameter :: i4_kind = selected_int_kind(9) !-- 999,999,999 max

!-- Kind for working real precision.
integer, parameter :: r_kind = r8_kind

!-- Big constants. These are less than huge so that we have some
!-- room for comparisons and other arithmetic without overflowing.
integer, parameter :: big_int = huge(i_kind)/16
real(r_kind), parameter :: r_zero = 0.
real(r_kind), parameter :: big_real = huge(r_zero)/16.
end module precision

[Anthony Iannetti]

Richard,

Thanks for the code. I could have been a little more specific. Yes, Fortran
has a lot of Intrinsic Character functions. I do use a lot of them. However,
for idiot proofing codes, I usually have to write a lot of repeated code to do
the same thing over and over. For instance, recognizing 'U' and 'u' as the same
input variable. This takes a lot of work, if you don't have a module that does
this already. Honestly, even if I put down in the manual, USE CAPTITAL LETTERS,
somebody would still use 'u', call my code crap, and blame me for wrecking his
or her research. (I am being a little dramatic.) You see my point.
Perhaps for the Fortran 2000 standard, some of this stuff could be added as
intrinsic functions? Just a thought

Thanks,
Tony

Anthony C. Iannetti
NASA Glenn Research Center

[Richard Maine]

Anthony Iannetti <ai...@pike.grc.nasa.gov> writes:

> For instance, recognizing 'U' and 'u' as the same input variable.

Yep. That's a really common one. It is one of the things in the
module I posted. (Use string_eq, which does case-insensitive
string comparison, or possibly string_index, which case-insensitively
matches against a list of keywords/names).

> Perhaps for the Fortran 2000 standard, some of this stuff could be added as
> intrinsic functions? Just a thought

I suggested that one myself (and I doubt I was the first to do so).
Internationalization issues make it far more complicated than I'd
thought - anyway, that's the response I got. For my own part, I'd
probably still have preferred this be standardized, even if in a
limited form. This may reflect my personal cultural biases, though.
(In that I don't personally use those languages and character sets
where it gets most messy).

In the end, even if I'd have preferred to have this in the standard,
I decided that this one wasn't something for me to fight about. You
have to pick your fights instead of just fight about everything (a
lesson that not all have learned). I decided it was just easier to
write my user version of this than to fight for its standardization.
An influence was that it is pretty easy to write an adequate (for
most purposes - even if not covering every quirk of every language)
user version of this. The reason for standardization here is more to
keep zillions of users from having to redo it than because any one
of these would be hard.

--
Richard Maine | Good judgment comes from experience;
email: my last name at host.domain | experience comes from bad judgment.
host: altair, domain: dfrc.nasa.gov | -- Mark Twain

[Arjen Markus]

Richard Maine wrote:
>

>
> I suggested that one myself (and I doubt I was the first to do so).
> Internationalization issues make it far more complicated than I'd
> thought - anyway, that's the response I got. For my own part, I'd
> probably still have preferred this be standardized, even if in a
> limited form. This may reflect my personal cultural biases, though.
> (In that I don't personally use those languages and character sets
> where it gets most messy).
>
> In the end, even if I'd have preferred to have this in the standard,
> I decided that this one wasn't something for me to fight about. You
> have to pick your fights instead of just fight about everything (a
> lesson that not all have learned). I decided it was just easier to
> write my user version of this than to fight for its standardization.
> An influence was that it is pretty easy to write an adequate (for
> most purposes - even if not covering every quirk of every language)
> user version of this. The reason for standardization here is more to
> keep zillions of users from having to redo it than because any one
> of these would be hard.
>

Just a few thoughts:
- These functions (and presumably many others as well) are so commonly
needed (I have written and rewritten such functions and subroutines
an uncounted number of times as well).
- Standardisation is difficult, due to unexpected and very nasty issues
with languages other than (US) English, but it is fairly easy to
write a version that does a decent job in plain Fortran.

Then, even without the language as such having to support all of these,
could not someone collect these functions and make them available in
a convenient spot? (I mean, netlib is an excellent source for numerical
alogrithms, I know sites for other languages that do something of the
sort).

Nothing formal, no quality guarantees. Just a common place.

(I know, this might be a lot of work, but it is work that can be shared)

Regards,

Arjen

[Richard Maine]

Arjen Markus <Arjen....@wldelft.nl> writes:
[about character case conversion and similar things]

> - These functions (and presumably many others as well) are so commonly
> needed (I have written and rewritten such functions and subroutines
> an uncounted number of times as well).
> - Standardisation is difficult, due to unexpected and very nasty issues
> with languages other than (US) English, but it is fairly easy to
> write a version that does a decent job in plain Fortran.
>
> Then, even without the language as such having to support all of these,
> could not someone collect these functions and make them available in
> a convenient spot? (I mean, netlib is an excellent source for numerical
> alogrithms, I know sites for other languages that do something of the
> sort).
>
> Nothing formal, no quality guarantees. Just a common place.
>
> (I know, this might be a lot of work, but it is work that can be shared)

I quite agree. That would be a nice thing.

But my agreement doesn't constitute volunteering to do it. :-(

(Independent of any questions of the amount of work, NASA makes it
*VERY* bureaucratically awkward for me to interact with anything from
the outside...."outside" including even other NASA centers, like the
stuff I'm currently trying to set up with Van at JPL. grumble,
gumble. P.S. In case you couldn't guess, this grumble is not an
official NASA position. Nor is it a criticism of my management,
who I am certain must have good reasons for everything. :-()

[Rajarshi Guha]

On Wed, 16 Jan 2002 08:34:05 +0100, Arjen Markus <Arjen....@wldelft.nl> wrote:
> Richard Maine wrote:
>>
>
>>
>> I suggested that one myself (and I doubt I was the first to do so).
>> Internationalization issues make it far more complicated than I'd
>> thought - anyway, that's the response I got. For my own part, I'd
>> probably still have preferred this be standardized, even if in a
>> limited form. This may reflect my personal cultural biases, though.
>> (In that I don't personally use those languages and character sets
>> where it gets most messy).
>

> Then, even without the language as such having to support all of these,
> could not someone collect these functions and make them available in
> a convenient spot? (I mean, netlib is an excellent source for numerical
> alogrithms, I know sites for other languages that do something of the
> sort).
>
> Nothing formal, no quality guarantees. Just a common place.

Sounds like a good idea. Richard's functions seem to fit the bill -
would Richard be willing to allow those to be put up for public use or
should we write them from scratch?

--

[Richard Maine]

Rajarshi Guha <raja...@presidency.com> writes:

> Sounds like a good idea. Richard's functions seem to fit the bill -
> would Richard be willing to allow those to be put up for public use or
> should we write them from scratch?

You can do anything you like with them (including improve them, ignore
them, etc.). If they were being put up on an archive site, I'd probably
want to make them actually useable as is (probably by also supplying
my sysdep_io module that they depend on) instead of just describing
how to remove the dependency. I place them in the public domain.
It would be nice to keep my name with them, but being nic is not a
requirement.

It is safe to assume that you may publicly use anything that I post here
(this being, after all, a public forum).

But it is nice to ask. I appreciate that.

[Toon Moene]

Richard Maine wrote:

> grumble,
> grumble. P.S. In case you couldn't guess, this grumble is not an

> official NASA position. Nor is it a criticism of my management,
> who I am certain must have good reasons for everything. :-()

I just realised it's over 30 years ago that NASA launched and recovered
(with no casualties) Apollo 13.

Lately, I've been discussing with my colleagues whether NASA could put a
human being on the Moon *in 2002* at all.

We agreed the odds were significantly below 50 %.

--
Toon Moene - mailto:to...@moene.indiv.nluug.nl - phoneto: +31 346 214290
Saturnushof 14, 3738 XG Maartensdijk, The Netherlands
Maintainer, GNU Fortran 77: http://gcc.gnu.org/onlinedocs/g77_news.html
Join GNU Fortran 95: http://g95.sourceforge.net/ (under construction)

[James Giles]

"Toon Moene" <to...@moene.indiv.nluug.nl> wrote in message
news:3C474686...@moene.indiv.nluug.nl...

> Richard Maine wrote:
>
> > grumble,
> > grumble. P.S. In case you couldn't guess, this grumble is not an
> > official NASA position. Nor is it a criticism of my management,
> > who I am certain must have good reasons for everything. :-()
>
> I just realised it's over 30 years ago that NASA launched and recovered
> (with no casualties) Apollo 13.
>
> Lately, I've been discussing with my colleagues whether NASA could put a
> human being on the Moon *in 2002* at all.
>
> We agreed the odds were significantly below 50 %.

Off topic for this group, but I would put the odds significantly below
1%. Of course, if the country made it a national priority (money no
object) and we were willing to accept risks to the astronauts, it might
be barely possible. Depends on how *much* risk we were willing
to tolerate.

--
J. Giles