C++ do_fio函数代码示例

OStack程序员社区-中国程序员成长平台 › 门户 › 编程› C++›C++教程

原作者: [db:作者] 来自: [db:来源] 收藏邀请

本文整理汇总了C++中do_fio函数的典型用法代码示例。如果您正苦于以下问题：C++ do_fio函数的具体用法？C++ do_fio怎么用？C++ do_fio使用的例子？那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。

在下文中一共展示了do_fio函数的20个代码示例，这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞，您的评价将有助于我们的系统推荐出更棒的C++代码示例。

示例1: isdcgn_


//.........这里部分代码省略.........
/*   910502  Removed MATVEC, MTTVEC and MSOLVE from ROUTINES CALLED */
/*           list.  (FNF) */
/*   910506  Made subsidiary to DCGN.  (FNF) */
/*   920407  COMMON BLOCK renamed DSLBLK.  (WRB) */
/*   920511  Added complete declaration section.  (WRB) */
/*   920930  Corrected to not print AK,BK when ITER=0.  (FNF) */
/*   921026  Changed 1.0E10 to D1MACH(2) and corrected D to E in */
/*           output format.  (FNF) */
/*   921113  Corrected C***CATEGORY line.  (FNF) */
/* ***END PROLOGUE  ISDCGN */
/*     .. Scalar Arguments .. */
/*     .. Array Arguments .. */
/*     .. Subroutine Arguments .. */
/*     .. Arrays in Common .. */
/*     .. Local Scalars .. */
/*     .. External Functions .. */
/*     .. Common blocks .. */
/* ***FIRST EXECUTABLE STATEMENT  ISDCGN */
    /* Parameter adjustments */
    --atdz;
    --dz;
    --atz;
    --atp;
    --p;
    --z__;
    --r__;
    --a;
    --x;
    --b;
    --ja;
    --ia;
    --rwork;
    --iwork;

    /* Function Body */
    ret_val = 0;

    if (*itol == 1) {
/*         err = ||Residual||/||RightHandSide|| (2-Norms). */
	if (*iter == 0) {
	    *bnrm = dnrm2_(n, &b[1], &c__1);
	}
	*err = dnrm2_(n, &r__[1], &c__1) / *bnrm;
    } else if (*itol == 2) {
/*                  -1              -1 */
/*         err = ||M  Residual||/||M  RightHandSide|| (2-Norms). */
	if (*iter == 0) {
	    (*msolve)(n, &b[1], &dz[1], nelt, &ia[1], &ja[1], &a[1], isym, &
		    rwork[1], &iwork[1]);
	    (*mttvec)(n, &dz[1], &atdz[1], nelt, &ia[1], &ja[1], &a[1], isym);
	    *bnrm = dnrm2_(n, &atdz[1], &c__1);
	}
	*err = dnrm2_(n, &atz[1], &c__1) / *bnrm;
    } else if (*itol == 11) {
/*         err = ||x-TrueSolution||/||TrueSolution|| (2-Norms). */
	if (*iter == 0) {
	    *solnrm = dnrm2_(n, dslblk_1.soln, &c__1);
	}
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    dz[i__] = x[i__] - dslblk_1.soln[i__ - 1];
/* L10: */
	}
	*err = dnrm2_(n, &dz[1], &c__1) / *solnrm;
    } else {

/*         If we get here ITOL is not one of the acceptable values. */
	*err = d1mach_(&c__2);
	*ierr = 3;
    }

    if (*iunit != 0) {
	if (*iter == 0) {
	    io___2.ciunit = *iunit;
	    s_wsfe(&io___2);
	    do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer));
	    do_fio(&c__1, (char *)&(*itol), (ftnlen)sizeof(integer));
	    e_wsfe();
	    io___3.ciunit = *iunit;
	    s_wsfe(&io___3);
	    do_fio(&c__1, (char *)&(*iter), (ftnlen)sizeof(integer));
	    do_fio(&c__1, (char *)&(*err), (ftnlen)sizeof(doublereal));
	    e_wsfe();
	} else {
	    io___4.ciunit = *iunit;
	    s_wsfe(&io___4);
	    do_fio(&c__1, (char *)&(*iter), (ftnlen)sizeof(integer));
	    do_fio(&c__1, (char *)&(*err), (ftnlen)sizeof(doublereal));
	    do_fio(&c__1, (char *)&(*ak), (ftnlen)sizeof(doublereal));
	    do_fio(&c__1, (char *)&(*bk), (ftnlen)sizeof(doublereal));
	    e_wsfe();
	}
    }
    if (*err <= *tol) {
	ret_val = 1;
    }

    return ret_val;
/* ------------- LAST LINE OF ISDCGN FOLLOWS ---------------------------- */
} /* isdcgn_ */

开发者ID:Rufflewind，项目名称:cslatec，代码行数:101，代码来源:isdcgn.c

示例2: s_wsfe

