LAPACK 3.3.0

slsets.f

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