1 SUBROUTINE CERRPS( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Craig Lucas, University of Manchester / NAG Ltd.
5 * October, 2008
6 *
7 * .. Scalar Arguments ..
8 INTEGER NUNIT
9 CHARACTER*3 PATH
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * CERRPS tests the error exits for the COMPLEX routines
16 * for CPSTRF..
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30 INTEGER NMAX
31 PARAMETER ( NMAX = 4 )
32 * ..
33 * .. Local Scalars ..
34 INTEGER I, INFO, J
35 * ..
36 * .. Local Arrays ..
37 COMPLEX A( NMAX, NMAX )
38 REAL RWORK( 2*NMAX )
39 INTEGER PIV( NMAX )
40 * ..
41 * .. External Subroutines ..
42 EXTERNAL ALAESM, CHKXER, CPSTF2, CPSTRF
43 * ..
44 * .. Scalars in Common ..
45 INTEGER INFOT, NOUT
46 LOGICAL LERR, OK
47 CHARACTER*32 SRNAMT
48 * ..
49 * .. Common blocks ..
50 COMMON / INFOC / INFOT, NOUT, OK, LERR
51 COMMON / SRNAMC / SRNAMT
52 * ..
53 * .. Intrinsic Functions ..
54 INTRINSIC REAL
55 * ..
56 * .. Executable Statements ..
57 *
58 NOUT = NUNIT
59 WRITE( NOUT, FMT = * )
60 *
61 * Set the variables to innocuous values.
62 *
63 DO 110 J = 1, NMAX
64 DO 100 I = 1, NMAX
65 A( I, J ) = 1.0 / REAL( I+J )
66 *
67 100 CONTINUE
68 PIV( J ) = J
69 RWORK( J ) = 0.
70 RWORK( NMAX+J ) = 0.
71 *
72 110 CONTINUE
73 OK = .TRUE.
74 *
75 *
76 * Test error exits of the routines that use the Cholesky
77 * decomposition of an Hermitian positive semidefinite matrix.
78 *
79 * CPSTRF
80 *
81 SRNAMT = 'CPSTRF'
82 INFOT = 1
83 CALL CPSTRF( '/', 0, A, 1, PIV, 1, -1.0, RWORK, INFO )
84 CALL CHKXER( 'CPSTRF', INFOT, NOUT, LERR, OK )
85 INFOT = 2
86 CALL CPSTRF( 'U', -1, A, 1, PIV, 1, -1.0, RWORK, INFO )
87 CALL CHKXER( 'CPSTRF', INFOT, NOUT, LERR, OK )
88 INFOT = 4
89 CALL CPSTRF( 'U', 2, A, 1, PIV, 1, -1.0, RWORK, INFO )
90 CALL CHKXER( 'CPSTRF', INFOT, NOUT, LERR, OK )
91 *
92 * CPSTF2
93 *
94 SRNAMT = 'CPSTF2'
95 INFOT = 1
96 CALL CPSTF2( '/', 0, A, 1, PIV, 1, -1.0, RWORK, INFO )
97 CALL CHKXER( 'CPSTF2', INFOT, NOUT, LERR, OK )
98 INFOT = 2
99 CALL CPSTF2( 'U', -1, A, 1, PIV, 1, -1.0, RWORK, INFO )
100 CALL CHKXER( 'CPSTF2', INFOT, NOUT, LERR, OK )
101 INFOT = 4
102 CALL CPSTF2( 'U', 2, A, 1, PIV, 1, -1.0, RWORK, INFO )
103 CALL CHKXER( 'CPSTF2', INFOT, NOUT, LERR, OK )
104 *
105 *
106 * Print a summary line.
107 *
108 CALL ALAESM( PATH, OK, NOUT )
109 *
110 RETURN
111 *
112 * End of CERRPS
113 *
114 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Craig Lucas, University of Manchester / NAG Ltd.
5 * October, 2008
6 *
7 * .. Scalar Arguments ..
8 INTEGER NUNIT
9 CHARACTER*3 PATH
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * CERRPS tests the error exits for the COMPLEX routines
16 * for CPSTRF..
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30 INTEGER NMAX
31 PARAMETER ( NMAX = 4 )
32 * ..
33 * .. Local Scalars ..
34 INTEGER I, INFO, J
35 * ..
36 * .. Local Arrays ..
37 COMPLEX A( NMAX, NMAX )
38 REAL RWORK( 2*NMAX )
39 INTEGER PIV( NMAX )
40 * ..
41 * .. External Subroutines ..
42 EXTERNAL ALAESM, CHKXER, CPSTF2, CPSTRF
43 * ..
44 * .. Scalars in Common ..
45 INTEGER INFOT, NOUT
46 LOGICAL LERR, OK
47 CHARACTER*32 SRNAMT
48 * ..
49 * .. Common blocks ..
50 COMMON / INFOC / INFOT, NOUT, OK, LERR
51 COMMON / SRNAMC / SRNAMT
52 * ..
53 * .. Intrinsic Functions ..
54 INTRINSIC REAL
55 * ..
56 * .. Executable Statements ..
57 *
58 NOUT = NUNIT
59 WRITE( NOUT, FMT = * )
60 *
61 * Set the variables to innocuous values.
62 *
63 DO 110 J = 1, NMAX
64 DO 100 I = 1, NMAX
65 A( I, J ) = 1.0 / REAL( I+J )
66 *
67 100 CONTINUE
68 PIV( J ) = J
69 RWORK( J ) = 0.
70 RWORK( NMAX+J ) = 0.
71 *
72 110 CONTINUE
73 OK = .TRUE.
74 *
75 *
76 * Test error exits of the routines that use the Cholesky
77 * decomposition of an Hermitian positive semidefinite matrix.
78 *
79 * CPSTRF
80 *
81 SRNAMT = 'CPSTRF'
82 INFOT = 1
83 CALL CPSTRF( '/', 0, A, 1, PIV, 1, -1.0, RWORK, INFO )
84 CALL CHKXER( 'CPSTRF', INFOT, NOUT, LERR, OK )
85 INFOT = 2
86 CALL CPSTRF( 'U', -1, A, 1, PIV, 1, -1.0, RWORK, INFO )
87 CALL CHKXER( 'CPSTRF', INFOT, NOUT, LERR, OK )
88 INFOT = 4
89 CALL CPSTRF( 'U', 2, A, 1, PIV, 1, -1.0, RWORK, INFO )
90 CALL CHKXER( 'CPSTRF', INFOT, NOUT, LERR, OK )
91 *
92 * CPSTF2
93 *
94 SRNAMT = 'CPSTF2'
95 INFOT = 1
96 CALL CPSTF2( '/', 0, A, 1, PIV, 1, -1.0, RWORK, INFO )
97 CALL CHKXER( 'CPSTF2', INFOT, NOUT, LERR, OK )
98 INFOT = 2
99 CALL CPSTF2( 'U', -1, A, 1, PIV, 1, -1.0, RWORK, INFO )
100 CALL CHKXER( 'CPSTF2', INFOT, NOUT, LERR, OK )
101 INFOT = 4
102 CALL CPSTF2( 'U', 2, A, 1, PIV, 1, -1.0, RWORK, INFO )
103 CALL CHKXER( 'CPSTF2', INFOT, NOUT, LERR, OK )
104 *
105 *
106 * Print a summary line.
107 *
108 CALL ALAESM( PATH, OK, NOUT )
109 *
110 RETURN
111 *
112 * End of CERRPS
113 *
114 END