Return to lsame.f CVS log

Up to [local] / rpl / lapack / lapack

Mise à jour de Lapack.

    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 December 2016
   48: *
   49: *> \ingroup auxOTHERauxiliary
   50: *
   51: *  =====================================================================
   52:       LOGICAL FUNCTION LSAME( CA, CB )
   53: *
   54: *  -- LAPACK auxiliary routine (version 3.7.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: *     December 2016
   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