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