1*> \brief \b DERRAC 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 DERRAC( NUNIT ) 12* 13* .. Scalar Arguments .. 14* INTEGER NUNIT 15* .. 16* 17* 18*> \par Purpose: 19* ============= 20*> 21*> \verbatim 22*> 23*> DERRAC tests the error exits for DSPOSV. 24*> \endverbatim 25* 26* Arguments: 27* ========== 28* 29*> \param[in] NUNIT 30*> \verbatim 31*> NUNIT is INTEGER 32*> The unit number for output. 33*> \endverbatim 34* 35* Authors: 36* ======== 37* 38*> \author Univ. of Tennessee 39*> \author Univ. of California Berkeley 40*> \author Univ. of Colorado Denver 41*> \author NAG Ltd. 42* 43*> \date November 2011 44* 45*> \ingroup double_lin 46* 47* ===================================================================== 48 SUBROUTINE DERRAC( NUNIT ) 49* 50* -- LAPACK test routine (version 3.4.0) -- 51* -- LAPACK is a software package provided by Univ. of Tennessee, -- 52* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 53* November 2011 54* 55* .. Scalar Arguments .. 56 INTEGER NUNIT 57* .. 58* 59* ===================================================================== 60* 61* .. Parameters .. 62 INTEGER NMAX 63 PARAMETER ( NMAX = 4 ) 64* .. 65* .. Local Scalars .. 66 INTEGER I, INFO, ITER, J 67* .. 68* .. Local Arrays .. 69 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 70 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ), 71 $ W( 2*NMAX ), X( NMAX ) 72 DOUBLE PRECISION WORK(NMAX*NMAX) 73 REAL SWORK(NMAX*NMAX) 74* .. 75* .. External Subroutines .. 76 EXTERNAL CHKXER, DSPOSV 77* .. 78* .. Scalars in Common .. 79 LOGICAL LERR, OK 80 CHARACTER*32 SRNAMT 81 INTEGER INFOT, NOUT 82* .. 83* .. Common blocks .. 84 COMMON / INFOC / INFOT, NOUT, OK, LERR 85 COMMON / SRNAMC / SRNAMT 86* .. 87* .. Intrinsic Functions .. 88 INTRINSIC DBLE 89* .. 90* .. Executable Statements .. 91* 92 NOUT = NUNIT 93 WRITE( NOUT, FMT = * ) 94* 95* Set the variables to innocuous values. 96* 97 DO 20 J = 1, NMAX 98 DO 10 I = 1, NMAX 99 A( I, J ) = 1.D0 / DBLE( I+J ) 100 AF( I, J ) = 1.D0 / DBLE( I+J ) 101 10 CONTINUE 102 B( J ) = 0.D0 103 R1( J ) = 0.D0 104 R2( J ) = 0.D0 105 W( J ) = 0.D0 106 X( J ) = 0.D0 107 C( J ) = 0.D0 108 R( J ) = 0.D0 109 20 CONTINUE 110 OK = .TRUE. 111* 112 SRNAMT = 'DSPOSV' 113 INFOT = 1 114 CALL DSPOSV('/',0,0,A,1,B,1,X,1,WORK,SWORK,ITER,INFO) 115 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 116 INFOT = 2 117 CALL DSPOSV('U',-1,0,A,1,B,1,X,1,WORK,SWORK,ITER,INFO) 118 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 119 INFOT = 3 120 CALL DSPOSV('U',0,-1,A,1,B,1,X,1,WORK,SWORK,ITER,INFO) 121 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 122 INFOT = 5 123 CALL DSPOSV('U',2,1,A,1,B,2,X,2,WORK,SWORK,ITER,INFO) 124 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 125 INFOT = 7 126 CALL DSPOSV('U',2,1,A,2,B,1,X,2,WORK,SWORK,ITER,INFO) 127 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 128 INFOT = 9 129 CALL DSPOSV('U',2,1,A,2,B,2,X,1,WORK,SWORK,ITER,INFO) 130 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 131* 132* Print a summary line. 133* 134 IF( OK ) THEN 135 WRITE( NOUT, FMT = 9999 )'DSPOSV' 136 ELSE 137 WRITE( NOUT, FMT = 9998 )'DSPOSV' 138 END IF 139* 140 9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' ) 141 9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ', 142 $ 'exits ***' ) 143* 144 RETURN 145* 146* End of DERRAC 147* 148 END 149