1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
/* lapack/util/lsame.f -- translated by f2c (version 20050501).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
*/
#ifdef __cplusplus
extern "C" {
#endif
#include "v3p_netlib.h"
/*< LOGICAL FUNCTION LSAME( CA, CB ) >*/
logical lsame_(const char *ca, const char *cb, ftnlen ca_len, ftnlen cb_len)
{
/* System generated locals */
logical ret_val;
/* Local variables */
integer inta, intb, zcode;
(void)ca_len;
(void)cb_len;
/* -- LAPACK auxiliary routine (version 3.0) -- */
/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
/* Courant Institute, Argonne National Lab, and Rice University */
/* September 30, 1994 */
/* .. Scalar Arguments .. */
/*< CHARACTER CA, CB >*/
/* .. */
/* Purpose */
/* ======= */
/* LSAME returns .TRUE. if CA is the same letter as CB regardless of */
/* case. */
/* Arguments */
/* ========= */
/* CA (input) CHARACTER*1 */
/* CB (input) CHARACTER*1 */
/* CA and CB specify the single characters to be compared. */
/* ===================================================================== */
/* .. Intrinsic Functions .. */
/*< INTRINSIC ICHAR >*/
/* .. */
/* .. Local Scalars .. */
/*< INTEGER INTA, INTB, ZCODE >*/
/* .. */
/* .. Executable Statements .. */
/* Test if the characters are equal */
/*< LSAME = CA.EQ.CB >*/
ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
/*< >*/
if (ret_val) {
return ret_val;
}
/* Now test for equivalence if both characters are alphabetic. */
/*< ZCODE = ICHAR( 'Z' ) >*/
zcode = 'Z';
/* Use 'Z' rather than 'A' so that ASCII can be detected on Prime */
/* machines, on which ICHAR returns a value with bit 8 set. */
/* ICHAR('A') on Prime machines returns 193 which is the same as */
/* ICHAR('A') on an EBCDIC machine. */
/*< INTA = ICHAR( CA ) >*/
inta = *(unsigned char *)ca;
/*< INTB = ICHAR( CB ) >*/
intb = *(unsigned char *)cb;
/*< IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN >*/
if (zcode == 90 || zcode == 122) {
/* ASCII is assumed - ZCODE is the ASCII code of either lower or */
/* upper case 'Z'. */
/*< IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32 >*/
if (inta >= 97 && inta <= 122) {
inta += -32;
}
/*< IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32 >*/
if (intb >= 97 && intb <= 122) {
intb += -32;
}
/*< ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN >*/
} else if (zcode == 233 || zcode == 169) {
/* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */
/* upper case 'Z'. */
/*< >*/
if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) || (inta
>= 162 && inta <= 169)) {
inta += 64;
}
/*< >*/
if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) || (intb
>= 162 && intb <= 169)) {
intb += 64;
}
/*< ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN >*/
} else if (zcode == 218 || zcode == 250) {
/* ASCII is assumed, on Prime machines - ZCODE is the ASCII code */
/* plus 128 of either lower or upper case 'Z'. */
/*< IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32 >*/
if (inta >= 225 && inta <= 250) {
inta += -32;
}
/*< IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32 >*/
if (intb >= 225 && intb <= 250) {
intb += -32;
}
/*< END IF >*/
}
/*< LSAME = INTA.EQ.INTB >*/
ret_val = inta == intb;
/* RETURN */
/* End of LSAME */
/*< END >*/
return ret_val;
} /* lsame_ */
#ifdef __cplusplus
}
#endif
|