/* Subroutine */ int ddrvsp_(logical *dotype, integer *nn, integer *nval, 
	integer *nrhs, doublereal *thresh, logical *tsterr, integer *nmax, 
	doublereal *a, doublereal *afac, doublereal *ainv, doublereal *b, 
	doublereal *x, doublereal *xact, doublereal *work, doublereal *rwork, 
	integer *iwork, integer *nout)
{
    /* Initialized data */

    static integer iseedy[4] = { 1988,1989,1990,1991 };
    static char facts[1*2] = "F" "N";

    /* Format strings */
    static char fmt_9999[] = "(1x,a6,\002, UPLO='\002,a1,\002', N =\002,i5"
	    ",\002, type \002,i2,\002, test \002,i2,\002, ratio =\002,g12.5)";
    static char fmt_9998[] = "(1x,a6,\002, FACT='\002,a1,\002', UPLO='\002,a"
	    "1,\002', N =\002,i5,\002, type \002,i2,\002, test \002,i2,\002, "
	    "ratio =\002,g12.5)";

    /* System generated locals */
    address a__1[2];
    integer i__1, i__2, i__3, i__4, i__5[2];
    char ch__1[2];

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    /* Local variables */
    integer i__, j, k, n, i1, i2, k1, in, kl, ku, nt, lda, npp;
    char fact[1];
    integer ioff, mode, imat, info;
    char path[3], dist[1], uplo[1], type__[1];
    integer nrun, ifact;
    extern /* Subroutine */ int dget04_(integer *, integer *, doublereal *, 
	    integer *, doublereal *, integer *, doublereal *, doublereal *);
    integer nfail, iseed[4];
    extern doublereal dget06_(doublereal *, doublereal *);
    doublereal rcond;
    integer nimat;
    extern /* Subroutine */ int dppt02_(char *, integer *, integer *, 
	    doublereal *, doublereal *, integer *, doublereal *, integer *, 
	    doublereal *, doublereal *), dspt01_(char *, integer *, 
	    doublereal *, doublereal *, integer *, doublereal *, integer *, 
	    doublereal *, doublereal *);
    doublereal anorm;
    extern /* Subroutine */ int dppt05_(char *, integer *, integer *, 
	    doublereal *, doublereal *, integer *, doublereal *, integer *, 
	    doublereal *, integer *, doublereal *, doublereal *, doublereal *), dcopy_(integer *, doublereal *, integer *, doublereal *, 
	     integer *);
    integer iuplo, izero, nerrs, lwork;
    extern /* Subroutine */ int dspsv_(char *, integer *, integer *, 
	    doublereal *, integer *, doublereal *, integer *, integer *);
    logical zerot;
    char xtype[1];
    extern /* Subroutine */ int dlatb4_(char *, integer *, integer *, integer 
	    *, char *, integer *, integer *, doublereal *, integer *, 
	    doublereal *, char *), aladhd_(integer *, 
	    char *), alaerh_(char *, char *, integer *, integer *, 
	    char *, integer *, integer *, integer *, integer *, integer *, 
	    integer *, integer *, integer *, integer *);
    doublereal rcondc;
    char packit[1];
    extern /* Subroutine */ int dlacpy_(char *, integer *, integer *, 
	    doublereal *, integer *, doublereal *, integer *), 
	    dlarhs_(char *, char *, char *, char *, integer *, integer *, 
	    integer *, integer *, integer *, doublereal *, integer *, 
	    doublereal *, integer *, doublereal *, integer *, integer *, 
	    integer *), dlaset_(char *, 
	    integer *, integer *, doublereal *, doublereal *, doublereal *, 
	    integer *);
    extern doublereal dlansp_(char *, char *, integer *, doublereal *, 
	    doublereal *);
    extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer 
	    *, integer *);
    doublereal cndnum;
    extern /* Subroutine */ int dlatms_(integer *, integer *, char *, integer 
	    *, char *, doublereal *, integer *, doublereal *, doublereal *, 
	    integer *, integer *, char *, doublereal *, integer *, doublereal 
	    *, integer *);
    doublereal ainvnm;
    extern /* Subroutine */ int dsptrf_(char *, integer *, doublereal *, 
	    integer *, integer *), dsptri_(char *, integer *, 
	    doublereal *, integer *, doublereal *, integer *), 
	    derrvx_(char *, integer *);
    doublereal result[6];
    extern /* Subroutine */ int dspsvx_(char *, char *, integer *, integer *, 
	    doublereal *, doublereal *, integer *, doublereal *, integer *, 
	    doublereal *, integer *, doublereal *, doublereal *, doublereal *, 
	     doublereal *, integer *, integer *);

    /* Fortran I/O blocks */
    static cilist io___41 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___44 = { 0, 0, 0, fmt_9998, 0 };



/*  -- LAPACK test routine (version 3.1) -- */
/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/*     November 2006 */
//.........这里部分代码省略.........

开发者ID:kstraube，项目名称:hysim，代码行数:101，代码来源:ddrvsp.c

示例3: between

