1 /*
2
3 Copyright (C) 2014, The University of Texas at Austin
4
5 This file is part of libflame and is available under the 3-Clause
6 BSD license, which can be found in the LICENSE file at the top-level
7 directory, or at http://opensource.org/licenses/BSD-3-Clause
8
9 */
10 /* lsame.f -- translated by f2c (version 19991025).
11 You must link the resulting object file with the libraries:
12 -lf2c -lm (in that order)
13 */
14
15 #ifdef __cplusplus
16 extern "C" {
17 #endif
18 #include "FLA_f2c.h"
19
fla_lsame(char * ca,char * cb,ftnlen ca_len,ftnlen cb_len)20 logical fla_lsame(char *ca, char *cb, ftnlen ca_len, ftnlen cb_len)
21 {
22 /* System generated locals */
23 logical ret_val;
24
25 /* Local variables */
26 static integer inta, intb, zcode;
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 */
122
123 #ifdef __cplusplus
124 }
125 #endif
126