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
00020 int alasum_(char *type__, integer *nout, integer *nfail,
00021 integer *nrun, integer *nerrs)
00022 {
00023
00024 static char fmt_9999[] = "(1x,a3,\002: \002,i6,\002 out of \002,i6,\002 "
00025 "tests failed to pass the threshold\002)";
00026 static char fmt_9998[] = "(/1x,\002All tests for \002,a3,\002 routines p"
00027 "assed the threshold (\002,i6,\002 tests run)\002)";
00028 static char fmt_9997[] = "(6x,i6,\002 error messages recorded\002)";
00029
00030
00031 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00032
00033
00034 static cilist io___1 = { 0, 0, 0, fmt_9999, 0 };
00035 static cilist io___2 = { 0, 0, 0, fmt_9998, 0 };
00036 static cilist io___3 = { 0, 0, 0, fmt_9997, 0 };
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075 if (*nfail > 0) {
00076 io___1.ciunit = *nout;
00077 s_wsfe(&io___1);
00078 do_fio(&c__1, type__, (ftnlen)3);
00079 do_fio(&c__1, (char *)&(*nfail), (ftnlen)sizeof(integer));
00080 do_fio(&c__1, (char *)&(*nrun), (ftnlen)sizeof(integer));
00081 e_wsfe();
00082 } else {
00083 io___2.ciunit = *nout;
00084 s_wsfe(&io___2);
00085 do_fio(&c__1, type__, (ftnlen)3);
00086 do_fio(&c__1, (char *)&(*nrun), (ftnlen)sizeof(integer));
00087 e_wsfe();
00088 }
00089 if (*nerrs > 0) {
00090 io___3.ciunit = *nout;
00091 s_wsfe(&io___3);
00092 do_fio(&c__1, (char *)&(*nerrs), (ftnlen)sizeof(integer));
00093 e_wsfe();
00094 }
00095
00096 return 0;
00097
00098
00099
00100 }