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