home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / blas / lsame.f < prev    next >
Text File  |  1996-09-28  |  2KB  |  90 lines
  1.       LOGICAL FUNCTION LSAME ( CA, CB )
  2. *     .. Scalar Arguments ..
  3.       CHARACTER*1            CA, CB
  4. *     ..
  5. *
  6. *  Purpose
  7. *  =======
  8. *
  9. *  LSAME  tests if CA is the same letter as CB regardless of case.
  10. *  CB is assumed to be an upper case letter. LSAME returns .TRUE. if
  11. *  CA is either the same as CB or the equivalent lower case letter.
  12. *
  13. *  N.B. This version of the routine is only correct for ASCII code.
  14. *       Installers must modify the routine for other character-codes.
  15. *
  16. *       For EBCDIC systems the constant IOFF must be changed to -64.
  17. *       For CDC systems using 6-12 bit representations, the system-
  18. *       specific code in comments must be activated.
  19. *
  20. *  Parameters
  21. *  ==========
  22. *
  23. *  CA     - CHARACTER*1
  24. *  CB     - CHARACTER*1
  25. *           On entry, CA and CB specify characters to be compared.
  26. *           Unchanged on exit.
  27. *
  28. *
  29. *  Auxiliary routine for Level 2 Blas.
  30. *
  31. *  -- Written on 20-July-1986
  32. *     Richard Hanson, Sandia National Labs.
  33. *     Jeremy Du Croz, Nag Central Office.
  34. *
  35. *     .. Parameters ..
  36.       INTEGER                IOFF
  37.       PARAMETER            ( IOFF=32 )
  38. *     .. Intrinsic Functions ..
  39.       INTRINSIC              ICHAR
  40. *     .. Executable Statements ..
  41. *
  42. *     Test if the characters are equal
  43. *
  44.       LSAME = CA .EQ. CB
  45. *
  46. *     Now test for equivalence
  47. *
  48.       IF ( .NOT.LSAME ) THEN
  49.          LSAME = ICHAR(CA) - IOFF .EQ. ICHAR(CB)
  50.       END IF
  51. *
  52.       RETURN
  53. *
  54. *  The following comments contain code for CDC systems using 6-12 bit
  55. *  representations.
  56. *
  57. *     .. Parameters ..
  58. *     INTEGER                ICIRFX
  59. *     PARAMETER            ( ICIRFX=62 )
  60. *     .. Scalar Arguments ..
  61. *     CHARACTER*1            CB
  62. *     .. Array Arguments ..
  63. *     CHARACTER*1            CA(*)
  64. *     .. Local Scalars ..
  65. *     INTEGER                IVAL
  66. *     .. Intrinsic Functions ..
  67. *     INTRINSIC              ICHAR, CHAR
  68. *     .. Executable Statements ..
  69. *
  70. *     See if the first character in string CA equals string CB.
  71. *
  72. *     LSAME = CA(1) .EQ. CB .AND. CA(1) .NE. CHAR(ICIRFX)
  73. *
  74. *     IF (LSAME) RETURN
  75. *
  76. *     The characters are not identical. Now check them for equivalence.
  77. *     Look for the 'escape' character, circumflex, followed by the
  78. *     letter.
  79. *
  80. *     IVAL = ICHAR(CA(2))
  81. *     IF (IVAL.GE.ICHAR('A') .AND. IVAL.LE.ICHAR('Z')) THEN
  82. *        LSAME = CA(1) .EQ. CHAR(ICIRFX) .AND. CA(2) .EQ. CB
  83. *     END IF
  84. *
  85. *     RETURN
  86. *
  87. *     End of LSAME.
  88. *
  89.       END
  90.