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__2 = 2;
00034 static integer c_n1 = -1;
00035 static integer c__0 = 0;
00036 static integer c__1 = 1;
00037
00038 int serrtz_(char *path, integer *nunit)
00039 {
00040
00041 integer s_wsle(cilist *), e_wsle(void);
00042 int s_copy(char *, char *, ftnlen, ftnlen);
00043
00044
00045 real a[4] , w[2];
00046 char c2[2];
00047 real tau[2];
00048 integer info;
00049 extern int alaesm_(char *, logical *, integer *);
00050 extern logical lsamen_(integer *, char *, char *);
00051 extern int chkxer_(char *, integer *, integer *, logical
00052 *, logical *), stzrqf_(integer *, integer *, real *,
00053 integer *, real *, integer *), stzrzf_(integer *, integer *, real
00054 *, integer *, real *, real *, integer *, integer *);
00055
00056
00057 static cilist io___1 = { 0, 0, 0, 0, 0 };
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 infoc_1.nout = *nunit;
00101 io___1.ciunit = infoc_1.nout;
00102 s_wsle(&io___1);
00103 e_wsle();
00104 s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00105 a[0] = 1.f;
00106 a[2] = 2.f;
00107 a[3] = 3.f;
00108 a[1] = 4.f;
00109 w[0] = 0.f;
00110 w[1] = 0.f;
00111 infoc_1.ok = TRUE_;
00112
00113 if (lsamen_(&c__2, c2, "TZ")) {
00114
00115
00116
00117
00118
00119 s_copy(srnamc_1.srnamt, "STZRQF", (ftnlen)32, (ftnlen)6);
00120 infoc_1.infot = 1;
00121 stzrqf_(&c_n1, &c__0, a, &c__1, tau, &info);
00122 chkxer_("STZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00123 infoc_1.ok);
00124 infoc_1.infot = 2;
00125 stzrqf_(&c__1, &c__0, a, &c__1, tau, &info);
00126 chkxer_("STZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00127 infoc_1.ok);
00128 infoc_1.infot = 4;
00129 stzrqf_(&c__2, &c__2, a, &c__1, tau, &info);
00130 chkxer_("STZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00131 infoc_1.ok);
00132
00133
00134
00135 s_copy(srnamc_1.srnamt, "STZRZF", (ftnlen)32, (ftnlen)6);
00136 infoc_1.infot = 1;
00137 stzrzf_(&c_n1, &c__0, a, &c__1, tau, w, &c__1, &info);
00138 chkxer_("STZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00139 infoc_1.ok);
00140 infoc_1.infot = 2;
00141 stzrzf_(&c__1, &c__0, a, &c__1, tau, w, &c__1, &info);
00142 chkxer_("STZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00143 infoc_1.ok);
00144 infoc_1.infot = 4;
00145 stzrzf_(&c__2, &c__2, a, &c__1, tau, w, &c__1, &info);
00146 chkxer_("STZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00147 infoc_1.ok);
00148 infoc_1.infot = 7;
00149 stzrzf_(&c__2, &c__2, a, &c__2, tau, w, &c__1, &info);
00150 chkxer_("STZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00151 infoc_1.ok);
00152 }
00153
00154
00155
00156 alaesm_(path, &infoc_1.ok, &infoc_1.nout);
00157
00158 return 0;
00159
00160
00161
00162 }