00001 SUBROUTINE DLSETS( M, P, N, A, AF, LDA, B, BF, LDB, C, CF, D, DF, 00002 $ X, WORK, LWORK, RWORK, RESULT ) 00003 * 00004 * -- LAPACK test routine (version 3.1) -- 00005 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 INTEGER LDA, LDB, LWORK, M, N, P 00010 * .. 00011 * .. Array Arguments .. 00012 * 00013 * Purpose 00014 * ======= 00015 * 00016 * DLSETS tests DGGLSE - a subroutine for solving linear equality 00017 * constrained least square problem (LSE). 00018 * 00019 * Arguments 00020 * ========= 00021 * 00022 * M (input) INTEGER 00023 * The number of rows of the matrix A. M >= 0. 00024 * 00025 * P (input) INTEGER 00026 * The number of rows of the matrix B. P >= 0. 00027 * 00028 * N (input) INTEGER 00029 * The number of columns of the matrices A and B. N >= 0. 00030 * 00031 * A (input) DOUBLE PRECISION array, dimension (LDA,N) 00032 * The M-by-N matrix A. 00033 * 00034 * AF (workspace) DOUBLE PRECISION array, dimension (LDA,N) 00035 * 00036 * LDA (input) INTEGER 00037 * The leading dimension of the arrays A, AF, Q and R. 00038 * LDA >= max(M,N). 00039 * 00040 * B (input) DOUBLE PRECISION array, dimension (LDB,N) 00041 * The P-by-N matrix A. 00042 * 00043 * BF (workspace) DOUBLE PRECISION array, dimension (LDB,N) 00044 * 00045 * LDB (input) INTEGER 00046 * The leading dimension of the arrays B, BF, V and S. 00047 * LDB >= max(P,N). 00048 * 00049 * C (input) DOUBLE PRECISION array, dimension( M ) 00050 * the vector C in the LSE problem. 00051 * 00052 * CF (workspace) DOUBLE PRECISION array, dimension( M ) 00053 * 00054 * D (input) DOUBLE PRECISION array, dimension( P ) 00055 * the vector D in the LSE problem. 00056 * 00057 * DF (workspace) DOUBLE PRECISION array, dimension( P ) 00058 * 00059 * X (output) DOUBLE PRECISION array, dimension( N ) 00060 * solution vector X in the LSE problem. 00061 * 00062 * WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) 00063 * 00064 * LWORK (input) INTEGER 00065 * The dimension of the array WORK. 00066 * 00067 * RWORK (workspace) DOUBLE PRECISION array, dimension (M) 00068 * 00069 * RESULT (output) DOUBLE PRECISION array, dimension (2) 00070 * The test ratios: 00071 * RESULT(1) = norm( A*x - c )/ norm(A)*norm(X)*EPS 00072 * RESULT(2) = norm( B*x - d )/ norm(B)*norm(X)*EPS 00073 * 00074 * ==================================================================== 00075 * 00076 DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), B( LDB, * ), 00077 $ BF( LDB, * ), C( * ), CF( * ), D( * ), DF( * ), 00078 $ RESULT( 2 ), RWORK( * ), WORK( LWORK ), X( * ) 00079 * .. 00080 * .. Local Scalars .. 00081 INTEGER INFO 00082 * .. 00083 * .. External Subroutines .. 00084 EXTERNAL DCOPY, DGET02, DGGLSE, DLACPY 00085 * .. 00086 * .. Executable Statements .. 00087 * 00088 * Copy the matrices A and B to the arrays AF and BF, 00089 * and the vectors C and D to the arrays CF and DF, 00090 * 00091 CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA ) 00092 CALL DLACPY( 'Full', P, N, B, LDB, BF, LDB ) 00093 CALL DCOPY( M, C, 1, CF, 1 ) 00094 CALL DCOPY( P, D, 1, DF, 1 ) 00095 * 00096 * Solve LSE problem 00097 * 00098 CALL DGGLSE( M, N, P, AF, LDA, BF, LDB, CF, DF, X, WORK, LWORK, 00099 $ INFO ) 00100 * 00101 * Test the residual for the solution of LSE 00102 * 00103 * Compute RESULT(1) = norm( A*x - c ) / norm(A)*norm(X)*EPS 00104 * 00105 CALL DCOPY( M, C, 1, CF, 1 ) 00106 CALL DCOPY( P, D, 1, DF, 1 ) 00107 CALL DGET02( 'No transpose', M, N, 1, A, LDA, X, N, CF, M, RWORK, 00108 $ RESULT( 1 ) ) 00109 * 00110 * Compute result(2) = norm( B*x - d ) / norm(B)*norm(X)*EPS 00111 * 00112 CALL DGET02( 'No transpose', P, N, 1, B, LDB, X, N, DF, P, RWORK, 00113 $ RESULT( 2 ) ) 00114 * 00115 RETURN 00116 * 00117 * End of DLSETS 00118 * 00119 END
1.7.2