m_chars.F90 2.8 KB

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