Return to lsame.f CVS log

Up to [local] / rpl / lapack / blas

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

1.1       bertrand    1:       LOGICAL FUNCTION LSAME(CA,CB)
                      2: *
                      3: *  -- LAPACK auxiliary routine (version 3.1) --
                      4: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
                      5: *     November 2006
                      6: *
                      7: *     .. Scalar Arguments ..
                      8:       CHARACTER CA,CB
                      9: *     ..
                     10: *
                     11: *  Purpose
                     12: *  =======
                     13: *
                     14: *  LSAME returns .TRUE. if CA is the same letter as CB regardless of
                     15: *  case.
                     16: *
                     17: *  Arguments
                     18: *  =========
                     19: *
                     20: *  CA      (input) CHARACTER*1
                     21: *
                     22: *  CB      (input) CHARACTER*1
                     23: *          CA and CB specify the single characters to be compared.
                     24: *
                     25: * =====================================================================
                     26: *
                     27: *     .. Intrinsic Functions ..
                     28:       INTRINSIC ICHAR
                     29: *     ..
                     30: *     .. Local Scalars ..
                     31:       INTEGER INTA,INTB,ZCODE
                     32: *     ..
                     33: *
                     34: *     Test if the characters are equal
                     35: *
                     36:       LSAME = CA .EQ. CB
                     37:       IF (LSAME) RETURN
                     38: *
                     39: *     Now test for equivalence if both characters are alphabetic.
                     40: *
                     41:       ZCODE = ICHAR('Z')
                     42: *
                     43: *     Use 'Z' rather than 'A' so that ASCII can be detected on Prime
                     44: *     machines, on which ICHAR returns a value with bit 8 set.
                     45: *     ICHAR('A') on Prime machines returns 193 which is the same as
                     46: *     ICHAR('A') on an EBCDIC machine.
                     47: *
                     48:       INTA = ICHAR(CA)
                     49:       INTB = ICHAR(CB)
                     50: *
                     51:       IF (ZCODE.EQ.90 .OR. ZCODE.EQ.122) THEN
                     52: *
                     53: *        ASCII is assumed - ZCODE is the ASCII code of either lower or
                     54: *        upper case 'Z'.
                     55: *
                     56:           IF (INTA.GE.97 .AND. INTA.LE.122) INTA = INTA - 32
                     57:           IF (INTB.GE.97 .AND. INTB.LE.122) INTB = INTB - 32
                     58: *
                     59:       ELSE IF (ZCODE.EQ.233 .OR. ZCODE.EQ.169) THEN
                     60: *
                     61: *        EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
                     62: *        upper case 'Z'.
                     63: *
                     64:           IF (INTA.GE.129 .AND. INTA.LE.137 .OR.
                     65:      +        INTA.GE.145 .AND. INTA.LE.153 .OR.
                     66:      +        INTA.GE.162 .AND. INTA.LE.169) INTA = INTA + 64
                     67:           IF (INTB.GE.129 .AND. INTB.LE.137 .OR.
                     68:      +        INTB.GE.145 .AND. INTB.LE.153 .OR.
                     69:      +        INTB.GE.162 .AND. INTB.LE.169) INTB = INTB + 64
                     70: *
                     71:       ELSE IF (ZCODE.EQ.218 .OR. ZCODE.EQ.250) THEN
                     72: *
                     73: *        ASCII is assumed, on Prime machines - ZCODE is the ASCII code
                     74: *        plus 128 of either lower or upper case 'Z'.
                     75: *
                     76:           IF (INTA.GE.225 .AND. INTA.LE.250) INTA = INTA - 32
                     77:           IF (INTB.GE.225 .AND. INTB.LE.250) INTB = INTB - 32
                     78:       END IF
                     79:       LSAME = INTA .EQ. INTB
                     80: *
                     81: *     RETURN
                     82: *
                     83: *     End of LSAME
                     84: *
                     85:       END