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