root / src / blas / lsame.f @ 4
Historique | Voir | Annoter | Télécharger (2,27 ko)
| 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 |