00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 static integer c__1 = 1;
00019 static integer c__4 = 4;
00020
00021 int slafts_(char *type__, integer *m, integer *n, integer *
00022 imat, integer *ntests, real *result, integer *iseed, real *thresh,
00023 integer *iounit, integer *ie)
00024 {
00025
00026 static char fmt_9999[] = "(\002 Matrix order=\002,i5,\002, type=\002,i2"
00027 ",\002, seed=\002,4(i4,\002,\002),\002 result \002,i3,\002 is\002"
00028 ",0p,f8.2)";
00029 static char fmt_9998[] = "(\002 Matrix order=\002,i5,\002, type=\002,i2"
00030 ",\002, seed=\002,4(i4,\002,\002),\002 result \002,i3,\002 is\002"
00031 ",1p,e10.3)";
00032 static char fmt_9997[] = "(1x,i5,\002 x\002,i5,\002 matrix, type=\002,"
00033 "i2,\002, s\002,\002eed=\002,3(i4,\002,\002),i4,\002: result \002"
00034 ",i3,\002 is\002,0p,f8.2)";
00035 static char fmt_9996[] = "(1x,i5,\002 x\002,i5,\002 matrix, type=\002,"
00036 "i2,\002, s\002,\002eed=\002,3(i4,\002,\002),i4,\002: result \002"
00037 ",i3,\002 is\002,1p,e10.3)";
00038
00039
00040 integer i__1;
00041
00042
00043 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00044
00045
00046 integer k;
00047 extern int slahd2_(integer *, char *);
00048
00049
00050 static cilist io___2 = { 0, 0, 0, fmt_9999, 0 };
00051 static cilist io___3 = { 0, 0, 0, fmt_9998, 0 };
00052 static cilist io___4 = { 0, 0, 0, fmt_9997, 0 };
00053 static cilist io___5 = { 0, 0, 0, fmt_9996, 0 };
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131 --iseed;
00132 --result;
00133
00134
00135 if (*m == *n) {
00136
00137
00138
00139 i__1 = *ntests;
00140 for (k = 1; k <= i__1; ++k) {
00141 if (result[k] >= *thresh) {
00142
00143
00144
00145
00146 if (*ie == 0) {
00147 slahd2_(iounit, type__);
00148 }
00149 ++(*ie);
00150 if (result[k] < 1e4f) {
00151 io___2.ciunit = *iounit;
00152 s_wsfe(&io___2);
00153 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00154 do_fio(&c__1, (char *)&(*imat), (ftnlen)sizeof(integer));
00155 do_fio(&c__4, (char *)&iseed[1], (ftnlen)sizeof(integer));
00156 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00157 do_fio(&c__1, (char *)&result[k], (ftnlen)sizeof(real));
00158 e_wsfe();
00159 } else {
00160 io___3.ciunit = *iounit;
00161 s_wsfe(&io___3);
00162 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00163 do_fio(&c__1, (char *)&(*imat), (ftnlen)sizeof(integer));
00164 do_fio(&c__4, (char *)&iseed[1], (ftnlen)sizeof(integer));
00165 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00166 do_fio(&c__1, (char *)&result[k], (ftnlen)sizeof(real));
00167 e_wsfe();
00168 }
00169 }
00170
00171 }
00172 } else {
00173
00174
00175
00176 i__1 = *ntests;
00177 for (k = 1; k <= i__1; ++k) {
00178 if (result[k] >= *thresh) {
00179
00180
00181
00182
00183 if (*ie == 0) {
00184 slahd2_(iounit, type__);
00185 }
00186 ++(*ie);
00187 if (result[k] < 1e4f) {
00188 io___4.ciunit = *iounit;
00189 s_wsfe(&io___4);
00190 do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer));
00191 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00192 do_fio(&c__1, (char *)&(*imat), (ftnlen)sizeof(integer));
00193 do_fio(&c__4, (char *)&iseed[1], (ftnlen)sizeof(integer));
00194 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00195 do_fio(&c__1, (char *)&result[k], (ftnlen)sizeof(real));
00196 e_wsfe();
00197 } else {
00198 io___5.ciunit = *iounit;
00199 s_wsfe(&io___5);
00200 do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer));
00201 do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
00202 do_fio(&c__1, (char *)&(*imat), (ftnlen)sizeof(integer));
00203 do_fio(&c__4, (char *)&iseed[1], (ftnlen)sizeof(integer));
00204 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00205 do_fio(&c__1, (char *)&result[k], (ftnlen)sizeof(real));
00206 e_wsfe();
00207 }
00208 }
00209
00210 }
00211
00212 }
00213 return 0;
00214
00215
00216
00217 }