/* Subroutine */ int sdrgsx_(integer *nsize, integer *ncmax, real *thresh, 
	integer *nin, integer *nout, real *a, integer *lda, real *b, real *ai,
	 real *bi, real *z__, real *q, real *alphar, real *alphai, real *beta,
	 real *c__, integer *ldc, real *s, real *work, integer *lwork, 
	integer *iwork, integer *liwork, logical *bwork, integer *info)
{
    /* Format strings */
    static char fmt_9999[] = "(\002 SDRGSX: \002,a,\002 returned INFO=\002,i"
	    "6,\002.\002,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002)\002)";
    static char fmt_9997[] = "(\002 SDRGSX: SGET53 returned INFO=\002,i1,"
	    "\002 for eigenvalue \002,i6,\002.\002,/9x,\002N=\002,i6,\002, JT"
	    "YPE=\002,i6,\002)\002)";
    static char fmt_9996[] = "(\002 SDRGSX: S not in Schur form at eigenvalu"
	    "e \002,i6,\002.\002,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002"
	    ")\002)";
    static char fmt_9995[] = "(/1x,a3,\002 -- Real Expert Generalized Schur "
	    "form\002,\002 problem driver\002)";
    static char fmt_9993[] = "(\002 Matrix types: \002,/\002  1:  A is a blo"
	    "ck diagonal matrix of Jordan blocks \002,\002and B is the identi"
	    "ty \002,/\002      matrix, \002,/\002  2:  A and B are upper tri"
	    "angular matrices, \002,/\002  3:  A and B are as type 2, but eac"
	    "h second diagonal \002,\002block in A_11 and \002,/\002      eac"
	    "h third diaongal block in A_22 are 2x2 blocks,\002,/\002  4:  A "
	    "and B are block diagonal matrices, \002,/\002  5:  (A,B) has pot"
	    "entially close or common \002,\002eigenvalues.\002,/)";
    static char fmt_9992[] = "(/\002 Tests performed:  (S is Schur, T is tri"
	    "angular, \002,\002Q and Z are \002,a,\002,\002,/19x,\002 a is al"
	    "pha, b is beta, and \002,a,\002 means \002,a,\002.)\002,/\002  1"
	    " = | A - Q S Z\002,a,\002 | / ( |A| n ulp )      2 = | B - Q T "
	    "Z\002,a,\002 | / ( |B| n ulp )\002,/\002  3 = | I - QQ\002,a,"
	    "\002 | / ( n ulp )             4 = | I - ZZ\002,a,\002 | / ( n u"
	    "lp )\002,/\002  5 = 1/ULP  if A is not in \002,\002Schur form "
	    "S\002,/\002  6 = difference between (alpha,beta)\002,\002 and di"
	    "agonals of (S,T)\002,/\002  7 = 1/ULP  if SDIM is not the correc"
	    "t number of \002,\002selected eigenvalues\002,/\002  8 = 1/ULP  "
	    "if DIFEST/DIFTRU > 10*THRESH or \002,\002DIFTRU/DIFEST > 10*THRE"
	    "SH\002,/\002  9 = 1/ULP  if DIFEST <> 0 or DIFTRU > ULP*norm(A,B"
	    ") \002,\002when reordering fails\002,/\002 10 = 1/ULP  if PLEST/"
	    "PLTRU > THRESH or \002,\002PLTRU/PLEST > THRESH\002,/\002    ( T"
	    "est 10 is only for input examples )\002,/)";
    static char fmt_9991[] = "(\002 Matrix order=\002,i2,\002, type=\002,i2"
	    ",\002, a=\002,e10.4,\002, order(A_11)=\002,i2,\002, result \002,"
	    "i2,\002 is \002,0p,f8.2)";
    static char fmt_9990[] = "(\002 Matrix order=\002,i2,\002, type=\002,i2"
	    ",\002, a=\002,e10.4,\002, order(A_11)=\002,i2,\002, result \002,"
	    "i2,\002 is \002,0p,e10.4)";
    static char fmt_9998[] = "(\002 SDRGSX: \002,a,\002 returned INFO=\002,i"
	    "6,\002.\002,/9x,\002N=\002,i6,\002, Input Example #\002,i2,\002"
	    ")\002)";
    static char fmt_9994[] = "(\002Input Example\002)";
    static char fmt_9989[] = "(\002 Input example #\002,i2,\002, matrix orde"
	    "r=\002,i4,\002,\002,\002 result \002,i2,\002 is\002,0p,f8.2)";
    static char fmt_9988[] = "(\002 Input example #\002,i2,\002, matrix orde"
	    "r=\002,i4,\002,\002,\002 result \002,i2,\002 is\002,1p,e10.3)";

    /* System generated locals */
    integer a_dim1, a_offset, ai_dim1, ai_offset, b_dim1, b_offset, bi_dim1, 
	    bi_offset, c_dim1, c_offset, q_dim1, q_offset, z_dim1, z_offset, 
	    i__1, i__2, i__3, i__4;
    real r__1, r__2, r__3, r__4, r__5, r__6, r__7, r__8, r__9, r__10;

    /* Builtin functions */
    double sqrt(doublereal);
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
	     s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), 
	    e_rsle(void);

    /* Local variables */
    static real temp1, temp2;
    static integer i__, j;
    static real abnrm;
    static integer ifunc, iinfo, linfo;
    extern /* Subroutine */ int sget51_(integer *, integer *, real *, integer 
	    *, real *, integer *, real *, integer *, real *, integer *, real *
	    , real *), sget53_(real *, integer *, real *, integer *, real *, 
	    real *, real *, real *, integer *);
    static char sense[1];
    static integer nerrs, i1, ntest;
    static real pltru;
    extern /* Subroutine */ int slakf2_(integer *, integer *, real *, integer 
	    *, real *, real *, real *, real *, integer *), slatm5_(integer *, 
	    integer *, integer *, real *, integer *, real *, integer *, real *
	    , integer *, real *, integer *, real *, integer *, real *, 
	    integer *, real *, integer *, real *, integer *, real *, integer *
	    , integer *);
    static logical ilabad;
    static real thrsh2;
    extern /* Subroutine */ int slabad_(real *, real *);
    static integer mm, bdspac;
    static real pl[2];
    extern doublereal slamch_(char *), slange_(char *, integer *, 
	    integer *, real *, integer *, real *);
    extern /* Subroutine */ int xerbla_(char *, integer *);
    static real difest[2];
    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, 
	    integer *, integer *, ftnlen, ftnlen);
    static real bignum;
    extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer 
	    *, integer *);
    static real weight;
//.........这里部分代码省略.........

开发者ID:zangel，项目名称:uquad，代码行数:101，代码来源:sdrgsx.c

示例4: cond


//.........这里部分代码省略.........

/*  IOUNIT  (input) INTEGER */
/*          The unit number to which the header information should be */
/*          printed. */

/*  PATH    (input) CHARACTER*3 */
/*          The name of the path for which the header information is to */
/*          be printed.  Current paths are */
/*             GQR:  GQR (general matrices) */
/*             GRQ:  GRQ (general matrices) */
/*             LSE:  LSE Problem */
/*             GLM:  GLM Problem */
/*             GSV:  Generalized Singular Value Decomposition */

/*  ===================================================================== */

/*     .. Local Scalars .. */
/*     .. */
/*     .. External Functions .. */
/*     .. */
/*     .. Executable Statements .. */

    if (*iounit <= 0) {
	return 0;
    }
    s_copy(c2, path, (ftnlen)3, (ftnlen)3);

/*     First line describing matrices in this path */

    if (lsamen_(&c__3, c2, "GQR")) {
	itype = 1;
	io___3.ciunit = *iounit;
	s_wsfe(&io___3);
	do_fio(&c__1, path, (ftnlen)3);
	e_wsfe();
    } else if (lsamen_(&c__3, c2, "GRQ")) {
	itype = 2;
	io___4.ciunit = *iounit;
	s_wsfe(&io___4);
	do_fio(&c__1, path, (ftnlen)3);
	e_wsfe();
    } else if (lsamen_(&c__3, c2, "LSE")) {
	itype = 3;
	io___5.ciunit = *iounit;
	s_wsfe(&io___5);
	do_fio(&c__1, path, (ftnlen)3);
	e_wsfe();
    } else if (lsamen_(&c__3, c2, "GLM")) {
	itype = 4;
	io___6.ciunit = *iounit;
	s_wsfe(&io___6);
	do_fio(&c__1, path, (ftnlen)3);
	e_wsfe();
    } else if (lsamen_(&c__3, c2, "GSV")) {
	itype = 5;
	io___7.ciunit = *iounit;
	s_wsfe(&io___7);
	do_fio(&c__1, path, (ftnlen)3);
	e_wsfe();
    }

/*     Matrix types */

    io___8.ciunit = *iounit;
    s_wsfe(&io___8);
    do_fio(&c__1, "Matrix types: ", (ftnlen)14);

开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:alahdg.c

示例5: sqrt

