fla_lsame.c File Reference
(r)
Functions | |
| logical | fla_lsame (char *ca, char *cb, ftnlen ca_len, ftnlen cb_len) |
Function Documentation
◆ fla_lsame()
21{
22 /* System generated locals */
23 logical ret_val;
24
25 /* Local variables */
27
28
29/* -- LAPACK auxiliary routine (version 3.2) -- */
30/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
31/* November 2006 */
32
33/* .. Scalar Arguments .. */
34/* .. */
35
36/* Purpose */
37/* ======= */
38
39/* LSAME returns .TRUE. if CA is the same letter as CB regardless of */
40/* case. */
41
42/* Arguments */
43/* ========= */
44
45/* CA (input) CHARACTER*1 */
46/* CB (input) CHARACTER*1 */
47/* CA and CB specify the single characters to be compared. */
48
49/* ===================================================================== */
50
51/* .. Intrinsic Functions .. */
52/* .. */
53/* .. Local Scalars .. */
54/* .. */
55/* .. Executable Statements .. */
56
57/* Test if the characters are equal */
58
59 ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
60 if (ret_val) {
61 return ret_val;
62 }
63
64/* Now test for equivalence if both characters are alphabetic. */
65
66 zcode = 'Z';
67
68/* Use 'Z' rather than 'A' so that ASCII can be detected on Prime */
69/* machines, on which ICHAR returns a value with bit 8 set. */
70/* ICHAR('A') on Prime machines returns 193 which is the same as */
71/* ICHAR('A') on an EBCDIC machine. */
72
73 inta = *(unsigned char *)ca;
74 intb = *(unsigned char *)cb;
75
76 if (zcode == 90 || zcode == 122) {
77
78/* ASCII is assumed - ZCODE is the ASCII code of either lower or */
79/* upper case 'Z'. */
80
81 if (inta >= 97 && inta <= 122) {
82 inta += -32;
83 }
84 if (intb >= 97 && intb <= 122) {
85 intb += -32;
86 }
87
88 } else if (zcode == 233 || zcode == 169) {
89
90/* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */
91/* upper case 'Z'. */
92
93 if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) || (inta
94 >= 162 && inta <= 169)) {
95 inta += 64;
96 }
97 if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) || (intb
98 >= 162 && intb <= 169)) {
99 intb += 64;
100 }
101
102 } else if (zcode == 218 || zcode == 250) {
103
104/* ASCII is assumed, on Prime machines - ZCODE is the ASCII code */
105/* plus 128 of either lower or upper case 'Z'. */
106
107 if (inta >= 225 && inta <= 250) {
108 inta += -32;
109 }
110 if (intb >= 225 && intb <= 250) {
111 intb += -32;
112 }
113 }
114 ret_val = inta == intb;
115
116/* RETURN */
117
118/* End of LSAME */
119
120 return ret_val;
121} /* fla_lsame */
Referenced by fla_dlamch(), and fla_slamch().
Generated on Thu Sep 23 2021 17:46:17 for libflame by
1.12.0