/* schkbb.f -- translated by f2c (version 20061008). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" #include "blaswrap.h" /* Table of constant values */ static real c_b18 = 0.f; static integer c__0 = 0; static integer c__6 = 6; static real c_b35 = 1.f; static integer c__1 = 1; static integer c__4 = 4; static integer c_n1 = -1; /* 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 */ integer i__, j, k, m, n, kl, jr, ku; real ulp, cond; integer jcol, kmax, mmax, nmax; real unfl, ovfl; logical badmm, badnn; 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 *); integer iinfo; real anorm; integer mnmin, mnmax, nmats, jsize; extern /* Subroutine */ int sort01_(char *, integer *, integer *, real *, integer *, real *, integer *, real *); integer nerrs, itype, jtype, ntest; extern /* Subroutine */ int slahd2_(integer *, char *); logical badnnb; 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 *); integer idumma[1]; extern /* Subroutine */ int xerbla_(char *, integer *); integer ioldsd[4]; real amninv; 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 *); real rtunfl, rtovfl, ulpinv; integer mtypes, ntestt; /* 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 }; /* -- LAPACK test routine (release 2.0) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* 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; */ /* SGBBRD can also overwrite a given matrix C with Q* C . */ /* For each pair of matrix dimensions (M,N) and each selected matrix */ /* type, an M by N matrix A and an M by NRHS matrix C are generated. */ /* The problem dimensions are as follows */ /* A: M x N */ /* Q: M x M */ /* P: N x N */ /* B: min(M,N) x min(M,N) */ /* C: M x NRHS */ /* For each generated matrix, 4 tests are performed: */ /* (1) | A - Q B PT | / ( |A| max(M,N) ulp ), PT = P' */ /* (2) | I - Q' Q | / ( M ulp ) */ /* (3) | I - PT PT' | / ( N ulp ) */ /* (4) | Y - Q' C | / ( |Y| max(M,NRHS) ulp ), where Y = Q' C. */ /* The "types" are specified by a logical array DOTYPE( 1:NTYPES ); */ /* if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. */ /* Currently, the list of possible types is: */ /* The possible matrix types are */ /* (1) The zero matrix. */ /* (2) The identity matrix. */ /* (3) A diagonal matrix with evenly spaced entries */ /* 1, ..., ULP and random signs. */ /* (ULP = (first number larger than 1) - 1 ) */ /* (4) A diagonal matrix with geometrically spaced entries */ /* 1, ..., ULP and random signs. */ /* (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP */ /* and random signs. */ /* (6) Same as (3), but multiplied by SQRT( overflow threshold ) */ /* (7) Same as (3), but multiplied by SQRT( underflow threshold ) */ /* (8) A matrix of the form U D V, where U and V are orthogonal and */ /* D has evenly spaced entries 1, ..., ULP with random signs */ /* on the diagonal. */ /* (9) A matrix of the form U D V, where U and V are orthogonal and */ /* D has geometrically spaced entries 1, ..., ULP with random */ /* signs on the diagonal. */ /* (10) A matrix of the form U D V, where U and V are orthogonal and */ /* D has "clustered" entries 1, ULP,..., ULP with random */ /* signs on the diagonal. */ /* (11) Same as (8), but multiplied by SQRT( overflow threshold ) */ /* (12) Same as (8), but multiplied by SQRT( underflow threshold ) */ /* (13) Rectangular matrix with random entries chosen from (-1,1). */ /* (14) Same as (13), but multiplied by SQRT( overflow threshold ) */ /* (15) Same as (13), but multiplied by SQRT( underflow threshold ) */ /* Arguments */ /* ========= */ /* NSIZES (input) INTEGER */ /* The number of values of M and N contained in the vectors */ /* MVAL and NVAL. The matrix sizes are used in pairs (M,N). */ /* If NSIZES is zero, SCHKBB does nothing. NSIZES must be at */ /* least zero. */ /* MVAL (input) INTEGER array, dimension (NSIZES) */ /* The values of the matrix row dimension M. */ /* NVAL (input) INTEGER array, dimension (NSIZES) */ /* The values of the matrix column dimension N. */ /* NWDTHS (input) INTEGER */ /* The number of bandwidths to use. If it is zero, */ /* SCHKBB does nothing. It must be at least zero. */ /* KK (input) INTEGER array, dimension (NWDTHS) */ /* An array containing the bandwidths to be used for the band */ /* matrices. The values must be at least zero. */ /* NTYPES (input) INTEGER */ /* The number of elements in DOTYPE. If it is zero, SCHKBB */ /* does nothing. It must be at least zero. If it is MAXTYP+1 */ /* and NSIZES is 1, then an additional type, MAXTYP+1 is */ /* defined, which is to use whatever matrix is in A. This */ /* is only useful if DOTYPE(1:MAXTYP) is .FALSE. and */ /* DOTYPE(MAXTYP+1) is .TRUE. . */ /* DOTYPE (input) LOGICAL array, dimension (NTYPES) */ /* If DOTYPE(j) is .TRUE., then for each size in NN a */ /* matrix of that size and of type j will be generated. */ /* If NTYPES is smaller than the maximum number of types */ /* defined (PARAMETER MAXTYP), then types NTYPES+1 through */ /* MAXTYP will not be generated. If NTYPES is larger */ /* than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) */ /* will be ignored. */ /* NRHS (input) INTEGER */ /* The number of columns in the "right-hand side" matrix C. */ /* If NRHS = 0, then the operations on the right-hand side will */ /* not be tested. NRHS must be at least 0. */ /* ISEED (input/output) INTEGER array, dimension (4) */ /* On entry ISEED specifies the seed of the random number */ /* generator. The array elements should be between 0 and 4095; */ /* if not they will be reduced mod 4096. Also, ISEED(4) must */ /* be odd. The random number generator uses a linear */ /* congruential sequence limited to small integers, and so */ /* should produce machine independent random numbers. The */ /* values of ISEED are changed on exit, and can be used in the */ /* next call to SCHKBB to continue the same random number */ /* sequence. */ /* THRESH (input) REAL */ /* A test will count as "failed" if the "error", computed as */ /* described above, exceeds THRESH. Note that the error */ /* is scaled to be O(1), so THRESH should be a reasonably */ /* small multiple of 1, e.g., 10 or 100. In particular, */ /* it should not depend on the precision (single vs. double) */ /* or the size of the matrix. It must be at least zero. */ /* NOUNIT (input) INTEGER */ /* The FORTRAN unit number for printing out error messages */ /* (e.g., if a routine returns IINFO not equal to 0.) */ /* A (input/workspace) REAL array, dimension */ /* (LDA, max(NN)) */ /* Used to hold the matrix A. */ /* LDA (input) INTEGER */ /* The leading dimension of A. It must be at least 1 */ /* and at least max( NN ). */ /* AB (workspace) REAL array, dimension (LDAB, max(NN)) */ /* Used to hold A in band storage format. */ /* LDAB (input) INTEGER */ /* The leading dimension of AB. It must be at least 2 (not 1!) */ /* and at least max( KK )+1. */ /* BD (workspace) REAL array, dimension (max(NN)) */ /* Used to hold the diagonal of the bidiagonal matrix computed */ /* by SGBBRD. */ /* BE (workspace) REAL array, dimension (max(NN)) */ /* Used to hold the off-diagonal of the bidiagonal matrix */ /* computed by SGBBRD. */ /* Q (workspace) REAL array, dimension (LDQ, max(NN)) */ /* Used to hold the orthogonal matrix Q computed by SGBBRD. */ /* LDQ (input) INTEGER */ /* The leading dimension of Q. It must be at least 1 */ /* and at least max( NN ). */ /* P (workspace) REAL array, dimension (LDP, max(NN)) */ /* Used to hold the orthogonal matrix P computed by SGBBRD. */ /* LDP (input) INTEGER */ /* The leading dimension of P. It must be at least 1 */ /* and at least max( NN ). */ /* C (workspace) REAL array, dimension (LDC, max(NN)) */ /* Used to hold the matrix C updated by SGBBRD. */ /* LDC (input) INTEGER */ /* The leading dimension of U. It must be at least 1 */ /* and at least max( NN ). */ /* CC (workspace) REAL array, dimension (LDC, max(NN)) */ /* Used to hold a copy of the matrix C. */ /* WORK (workspace) REAL array, dimension (LWORK) */ /* LWORK (input) INTEGER */ /* The number of entries in WORK. This must be at least */ /* max( LDA+1, max(NN)+1 )*max(NN). */ /* RESULT (output) REAL array, dimension (4) */ /* The values computed by the tests described above. */ /* The values are currently limited to 1/ulp, to avoid */ /* overflow. */ /* INFO (output) INTEGER */ /* If 0, then everything ran OK. */ /* ----------------------------------------------------------------------- */ /* Some Local Variables and Parameters: */ /* ---- ----- --------- --- ---------- */ /* ZERO, ONE Real 0 and 1. */ /* MAXTYP The number of types defined. */ /* NTEST The number of tests performed, or which can */ /* be performed so far, for the current matrix. */ /* NTESTT The total number of tests performed so far. */ /* NMAX Largest value in NN. */ /* NMATS The number of matrices generated so far. */ /* NERRS The number of tests which have exceeded THRESH */ /* so far. */ /* COND, IMODE Values to be passed to the matrix generators. */ /* ANORM Norm of A; passed to matrix generators. */ /* OVFL, UNFL Overflow and underflow thresholds. */ /* ULP, ULPINV Finest relative precision and its inverse. */ /* RTOVFL, RTUNFL Square roots of the previous 2 values. */ /* The following four arrays decode JTYPE: */ /* KTYPE(j) The general type (1-10) for type "j". */ /* KMODE(j) The MODE value to be passed to the matrix */ /* generator for type "j". */ /* KMAGN(j) The order of magnitude ( O(1), */ /* O(overflow^(1/2) ), O(underflow^(1/2) ) */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Data statements .. */ /* Parameter adjustments */ --mval; --nval; --kk; --dotype; --iseed; a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; ab_dim1 = *ldab; ab_offset = 1 + ab_dim1; ab -= ab_offset; --bd; --be; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; p_dim1 = *ldp; p_offset = 1 + p_dim1; p -= p_offset; cc_dim1 = *ldc; cc_offset = 1 + cc_dim1; cc -= cc_offset; c_dim1 = *ldc; c_offset = 1 + c_dim1; c__ -= c_offset; --work; --result; /* Function Body */ /* .. */ /* .. Executable Statements .. */ /* Check for errors */ ntestt = 0; *info = 0; /* Important constants */ badmm = FALSE_; badnn = FALSE_; mmax = 1; nmax = 1; mnmax = 1; i__1 = *nsizes; for (j = 1; j <= i__1; ++j) { /* Computing MAX */ i__2 = mmax, i__3 = mval[j]; mmax = max(i__2,i__3); if (mval[j] < 0) { badmm = TRUE_; } /* Computing MAX */ i__2 = nmax, i__3 = nval[j]; nmax = max(i__2,i__3); if (nval[j] < 0) { badnn = TRUE_; } /* Computing MAX */ /* Computing MIN */ i__4 = mval[j], i__5 = nval[j]; i__2 = mnmax, i__3 = min(i__4,i__5); mnmax = max(i__2,i__3); /* L10: */ } badnnb = FALSE_; kmax = 0; i__1 = *nwdths; for (j = 1; j <= i__1; ++j) { /* Computing MAX */ i__2 = kmax, i__3 = kk[j]; kmax = max(i__2,i__3); if (kk[j] < 0) { badnnb = TRUE_; } /* L20: */ } /* Check for errors */ if (*nsizes < 0) { *info = -1; } else if (badmm) { *info = -2; } else if (badnn) { *info = -3; } else if (*nwdths < 0) { *info = -4; } else if (badnnb) { *info = -5; } else if (*ntypes < 0) { *info = -6; } else if (*nrhs < 0) { *info = -8; } else if (*lda < nmax) { *info = -13; } else if (*ldab < (kmax << 1) + 1) { *info = -15; } else if (*ldq < nmax) { *info = -19; } else if (*ldp < nmax) { *info = -21; } else if (*ldc < nmax) { *info = -23; } else if ((max(*lda,nmax) + 1) * nmax > *lwork) { *info = -26; } if (*info != 0) { i__1 = -(*info); xerbla_("SCHKBB", &i__1); return 0; } /* Quick return if possible */ if (*nsizes == 0 || *ntypes == 0 || *nwdths == 0) { return 0; } /* More Important constants */ unfl = slamch_("Safe minimum"); ovfl = 1.f / unfl; ulp = slamch_("Epsilon") * slamch_("Base"); ulpinv = 1.f / ulp; rtunfl = sqrt(unfl); rtovfl = sqrt(ovfl); /* Loop over sizes, widths, types */ nerrs = 0; nmats = 0; i__1 = *nsizes; for (jsize = 1; jsize <= i__1; ++jsize) { m = mval[jsize]; n = nval[jsize]; mnmin = min(m,n); /* Computing MAX */ i__2 = max(1,m); amninv = 1.f / (real) max(i__2,n); i__2 = *nwdths; for (jwidth = 1; jwidth <= i__2; ++jwidth) { k = kk[jwidth]; if (k >= m && k >= n) { goto L150; } /* Computing MAX */ /* Computing MIN */ i__5 = m - 1; i__3 = 0, i__4 = min(i__5,k); kl = max(i__3,i__4); /* Computing MAX */ /* Computing MIN */ i__5 = n - 1; i__3 = 0, i__4 = min(i__5,k); ku = max(i__3,i__4); if (*nsizes != 1) { mtypes = min(15,*ntypes); } else { mtypes = min(16,*ntypes); } i__3 = mtypes; for (jtype = 1; jtype <= i__3; ++jtype) { if (! dotype[jtype]) { goto L140; } ++nmats; ntest = 0; for (j = 1; j <= 4; ++j) { ioldsd[j - 1] = iseed[j]; /* L30: */ } /* Compute "A". */ /* Control parameters: */ /* KMAGN KMODE KTYPE */ /* =1 O(1) clustered 1 zero */ /* =2 large clustered 2 identity */ /* =3 small exponential (none) */ /* =4 arithmetic diagonal, (w/ singular values) */ /* =5 random log (none) */ /* =6 random nonhermitian, w/ singular values */ /* =7 (none) */ /* =8 (none) */ /* =9 random nonhermitian */ if (mtypes > 15) { goto L90; } itype = ktype[jtype - 1]; imode = kmode[jtype - 1]; /* Compute norm */ switch (kmagn[jtype - 1]) { case 1: goto L40; case 2: goto L50; case 3: goto L60; } L40: anorm = 1.f; goto L70; L50: anorm = rtovfl * ulp * amninv; goto L70; L60: anorm = rtunfl * max(m,n) * ulpinv; goto L70; L70: slaset_("Full", lda, &n, &c_b18, &c_b18, &a[a_offset], lda); slaset_("Full", ldab, &n, &c_b18, &c_b18, &ab[ab_offset], ldab); iinfo = 0; cond = ulpinv; /* Special Matrices -- Identity & Jordan block */ /* Zero */ if (itype == 1) { iinfo = 0; } else if (itype == 2) { /* Identity */ i__4 = n; for (jcol = 1; jcol <= i__4; ++jcol) { a[jcol + jcol * a_dim1] = anorm; /* L80: */ } } else if (itype == 4) { /* Diagonal Matrix, singular values specified */ slatms_(&m, &n, "S", &iseed[1], "N", &work[1], &imode, & cond, &anorm, &c__0, &c__0, "N", &a[a_offset], lda, &work[m + 1], &iinfo); } else if (itype == 6) { /* Nonhermitian, singular values specified */ slatms_(&m, &n, "S", &iseed[1], "N", &work[1], &imode, & cond, &anorm, &kl, &ku, "N", &a[a_offset], lda, & work[m + 1], &iinfo); } else if (itype == 9) { /* Nonhermitian, random entries */ slatmr_(&m, &n, "S", &iseed[1], "N", &work[1], &c__6, & c_b35, &c_b35, "T", "N", &work[n + 1], &c__1, & c_b35, &work[(n << 1) + 1], &c__1, &c_b35, "N", idumma, &kl, &ku, &c_b18, &anorm, "N", &a[ a_offset], lda, idumma, &iinfo); } else { iinfo = 1; } /* Generate Right-Hand Side */ slatmr_(&m, nrhs, "S", &iseed[1], "N", &work[1], &c__6, & c_b35, &c_b35, "T", "N", &work[m + 1], &c__1, &c_b35, &work[(m << 1) + 1], &c__1, &c_b35, "N", idumma, &m, nrhs, &c_b18, &c_b35, "NO", &c__[c_offset], ldc, idumma, &iinfo); if (iinfo != 0) { io___41.ciunit = *nounit; s_wsfe(&io___41); 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; } L90: /* Copy A to band storage. */ i__4 = n; for (j = 1; j <= i__4; ++j) { /* Computing MAX */ i__5 = 1, i__6 = j - ku; /* Computing MIN */ i__8 = m, i__9 = j + kl; i__7 = min(i__8,i__9); for (i__ = max(i__5,i__6); i__ <= i__7; ++i__) { ab[ku + 1 + i__ - j + j * ab_dim1] = a[i__ + j * a_dim1]; /* L100: */ } /* L110: */ } /* Copy C */ slacpy_("Full", &m, nrhs, &c__[c_offset], ldc, &cc[cc_offset], ldc); /* Call SGBBRD to compute B, Q and P, and to update C. */ sgbbrd_("B", &m, &n, nrhs, &kl, &ku, &ab[ab_offset], ldab, & bd[1], &be[1], &q[q_offset], ldq, &p[p_offset], ldp, & cc[cc_offset], ldc, &work[1], &iinfo); if (iinfo != 0) { io___43.ciunit = *nounit; s_wsfe(&io___43); do_fio(&c__1, "SGBBRD", (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)) ; e_wsfe(); *info = abs(iinfo); if (iinfo < 0) { return 0; } else { result[1] = ulpinv; goto L120; } } /* Test 1: Check the decomposition A := Q * B * P' */ /* 2: Check the orthogonality of Q */ /* 3: Check the orthogonality of P */ /* 4: Check the computation of Q' * C */ sbdt01_(&m, &n, &c_n1, &a[a_offset], lda, &q[q_offset], ldq, & bd[1], &be[1], &p[p_offset], ldp, &work[1], &result[1] ); sort01_("Columns", &m, &m, &q[q_offset], ldq, &work[1], lwork, &result[2]); sort01_("Rows", &n, &n, &p[p_offset], ldp, &work[1], lwork, & result[3]); sbdt02_(&m, nrhs, &c__[c_offset], ldc, &cc[cc_offset], ldc, & q[q_offset], ldq, &work[1], &result[4]); /* End of Loop -- Check for RESULT(j) > THRESH */ ntest = 4; L120: ntestt += ntest; /* Print out tests which fail. */ i__4 = ntest; for (jr = 1; jr <= i__4; ++jr) { if (result[jr] >= *thresh) { if (nerrs == 0) { slahd2_(nounit, "SBB"); } ++nerrs; io___45.ciunit = *nounit; s_wsfe(&io___45); do_fio(&c__1, (char *)&m, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&jr, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&result[jr], (ftnlen)sizeof( real)); e_wsfe(); } /* L130: */ } L140: ; } L150: ; } /* L160: */ } /* Summary */ slasum_("SBB", nounit, &nerrs, &ntestt); return 0; /* End of SCHKBB */ } /* schkbb_ */