/* Subroutine */ int schkbb_(integer *nsizes, integer *mval, integer *nval, 
	integer *nwdths, integer *kk, integer *ntypes, logical *dotype, 
	integer *nrhs, integer *iseed, real *thresh, integer *nounit, real *a,
	 integer *lda, real *ab, integer *ldab, real *bd, real *be, real *q, 
	integer *ldq, real *p, integer *ldp, real *c__, integer *ldc, real *
	cc, real *work, integer *lwork, real *result, integer *info)
{
    /* Initialized data */

    static integer ktype[15] = { 1,2,4,4,4,4,4,6,6,6,6,6,9,9,9 };
    static integer kmagn[15] = { 1,1,1,1,1,2,3,1,1,1,2,3,1,2,3 };
    static integer kmode[15] = { 0,0,4,3,1,4,4,4,3,1,4,4,0,0,0 };

    /* Format strings */
    static char fmt_9999[] = "(\002 SCHKBB: \002,a,\002 returned INFO=\002,i"
	    "5,\002.\002,/9x,\002M=\002,i5,\002 N=\002,i5,\002 K=\002,i5,\002"
	    ", JTYPE=\002,i5,\002, ISEED=(\002,3(i5,\002,\002),i5,\002)\002)";
    static char fmt_9998[] = "(\002 M =\002,i4,\002 N=\002,i4,\002, K=\002,i"
	    "3,\002, seed=\002,4(i4,\002,\002),\002 type \002,i2,\002, test"
	    "(\002,i2,\002)=\002,g10.3)";

    /* System generated locals */
    integer a_dim1, a_offset, ab_dim1, ab_offset, c_dim1, c_offset, cc_dim1, 
	    cc_offset, p_dim1, p_offset, q_dim1, q_offset, i__1, i__2, i__3, 
	    i__4, i__5, i__6, i__7, i__8, i__9;

    /* Builtin functions */
    double sqrt(doublereal);
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);

    /* Local variables */
    static real cond;
    static integer jcol, kmax, mmax, nmax;
    static real unfl, ovfl;
    static integer i__, j, k, m, n;
    static logical badmm, badnn;
    static integer imode;
    extern /* Subroutine */ int sbdt01_(integer *, integer *, integer *, real 
	    *, integer *, real *, integer *, real *, real *, real *, integer *
	    , real *, real *), sbdt02_(integer *, integer *, real *, integer *
	    , real *, integer *, real *, integer *, real *, real *);
    static integer iinfo;
    static real anorm;
    static integer mnmin, mnmax, nmats, jsize;
    extern /* Subroutine */ int sort01_(char *, integer *, integer *, real *, 
	    integer *, real *, integer *, real *);
    static integer nerrs, itype, jtype, ntest;
    extern /* Subroutine */ int slahd2_(integer *, char *);
    static logical badnnb;
    static integer kl, jr, ku;
    extern /* Subroutine */ int sgbbrd_(char *, integer *, integer *, integer 
	    *, integer *, integer *, real *, integer *, real *, real *, real *
	    , integer *, real *, integer *, real *, integer *, real *, 
	    integer *);
    extern doublereal slamch_(char *);
    static integer idumma[1];
    extern /* Subroutine */ int xerbla_(char *, integer *);
    static integer ioldsd[4];
    static real amninv;
    static integer jwidth;
    extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, 
	    integer *, real *, integer *), slaset_(char *, integer *, 
	    integer *, real *, real *, real *, integer *), slatmr_(
	    integer *, integer *, char *, integer *, char *, real *, integer *
	    , real *, real *, char *, char *, real *, integer *, real *, real 
	    *, integer *, real *, char *, integer *, integer *, integer *, 
	    real *, real *, char *, real *, integer *, integer *, integer *), slatms_(integer *
	    , integer *, char *, integer *, char *, real *, integer *, real *,
	     real *, integer *, integer *, char *, real *, integer *, real *, 
	    integer *), slasum_(char *, integer *, 
	    integer *, integer *);
    static real rtunfl, rtovfl, ulpinv;
    static integer mtypes, ntestt;
    static real ulp;

    /* Fortran I/O blocks */
    static cilist io___41 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___43 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___45 = { 0, 0, 0, fmt_9998, 0 };



#define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
#define ab_ref(a_1,a_2) ab[(a_2)*ab_dim1 + a_1]


/*  -- LAPACK test routine (release 2.0) --   
       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
       Courant Institute, Argonne National Lab, and Rice University   
       June 30, 1999   


    Purpose   
    =======   

    SCHKBB tests the reduction of a general real rectangular band   
    matrix to bidiagonal form.   

    SGBBRD factors a general band matrix A as  Q B P* , where * means   
    transpose, B is upper bidiagonal, and Q and P are orthogonal;   
//.........这里部分代码省略.........

开发者ID:zangel，项目名称:uquad，代码行数:101，代码来源:schkbb.c

示例6: cget10_


//.........这里部分代码省略.........
			&c_b2, "T", "N", &work[n + 1], &c__1, &c_b27, &work[(
			n << 1) + 1], &c__1, &c_b27, "N", idumma, &n, &n, &
			c_b33, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
			iinfo);

	    } else if (itype == 9) {

/*              General, random eigenvalues */

		clatmr_(&n, &n, "D", &iseed[1], "N", &work[1], &c__6, &c_b27, 
			&c_b2, "T", "N", &work[n + 1], &c__1, &c_b27, &work[(
			n << 1) + 1], &c__1, &c_b27, "N", idumma, &n, &n, &
			c_b33, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
			iinfo);

	    } else if (itype == 10) {

/*              Triangular, random eigenvalues */

		clatmr_(&n, &n, "D", &iseed[1], "N", &work[1], &c__6, &c_b27, 
			&c_b2, "T", "N", &work[n + 1], &c__1, &c_b27, &work[(
			n << 1) + 1], &c__1, &c_b27, "N", idumma, &n, &c__0, &
			c_b33, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
			iinfo);

	    } else {

		iinfo = 1;
	    }

	    if (iinfo != 0) {
		io___35.ciunit = *nounit;
		s_wsfe(&io___35);
		do_fio(&c__1, "Generator", (ftnlen)9);
		do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
		do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
		do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
		do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
		e_wsfe();
		*info = abs(iinfo);
		return 0;
	    }

L100:

