1 SUBROUTINE ZERRAC( 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 * ZERRPX tests the error exits for ZCPOSV.
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 COMPLEX*16 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 RWORK( NMAX )
37 COMPLEX*16 WORK(NMAX*NMAX)
38 COMPLEX SWORK(NMAX*NMAX)
39 * ..
40 * .. External Subroutines ..
41 EXTERNAL CHKXER, ZCPOSV
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 20 CONTINUE
75 OK = .TRUE.
76 *
77 SRNAMT = 'ZCPOSV'
78 INFOT = 1
79 CALL ZCPOSV('/',0,0,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
80 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL ZCPOSV('U',-1,0,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
83 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
84 INFOT = 3
85 CALL ZCPOSV('U',0,-1,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
86 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
87 INFOT = 5
88 CALL ZCPOSV('U',2,1,A,1,B,2,X,2,WORK,SWORK,RWORK,ITER,INFO)
89 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
90 INFOT = 7
91 CALL ZCPOSV('U',2,1,A,2,B,1,X,2,WORK,SWORK,RWORK,ITER,INFO)
92 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
93 INFOT = 9
94 CALL ZCPOSV('U',2,1,A,2,B,2,X,1,WORK,SWORK,RWORK,ITER,INFO)
95 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
96 *
97 * Print a summary line.
98 *
99 IF( OK ) THEN
100 WRITE( NOUT, FMT = 9999 )'ZCPOSV'
101 ELSE
102 WRITE( NOUT, FMT = 9998 )'ZCPOSV'
103 END IF
104 *
105 9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' )
106 9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ',
107 $ 'exits ***' )
108 *
109 RETURN
110 *
111 * End of ZERRAC
112 *
113 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 * ZERRPX tests the error exits for ZCPOSV.
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 COMPLEX*16 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 RWORK( NMAX )
37 COMPLEX*16 WORK(NMAX*NMAX)
38 COMPLEX SWORK(NMAX*NMAX)
39 * ..
40 * .. External Subroutines ..
41 EXTERNAL CHKXER, ZCPOSV
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 20 CONTINUE
75 OK = .TRUE.
76 *
77 SRNAMT = 'ZCPOSV'
78 INFOT = 1
79 CALL ZCPOSV('/',0,0,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
80 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL ZCPOSV('U',-1,0,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
83 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
84 INFOT = 3
85 CALL ZCPOSV('U',0,-1,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO)
86 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
87 INFOT = 5
88 CALL ZCPOSV('U',2,1,A,1,B,2,X,2,WORK,SWORK,RWORK,ITER,INFO)
89 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
90 INFOT = 7
91 CALL ZCPOSV('U',2,1,A,2,B,1,X,2,WORK,SWORK,RWORK,ITER,INFO)
92 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
93 INFOT = 9
94 CALL ZCPOSV('U',2,1,A,2,B,2,X,1,WORK,SWORK,RWORK,ITER,INFO)
95 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK )
96 *
97 * Print a summary line.
98 *
99 IF( OK ) THEN
100 WRITE( NOUT, FMT = 9999 )'ZCPOSV'
101 ELSE
102 WRITE( NOUT, FMT = 9998 )'ZCPOSV'
103 END IF
104 *
105 9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' )
106 9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ',
107 $ 'exits ***' )
108 *
109 RETURN
110 *
111 * End of ZERRAC
112 *
113 END