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