/*           Call CGEHRD to compute H and U, do tests. */

	    clacpy_(" ", &n, &n, &a[a_offset], lda, &h__[h_offset], lda);
	    ntest = 1;

	    ilo = 1;
	    ihi = n;

	    i__3 = *nwork - n;
	    cgehrd_(&n, &ilo, &ihi, &h__[h_offset], lda, &work[1], &work[n + 
		    1], &i__3, &iinfo);

	    if (iinfo != 0) {
		result[1] = ulpinv;
		io___38.ciunit = *nounit;
		s_wsfe(&io___38);
		do_fio(&c__1, "CGEHRD", (ftnlen)6);
		do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
		do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
		do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
		do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));

开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:cchkhs.c

示例7: Error

/* Subroutine */ int ddrvrf2_(integer *nout, integer *nn, integer *nval, 
	doublereal *a, integer *lda, doublereal *arf, doublereal *ap, 
	doublereal *asav)
{
    /* Initialized data */

    static integer iseedy[4] = { 1988,1989,1990,1991 };
    static char uplos[1*2] = "U" "L";
    static char forms[1*2] = "N" "T";

    /* Format strings */
    static char fmt_9999[] = "(1x,\002 *** Error(s) while testing the RFP co"
	    "nvertion\002,\002 routines ***\002)";
    static char fmt_9998[] = "(1x,\002     Error in RFP,convertion routines "
	    "N=\002,i5,\002 UPLO='\002,a1,\002', FORM ='\002,a1,\002'\002)";
    static char fmt_9997[] = "(1x,\002All tests for the RFP convertion routi"
	    "nes passed (\002,i5,\002 tests run)\002)";
    static char fmt_9996[] = "(1x,\002RFP convertion routines:\002,i5,\002 o"
	    "ut of \002,i5,\002 error message recorded\002)";

    /* System generated locals */
    integer a_dim1, a_offset, asav_dim1, asav_offset, i__1, i__2, i__3;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_wsle(cilist *), e_wsle(void), s_wsfe(cilist *), e_wsfe(void), 
	    do_fio(integer *, char *, ftnlen);

    /* Local variables */
    integer i__, j, n;
    logical ok1, ok2;
    integer iin, info;
    char uplo[1];
    integer nrun, iseed[4];
    char cform[1];
    integer iform;
    logical lower;
    integer iuplo, nerrs;
    extern doublereal dlarnd_(integer *, integer *);
    extern /* Subroutine */ int dtfttp_(char *, char *, integer *, doublereal 
	    *, doublereal *, integer *), dtpttf_(char *, char 
	    *, integer *, doublereal *, doublereal *, integer *), dtfttr_(char *, char *, integer *, doublereal *, 
	    doublereal *, integer *, integer *), dtrttf_(char 
	    *, char *, integer *, doublereal *, integer *, doublereal *, 
	    integer *), dtrttp_(char *, integer *, doublereal 
	    *, integer *, doublereal *, integer *), dtpttr_(char *, 
	    integer *, doublereal *, doublereal *, integer *, integer *);

    /* Fortran I/O blocks */
    static cilist io___19 = { 0, 0, 0, 0, 0 };
    static cilist io___20 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___21 = { 0, 0, 0, fmt_9998, 0 };
    static cilist io___22 = { 0, 0, 0, fmt_9997, 0 };
    static cilist io___23 = { 0, 0, 0, fmt_9996, 0 };



/*  -- LAPACK test routine (version 3.2.0) -- */
/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/*     November 2008 */

/*     .. Scalar Arguments .. */
/*     .. */
/*     .. Array Arguments .. */
/*     .. */

/*  Purpose */
/*  ======= */

/*  DDRVRF2 tests the LAPACK RFP convertion routines. */

/*  Arguments */
/*  ========= */

/*  NOUT          (input) INTEGER */
/*                The unit number for output. */

/*  NN            (input) INTEGER */
/*                The number of values of N contained in the vector NVAL. */

/*  NVAL          (input) INTEGER array, dimension (NN) */
/*                The values of the matrix dimension N. */

/*  A             (workspace) DOUBLE PRECISION array, dimension (LDA,NMAX) */

/*  LDA           (input) INTEGER */
/*                The leading dimension of the array A.  LDA >= max(1,NMAX). */

/*  ARF           (workspace) DOUBLE PRECISION array, dimension ((NMAX*(NMAX+1))/2). */

/*  AP            (workspace) DOUBLE PRECISION array, dimension ((NMAX*(NMAX+1))/2). */

/*  A2            (workspace) DOUBLE PRECISION array, dimension (LDA,NMAX) */

/*  ===================================================================== */
/*     .. */
/*     .. Local Scalars .. */
/*     .. */
/*     .. Local Arrays .. */
/*     .. */
//.........这里部分代码省略.........

开发者ID:3deggi，项目名称:levmar-ndk，代码行数:101，代码来源:ddrvrf2.c

示例8: test

/* Subroutine */ int sdrvpb_(logical *dotype, integer *nn, integer *nval, 
	integer *nrhs, real *thresh, logical *tsterr, integer *nmax, real *a, 
	real *afac, real *asav, real *b, real *bsav, real *x, real *xact, 
	real *s, real *work, real *rwork, integer *iwork, integer *nout)
{
    /* Initialized data */

    static integer iseedy[4] = { 1988,1989,1990,1991 };
    static char facts[1*3] = "F" "N" "E";
    static char equeds[1*2] = "N" "Y";

    /* Format strings */
    static char fmt_9999[] = "(1x,a,\002, UPLO='\002,a1,\002', N =\002,i5"
	    ",\002, KD =\002,i5,\002, type \002,i1,\002, test(\002,i1,\002)"
	    "=\002,g12.5)";
    static char fmt_9997[] = "(1x,a,\002( '\002,a1,\002', '\002,a1,\002',"
	    " \002,i5,\002, \002,i5,\002, ... ), EQUED='\002,a1,\002', type"
	    " \002,i1,\002, test(\002,i1,\002)=\002,g12.5)";
    static char fmt_9998[] = "(1x,a,\002( '\002,a1,\002', '\002,a1,\002',"
	    " \002,i5,\002, \002,i5,\002, ... ), type \002,i1,\002, test(\002"
	    ",i1,\002)=\002,g12.5)";

    /* System generated locals */
    address a__1[2];
    integer i__1, i__2, i__3, i__4, i__5, i__6, i__7[2];
    char ch__1[2];

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    /* Local variables */
    integer i__, k, n, i1, i2, k1, kd, nb, in, kl, iw, ku, nt, lda, ikd, nkd, 
	    ldab;
    char fact[1];
    integer ioff, mode, koff;
    real amax;
    char path[3];
    integer imat, info;
    char dist[1], uplo[1], type__[1];
    integer nrun, ifact, nfail, iseed[4], nfact, kdval[4];
    extern logical lsame_(char *, char *);
    char equed[1];
    integer nbmin;
    real rcond, roldc, scond;
    integer nimat;
    extern doublereal sget06_(real *, real *);
    extern /* Subroutine */ int sget04_(integer *, integer *, real *, integer 
	    *, real *, integer *, real *, real *), spbt01_(char *, integer *, 
	    integer *, real *, integer *, real *, integer *, real *, real *);
    real anorm;
    extern /* Subroutine */ int spbt02_(char *, integer *, integer *, integer 
	    *, real *, integer *, real *, integer *, real *, integer *, real *
, real *), spbt05_(char *, integer *, integer *, integer *
, real *, integer *, real *, integer *, real *, integer *, real *, 
	     integer *, real *, real *, real *);
    logical equil;
    integer iuplo, izero, nerrs;
    extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *, 
	    integer *), spbsv_(char *, integer *, integer *, integer *, real *
, integer *, real *, integer *, integer *), sswap_(
	    integer *, real *, integer *, real *, integer *);
    logical zerot;
    char xtype[1];
    extern /* Subroutine */ int slatb4_(char *, integer *, integer *, integer 
	    *, char *, integer *, integer *, real *, integer *, real *, char *
), aladhd_(integer *, char *), 
	    alaerh_(char *, char *, integer *, integer *, char *, integer *, 
	    integer *, integer *, integer *, integer *, integer *, integer *, 
	    integer *, integer *);
    logical prefac;
    real rcondc;
    extern doublereal slange_(char *, integer *, integer *, real *, integer *, 
	     real *);
    logical nofact;
    char packit[1];
    integer iequed;
    extern doublereal slansb_(char *, char *, integer *, integer *, real *, 
	    integer *, real *);
    real cndnum;
    extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer 
	    *, integer *), slaqsb_(char *, integer *, integer *, real 
	    *, integer *, real *, real *, real *, char *);
    real ainvnm;
    extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, 
	    integer *, real *, integer *), slarhs_(char *, char *, 
	    char *, char *, integer *, integer *, integer *, integer *, 
	    integer *, real *, integer *, real *, integer *, real *, integer *
, integer *, integer *), slaset_(
	    char *, integer *, integer *, real *, real *, real *, integer *), spbequ_(char *, integer *, integer *, real *, integer *, 
	    real *, real *, real *, integer *), spbtrf_(char *, 
	    integer *, integer *, real *, integer *, integer *), 
	    xlaenv_(integer *, integer *), slatms_(integer *, integer *, char 
	    *, integer *, char *, real *, integer *, real *, real *, integer *
, integer *, char *, real *, integer *, real *, integer *), spbtrs_(char *, integer *, integer *, integer *, 
	     real *, integer *, real *, integer *, integer *);
    real result[6];
    extern /* Subroutine */ int spbsvx_(char *, char *, integer *, integer *, 
	    integer *, real *, integer *, real *, integer *, char *, real *, 
//.........这里部分代码省略.........

开发者ID:3deggi，项目名称:levmar-ndk，代码行数:101，代码来源:sdrvpb.c

示例9: s_rnge

/* $Procedure  WRENCD  ( Write encoded d.p. numbers to text file ) */
/* Subroutine */ int wrencd_(integer *unit, integer *n, doublereal *data)
{
    /* System generated locals */
    address a__1[3];
    integer i__1, i__2, i__3, i__4[3];
    char ch__1[66];
    cilist ci__1;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer), s_wsfe(cilist *);
    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
    integer do_fio(integer *, char *, ftnlen), e_wsfe(void);

    /* Local variables */
    char work[64*64];
    extern /* Subroutine */ int dp2hx_(doublereal *, char *, integer *, 
	    ftnlen);
    integer i__;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    integer nitms, itmbeg, length[64];
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), setmsg_(char *, ftnlen);
    integer iostat;
    extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
    extern logical return_(void);

