Return to lsame.f CVS log

Up to [local] / rpl / lapack / blas

Mise à jour de Blas.

    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: *>          CA is CHARACTER*1
   33: *> \endverbatim
   34: *>
   35: *> \param[in] CB
   36: *> \verbatim
   37: *>          CB is CHARACTER*1
   38: *>          CA and CB specify the single characters to be compared.
   39: *> \endverbatim
   40: *
   41: *  Authors:
   42: *  ========
   43: *
   44: *> \author Univ. of Tennessee
   45: *> \author Univ. of California Berkeley
   46: *> \author Univ. of Colorado Denver
   47: *> \author NAG Ltd.
   48: *
   49: *> \date December 2016
   50: *
   51: *> \ingroup aux_blas
   52: *
   53: *  =====================================================================
   54:       LOGICAL FUNCTION LSAME(CA,CB)
   55: *
   56: *  -- Reference BLAS level1 routine (version 3.1) --
   57: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
   58: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
   59: *     December 2016
   60: *
   61: *     .. Scalar Arguments ..
   62:       CHARACTER CA,CB
   63: *     ..
   64: *
   65: * =====================================================================
   66: *
   67: *     .. Intrinsic Functions ..
   68:       INTRINSIC ICHAR
   69: *     ..
   70: *     .. Local Scalars ..
   71:       INTEGER INTA,INTB,ZCODE
   72: *     ..
   73: *
   74: *     Test if the characters are equal
   75: *
   76:       LSAME = CA .EQ. CB
   77:       IF (LSAME) 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