예제 #1
0
파일: spftrs.c 프로젝트: csapng/libflame
/* Subroutine */
int spftrs_(char *transr, char *uplo, integer *n, integer * nrhs, real *a, real *b, integer *ldb, integer *info)
{
    /* System generated locals */
    integer b_dim1, b_offset, i__1;
    /* Local variables */
    logical normaltransr;
    extern logical lsame_(char *, char *);
    logical lower;
    extern /* Subroutine */
    int stfsm_(char *, char *, char *, char *, char *, integer *, integer *, real *, real *, real *, integer *), xerbla_(char *, integer *);
    /* -- LAPACK computational routine (version 3.4.0) -- */
    /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
    /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
    /* November 2011 */
    /* .. Scalar Arguments .. */
    /* .. */
    /* .. Array Arguments .. */
    /* .. */
    /* ===================================================================== */
    /* .. Parameters .. */
    /* .. */
    /* .. Local Scalars .. */
    /* .. */
    /* .. External Functions .. */
    /* .. */
    /* .. External Subroutines .. */
    /* .. */
    /* .. Intrinsic Functions .. */
    /* .. */
    /* .. Executable Statements .. */
    /* Test the input parameters. */
    /* Parameter adjustments */
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    /* Function Body */
    *info = 0;
    normaltransr = lsame_(transr, "N");
    lower = lsame_(uplo, "L");
    if (! normaltransr && ! lsame_(transr, "T"))
    {
        *info = -1;
    }
    else if (! lower && ! lsame_(uplo, "U"))
    {
        *info = -2;
    }
    else if (*n < 0)
    {
        *info = -3;
    }
    else if (*nrhs < 0)
    {
        *info = -4;
    }
    else if (*ldb < max(1,*n))
    {
        *info = -7;
    }
    if (*info != 0)
    {
        i__1 = -(*info);
        xerbla_("SPFTRS", &i__1);
        return 0;
    }
    /* Quick return if possible */
    if (*n == 0 || *nrhs == 0)
    {
        return 0;
    }
    /* start execution: there are two triangular solves */
    if (lower)
    {
        stfsm_(transr, "L", uplo, "N", "N", n, nrhs, &c_b10, a, &b[b_offset], ldb);
        stfsm_(transr, "L", uplo, "T", "N", n, nrhs, &c_b10, a, &b[b_offset], ldb);
    }
    else
    {
        stfsm_(transr, "L", uplo, "T", "N", n, nrhs, &c_b10, a, &b[b_offset], ldb);
        stfsm_(transr, "L", uplo, "N", "N", n, nrhs, &c_b10, a, &b[b_offset], ldb);
    }
    return 0;
    /* End of SPFTRS */
}
예제 #2
0
/* Subroutine */ int spftrs_(char *transr, char *uplo, integer *n, integer *
	nrhs, real *a, real *b, integer *ldb, integer *info)
{
    /* System generated locals */
    integer b_dim1, b_offset, i__1;

    /* Local variables */
    logical normaltransr;
    extern logical lsame_(char *, char *);
    logical lower;
    extern /* Subroutine */ int stfsm_(char *, char *, char *, char *, char *, 
	     integer *, integer *, real *, real *, real *, integer *), xerbla_(char *, integer *);


/*  -- LAPACK routine (version 3.2)                                    -- */

/*  -- Contributed by Fred Gustavson of the IBM Watson Research Center -- */
/*  -- November 2008                                                   -- */

/*  -- LAPACK is a software package provided by Univ. of Tennessee,    -- */
/*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */

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

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

/*  SPFTRS solves a system of linear equations A*X = B with a symmetric */
/*  positive definite matrix A using the Cholesky factorization */
/*  A = U**T*U or A = L*L**T computed by SPFTRF. */

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

/*  TRANSR    (input) CHARACTER */
/*          = 'N':  The Normal TRANSR of RFP A is stored; */
/*          = 'T':  The Transpose TRANSR of RFP A is stored. */

/*  UPLO    (input) CHARACTER */
/*          = 'U':  Upper triangle of RFP A is stored; */
/*          = 'L':  Lower triangle of RFP A is stored. */

/*  N       (input) INTEGER */
/*          The order of the matrix A.  N >= 0. */

/*  NRHS    (input) INTEGER */
/*          The number of right hand sides, i.e., the number of columns */
/*          of the matrix B.  NRHS >= 0. */

/*  A       (input) REAL array, dimension ( N*(N+1)/2 ) */
/*          The triangular factor U or L from the Cholesky factorization */
/*          of RFP A = U**H*U or RFP A = L*L**T, as computed by SPFTRF. */
/*          See note below for more details about RFP A. */

/*  B       (input/output) REAL array, dimension (LDB,NRHS) */
/*          On entry, the right hand side matrix B. */
/*          On exit, the solution matrix X. */

/*  LDB     (input) INTEGER */
/*          The leading dimension of the array B.  LDB >= max(1,N). */

/*  INFO    (output) INTEGER */
/*          = 0:  successful exit */
/*          < 0:  if INFO = -i, the i-th argument had an illegal value */

/*  Notes */
/*  ===== */

/*  We first consider Rectangular Full Packed (RFP) Format when N is */
/*  even. We give an example where N = 6. */

/*      AP is Upper             AP is Lower */

/*   00 01 02 03 04 05       00 */
/*      11 12 13 14 15       10 11 */
/*         22 23 24 25       20 21 22 */
/*            33 34 35       30 31 32 33 */
/*               44 45       40 41 42 43 44 */
/*                  55       50 51 52 53 54 55 */


/*  Let TRANSR = 'N'. RFP holds AP as follows: */
/*  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last */
/*  three columns of AP upper. The lower triangle A(4:6,0:2) consists of */
/*  the transpose of the first three columns of AP upper. */
/*  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first */
/*  three columns of AP lower. The upper triangle A(0:2,0:2) consists of */
/*  the transpose of the last three columns of AP lower. */
/*  This covers the case N even and TRANSR = 'N'. */

/*         RFP A                   RFP A */

/*        03 04 05                33 43 53 */
/*        13 14 15                00 44 54 */
/*        23 24 25                10 11 55 */
/*        33 34 35                20 21 22 */
/*        00 44 45                30 31 32 */
/*        01 11 55                40 41 42 */
/*        02 12 22                50 51 52 */

/*  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the */
/*  transpose of RFP A above. One therefore gets: */


/*           RFP A                   RFP A */

/*     03 13 23 33 00 01 02    33 00 10 20 30 40 50 */
/*     04 14 24 34 44 11 12    43 44 11 21 31 41 51 */
/*     05 15 25 35 45 55 22    53 54 55 22 32 42 52 */


/*  We first consider Rectangular Full Packed (RFP) Format when N is */
/*  odd. We give an example where N = 5. */

/*     AP is Upper                 AP is Lower */

/*   00 01 02 03 04              00 */
/*      11 12 13 14              10 11 */
/*         22 23 24              20 21 22 */
/*            33 34              30 31 32 33 */
/*               44              40 41 42 43 44 */


/*  Let TRANSR = 'N'. RFP holds AP as follows: */
/*  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last */
/*  three columns of AP upper. The lower triangle A(3:4,0:1) consists of */
/*  the transpose of the first two columns of AP upper. */
/*  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first */
/*  three columns of AP lower. The upper triangle A(0:1,1:2) consists of */
/*  the transpose of the last two columns of AP lower. */
/*  This covers the case N odd and TRANSR = 'N'. */

/*         RFP A                   RFP A */

/*        02 03 04                00 33 43 */
/*        12 13 14                10 11 44 */
/*        22 23 24                20 21 22 */
/*        00 33 34                30 31 32 */
/*        01 11 44                40 41 42 */

/*  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the */
/*  transpose of RFP A above. One therefore gets: */

/*           RFP A                   RFP A */

/*     02 12 22 00 01             00 10 20 30 40 50 */
/*     03 13 23 33 11             33 11 21 31 41 51 */
/*     04 14 24 34 44             43 44 22 32 42 52 */

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

/*     .. Parameters .. */
/*     .. */
/*     .. Local Scalars .. */
/*     .. */
/*     .. External Functions .. */
/*     .. */
/*     .. External Subroutines .. */
/*     .. */
/*     .. Intrinsic Functions .. */
/*     .. */
/*     .. Executable Statements .. */

/*     Test the input parameters. */

    /* Parameter adjustments */
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;

    /* Function Body */
    *info = 0;
    normaltransr = lsame_(transr, "N");
    lower = lsame_(uplo, "L");
    if (! normaltransr && ! lsame_(transr, "T")) {
	*info = -1;
    } else if (! lower && ! lsame_(uplo, "U")) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (*nrhs < 0) {
	*info = -4;
    } else if (*ldb < max(1,*n)) {
	*info = -7;
    }
    if (*info != 0) {
	i__1 = -(*info);
	xerbla_("SPFTRS", &i__1);
	return 0;
    }

/*     Quick return if possible */

    if (*n == 0 || *nrhs == 0) {
	return 0;
    }

/*     start execution: there are two triangular solves */

    if (lower) {
	stfsm_(transr, "L", uplo, "N", "N", n, nrhs, &c_b10, a, &b[b_offset], 
		ldb);
	stfsm_(transr, "L", uplo, "T", "N", n, nrhs, &c_b10, a, &b[b_offset], 
		ldb);
    } else {
	stfsm_(transr, "L", uplo, "T", "N", n, nrhs, &c_b10, a, &b[b_offset], 
		ldb);
	stfsm_(transr, "L", uplo, "N", "N", n, nrhs, &c_b10, a, &b[b_offset], 
		ldb);
    }

    return 0;

/*     End of SPFTRS */

} /* spftrs_ */
예제 #3
0
파일: serrrfp.c 프로젝트: 3deggi/levmar-ndk
/* Subroutine */ int serrrfp_(integer *nunit)
{
    /* Format strings */
    static char fmt_9999[] = "(1x,\002REAL RFP routines passed the tests of"
	    " \002,\002the error exits\002)";
    static char fmt_9998[] = "(\002 *** RFP routines failed the tests of the"
	    " error \002,\002exits ***\002)";

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

    /* Local variables */
    real a[1]	/* was [1][1] */, b[1]	/* was [1][1] */, beta;
    integer info;
    real alpha;
    extern /* Subroutine */ int ssfrk_(char *, char *, char *, integer *, 
	    integer *, real *, real *, integer *, real *, real *), stfsm_(char *, char *, char *, char *, char *, 
	    integer *, integer *, real *, real *, real *, integer *), chkxer_(char *, integer *, 
	    integer *, logical *, logical *), spftrf_(char *, char *, 
	    integer *, real *, integer *), spftri_(char *, 
	    char *, integer *, real *, integer *), stftri_(
	    char *, char *, char *, integer *, real *, integer *), spftrs_(char *, char *, integer *, integer *, 
	    real *, real *, integer *, integer *), stfttp_(
	    char *, char *, integer *, real *, real *, integer *), stpttf_(char *, char *, integer *, real *, real *, 
	    integer *), stfttr_(char *, char *, integer *, 
	    real *, real *, integer *, integer *), strttf_(
	    char *, char *, integer *, real *, integer *, real *, integer *), stpttr_(char *, integer *, real *, real *, 
	    integer *, integer *), strttp_(char *, integer *, real *, 
	    integer *, real *, integer *);

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



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

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

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

/*  SERRRFP tests the error exits for the REAL driver routines */
/*  for solving linear systems of equations. */

/*  SDRVRFP tests the REAL LAPACK RFP routines: */
/*      STFSM, STFTRI, SSFRK, STFTTP, STFTTR, SPFTRF, SPFTRS, STPTTF, */
/*      STPTTR, STRTTF, and STRTTP */

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

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

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

/*     .. */
/*     .. Local Scalars .. */
/*     .. */
/*     .. Local Arrays .. */
/*     .. */
/*     .. External Subroutines .. */
/*     .. */
/*     .. Scalars in Common .. */
/*     .. */
/*     .. Common blocks .. */
/*     .. */
/*     .. Executable Statements .. */

    infoc_1.nout = *nunit;
    infoc_1.ok = TRUE_;
    a[0] = 1.f;
    b[0] = 1.f;
    alpha = 1.f;
    beta = 1.f;

    s_copy(srnamc_1.srnamt, "SPFTRF", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    spftrf_("/", "U", &c__0, a, &info);
    chkxer_("SPFTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    spftrf_("N", "/", &c__0, a, &info);
    chkxer_("SPFTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    spftrf_("N", "U", &c_n1, a, &info);
    chkxer_("SPFTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "SPFTRS", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    spftrs_("/", "U", &c__0, &c__0, a, b, &c__1, &info);
    chkxer_("SPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    spftrs_("N", "/", &c__0, &c__0, a, b, &c__1, &info);
    chkxer_("SPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    spftrs_("N", "U", &c_n1, &c__0, a, b, &c__1, &info);
    chkxer_("SPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    spftrs_("N", "U", &c__0, &c_n1, a, b, &c__1, &info);
    chkxer_("SPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 7;
    spftrs_("N", "U", &c__0, &c__0, a, b, &c__0, &info);
    chkxer_("SPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "SPFTRI", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    spftri_("/", "U", &c__0, a, &info);
    chkxer_("SPFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    spftri_("N", "/", &c__0, a, &info);
    chkxer_("SPFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    spftri_("N", "U", &c_n1, a, &info);
    chkxer_("SPFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "STFSM ", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    stfsm_("/", "L", "U", "T", "U", &c__0, &c__0, &alpha, a, b, &c__1);
    chkxer_("STFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    stfsm_("N", "/", "U", "T", "U", &c__0, &c__0, &alpha, a, b, &c__1);
    chkxer_("STFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    stfsm_("N", "L", "/", "T", "U", &c__0, &c__0, &alpha, a, b, &c__1);
    chkxer_("STFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    stfsm_("N", "L", "U", "/", "U", &c__0, &c__0, &alpha, a, b, &c__1);
    chkxer_("STFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 5;
    stfsm_("N", "L", "U", "T", "/", &c__0, &c__0, &alpha, a, b, &c__1);
    chkxer_("STFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 6;
    stfsm_("N", "L", "U", "T", "U", &c_n1, &c__0, &alpha, a, b, &c__1);
    chkxer_("STFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 7;
    stfsm_("N", "L", "U", "T", "U", &c__0, &c_n1, &alpha, a, b, &c__1);
    chkxer_("STFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 11;
    stfsm_("N", "L", "U", "T", "U", &c__0, &c__0, &alpha, a, b, &c__0);
    chkxer_("STFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "STFTRI", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    stftri_("/", "L", "N", &c__0, a, &info);
    chkxer_("STFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    stftri_("N", "/", "N", &c__0, a, &info);
    chkxer_("STFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    stftri_("N", "L", "/", &c__0, a, &info);
    chkxer_("STFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    stftri_("N", "L", "N", &c_n1, a, &info);
    chkxer_("STFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "STFTTR", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    stfttr_("/", "U", &c__0, a, b, &c__1, &info);
    chkxer_("STFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    stfttr_("N", "/", &c__0, a, b, &c__1, &info);
    chkxer_("STFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    stfttr_("N", "U", &c_n1, a, b, &c__1, &info);
    chkxer_("STFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 6;
    stfttr_("N", "U", &c__0, a, b, &c__0, &info);
    chkxer_("STFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "STRTTF", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    strttf_("/", "U", &c__0, a, &c__1, b, &info);
    chkxer_("STRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    strttf_("N", "/", &c__0, a, &c__1, b, &info);
    chkxer_("STRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    strttf_("N", "U", &c_n1, a, &c__1, b, &info);
    chkxer_("STRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 5;
    strttf_("N", "U", &c__0, a, &c__0, b, &info);
    chkxer_("STRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "STFTTP", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    stfttp_("/", "U", &c__0, a, b, &info);
    chkxer_("STFTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    stfttp_("N", "/", &c__0, a, b, &info);
    chkxer_("STFTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    stfttp_("N", "U", &c_n1, a, b, &info);
    chkxer_("STFTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "STPTTF", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    stpttf_("/", "U", &c__0, a, b, &info);
    chkxer_("STPTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    stpttf_("N", "/", &c__0, a, b, &info);
    chkxer_("STPTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    stpttf_("N", "U", &c_n1, a, b, &info);
    chkxer_("STPTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "STRTTP", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    strttp_("/", &c__0, a, &c__1, b, &info);
    chkxer_("STRTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    strttp_("U", &c_n1, a, &c__1, b, &info);
    chkxer_("STRTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    strttp_("U", &c__0, a, &c__0, b, &info);
    chkxer_("STRTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "STPTTR", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    stpttr_("/", &c__0, a, b, &c__1, &info);
    chkxer_("STPTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    stpttr_("U", &c_n1, a, b, &c__1, &info);
    chkxer_("STPTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 5;
    stpttr_("U", &c__0, a, b, &c__0, &info);
    chkxer_("STPTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

    s_copy(srnamc_1.srnamt, "SSFRK ", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    ssfrk_("/", "U", "N", &c__0, &c__0, &alpha, a, &c__1, &beta, b);
    chkxer_("SSFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    ssfrk_("N", "/", "N", &c__0, &c__0, &alpha, a, &c__1, &beta, b);
    chkxer_("SSFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    ssfrk_("N", "U", "/", &c__0, &c__0, &alpha, a, &c__1, &beta, b);
    chkxer_("SSFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    ssfrk_("N", "U", "N", &c_n1, &c__0, &alpha, a, &c__1, &beta, b);
    chkxer_("SSFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 5;
    ssfrk_("N", "U", "N", &c__0, &c_n1, &alpha, a, &c__1, &beta, b);
    chkxer_("SSFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 8;
    ssfrk_("N", "U", "N", &c__0, &c__0, &alpha, a, &c__0, &beta, b);
    chkxer_("SSFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);

/*     Print a summary line. */

    if (infoc_1.ok) {
	io___6.ciunit = infoc_1.nout;
	s_wsfe(&io___6);
	e_wsfe();
    } else {
	io___7.ciunit = infoc_1.nout;
	s_wsfe(&io___7);
	e_wsfe();
    }

    return 0;

/*     End of SERRRFP */

} /* serrrfp_ */