/* $ Abstract */

/*     Encode and write d.p. numbers to a text file. */

/* $ Disclaimer */

/*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */

/*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */

/*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */

/* $ Required_Reading */

/*     None. */

/* $ Keywords */

/*     CONVERSION */
/*     NUMBERS */
/*     UTILITY */

/* $ Declarations */
/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*      UNIT      I    Fortran unit number of output text file. */
/*      N         I    Number of d.p. numbers to encode and write. */
/*      DATA      I    List of d.p. numbers to encode and write. */

/* $ Detailed_Input */

/*     UNIT     The Fortran unit number for a previously opened text */
/*              file. All writing will begin at the CURRENT POSITION */
/*              in the text file. */

/*     N        The number of double precision numbers to be encoded */
/*              and written to the text file attached to UNIT. */

/*     DATA     List of double precision numbers to be encoded and */
/*              written to the text file attached to UNIT. */

/* $ Detailed_Output */

/*     See the Particulars section for a description of the effect of */
/*     this routine. */

/* $ Parameters */

/*      None. */

/* $ Exceptions */

/*     1)   If N, the number of data items, is not positive, the error */
/*          SPICE(INVALIDARGUMENT) will be signalled. */
//.........这里部分代码省略.........

开发者ID:Dbelsa，项目名称:coft，代码行数:101，代码来源:wrencd.c

示例10: s_rsle

