1 SUBROUTINE DERRAC( NUNIT )
2 IMPLICIT NONE
3 *
4 * -- LAPACK test routine (version 3.1.2) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * May 2007
7 *
8 * .. Scalar Arguments ..
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DERRAC tests the error exits for DSPOSV.
16 *
17 * Arguments
18 * =========
19 *
20 * NUNIT (input) INTEGER
21 * The unit number for output.
22 *
23 * =====================================================================
24 *
25 * .. Parameters ..
26 INTEGER NMAX
27 PARAMETER ( NMAX = 4 )
28 * ..
29 * .. Local Scalars ..
30 INTEGER I, INFO, ITER, J
31 * ..
32 * .. Local Arrays ..
33 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
34 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
35 $ W( 2*NMAX ), X( NMAX )
36 DOUBLE PRECISION WORK(NMAX*NMAX)
37 REAL SWORK(NMAX*NMAX)
38 * ..
39 * .. External Subroutines ..
40 EXTERNAL CHKXER, DSPOSV
41 * ..
42 * .. Scalars in Common ..
43 LOGICAL LERR, OK
44 CHARACTER*32 SRNAMT
45 INTEGER INFOT, NOUT
46 * ..
47 * .. Common blocks ..
48 COMMON / INFOC / INFOT, NOUT, OK, LERR
49 COMMON / SRNAMC / SRNAMT
50 * ..
51 * .. Intrinsic Functions ..
52 INTRINSIC DBLE
53 * ..
54 * .. Executable Statements ..
55 *
56 NOUT = NUNIT
57 WRITE( NOUT, FMT = * )
58 *
59 * Set the variables to innocuous values.
60 *
61 DO 20 J = 1, NMAX
62 DO 10 I = 1, NMAX
63 A( I, J ) = 1.D0 / DBLE( I+J )
64 AF( I, J ) = 1.D0 / DBLE( I+J )
65 10 CONTINUE
66 B( J ) = 0.D0
67 R1( J ) = 0.D0
68 R2( J ) = 0.D0
69 W( J ) = 0.D0
70 X( J ) = 0.D0
71 C( J ) = 0.D0
72 R( J ) = 0.D0
73 20 CONTINUE
74 OK = .TRUE.
75 *
76 SRNAMT = 'DSPOSV'
77 INFOT = 1
78 CALL DSPOSV('/',0,0,A,1,B,1,X,1,WORK,SWORK,ITER,INFO)
79 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
80 INFOT = 2
81 CALL DSPOSV('U',-1,0,A,1,B,1,X,1,WORK,SWORK,ITER,INFO)
82 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
83 INFOT = 3
84 CALL DSPOSV('U',0,-1,A,1,B,1,X,1,WORK,SWORK,ITER,INFO)
85 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
86 INFOT = 5
87 CALL DSPOSV('U',2,1,A,1,B,2,X,2,WORK,SWORK,ITER,INFO)
88 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
89 INFOT = 7
90 CALL DSPOSV('U',2,1,A,2,B,1,X,2,WORK,SWORK,ITER,INFO)
91 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
92 INFOT = 9
93 CALL DSPOSV('U',2,1,A,2,B,2,X,1,WORK,SWORK,ITER,INFO)
94 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
95 *
96 * Print a summary line.
97 *
98 IF( OK ) THEN
99 WRITE( NOUT, FMT = 9999 )'DSPOSV'
100 ELSE
101 WRITE( NOUT, FMT = 9998 )'DSPOSV'
102 END IF
103 *
104 9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' )
105 9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ',
106 $ 'exits ***' )
107 *
108 RETURN
109 *
110 * End of DERRAC
111 *
112 END
2 IMPLICIT NONE
3 *
4 * -- LAPACK test routine (version 3.1.2) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * May 2007
7 *
8 * .. Scalar Arguments ..
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DERRAC tests the error exits for DSPOSV.
16 *
17 * Arguments
18 * =========
19 *
20 * NUNIT (input) INTEGER
21 * The unit number for output.
22 *
23 * =====================================================================
24 *
25 * .. Parameters ..
26 INTEGER NMAX
27 PARAMETER ( NMAX = 4 )
28 * ..
29 * .. Local Scalars ..
30 INTEGER I, INFO, ITER, J
31 * ..
32 * .. Local Arrays ..
33 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
34 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
35 $ W( 2*NMAX ), X( NMAX )
36 DOUBLE PRECISION WORK(NMAX*NMAX)
37 REAL SWORK(NMAX*NMAX)
38 * ..
39 * .. External Subroutines ..
40 EXTERNAL CHKXER, DSPOSV
41 * ..
42 * .. Scalars in Common ..
43 LOGICAL LERR, OK
44 CHARACTER*32 SRNAMT
45 INTEGER INFOT, NOUT
46 * ..
47 * .. Common blocks ..
48 COMMON / INFOC / INFOT, NOUT, OK, LERR
49 COMMON / SRNAMC / SRNAMT
50 * ..
51 * .. Intrinsic Functions ..
52 INTRINSIC DBLE
53 * ..
54 * .. Executable Statements ..
55 *
56 NOUT = NUNIT
57 WRITE( NOUT, FMT = * )
58 *
59 * Set the variables to innocuous values.
60 *
61 DO 20 J = 1, NMAX
62 DO 10 I = 1, NMAX
63 A( I, J ) = 1.D0 / DBLE( I+J )
64 AF( I, J ) = 1.D0 / DBLE( I+J )
65 10 CONTINUE
66 B( J ) = 0.D0
67 R1( J ) = 0.D0
68 R2( J ) = 0.D0
69 W( J ) = 0.D0
70 X( J ) = 0.D0
71 C( J ) = 0.D0
72 R( J ) = 0.D0
73 20 CONTINUE
74 OK = .TRUE.
75 *
76 SRNAMT = 'DSPOSV'
77 INFOT = 1
78 CALL DSPOSV('/',0,0,A,1,B,1,X,1,WORK,SWORK,ITER,INFO)
79 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
80 INFOT = 2
81 CALL DSPOSV('U',-1,0,A,1,B,1,X,1,WORK,SWORK,ITER,INFO)
82 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
83 INFOT = 3
84 CALL DSPOSV('U',0,-1,A,1,B,1,X,1,WORK,SWORK,ITER,INFO)
85 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
86 INFOT = 5
87 CALL DSPOSV('U',2,1,A,1,B,2,X,2,WORK,SWORK,ITER,INFO)
88 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
89 INFOT = 7
90 CALL DSPOSV('U',2,1,A,2,B,1,X,2,WORK,SWORK,ITER,INFO)
91 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
92 INFOT = 9
93 CALL DSPOSV('U',2,1,A,2,B,2,X,1,WORK,SWORK,ITER,INFO)
94 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
95 *
96 * Print a summary line.
97 *
98 IF( OK ) THEN
99 WRITE( NOUT, FMT = 9999 )'DSPOSV'
100 ELSE
101 WRITE( NOUT, FMT = 9998 )'DSPOSV'
102 END IF
103 *
104 9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' )
105 9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ',
106 $ 'exits ***' )
107 *
108 RETURN
109 *
110 * End of DERRAC
111 *
112 END