1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154
|
*> \brief \b SERRPS
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE SERRPS( PATH, NUNIT )
*
* .. Scalar Arguments ..
* INTEGER NUNIT
* CHARACTER*3 PATH
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> SERRPS tests the error exits for the REAL routines
*> for SPSTRF..
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] PATH
*> \verbatim
*> PATH is CHARACTER*3
*> The LAPACK path name for the routines to be tested.
*> \endverbatim
*>
*> \param[in] NUNIT
*> \verbatim
*> NUNIT is INTEGER
*> The unit number for output.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup single_lin
*
* =====================================================================
SUBROUTINE SERRPS( PATH, NUNIT )
*
* -- LAPACK test 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 ..
INTEGER NUNIT
CHARACTER*3 PATH
* ..
*
* =====================================================================
*
* .. Parameters ..
INTEGER NMAX
PARAMETER ( NMAX = 4 )
* ..
* .. Local Scalars ..
INTEGER I, INFO, J, RANK
* ..
* .. Local Arrays ..
REAL A( NMAX, NMAX ), WORK( 2*NMAX )
INTEGER PIV( NMAX )
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, SPSTF2, SPSTRF
* ..
* .. Scalars in Common ..
INTEGER INFOT, NOUT
LOGICAL LERR, OK
CHARACTER*32 SRNAMT
* ..
* .. Common blocks ..
COMMON / INFOC / INFOT, NOUT, OK, LERR
COMMON / SRNAMC / SRNAMT
* ..
* .. Intrinsic Functions ..
INTRINSIC REAL
* ..
* .. Executable Statements ..
*
NOUT = NUNIT
WRITE( NOUT, FMT = * )
*
* Set the variables to innocuous values.
*
DO 110 J = 1, NMAX
DO 100 I = 1, NMAX
A( I, J ) = 1.0 / REAL( I+J )
*
100 CONTINUE
PIV( J ) = J
WORK( J ) = 0.
WORK( NMAX+J ) = 0.
*
110 CONTINUE
OK = .TRUE.
*
*
* Test error exits of the routines that use the Cholesky
* decomposition of a symmetric positive semidefinite matrix.
*
* SPSTRF
*
SRNAMT = 'SPSTRF'
INFOT = 1
CALL SPSTRF( '/', 0, A, 1, PIV, RANK, -1.0, WORK, INFO )
CALL CHKXER( 'SPSTRF', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL SPSTRF( 'U', -1, A, 1, PIV, RANK, -1.0, WORK, INFO )
CALL CHKXER( 'SPSTRF', INFOT, NOUT, LERR, OK )
INFOT = 4
CALL SPSTRF( 'U', 2, A, 1, PIV, RANK, -1.0, WORK, INFO )
CALL CHKXER( 'SPSTRF', INFOT, NOUT, LERR, OK )
*
* SPSTF2
*
SRNAMT = 'SPSTF2'
INFOT = 1
CALL SPSTF2( '/', 0, A, 1, PIV, RANK, -1.0, WORK, INFO )
CALL CHKXER( 'SPSTF2', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL SPSTF2( 'U', -1, A, 1, PIV, RANK, -1.0, WORK, INFO )
CALL CHKXER( 'SPSTF2', INFOT, NOUT, LERR, OK )
INFOT = 4
CALL SPSTF2( 'U', 2, A, 1, PIV, RANK, -1.0, WORK, INFO )
CALL CHKXER( 'SPSTF2', INFOT, NOUT, LERR, OK )
*
*
* Print a summary line.
*
CALL ALAESM( PATH, OK, NOUT )
*
RETURN
*
* End of SERRPS
*
END
|