00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 struct {
00019 integer infot, nout;
00020 logical ok, lerr;
00021 } infoc_;
00022
00023 #define infoc_1 infoc_
00024
00025 struct {
00026 char srnamt[32];
00027 } srnamc_;
00028
00029 #define srnamc_1 srnamc_
00030
00031
00032
00033 static integer c_n1 = -1;
00034 static integer c__0 = 0;
00035 static integer c__1 = 1;
00036 static integer c__2 = 2;
00037
00038 int zerrab_(integer *nunit)
00039 {
00040
00041 static char fmt_9999[] = "(1x,a6,\002 drivers passed the tests of the er"
00042 "ror exits\002)";
00043 static char fmt_9998[] = "(\002 *** \002,a6,\002 drivers failed the test"
00044 "s of the error \002,\002exits ***\002)";
00045
00046
00047 integer i__1;
00048 doublereal d__1;
00049
00050
00051 integer s_wsle(cilist *), e_wsle(void);
00052 int s_copy(char *, char *, ftnlen, ftnlen);
00053 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00054
00055
00056 doublecomplex a[16] , b[4], c__[4];
00057 integer i__, j;
00058 doublecomplex r__[4], w[8], x[4], r1[4], r2[4], af[16]
00059 ;
00060 integer ip[4], info, iter;
00061 doublecomplex work[1];
00062 doublereal rwork[1];
00063 complex swork[1];
00064 extern int chkxer_(char *, integer *, integer *, logical
00065 *, logical *), zcgesv_(integer *, integer *,
00066 doublecomplex *, integer *, integer *, doublecomplex *, integer *,
00067 doublecomplex *, integer *, doublecomplex *, complex *,
00068 doublereal *, integer *, integer *);
00069
00070
00071 static cilist io___1 = { 0, 0, 0, 0, 0 };
00072 static cilist io___19 = { 0, 0, 0, fmt_9999, 0 };
00073 static cilist io___20 = { 0, 0, 0, fmt_9998, 0 };
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 infoc_1.nout = *nunit;
00116 io___1.ciunit = infoc_1.nout;
00117 s_wsle(&io___1);
00118 e_wsle();
00119
00120
00121
00122 for (j = 1; j <= 4; ++j) {
00123 for (i__ = 1; i__ <= 4; ++i__) {
00124 i__1 = i__ + (j << 2) - 5;
00125 d__1 = 1. / (doublereal) (i__ + j);
00126 a[i__1].r = d__1, a[i__1].i = 0.;
00127 i__1 = i__ + (j << 2) - 5;
00128 d__1 = 1. / (doublereal) (i__ + j);
00129 af[i__1].r = d__1, af[i__1].i = 0.;
00130
00131 }
00132 i__1 = j - 1;
00133 b[i__1].r = 0., b[i__1].i = 0.;
00134 i__1 = j - 1;
00135 r1[i__1].r = 0., r1[i__1].i = 0.;
00136 i__1 = j - 1;
00137 r2[i__1].r = 0., r2[i__1].i = 0.;
00138 i__1 = j - 1;
00139 w[i__1].r = 0., w[i__1].i = 0.;
00140 i__1 = j - 1;
00141 x[i__1].r = 0., x[i__1].i = 0.;
00142 i__1 = j - 1;
00143 c__[i__1].r = 0., c__[i__1].i = 0.;
00144 i__1 = j - 1;
00145 r__[i__1].r = 0., r__[i__1].i = 0.;
00146 ip[j - 1] = j;
00147
00148 }
00149 infoc_1.ok = TRUE_;
00150
00151 s_copy(srnamc_1.srnamt, "ZCGESV", (ftnlen)32, (ftnlen)6);
00152 infoc_1.infot = 1;
00153 zcgesv_(&c_n1, &c__0, a, &c__1, ip, b, &c__1, x, &c__1, work, swork,
00154 rwork, &iter, &info);
00155 chkxer_("ZCGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00156 infoc_1.ok);
00157 infoc_1.infot = 2;
00158 zcgesv_(&c__0, &c_n1, a, &c__1, ip, b, &c__1, x, &c__1, work, swork,
00159 rwork, &iter, &info);
00160 chkxer_("ZCGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00161 infoc_1.ok);
00162 infoc_1.infot = 4;
00163 zcgesv_(&c__2, &c__1, a, &c__1, ip, b, &c__2, x, &c__2, work, swork,
00164 rwork, &iter, &info);
00165 chkxer_("ZCGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00166 infoc_1.ok);
00167 infoc_1.infot = 7;
00168 zcgesv_(&c__2, &c__1, a, &c__2, ip, b, &c__1, x, &c__2, work, swork,
00169 rwork, &iter, &info);
00170 chkxer_("ZCGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00171 infoc_1.ok);
00172 infoc_1.infot = 9;
00173 zcgesv_(&c__2, &c__1, a, &c__2, ip, b, &c__2, x, &c__1, work, swork,
00174 rwork, &iter, &info);
00175 chkxer_("ZCGESV", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00176 infoc_1.ok);
00177
00178
00179
00180 if (infoc_1.ok) {
00181 io___19.ciunit = infoc_1.nout;
00182 s_wsfe(&io___19);
00183 do_fio(&c__1, "ZCGESV", (ftnlen)6);
00184 e_wsfe();
00185 } else {
00186 io___20.ciunit = infoc_1.nout;
00187 s_wsfe(&io___20);
00188 do_fio(&c__1, "ZCGESV", (ftnlen)6);
00189 e_wsfe();
00190 }
00191
00192
00193 return 0;
00194
00195
00196
00197 }