Annotation of rpl/lapack/blas/lsame.f, revision 1.7

1.7     ! bertrand    1: *> \brief \b LSAME
1.1       bertrand    2: *
1.7     ! bertrand    3: *  =========== DOCUMENTATION ===========
1.1       bertrand    4: *
1.7     ! bertrand    5: * Online html documentation available at 
        !             6: *            http://www.netlib.org/lapack/explore-html/ 
1.1       bertrand    7: *
1.7     ! bertrand    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. 
1.1       bertrand   48: *
1.7     ! bertrand   49: *> \date November 2011
1.1       bertrand   50: *
1.7     ! bertrand   51: *> \ingroup aux_blas
1.1       bertrand   52: *
1.7     ! bertrand   53: *  =====================================================================
        !            54:       LOGICAL FUNCTION LSAME(CA,CB)
1.1       bertrand   55: *
1.7     ! bertrand   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: *     November 2011
        !            60: *
        !            61: *     .. Scalar Arguments ..
        !            62:       CHARACTER CA,CB
        !            63: *     ..
1.1       bertrand   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

CVSweb interface <joel.bertrand@systella.fr>