dchkpt.c
Go to the documentation of this file.
00001 /* dchkpt.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Common Block Declarations */
00017 
00018 struct {
00019     integer infot, nunit;
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 /* Table of constant values */
00032 
00033 static integer c__2 = 2;
00034 static integer c__0 = 0;
00035 static integer c_n1 = -1;
00036 static integer c__1 = 1;
00037 static doublereal c_b46 = 1.;
00038 static doublereal c_b47 = 0.;
00039 static integer c__7 = 7;
00040 
00041 /* Subroutine */ int dchkpt_(logical *dotype, integer *nn, integer *nval, 
00042         integer *nns, integer *nsval, doublereal *thresh, logical *tsterr, 
00043         doublereal *a, doublereal *d__, doublereal *e, doublereal *b, 
00044         doublereal *x, doublereal *xact, doublereal *work, doublereal *rwork, 
00045         integer *nout)
00046 {
00047     /* Initialized data */
00048 
00049     static integer iseedy[4] = { 0,0,0,1 };
00050 
00051     /* Format strings */
00052     static char fmt_9999[] = "(\002 N =\002,i5,\002, type \002,i2,\002, te"
00053             "st \002,i2,\002, ratio = \002,g12.5)";
00054     static char fmt_9998[] = "(\002 N =\002,i5,\002, NRHS=\002,i3,\002, ty"
00055             "pe \002,i2,\002, test(\002,i2,\002) = \002,g12.5)";
00056 
00057     /* System generated locals */
00058     integer i__1, i__2, i__3, i__4;
00059     doublereal d__1, d__2, d__3;
00060 
00061     /* Builtin functions */
00062     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00063     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00064 
00065     /* Local variables */
00066     integer i__, j, k, n;
00067     doublereal z__[3];
00068     integer ia, in, kl, ku, ix, lda;
00069     doublereal cond;
00070     integer mode;
00071     doublereal dmax__;
00072     integer imat, info;
00073     char path[3], dist[1];
00074     integer irhs, nrhs;
00075     char type__[1];
00076     integer nrun;
00077     extern /* Subroutine */ int alahd_(integer *, char *), dscal_(
00078             integer *, doublereal *, doublereal *, integer *), dget04_(
00079             integer *, integer *, doublereal *, integer *, doublereal *, 
00080             integer *, doublereal *, doublereal *);
00081     integer nfail, iseed[4];
00082     extern doublereal dget06_(doublereal *, doublereal *);
00083     doublereal rcond;
00084     integer nimat;
00085     extern doublereal dasum_(integer *, doublereal *, integer *);
00086     doublereal anorm;
00087     extern /* Subroutine */ int dptt01_(integer *, doublereal *, doublereal *, 
00088              doublereal *, doublereal *, doublereal *, doublereal *), dcopy_(
00089             integer *, doublereal *, integer *, doublereal *, integer *), 
00090             dptt02_(integer *, integer *, doublereal *, doublereal *, 
00091             doublereal *, integer *, doublereal *, integer *, doublereal *), 
00092             dptt05_(integer *, integer *, doublereal *, doublereal *, 
00093             doublereal *, integer *, doublereal *, integer *, doublereal *, 
00094             integer *, doublereal *, doublereal *, doublereal *);
00095     integer izero, nerrs;
00096     logical zerot;
00097     extern /* Subroutine */ int dlatb4_(char *, integer *, integer *, integer 
00098             *, char *, integer *, integer *, doublereal *, integer *, 
00099             doublereal *, char *), alaerh_(char *, 
00100             char *, integer *, integer *, char *, integer *, integer *, 
00101             integer *, integer *, integer *, integer *, integer *, integer *, 
00102             integer *);
00103     extern integer idamax_(integer *, doublereal *, integer *);
00104     doublereal rcondc;
00105     extern /* Subroutine */ int dlacpy_(char *, integer *, integer *, 
00106             doublereal *, integer *, doublereal *, integer *), 
00107             dlaptm_(integer *, integer *, doublereal *, doublereal *, 
00108             doublereal *, doublereal *, integer *, doublereal *, doublereal *, 
00109              integer *), alasum_(char *, integer *, integer *, integer *, 
00110             integer *), dlatms_(integer *, integer *, char *, integer 
00111             *, char *, doublereal *, integer *, doublereal *, doublereal *, 
00112             integer *, integer *, char *, doublereal *, integer *, doublereal 
00113             *, integer *);
00114     extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
00115     extern /* Subroutine */ int dlarnv_(integer *, integer *, integer *, 
00116             doublereal *), derrgt_(char *, integer *);
00117     doublereal ainvnm;
00118     extern /* Subroutine */ int dptcon_(integer *, doublereal *, doublereal *, 
00119              doublereal *, doublereal *, doublereal *, integer *), dptrfs_(
00120             integer *, integer *, doublereal *, doublereal *, doublereal *, 
00121             doublereal *, doublereal *, integer *, doublereal *, integer *, 
00122             doublereal *, doublereal *, doublereal *, integer *), dpttrf_(
00123             integer *, doublereal *, doublereal *, integer *);
00124     doublereal result[7];
00125     extern /* Subroutine */ int dpttrs_(integer *, integer *, doublereal *, 
00126             doublereal *, doublereal *, integer *, integer *);
00127 
00128     /* Fortran I/O blocks */
00129     static cilist io___29 = { 0, 0, 0, fmt_9999, 0 };
00130     static cilist io___35 = { 0, 0, 0, fmt_9998, 0 };
00131     static cilist io___37 = { 0, 0, 0, fmt_9999, 0 };
00132 
00133 
00134 
00135 /*  -- LAPACK test routine (version 3.1) -- */
00136 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00137 /*     November 2006 */
00138 
00139 /*     .. Scalar Arguments .. */
00140 /*     .. */
00141 /*     .. Array Arguments .. */
00142 /*     .. */
00143 
00144 /*  Purpose */
00145 /*  ======= */
00146 
00147 /*  DCHKPT tests DPTTRF, -TRS, -RFS, and -CON */
00148 
00149 /*  Arguments */
00150 /*  ========= */
00151 
00152 /*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
00153 /*          The matrix types to be used for testing.  Matrices of type j */
00154 /*          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
00155 /*          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */
00156 
00157 /*  NN      (input) INTEGER */
00158 /*          The number of values of N contained in the vector NVAL. */
00159 
00160 /*  NVAL    (input) INTEGER array, dimension (NN) */
00161 /*          The values of the matrix dimension N. */
00162 
00163 /*  NNS     (input) INTEGER */
00164 /*          The number of values of NRHS contained in the vector NSVAL. */
00165 
00166 /*  NSVAL   (input) INTEGER array, dimension (NNS) */
00167 /*          The values of the number of right hand sides NRHS. */
00168 
00169 /*  THRESH  (input) DOUBLE PRECISION */
00170 /*          The threshold value for the test ratios.  A result is */
00171 /*          included in the output file if RESULT >= THRESH.  To have */
00172 /*          every test ratio printed, use THRESH = 0. */
00173 
00174 /*  TSTERR  (input) LOGICAL */
00175 /*          Flag that indicates whether error exits are to be tested. */
00176 
00177 /*  A       (workspace) DOUBLE PRECISION array, dimension (NMAX*2) */
00178 
00179 /*  D       (workspace) DOUBLE PRECISION array, dimension (NMAX*2) */
00180 
00181 /*  E       (workspace) DOUBLE PRECISION array, dimension (NMAX*2) */
00182 
00183 /*  B       (workspace) DOUBLE PRECISION array, dimension (NMAX*NSMAX) */
00184 /*          where NSMAX is the largest entry in NSVAL. */
00185 
00186 /*  X       (workspace) DOUBLE PRECISION array, dimension (NMAX*NSMAX) */
00187 
00188 /*  XACT    (workspace) DOUBLE PRECISION array, dimension (NMAX*NSMAX) */
00189 
00190 /*  WORK    (workspace) DOUBLE PRECISION array, dimension */
00191 /*                      (NMAX*max(3,NSMAX)) */
00192 
00193 /*  RWORK   (workspace) DOUBLE PRECISION array, dimension */
00194 /*                      (max(NMAX,2*NSMAX)) */
00195 
00196 /*  NOUT    (input) INTEGER */
00197 /*          The unit number for output. */
00198 
00199 /*  ===================================================================== */
00200 
00201 /*     .. Parameters .. */
00202 /*     .. */
00203 /*     .. Local Scalars .. */
00204 /*     .. */
00205 /*     .. Local Arrays .. */
00206 /*     .. */
00207 /*     .. External Functions .. */
00208 /*     .. */
00209 /*     .. External Subroutines .. */
00210 /*     .. */
00211 /*     .. Intrinsic Functions .. */
00212 /*     .. */
00213 /*     .. Scalars in Common .. */
00214 /*     .. */
00215 /*     .. Common blocks .. */
00216 /*     .. */
00217 /*     .. Data statements .. */
00218     /* Parameter adjustments */
00219     --rwork;
00220     --work;
00221     --xact;
00222     --x;
00223     --b;
00224     --e;
00225     --d__;
00226     --a;
00227     --nsval;
00228     --nval;
00229     --dotype;
00230 
00231     /* Function Body */
00232 /*     .. */
00233 /*     .. Executable Statements .. */
00234 
00235     s_copy(path, "Double precision", (ftnlen)1, (ftnlen)16);
00236     s_copy(path + 1, "PT", (ftnlen)2, (ftnlen)2);
00237     nrun = 0;
00238     nfail = 0;
00239     nerrs = 0;
00240     for (i__ = 1; i__ <= 4; ++i__) {
00241         iseed[i__ - 1] = iseedy[i__ - 1];
00242 /* L10: */
00243     }
00244 
00245 /*     Test the error exits */
00246 
00247     if (*tsterr) {
00248         derrgt_(path, nout);
00249     }
00250     infoc_1.infot = 0;
00251 
00252     i__1 = *nn;
00253     for (in = 1; in <= i__1; ++in) {
00254 
00255 /*        Do for each value of N in NVAL. */
00256 
00257         n = nval[in];
00258         lda = max(1,n);
00259         nimat = 12;
00260         if (n <= 0) {
00261             nimat = 1;
00262         }
00263 
00264         i__2 = nimat;
00265         for (imat = 1; imat <= i__2; ++imat) {
00266 
00267 /*           Do the tests only if DOTYPE( IMAT ) is true. */
00268 
00269             if (n > 0 && ! dotype[imat]) {
00270                 goto L100;
00271             }
00272 
00273 /*           Set up parameters with DLATB4. */
00274 
00275             dlatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode, &
00276                     cond, dist);
00277 
00278             zerot = imat >= 8 && imat <= 10;
00279             if (imat <= 6) {
00280 
00281 /*              Type 1-6:  generate a symmetric tridiagonal matrix of */
00282 /*              known condition number in lower triangular band storage. */
00283 
00284                 s_copy(srnamc_1.srnamt, "DLATMS", (ftnlen)32, (ftnlen)6);
00285                 dlatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &cond, 
00286                         &anorm, &kl, &ku, "B", &a[1], &c__2, &work[1], &info);
00287 
00288 /*              Check the error code from DLATMS. */
00289 
00290                 if (info != 0) {
00291                     alaerh_(path, "DLATMS", &info, &c__0, " ", &n, &n, &kl, &
00292                             ku, &c_n1, &imat, &nfail, &nerrs, nout);
00293                     goto L100;
00294                 }
00295                 izero = 0;
00296 
00297 /*              Copy the matrix to D and E. */
00298 
00299                 ia = 1;
00300                 i__3 = n - 1;
00301                 for (i__ = 1; i__ <= i__3; ++i__) {
00302                     d__[i__] = a[ia];
00303                     e[i__] = a[ia + 1];
00304                     ia += 2;
00305 /* L20: */
00306                 }
00307                 if (n > 0) {
00308                     d__[n] = a[ia];
00309                 }
00310             } else {
00311 
00312 /*              Type 7-12:  generate a diagonally dominant matrix with */
00313 /*              unknown condition number in the vectors D and E. */
00314 
00315                 if (! zerot || ! dotype[7]) {
00316 
00317 /*                 Let D and E have values from [-1,1]. */
00318 
00319                     dlarnv_(&c__2, iseed, &n, &d__[1]);
00320                     i__3 = n - 1;
00321                     dlarnv_(&c__2, iseed, &i__3, &e[1]);
00322 
00323 /*                 Make the tridiagonal matrix diagonally dominant. */
00324 
00325                     if (n == 1) {
00326                         d__[1] = abs(d__[1]);
00327                     } else {
00328                         d__[1] = abs(d__[1]) + abs(e[1]);
00329                         d__[n] = (d__1 = d__[n], abs(d__1)) + (d__2 = e[n - 1]
00330                                 , abs(d__2));
00331                         i__3 = n - 1;
00332                         for (i__ = 2; i__ <= i__3; ++i__) {
00333                             d__[i__] = (d__1 = d__[i__], abs(d__1)) + (d__2 = 
00334                                     e[i__], abs(d__2)) + (d__3 = e[i__ - 1], 
00335                                     abs(d__3));
00336 /* L30: */
00337                         }
00338                     }
00339 
00340 /*                 Scale D and E so the maximum element is ANORM. */
00341 
00342                     ix = idamax_(&n, &d__[1], &c__1);
00343                     dmax__ = d__[ix];
00344                     d__1 = anorm / dmax__;
00345                     dscal_(&n, &d__1, &d__[1], &c__1);
00346                     i__3 = n - 1;
00347                     d__1 = anorm / dmax__;
00348                     dscal_(&i__3, &d__1, &e[1], &c__1);
00349 
00350                 } else if (izero > 0) {
00351 
00352 /*                 Reuse the last matrix by copying back the zeroed out */
00353 /*                 elements. */
00354 
00355                     if (izero == 1) {
00356                         d__[1] = z__[1];
00357                         if (n > 1) {
00358                             e[1] = z__[2];
00359                         }
00360                     } else if (izero == n) {
00361                         e[n - 1] = z__[0];
00362                         d__[n] = z__[1];
00363                     } else {
00364                         e[izero - 1] = z__[0];
00365                         d__[izero] = z__[1];
00366                         e[izero] = z__[2];
00367                     }
00368                 }
00369 
00370 /*              For types 8-10, set one row and column of the matrix to */
00371 /*              zero. */
00372 
00373                 izero = 0;
00374                 if (imat == 8) {
00375                     izero = 1;
00376                     z__[1] = d__[1];
00377                     d__[1] = 0.;
00378                     if (n > 1) {
00379                         z__[2] = e[1];
00380                         e[1] = 0.;
00381                     }
00382                 } else if (imat == 9) {
00383                     izero = n;
00384                     if (n > 1) {
00385                         z__[0] = e[n - 1];
00386                         e[n - 1] = 0.;
00387                     }
00388                     z__[1] = d__[n];
00389                     d__[n] = 0.;
00390                 } else if (imat == 10) {
00391                     izero = (n + 1) / 2;
00392                     if (izero > 1) {
00393                         z__[0] = e[izero - 1];
00394                         e[izero - 1] = 0.;
00395                         z__[2] = e[izero];
00396                         e[izero] = 0.;
00397                     }
00398                     z__[1] = d__[izero];
00399                     d__[izero] = 0.;
00400                 }
00401             }
00402 
00403             dcopy_(&n, &d__[1], &c__1, &d__[n + 1], &c__1);
00404             if (n > 1) {
00405                 i__3 = n - 1;
00406                 dcopy_(&i__3, &e[1], &c__1, &e[n + 1], &c__1);
00407             }
00408 
00409 /* +    TEST 1 */
00410 /*           Factor A as L*D*L' and compute the ratio */
00411 /*              norm(L*D*L' - A) / (n * norm(A) * EPS ) */
00412 
00413             dpttrf_(&n, &d__[n + 1], &e[n + 1], &info);
00414 
00415 /*           Check error code from DPTTRF. */
00416 
00417             if (info != izero) {
00418                 alaerh_(path, "DPTTRF", &info, &izero, " ", &n, &n, &c_n1, &
00419                         c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
00420                 goto L100;
00421             }
00422 
00423             if (info > 0) {
00424                 rcondc = 0.;
00425                 goto L90;
00426             }
00427 
00428             dptt01_(&n, &d__[1], &e[1], &d__[n + 1], &e[n + 1], &work[1], 
00429                     result);
00430 
00431 /*           Print the test ratio if greater than or equal to THRESH. */
00432 
00433             if (result[0] >= *thresh) {
00434                 if (nfail == 0 && nerrs == 0) {
00435                     alahd_(nout, path);
00436                 }
00437                 io___29.ciunit = *nout;
00438                 s_wsfe(&io___29);
00439                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00440                 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00441                 do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00442                 do_fio(&c__1, (char *)&result[0], (ftnlen)sizeof(doublereal));
00443                 e_wsfe();
00444                 ++nfail;
00445             }
00446             ++nrun;
00447 
00448 /*           Compute RCONDC = 1 / (norm(A) * norm(inv(A)) */
00449 
00450 /*           Compute norm(A). */
00451 
00452             anorm = dlanst_("1", &n, &d__[1], &e[1]);
00453 
00454 /*           Use DPTTRS to solve for one column at a time of inv(A), */
00455 /*           computing the maximum column sum as we go. */
00456 
00457             ainvnm = 0.;
00458             i__3 = n;
00459             for (i__ = 1; i__ <= i__3; ++i__) {
00460                 i__4 = n;
00461                 for (j = 1; j <= i__4; ++j) {
00462                     x[j] = 0.;
00463 /* L40: */
00464                 }
00465                 x[i__] = 1.;
00466                 dpttrs_(&n, &c__1, &d__[n + 1], &e[n + 1], &x[1], &lda, &info)
00467                         ;
00468 /* Computing MAX */
00469                 d__1 = ainvnm, d__2 = dasum_(&n, &x[1], &c__1);
00470                 ainvnm = max(d__1,d__2);
00471 /* L50: */
00472             }
00473 /* Computing MAX */
00474             d__1 = 1., d__2 = anorm * ainvnm;
00475             rcondc = 1. / max(d__1,d__2);
00476 
00477             i__3 = *nns;
00478             for (irhs = 1; irhs <= i__3; ++irhs) {
00479                 nrhs = nsval[irhs];
00480 
00481 /*           Generate NRHS random solution vectors. */
00482 
00483                 ix = 1;
00484                 i__4 = nrhs;
00485                 for (j = 1; j <= i__4; ++j) {
00486                     dlarnv_(&c__2, iseed, &n, &xact[ix]);
00487                     ix += lda;
00488 /* L60: */
00489                 }
00490 
00491 /*           Set the right hand side. */
00492 
00493                 dlaptm_(&n, &nrhs, &c_b46, &d__[1], &e[1], &xact[1], &lda, &
00494                         c_b47, &b[1], &lda);
00495 
00496 /* +    TEST 2 */
00497 /*           Solve A*x = b and compute the residual. */
00498 
00499                 dlacpy_("Full", &n, &nrhs, &b[1], &lda, &x[1], &lda);
00500                 dpttrs_(&n, &nrhs, &d__[n + 1], &e[n + 1], &x[1], &lda, &info)
00501                         ;
00502 
00503 /*           Check error code from DPTTRS. */
00504 
00505                 if (info != 0) {
00506                     alaerh_(path, "DPTTRS", &info, &c__0, " ", &n, &n, &c_n1, 
00507                             &c_n1, &nrhs, &imat, &nfail, &nerrs, nout);
00508                 }
00509 
00510                 dlacpy_("Full", &n, &nrhs, &b[1], &lda, &work[1], &lda);
00511                 dptt02_(&n, &nrhs, &d__[1], &e[1], &x[1], &lda, &work[1], &
00512                         lda, &result[1]);
00513 
00514 /* +    TEST 3 */
00515 /*           Check solution from generated exact solution. */
00516 
00517                 dget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &rcondc, &
00518                         result[2]);
00519 
00520 /* +    TESTS 4, 5, and 6 */
00521 /*           Use iterative refinement to improve the solution. */
00522 
00523                 s_copy(srnamc_1.srnamt, "DPTRFS", (ftnlen)32, (ftnlen)6);
00524                 dptrfs_(&n, &nrhs, &d__[1], &e[1], &d__[n + 1], &e[n + 1], &b[
00525                         1], &lda, &x[1], &lda, &rwork[1], &rwork[nrhs + 1], &
00526                         work[1], &info);
00527 
00528 /*           Check error code from DPTRFS. */
00529 
00530                 if (info != 0) {
00531                     alaerh_(path, "DPTRFS", &info, &c__0, " ", &n, &n, &c_n1, 
00532                             &c_n1, &nrhs, &imat, &nfail, &nerrs, nout);
00533                 }
00534 
00535                 dget04_(&n, &nrhs, &x[1], &lda, &xact[1], &lda, &rcondc, &
00536                         result[3]);
00537                 dptt05_(&n, &nrhs, &d__[1], &e[1], &b[1], &lda, &x[1], &lda, &
00538                         xact[1], &lda, &rwork[1], &rwork[nrhs + 1], &result[4]
00539 );
00540 
00541 /*           Print information about the tests that did not pass the */
00542 /*           threshold. */
00543 
00544                 for (k = 2; k <= 6; ++k) {
00545                     if (result[k - 1] >= *thresh) {
00546                         if (nfail == 0 && nerrs == 0) {
00547                             alahd_(nout, path);
00548                         }
00549                         io___35.ciunit = *nout;
00550                         s_wsfe(&io___35);
00551                         do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00552                         do_fio(&c__1, (char *)&nrhs, (ftnlen)sizeof(integer));
00553                         do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00554                         do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
00555                         do_fio(&c__1, (char *)&result[k - 1], (ftnlen)sizeof(
00556                                 doublereal));
00557                         e_wsfe();
00558                         ++nfail;
00559                     }
00560 /* L70: */
00561                 }
00562                 nrun += 5;
00563 /* L80: */
00564             }
00565 
00566 /* +    TEST 7 */
00567 /*           Estimate the reciprocal of the condition number of the */
00568 /*           matrix. */
00569 
00570 L90:
00571             s_copy(srnamc_1.srnamt, "DPTCON", (ftnlen)32, (ftnlen)6);
00572             dptcon_(&n, &d__[n + 1], &e[n + 1], &anorm, &rcond, &rwork[1], &
00573                     info);
00574 
00575 /*           Check error code from DPTCON. */
00576 
00577             if (info != 0) {
00578                 alaerh_(path, "DPTCON", &info, &c__0, " ", &n, &n, &c_n1, &
00579                         c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
00580             }
00581 
00582             result[6] = dget06_(&rcond, &rcondc);
00583 
00584 /*           Print the test ratio if greater than or equal to THRESH. */
00585 
00586             if (result[6] >= *thresh) {
00587                 if (nfail == 0 && nerrs == 0) {
00588                     alahd_(nout, path);
00589                 }
00590                 io___37.ciunit = *nout;
00591                 s_wsfe(&io___37);
00592                 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00593                 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00594                 do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
00595                 do_fio(&c__1, (char *)&result[6], (ftnlen)sizeof(doublereal));
00596                 e_wsfe();
00597                 ++nfail;
00598             }
00599             ++nrun;
00600 L100:
00601             ;
00602         }
00603 /* L110: */
00604     }
00605 
00606 /*     Print a summary of the results. */
00607 
00608     alasum_(path, nout, &nfail, &nrun, &nerrs);
00609 
00610     return 0;
00611 
00612 /*     End of DCHKPT */
00613 
00614 } /* dchkpt_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:38