/* Subroutine */ int zchkgl_(integer *nin, integer *nout)
{
    /* Format strings */
    static char fmt_9999[] = "(\002 .. test output of ZGGBAL .. \002)";
    static char fmt_9998[] = "(\002 ratio of largest test error             "
	    " = \002,d12.3)";
    static char fmt_9997[] = "(\002 example number where info is not zero   "
	    " = \002,i4)";
    static char fmt_9996[] = "(\002 example number where ILO or IHI is wrong"
	    " = \002,i4)";
    static char fmt_9995[] = "(\002 example number having largest error     "
	    " = \002,i4)";
    static char fmt_9994[] = "(\002 number of examples where info is not 0  "
	    " = \002,i4)";
    static char fmt_9993[] = "(\002 total number of examples tested         "
	    " = \002,i4)";

    /* System generated locals */
    integer i__1, i__2, i__3, i__4;
    doublereal d__1, d__2, d__3;
    doublecomplex z__1;

    /* Builtin functions */
    integer s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), 
	    e_rsle(void);
    double z_abs(doublecomplex *);
    integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);

    /* Local variables */
    doublecomplex a[400]	/* was [20][20] */, b[400]	/* was [20][
	    20] */;
    integer i__, j, n;
    doublecomplex ain[400]	/* was [20][20] */, bin[400]	/* was [20][
	    20] */;
    integer ihi, ilo;
    doublereal eps;
    integer knt, info, lmax[3];
    doublereal rmax, vmax, work[120];
    integer ihiin, ninfo, iloin;
    doublereal anorm, bnorm;
    extern doublereal dlamch_(char *);
    doublereal lscale[20];
    extern /* Subroutine */ int zggbal_(char *, integer *, doublecomplex *, 
	    integer *, doublecomplex *, integer *, integer *, integer *, 
	    doublereal *, doublereal *, doublereal *, integer *);
    doublereal rscale[20];
    extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, 
	    integer *, doublereal *);
    doublereal lsclin[20], rsclin[20];

    /* Fortran I/O blocks */
    static cilist io___6 = { 0, 0, 0, 0, 0 };
    static cilist io___9 = { 0, 0, 0, 0, 0 };
    static cilist io___12 = { 0, 0, 0, 0, 0 };
    static cilist io___14 = { 0, 0, 0, 0, 0 };
    static cilist io___17 = { 0, 0, 0, 0, 0 };
    static cilist io___19 = { 0, 0, 0, 0, 0 };
    static cilist io___21 = { 0, 0, 0, 0, 0 };
    static cilist io___23 = { 0, 0, 0, 0, 0 };
    static cilist io___34 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___35 = { 0, 0, 0, fmt_9998, 0 };
    static cilist io___36 = { 0, 0, 0, fmt_9997, 0 };
    static cilist io___37 = { 0, 0, 0, fmt_9996, 0 };
    static cilist io___38 = { 0, 0, 0, fmt_9995, 0 };
    static cilist io___39 = { 0, 0, 0, fmt_9994, 0 };
    static cilist io___40 = { 0, 0, 0, fmt_9993, 0 };



/*  -- LAPACK test routine (version 3.1) -- */
/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/*     November 2006 */

/*     .. Scalar Arguments .. */
/*     .. */

/*  Purpose */
/*  ======= */

/*  ZCHKGL tests ZGGBAL, a routine for balancing a matrix pair (A, B). */

/*  Arguments */
/*  ========= */

/*  NIN     (input) INTEGER */
/*          The logical unit number for input.  NIN > 0. */

/*  NOUT    (input) INTEGER */
/*          The logical unit number for output.  NOUT > 0. */

/*  ===================================================================== */

/*     .. Parameters .. */
/*     .. */
/*     .. Local Scalars .. */
/*     .. */
/*     .. Local Arrays .. */
/*     .. */
/*     .. External Functions .. */
/*     .. */
//.........这里部分代码省略.........

开发者ID:kstraube，项目名称:hysim，代码行数:101，代码来源:zchkgl.c

示例11: types

