You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

lsame.f 3.2 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125
  1. *> \brief \b LSAME
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * LOGICAL FUNCTION LSAME( CA, CB )
  12. *
  13. * .. Scalar Arguments ..
  14. * CHARACTER CA, CB
  15. * ..
  16. *
  17. *
  18. *> \par Purpose:
  19. * =============
  20. *>
  21. *> \verbatim
  22. *>
  23. *> LSAME returns .TRUE. if CA is the same letter as CB regardless of
  24. *> case.
  25. *> \endverbatim
  26. *
  27. * Arguments:
  28. * ==========
  29. *
  30. *> \param[in] CA
  31. *> \verbatim
  32. *> \endverbatim
  33. *>
  34. *> \param[in] CB
  35. *> \verbatim
  36. *> CA and CB specify the single characters to be compared.
  37. *> \endverbatim
  38. *
  39. * Authors:
  40. * ========
  41. *
  42. *> \author Univ. of Tennessee
  43. *> \author Univ. of California Berkeley
  44. *> \author Univ. of Colorado Denver
  45. *> \author NAG Ltd.
  46. *
  47. *> \date November 2011
  48. *
  49. *> \ingroup auxOTHERauxiliary
  50. *
  51. * =====================================================================
  52. LOGICAL FUNCTION LSAME( CA, CB )
  53. *
  54. * -- LAPACK auxiliary routine (version 3.4.0) --
  55. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  56. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  57. * November 2011
  58. *
  59. * .. Scalar Arguments ..
  60. CHARACTER CA, CB
  61. * ..
  62. *
  63. * =====================================================================
  64. *
  65. * .. Intrinsic Functions ..
  66. INTRINSIC ICHAR
  67. * ..
  68. * .. Local Scalars ..
  69. INTEGER INTA, INTB, ZCODE
  70. * ..
  71. * .. Executable Statements ..
  72. *
  73. * Test if the characters are equal
  74. *
  75. LSAME = CA.EQ.CB
  76. IF( LSAME )
  77. $ RETURN
  78. *
  79. * Now test for equivalence if both characters are alphabetic.
  80. *
  81. ZCODE = ICHAR( 'Z' )
  82. *
  83. * Use 'Z' rather than 'A' so that ASCII can be detected on Prime
  84. * machines, on which ICHAR returns a value with bit 8 set.
  85. * ICHAR('A') on Prime machines returns 193 which is the same as
  86. * ICHAR('A') on an EBCDIC machine.
  87. *
  88. INTA = ICHAR( CA )
  89. INTB = ICHAR( CB )
  90. *
  91. IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN
  92. *
  93. * ASCII is assumed - ZCODE is the ASCII code of either lower or
  94. * upper case 'Z'.
  95. *
  96. IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32
  97. IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32
  98. *
  99. ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN
  100. *
  101. * EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
  102. * upper case 'Z'.
  103. *
  104. IF( INTA.GE.129 .AND. INTA.LE.137 .OR.
  105. $ INTA.GE.145 .AND. INTA.LE.153 .OR.
  106. $ INTA.GE.162 .AND. INTA.LE.169 ) INTA = INTA + 64
  107. IF( INTB.GE.129 .AND. INTB.LE.137 .OR.
  108. $ INTB.GE.145 .AND. INTB.LE.153 .OR.
  109. $ INTB.GE.162 .AND. INTB.LE.169 ) INTB = INTB + 64
  110. *
  111. ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN
  112. *
  113. * ASCII is assumed, on Prime machines - ZCODE is the ASCII code
  114. * plus 128 of either lower or upper case 'Z'.
  115. *
  116. IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32
  117. IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32
  118. END IF
  119. LSAME = INTA.EQ.INTB
  120. *
  121. * RETURN
  122. *
  123. * End of LSAME
  124. *
  125. END