1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS !
!-----------------------------------------------------------------------
! CVS m_chars.F90,v 1.3 2004-04-21 22:54:46 jacob Exp
! CVS MCT_2_8_0
!-----------------------------------------------------------------------
!BOP
!
! !MODULE: m_chars - a module for character class object operations
!
! !DESCRIPTION:
!
! !INTERFACE:
module m_chars
implicit none
private
public :: operator (.upper.) ! convert a string to uppercase
public :: uppercase
public :: operator (.lower.) ! convert a string to lowercase
public :: lowercase
interface operator (.upper.)
module procedure upper_case
end interface
interface uppercase
module procedure upper_case
end interface
interface operator (.lower.)
module procedure lower_case
end interface
interface lowercase
module procedure lower_case
end interface
! !REVISION HISTORY:
! 16Jul96 - J. Guo - (to do)
!EOP
!_______________________________________________________________________
character(len=*),parameter :: myname='MCT(MPEU)::m_chars'
contains
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS !
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: upper_case - convert lowercase letters to uppercase.
!
! !DESCRIPTION:
!
! !INTERFACE:
function upper_case(str) result(ustr)
implicit none
character(len=*), intent(in) :: str
character(len=len(str)) :: ustr
! !REVISION HISTORY:
! 13Aug96 - J. Guo - (to do)
!EOP
!_______________________________________________________________________
integer i
integer,parameter :: il2u=ichar('A')-ichar('a')
ustr=str
do i=1,len_trim(str)
if(str(i:i).ge.'a'.and.str(i:i).le.'z') &
ustr(i:i)=char(ichar(str(i:i))+il2u)
end do
end function upper_case
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS !
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: lower_case - convert uppercase letters to lowercase.
!
! !DESCRIPTION:
!
! !INTERFACE:
function lower_case(str) result(lstr)
implicit none
character(len=*), intent(in) :: str
character(len=len(str)) :: lstr
! !REVISION HISTORY:
! 13Aug96 - J. Guo - (to do)
!EOP
!_______________________________________________________________________
integer i
integer,parameter :: iu2l=ichar('a')-ichar('A')
lstr=str
do i=1,len_trim(str)
if(str(i:i).ge.'A'.and.str(i:i).le.'Z') &
lstr(i:i)=char(ichar(str(i:i))+iu2l)
end do
end function lower_case
end module m_chars
!.
|