/* Subroutine */ int zdrvev_(integer *nsizes, integer *nn, integer *ntypes, 
	logical *dotype, integer *iseed, doublereal *thresh, integer *nounit, 
	doublecomplex *a, integer *lda, doublecomplex *h__, doublecomplex *w, 
	doublecomplex *w1, doublecomplex *vl, integer *ldvl, doublecomplex *
	vr, integer *ldvr, doublecomplex *lre, integer *ldlre, doublereal *
	result, doublecomplex *work, integer *nwork, doublereal *rwork, 
	integer *iwork, integer *info)
{
    /* Initialized data */

    static integer ktype[21] = { 1,2,3,4,4,4,4,4,6,6,6,6,6,6,6,6,6,6,9,9,9 };
    static integer kmagn[21] = { 1,1,1,1,1,1,2,3,1,1,1,1,1,1,1,1,2,3,1,2,3 };
    static integer kmode[21] = { 0,0,0,4,3,1,4,4,4,3,1,5,4,3,1,5,5,5,4,3,1 };
    static integer kconds[21] = { 0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,2,2,0,0,0 };

    /* Format strings */
    static char fmt_9993[] = "(\002 ZDRVEV: \002,a,\002 returned INFO=\002,i"
	    "6,\002.\002,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002, ISEED="
	    "(\002,3(i5,\002,\002),i5,\002)\002)";
    static char fmt_9999[] = "(/1x,a3,\002 -- Complex Eigenvalue-Eigenvect"
	    "or \002,\002Decomposition Driver\002,/\002 Matrix types (see ZDR"
	    "VEV for details): \002)";
    static char fmt_9998[] = "(/\002 Special Matrices:\002,/\002  1=Zero mat"
	    "rix.             \002,\002           \002,\002  5=Diagonal: geom"
	    "etr. spaced entries.\002,/\002  2=Identity matrix.              "
	    "      \002,\002  6=Diagona\002,\002l: clustered entries.\002,"
	    "/\002  3=Transposed Jordan block.  \002,\002          \002,\002 "
	    " 7=Diagonal: large, evenly spaced.\002,/\002  \002,\0024=Diagona"
	    "l: evenly spaced entries.    \002,\002  8=Diagonal: s\002,\002ma"
	    "ll, evenly spaced.\002)";
    static char fmt_9997[] = "(\002 Dense, Non-Symmetric Matrices:\002,/\002"
	    "  9=Well-cond., ev\002,\002enly spaced eigenvals.\002,\002 14=Il"
	    "l-cond., geomet. spaced e\002,\002igenals.\002,/\002 10=Well-con"
	    "d., geom. spaced eigenvals. \002,\002 15=Ill-conditioned, cluste"
	    "red e.vals.\002,/\002 11=Well-cond\002,\002itioned, clustered e."
	    "vals. \002,\002 16=Ill-cond., random comp\002,\002lex \002,a6,"
	    "/\002 12=Well-cond., random complex \002,a6,\002   \002,\002 17="
	    "Ill-cond., large rand. complx \002,a4,/\002 13=Ill-condi\002,"
	    "\002tioned, evenly spaced.     \002,\002 18=Ill-cond., small ran"
	    "d.\002,\002 complx \002,a4)";
    static char fmt_9996[] = "(\002 19=Matrix with random O(1) entries.   "
	    " \002,\002 21=Matrix \002,\002with small random entries.\002,"
	    "/\002 20=Matrix with large ran\002,\002dom entries.   \002,/)";
    static char fmt_9995[] = "(\002 Tests performed with test threshold ="
	    "\002,f8.2,//\002 1 = | A VR - VR W | / ( n |A| ulp ) \002,/\002 "
	    "2 = | conj-trans(A) VL - VL conj-trans(W) | /\002,\002 ( n |A| u"
	    "lp ) \002,/\002 3 = | |VR(i)| - 1 | / ulp \002,/\002 4 = | |VL(i"
	    ")| - 1 | / ulp \002,/\002 5 = 0 if W same no matter if VR or VL "
	    "computed,\002,\002 1/ulp otherwise\002,/\002 6 = 0 if VR same no"
	    " matter if VL computed,\002,\002  1/ulp otherwise\002,/\002 7 = "
	    "0 if VL same no matter if VR computed,\002,\002  1/ulp otherwis"
	    "e\002,/)";
    static char fmt_9994[] = "(\002 N=\002,i5,\002, IWK=\002,i2,\002, seed"
	    "=\002,4(i4,\002,\002),\002 type \002,i2,\002, test(\002,i2,\002)="
	    "\002,g10.3)";

    /* System generated locals */
    integer a_dim1, a_offset, h_dim1, h_offset, lre_dim1, lre_offset, vl_dim1,
	     vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3, i__4, i__5, 
	    i__6;
    doublereal d__1, d__2, d__3, d__4, d__5;
    doublecomplex z__1;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    double sqrt(doublereal);
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
    double z_abs(doublecomplex *), d_imag(doublecomplex *);

    /* Local variables */
    integer j, n, jj;
    doublecomplex dum[1];
    doublereal res[2];
    integer iwk;
    doublereal ulp, vmx, cond;
    integer jcol;
    char path[3];
    integer nmax;
    doublereal unfl, ovfl, tnrm, vrmx, vtst;
    logical badnn;
    integer nfail, imode, iinfo;
    doublereal conds, anorm;
    extern /* Subroutine */ int zget22_(char *, char *, char *, integer *, 
	    doublecomplex *, integer *, doublecomplex *, integer *, 
	    doublecomplex *, doublecomplex *, doublereal *, doublereal *), zgeev_(char *, char *, integer *, 
	    doublecomplex *, integer *, doublecomplex *, doublecomplex *, 
	    integer *, doublecomplex *, integer *, doublecomplex *, integer *, 
	     doublereal *, integer *);
    integer jsize, nerrs, itype, jtype, ntest;
    doublereal rtulp;
    extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
    extern doublereal dznrm2_(integer *, doublecomplex *, integer *), dlamch_(
	    char *);
    integer idumma[1];
    extern /* Subroutine */ int xerbla_(char *, integer *);
    integer ioldsd[4];
    extern /* Subroutine */ int dlasum_(char *, integer *, integer *, integer 
	    *), zlatme_(integer *, char *, integer *, doublecomplex *, 
	     integer *, doublereal *, doublecomplex *, char *, char *, char *, 
	     char *, doublereal *, integer *, doublereal *, integer *, 
//.........这里部分代码省略.........

开发者ID:kstraube，项目名称:hysim，代码行数:101，代码来源:zdrvev.c

示例12: test

/* Subroutine */ int dchkpo_(logical *dotype, integer *nn, integer *nval, 
	integer *nnb, integer *nbval, integer *nns, integer *nsval, 
	doublereal *thresh, logical *tsterr, integer *nmax, doublereal *a, 
	doublereal *afac, doublereal *ainv, doublereal *b, doublereal *x, 
	doublereal *xact, doublereal *work, doublereal *rwork, integer *iwork, 
	 integer *nout)
{
    /* Initialized data */

    static integer iseedy[4] = { 1988,1989,1990,1991 };
    static char uplos[1*2] = "U" "L";

    /* Format strings */
    static char fmt_9999[] = "(\002 UPLO = '\002,a1,\002', N =\002,i5,\002, "
	    "NB =\002,i4,\002, type \002,i2,\002, test \002,i2,\002, ratio "
	    "=\002,g12.5)";
    static char fmt_9998[] = "(\002 UPLO = '\002,a1,\002', N =\002,i5,\002, "
	    "NRHS=\002,i3,\002, type \002,i2,\002, test(\002,i2,\002) =\002,g"
	    "12.5)";
    static char fmt_9997[] = "(\002 UPLO = '\002,a1,\002', N =\002,i5,\002"
	    ",\002,10x,\002 type \002,i2,\002, test(\002,i2,\002) =\002,g12.5)"
	    ;

    /* System generated locals */
    integer i__1, i__2, i__3, i__4;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);

    /* Local variables */
    integer i__, k, n, nb, in, kl, ku, lda, inb, ioff, mode, imat, info;
    char path[3], dist[1];
    integer irhs, nrhs;
    char uplo[1], type__[1];
    integer nrun;
    extern /* Subroutine */ int alahd_(integer *, char *), dget04_(
	    integer *, integer *, doublereal *, integer *, doublereal *, 
	    integer *, doublereal *, doublereal *);
    integer nfail, iseed[4];
    extern doublereal dget06_(doublereal *, doublereal *);
    doublereal rcond;
    extern /* Subroutine */ int dpot01_(char *, integer *, doublereal *, 
	    integer *, doublereal *, integer *, doublereal *, doublereal *);
    integer nimat;
    extern /* Subroutine */ int dpot02_(char *, integer *, integer *, 
	    doublereal *, integer *, doublereal *, integer *, doublereal *, 
	    integer *, doublereal *, doublereal *), dpot03_(char *, 
	    integer *, doublereal *, integer *, doublereal *, integer *, 
	    doublereal *, integer *, doublereal *, doublereal *, doublereal *), dpot05_(char *, integer *, integer *, doublereal *, 
	    integer *, doublereal *, integer *, doublereal *, integer *, 
	    doublereal *, integer *, doublereal *, doublereal *, doublereal *);
    doublereal anorm;
    integer iuplo, izero, nerrs;
    logical zerot;
    char xtype[1];
    extern /* Subroutine */ int dlatb4_(char *, integer *, integer *, integer 
	    *, char *, integer *, integer *, doublereal *, integer *, 
	    doublereal *, char *), alaerh