1module m_char
2
3  implicit none
4
5  public :: lcase, ucase, ccase
6
7  character(len=26), parameter :: upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
8  character(len=26), parameter :: lower = 'abcdefghijklmnopqrstuvwxyz'
9
10contains
11
12  ! Lower-case a string
13  pure function lcase(str)
14    character(len=*), intent(in) :: str
15    character(len=len(str)) :: lcase
16    integer :: ic, i
17
18    ! Capitalize each letter if it is lowecase
19    lcase = str
20    i = scan(lcase,upper)
21    do while ( i > 0 )
22       ! Get the conversion index
23       ic = index(upper,lcase(i:i))
24       lcase(i:i) = lower(ic:ic)
25       ic = scan(lcase(i+1:),upper)
26       if ( ic > 0 ) then
27          i = i + ic
28       else
29          i = 0
30       end if
31    end do
32
33  end function lcase
34
35  ! Upper-case a string
36  pure function ucase(str)
37    character(len=*), intent(in) :: str
38    character(len=len(str)) :: ucase
39    integer :: ic, i
40
41    ! Capitalize each letter if it is lowecase
42    ucase = str
43    i = scan(ucase,lower)
44    do while ( i > 0 )
45       ! Get the conversion index
46       ic = index(lower,ucase(i:i))
47       ucase(i:i) = upper(ic:ic)
48       ic = scan(ucase(i+1:),lower)
49       if ( ic > 0 ) then
50          i = i + ic
51       else
52          i = 0
53       end if
54    end do
55
56  end function ucase
57
58  ! convert a string based on input
59  pure function ccase(str,case)
60    character(len=*), intent(in) :: str
61    character(len=1), intent(in), optional :: case
62    character(len=len(str)) :: ccase
63
64    if ( present(case) ) then
65       if ( scan(case,'Uu') > 0 ) then
66          ccase = ucase(str)
67       else if ( scan(case,'Ll') > 0 ) then
68          ccase = lcase(str)
69       else
70          ccase = str
71       end if
72    else
73       ccase = str
74    end if
75  end function ccase
76
77end module m_char
78
79