1 SUBROUTINE DERRPS( 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 * DERRPS tests the error exits for the DOUBLE PRECISION routines
16 * for DPSTRF.
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 DOUBLE PRECISION A( NMAX, NMAX ), WORK( 2*NMAX )
38 INTEGER PIV( NMAX )
39 * ..
40 * .. External Subroutines ..
41 EXTERNAL ALAESM, CHKXER, DPSTF2, DPSTRF
42 * ..
43 * .. Scalars in Common ..
44 INTEGER INFOT, NOUT
45 LOGICAL LERR, OK
46 CHARACTER*32 SRNAMT
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 110 J = 1, NMAX
63 DO 100 I = 1, NMAX
64 A( I, J ) = 1.D0 / DBLE( I+J )
65 *
66 100 CONTINUE
67 PIV( J ) = J
68 WORK( J ) = 0.D0
69 WORK( NMAX+J ) = 0.D0
70 *
71 110 CONTINUE
72 OK = .TRUE.
73 *
74 *
75 * Test error exits of the routines that use the Cholesky
76 * decomposition of a symmetric positive semidefinite matrix.
77 *
78 * DPSTRF
79 *
80 SRNAMT = 'DPSTRF'
81 INFOT = 1
82 CALL DPSTRF( '/', 0, A, 1, PIV, 1, -1.D0, WORK, INFO )
83 CALL CHKXER( 'DPSTRF', INFOT, NOUT, LERR, OK )
84 INFOT = 2
85 CALL DPSTRF( 'U', -1, A, 1, PIV, 1, -1.D0, WORK, INFO )
86 CALL CHKXER( 'DPSTRF', INFOT, NOUT, LERR, OK )
87 INFOT = 4
88 CALL DPSTRF( 'U', 2, A, 1, PIV, 1, -1.D0, WORK, INFO )
89 CALL CHKXER( 'DPSTRF', INFOT, NOUT, LERR, OK )
90 *
91 * DPSTF2
92 *
93 SRNAMT = 'DPSTF2'
94 INFOT = 1
95 CALL DPSTF2( '/', 0, A, 1, PIV, 1, -1.D0, WORK, INFO )
96 CALL CHKXER( 'DPSTF2', INFOT, NOUT, LERR, OK )
97 INFOT = 2
98 CALL DPSTF2( 'U', -1, A, 1, PIV, 1, -1.D0, WORK, INFO )
99 CALL CHKXER( 'DPSTF2', INFOT, NOUT, LERR, OK )
100 INFOT = 4
101 CALL DPSTF2( 'U', 2, A, 1, PIV, 1, -1.D0, WORK, INFO )
102 CALL CHKXER( 'DPSTF2', INFOT, NOUT, LERR, OK )
103 *
104 *
105 * Print a summary line.
106 *
107 CALL ALAESM( PATH, OK, NOUT )
108 *
109 RETURN
110 *
111 * End of DERRPS
112 *
113 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 * DERRPS tests the error exits for the DOUBLE PRECISION routines
16 * for DPSTRF.
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 DOUBLE PRECISION A( NMAX, NMAX ), WORK( 2*NMAX )
38 INTEGER PIV( NMAX )
39 * ..
40 * .. External Subroutines ..
41 EXTERNAL ALAESM, CHKXER, DPSTF2, DPSTRF
42 * ..
43 * .. Scalars in Common ..
44 INTEGER INFOT, NOUT
45 LOGICAL LERR, OK
46 CHARACTER*32 SRNAMT
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 110 J = 1, NMAX
63 DO 100 I = 1, NMAX
64 A( I, J ) = 1.D0 / DBLE( I+J )
65 *
66 100 CONTINUE
67 PIV( J ) = J
68 WORK( J ) = 0.D0
69 WORK( NMAX+J ) = 0.D0
70 *
71 110 CONTINUE
72 OK = .TRUE.
73 *
74 *
75 * Test error exits of the routines that use the Cholesky
76 * decomposition of a symmetric positive semidefinite matrix.
77 *
78 * DPSTRF
79 *
80 SRNAMT = 'DPSTRF'
81 INFOT = 1
82 CALL DPSTRF( '/', 0, A, 1, PIV, 1, -1.D0, WORK, INFO )
83 CALL CHKXER( 'DPSTRF', INFOT, NOUT, LERR, OK )
84 INFOT = 2
85 CALL DPSTRF( 'U', -1, A, 1, PIV, 1, -1.D0, WORK, INFO )
86 CALL CHKXER( 'DPSTRF', INFOT, NOUT, LERR, OK )
87 INFOT = 4
88 CALL DPSTRF( 'U', 2, A, 1, PIV, 1, -1.D0, WORK, INFO )
89 CALL CHKXER( 'DPSTRF', INFOT, NOUT, LERR, OK )
90 *
91 * DPSTF2
92 *
93 SRNAMT = 'DPSTF2'
94 INFOT = 1
95 CALL DPSTF2( '/', 0, A, 1, PIV, 1, -1.D0, WORK, INFO )
96 CALL CHKXER( 'DPSTF2', INFOT, NOUT, LERR, OK )
97 INFOT = 2
98 CALL DPSTF2( 'U', -1, A, 1, PIV, 1, -1.D0, WORK, INFO )
99 CALL CHKXER( 'DPSTF2', INFOT, NOUT, LERR, OK )
100 INFOT = 4
101 CALL DPSTF2( 'U', 2, A, 1, PIV, 1, -1.D0, WORK, INFO )
102 CALL CHKXER( 'DPSTF2', INFOT, NOUT, LERR, OK )
103 *
104 *
105 * Print a summary line.
106 *
107 CALL ALAESM( PATH, OK, NOUT )
108 *
109 RETURN
110 *
111 * End of DERRPS
112 *
113 END