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