1 SUBROUTINE DLSETS( M, P, N, A, AF, LDA, B, BF, LDB, C, CF, D, DF,
2 $ X, WORK, LWORK, RWORK, RESULT )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 INTEGER LDA, LDB, LWORK, M, N, P
10 * ..
11 * .. Array Arguments ..
12 *
13 * Purpose
14 * =======
15 *
16 * DLSETS tests DGGLSE - a subroutine for solving linear equality
17 * constrained least square problem (LSE).
18 *
19 * Arguments
20 * =========
21 *
22 * M (input) INTEGER
23 * The number of rows of the matrix A. M >= 0.
24 *
25 * P (input) INTEGER
26 * The number of rows of the matrix B. P >= 0.
27 *
28 * N (input) INTEGER
29 * The number of columns of the matrices A and B. N >= 0.
30 *
31 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
32 * The M-by-N matrix A.
33 *
34 * AF (workspace) DOUBLE PRECISION array, dimension (LDA,N)
35 *
36 * LDA (input) INTEGER
37 * The leading dimension of the arrays A, AF, Q and R.
38 * LDA >= max(M,N).
39 *
40 * B (input) DOUBLE PRECISION array, dimension (LDB,N)
41 * The P-by-N matrix A.
42 *
43 * BF (workspace) DOUBLE PRECISION array, dimension (LDB,N)
44 *
45 * LDB (input) INTEGER
46 * The leading dimension of the arrays B, BF, V and S.
47 * LDB >= max(P,N).
48 *
49 * C (input) DOUBLE PRECISION array, dimension( M )
50 * the vector C in the LSE problem.
51 *
52 * CF (workspace) DOUBLE PRECISION array, dimension( M )
53 *
54 * D (input) DOUBLE PRECISION array, dimension( P )
55 * the vector D in the LSE problem.
56 *
57 * DF (workspace) DOUBLE PRECISION array, dimension( P )
58 *
59 * X (output) DOUBLE PRECISION array, dimension( N )
60 * solution vector X in the LSE problem.
61 *
62 * WORK (workspace) DOUBLE PRECISION array, dimension (LWORK)
63 *
64 * LWORK (input) INTEGER
65 * The dimension of the array WORK.
66 *
67 * RWORK (workspace) DOUBLE PRECISION array, dimension (M)
68 *
69 * RESULT (output) DOUBLE PRECISION array, dimension (2)
70 * The test ratios:
71 * RESULT(1) = norm( A*x - c )/ norm(A)*norm(X)*EPS
72 * RESULT(2) = norm( B*x - d )/ norm(B)*norm(X)*EPS
73 *
74 * ====================================================================
75 *
76 DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), B( LDB, * ),
77 $ BF( LDB, * ), C( * ), CF( * ), D( * ), DF( * ),
78 $ RESULT( 2 ), RWORK( * ), WORK( LWORK ), X( * )
79 * ..
80 * .. Local Scalars ..
81 INTEGER INFO
82 * ..
83 * .. External Subroutines ..
84 EXTERNAL DCOPY, DGET02, DGGLSE, DLACPY
85 * ..
86 * .. Executable Statements ..
87 *
88 * Copy the matrices A and B to the arrays AF and BF,
89 * and the vectors C and D to the arrays CF and DF,
90 *
91 CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA )
92 CALL DLACPY( 'Full', P, N, B, LDB, BF, LDB )
93 CALL DCOPY( M, C, 1, CF, 1 )
94 CALL DCOPY( P, D, 1, DF, 1 )
95 *
96 * Solve LSE problem
97 *
98 CALL DGGLSE( M, N, P, AF, LDA, BF, LDB, CF, DF, X, WORK, LWORK,
99 $ INFO )
100 *
101 * Test the residual for the solution of LSE
102 *
103 * Compute RESULT(1) = norm( A*x - c ) / norm(A)*norm(X)*EPS
104 *
105 CALL DCOPY( M, C, 1, CF, 1 )
106 CALL DCOPY( P, D, 1, DF, 1 )
107 CALL DGET02( 'No transpose', M, N, 1, A, LDA, X, N, CF, M, RWORK,
108 $ RESULT( 1 ) )
109 *
110 * Compute result(2) = norm( B*x - d ) / norm(B)*norm(X)*EPS
111 *
112 CALL DGET02( 'No transpose', P, N, 1, B, LDB, X, N, DF, P, RWORK,
113 $ RESULT( 2 ) )
114 *
115 RETURN
116 *
117 * End of DLSETS
118 *
119 END
2 $ X, WORK, LWORK, RWORK, RESULT )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 INTEGER LDA, LDB, LWORK, M, N, P
10 * ..
11 * .. Array Arguments ..
12 *
13 * Purpose
14 * =======
15 *
16 * DLSETS tests DGGLSE - a subroutine for solving linear equality
17 * constrained least square problem (LSE).
18 *
19 * Arguments
20 * =========
21 *
22 * M (input) INTEGER
23 * The number of rows of the matrix A. M >= 0.
24 *
25 * P (input) INTEGER
26 * The number of rows of the matrix B. P >= 0.
27 *
28 * N (input) INTEGER
29 * The number of columns of the matrices A and B. N >= 0.
30 *
31 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
32 * The M-by-N matrix A.
33 *
34 * AF (workspace) DOUBLE PRECISION array, dimension (LDA,N)
35 *
36 * LDA (input) INTEGER
37 * The leading dimension of the arrays A, AF, Q and R.
38 * LDA >= max(M,N).
39 *
40 * B (input) DOUBLE PRECISION array, dimension (LDB,N)
41 * The P-by-N matrix A.
42 *
43 * BF (workspace) DOUBLE PRECISION array, dimension (LDB,N)
44 *
45 * LDB (input) INTEGER
46 * The leading dimension of the arrays B, BF, V and S.
47 * LDB >= max(P,N).
48 *
49 * C (input) DOUBLE PRECISION array, dimension( M )
50 * the vector C in the LSE problem.
51 *
52 * CF (workspace) DOUBLE PRECISION array, dimension( M )
53 *
54 * D (input) DOUBLE PRECISION array, dimension( P )
55 * the vector D in the LSE problem.
56 *
57 * DF (workspace) DOUBLE PRECISION array, dimension( P )
58 *
59 * X (output) DOUBLE PRECISION array, dimension( N )
60 * solution vector X in the LSE problem.
61 *
62 * WORK (workspace) DOUBLE PRECISION array, dimension (LWORK)
63 *
64 * LWORK (input) INTEGER
65 * The dimension of the array WORK.
66 *
67 * RWORK (workspace) DOUBLE PRECISION array, dimension (M)
68 *
69 * RESULT (output) DOUBLE PRECISION array, dimension (2)
70 * The test ratios:
71 * RESULT(1) = norm( A*x - c )/ norm(A)*norm(X)*EPS
72 * RESULT(2) = norm( B*x - d )/ norm(B)*norm(X)*EPS
73 *
74 * ====================================================================
75 *
76 DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), B( LDB, * ),
77 $ BF( LDB, * ), C( * ), CF( * ), D( * ), DF( * ),
78 $ RESULT( 2 ), RWORK( * ), WORK( LWORK ), X( * )
79 * ..
80 * .. Local Scalars ..
81 INTEGER INFO
82 * ..
83 * .. External Subroutines ..
84 EXTERNAL DCOPY, DGET02, DGGLSE, DLACPY
85 * ..
86 * .. Executable Statements ..
87 *
88 * Copy the matrices A and B to the arrays AF and BF,
89 * and the vectors C and D to the arrays CF and DF,
90 *
91 CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA )
92 CALL DLACPY( 'Full', P, N, B, LDB, BF, LDB )
93 CALL DCOPY( M, C, 1, CF, 1 )
94 CALL DCOPY( P, D, 1, DF, 1 )
95 *
96 * Solve LSE problem
97 *
98 CALL DGGLSE( M, N, P, AF, LDA, BF, LDB, CF, DF, X, WORK, LWORK,
99 $ INFO )
100 *
101 * Test the residual for the solution of LSE
102 *
103 * Compute RESULT(1) = norm( A*x - c ) / norm(A)*norm(X)*EPS
104 *
105 CALL DCOPY( M, C, 1, CF, 1 )
106 CALL DCOPY( P, D, 1, DF, 1 )
107 CALL DGET02( 'No transpose', M, N, 1, A, LDA, X, N, CF, M, RWORK,
108 $ RESULT( 1 ) )
109 *
110 * Compute result(2) = norm( B*x - d ) / norm(B)*norm(X)*EPS
111 *
112 CALL DGET02( 'No transpose', P, N, 1, B, LDB, X, N, DF, P, RWORK,
113 $ RESULT( 2 ) )
114 *
115 RETURN
116 *
117 * End of DLSETS
118 *
119 END