1 /* lsametst.f -- translated by f2c (version 20061008).
2 You must link the resulting object file with libf2c:
3 on Microsoft Windows system, link with libf2c.lib;
4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 or, if you install libf2c.a in a standard place, with -lf2c -lm
6 -- in that order, at the end of the command line, as in
7 cc *.o -lf2c -lm
8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9
10 http://www.netlib.org/f2c/libf2c.zip
11 */
12
13 #include "FLA_f2c.h"
14
15
16 /* Table of constant values */
17
18 static integer c__9 = 9;
19 static integer c__1 = 1;
20 static integer c__3 = 3;
21
22 /* Main program */
MAIN__(void)23 int MAIN__(void)
24 {
25 /* Format strings */
26 static char fmt_9999[] = "(\002 *** Error: LSAME( \002,a1,\002, \002,"
27 "a1,\002) is .FALSE.\002)";
28 static char fmt_9998[] = "(\002 *** Error: LSAME( \002,a1,\002, \002,"
29 "a1,\002) is .TRUE.\002)";
30
31 /* System generated locals */
32 integer i__1;
33
34 /* Builtin functions */
35 integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
36 e_wsle(void), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen),
37 e_wsfe(void);
38
39 /* Local variables */
40 integer i1, i2;
41 extern logical lsame_(char *, char *);
42
43 /* Fortran I/O blocks */
44 static cilist io___3 = { 0, 6, 0, 0, 0 };
45 static cilist io___4 = { 0, 6, 0, 0, 0 };
46 static cilist io___5 = { 0, 6, 0, fmt_9999, 0 };
47 static cilist io___6 = { 0, 6, 0, fmt_9999, 0 };
48 static cilist io___7 = { 0, 6, 0, fmt_9999, 0 };
49 static cilist io___8 = { 0, 6, 0, fmt_9999, 0 };
50 static cilist io___9 = { 0, 6, 0, fmt_9998, 0 };
51 static cilist io___10 = { 0, 6, 0, fmt_9998, 0 };
52 static cilist io___11 = { 0, 6, 0, fmt_9998, 0 };
53 static cilist io___12 = { 0, 6, 0, fmt_9998, 0 };
54 static cilist io___13 = { 0, 6, 0, fmt_9998, 0 };
55 static cilist io___14 = { 0, 6, 0, fmt_9998, 0 };
56 static cilist io___15 = { 0, 6, 0, fmt_9998, 0 };
57 static cilist io___16 = { 0, 6, 0, fmt_9998, 0 };
58 static cilist io___17 = { 0, 6, 0, 0, 0 };
59
60
61
62 /* -- LAPACK test routine (version 3.2) -- */
63 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
64 /* November 2006 */
65
66 /* .. Local Scalars .. */
67 /* .. */
68 /* .. External Functions .. */
69 /* .. */
70 /* .. Intrinsic Functions .. */
71 /* .. */
72 /* .. Executable Statements .. */
73
74
75 /* Determine the character set. */
76
77 i1 = 'A';
78 i2 = 'a';
79 if (i2 - i1 == 32)
80 {
81 s_wsle(&io___3);
82 do_lio(&c__9, &c__1, " ASCII character set", (ftnlen)20);
83 e_wsle();
84 }
85 else
86 {
87 s_wsle(&io___4);
88 do_lio(&c__9, &c__1, " Non-ASCII character set, IOFF should be ", (
89 ftnlen)41);
90 i__1 = i2 - i1;
91 do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
92 e_wsle();
93 }
94
95 /* Test LSAME. */
96
97 if (! lsame_("A", "A"))
98 {
99 s_wsfe(&io___5);
100 do_fio(&c__1, "A", (ftnlen)1);
101 do_fio(&c__1, "A", (ftnlen)1);
102 e_wsfe();
103 }
104 if (! lsame_("A", "a"))
105 {
106 s_wsfe(&io___6);
107 do_fio(&c__1, "A", (ftnlen)1);
108 do_fio(&c__1, "a", (ftnlen)1);
109 e_wsfe();
110 }
111 if (! lsame_("a", "A"))
112 {
113 s_wsfe(&io___7);
114 do_fio(&c__1, "a", (ftnlen)1);
115 do_fio(&c__1, "A", (ftnlen)1);
116 e_wsfe();
117 }
118 if (! lsame_("a", "a"))
119 {
120 s_wsfe(&io___8);
121 do_fio(&c__1, "a", (ftnlen)1);
122 do_fio(&c__1, "a", (ftnlen)1);
123 e_wsfe();
124 }
125 if (lsame_("A", "B"))
126 {
127 s_wsfe(&io___9);
128 do_fio(&c__1, "A", (ftnlen)1);
129 do_fio(&c__1, "B", (ftnlen)1);
130 e_wsfe();
131 }
132 if (lsame_("A", "b"))
133 {
134 s_wsfe(&io___10);
135 do_fio(&c__1, "A", (ftnlen)1);
136 do_fio(&c__1, "b", (ftnlen)1);
137 e_wsfe();
138 }
139 if (lsame_("a", "B"))
140 {
141 s_wsfe(&io___11);
142 do_fio(&c__1, "a", (ftnlen)1);
143 do_fio(&c__1, "B", (ftnlen)1);
144 e_wsfe();
145 }
146 if (lsame_("a", "b"))
147 {
148 s_wsfe(&io___12);
149 do_fio(&c__1, "a", (ftnlen)1);
150 do_fio(&c__1, "b", (ftnlen)1);
151 e_wsfe();
152 }
153 if (lsame_("O", "/"))
154 {
155 s_wsfe(&io___13);
156 do_fio(&c__1, "O", (ftnlen)1);
157 do_fio(&c__1, "/", (ftnlen)1);
158 e_wsfe();
159 }
160 if (lsame_("/", "O"))
161 {
162 s_wsfe(&io___14);
163 do_fio(&c__1, "/", (ftnlen)1);
164 do_fio(&c__1, "O", (ftnlen)1);
165 e_wsfe();
166 }
167 if (lsame_("o", "/"))
168 {
169 s_wsfe(&io___15);
170 do_fio(&c__1, "o", (ftnlen)1);
171 do_fio(&c__1, "/", (ftnlen)1);
172 e_wsfe();
173 }
174 if (lsame_("/", "o"))
175 {
176 s_wsfe(&io___16);
177 do_fio(&c__1, "/", (ftnlen)1);
178 do_fio(&c__1, "o", (ftnlen)1);
179 e_wsfe();
180 }
181 s_wsle(&io___17);
182 do_lio(&c__9, &c__1, " Tests completed", (ftnlen)16);
183 e_wsle();
184
185 return 0;
186 } /* MAIN__ */
187
test1_()188 /* Main program alias */ int test1_ ()
189 {
190 MAIN__ ();
191 return 0;
192 }
193