LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cglmts.f
Go to the documentation of this file.
00001 *> \brief \b CGLMTS
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE CGLMTS( N, M, P, A, AF, LDA, B, BF, LDB, D, DF,
00012 *                          X, U, WORK, LWORK, RWORK, RESULT )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       INTEGER            LDA, LDB, LWORK, M, P, N
00016 *       REAL               RESULT
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       REAL               RWORK( * )
00020 *       COMPLEX            A( LDA, * ), AF( LDA, * ), B( LDB, * ),
00021 *      $                   BF( LDB, * ), D( * ), DF( * ), U( * ),
00022 *      $                   WORK( LWORK ), X( * )
00023 *  
00024 *
00025 *> \par Purpose:
00026 *  =============
00027 *>
00028 *> \verbatim
00029 *>
00030 *> CGLMTS tests CGGGLM - a subroutine for solving the generalized
00031 *> linear model problem.
00032 *> \endverbatim
00033 *
00034 *  Arguments:
00035 *  ==========
00036 *
00037 *> \param[in] N
00038 *> \verbatim
00039 *>          N is INTEGER
00040 *>          The number of rows of the matrices A and B.  N >= 0.
00041 *> \endverbatim
00042 *>
00043 *> \param[in] M
00044 *> \verbatim
00045 *>          M is INTEGER
00046 *>          The number of columns of the matrix A.  M >= 0.
00047 *> \endverbatim
00048 *>
00049 *> \param[in] P
00050 *> \verbatim
00051 *>          P is INTEGER
00052 *>          The number of columns of the matrix B.  P >= 0.
00053 *> \endverbatim
00054 *>
00055 *> \param[in] A
00056 *> \verbatim
00057 *>          A is COMPLEX array, dimension (LDA,M)
00058 *>          The N-by-M matrix A.
00059 *> \endverbatim
00060 *>
00061 *> \param[out] AF
00062 *> \verbatim
00063 *>          AF is COMPLEX array, dimension (LDA,M)
00064 *> \endverbatim
00065 *>
00066 *> \param[in] LDA
00067 *> \verbatim
00068 *>          LDA is INTEGER
00069 *>          The leading dimension of the arrays A, AF. LDA >= max(M,N).
00070 *> \endverbatim
00071 *>
00072 *> \param[in] B
00073 *> \verbatim
00074 *>          B is COMPLEX array, dimension (LDB,P)
00075 *>          The N-by-P matrix A.
00076 *> \endverbatim
00077 *>
00078 *> \param[out] BF
00079 *> \verbatim
00080 *>          BF is COMPLEX array, dimension (LDB,P)
00081 *> \endverbatim
00082 *>
00083 *> \param[in] LDB
00084 *> \verbatim
00085 *>          LDB is INTEGER
00086 *>          The leading dimension of the arrays B, BF. LDB >= max(P,N).
00087 *> \endverbatim
00088 *>
00089 *> \param[in] D
00090 *> \verbatim
00091 *>          D is COMPLEX array, dimension( N )
00092 *>          On input, the left hand side of the GLM.
00093 *> \endverbatim
00094 *>
00095 *> \param[out] DF
00096 *> \verbatim
00097 *>          DF is COMPLEX array, dimension( N )
00098 *> \endverbatim
00099 *>
00100 *> \param[out] X
00101 *> \verbatim
00102 *>          X is COMPLEX array, dimension( M )
00103 *>          solution vector X in the GLM problem.
00104 *> \endverbatim
00105 *>
00106 *> \param[out] U
00107 *> \verbatim
00108 *>          U is COMPLEX array, dimension( P )
00109 *>          solution vector U in the GLM problem.
00110 *> \endverbatim
00111 *>
00112 *> \param[out] WORK
00113 *> \verbatim
00114 *>          WORK is COMPLEX array, dimension (LWORK)
00115 *> \endverbatim
00116 *>
00117 *> \param[in] LWORK
00118 *> \verbatim
00119 *>          LWORK is INTEGER
00120 *>          The dimension of the array WORK.
00121 *> \endverbatim
00122 *>
00123 *> \param[out] RWORK
00124 *> \verbatim
00125 *>          RWORK is REAL array, dimension (M)
00126 *> \endverbatim
00127 *>
00128 *> \param[out] RESULT
00129 *> \verbatim
00130 *>          RESULT is REAL
00131 *>          The test ratio:
00132 *>                           norm( d - A*x - B*u )
00133 *>            RESULT = -----------------------------------------
00134 *>                     (norm(A)+norm(B))*(norm(x)+norm(u))*EPS
00135 *> \endverbatim
00136 *
00137 *  Authors:
00138 *  ========
00139 *
00140 *> \author Univ. of Tennessee 
00141 *> \author Univ. of California Berkeley 
00142 *> \author Univ. of Colorado Denver 
00143 *> \author NAG Ltd. 
00144 *
00145 *> \date November 2011
00146 *
00147 *> \ingroup complex_eig
00148 *
00149 *  =====================================================================
00150       SUBROUTINE CGLMTS( N, M, P, A, AF, LDA, B, BF, LDB, D, DF,
00151      $                   X, U, WORK, LWORK, RWORK, RESULT )
00152 *
00153 *  -- LAPACK test routine (version 3.4.0) --
00154 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00155 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00156 *     November 2011
00157 *
00158 *     .. Scalar Arguments ..
00159       INTEGER            LDA, LDB, LWORK, M, P, N
00160       REAL               RESULT
00161 *     ..
00162 *     .. Array Arguments ..
00163       REAL               RWORK( * )
00164       COMPLEX            A( LDA, * ), AF( LDA, * ), B( LDB, * ),
00165      $                   BF( LDB, * ), D( * ), DF( * ), U( * ),
00166      $                   WORK( LWORK ), X( * )
00167 *
00168 *  ====================================================================
00169 *
00170 *     .. Parameters ..
00171       REAL               ZERO
00172       PARAMETER          ( ZERO = 0.0E+0 )
00173       COMPLEX            CONE
00174       PARAMETER          ( CONE = 1.0E+0 )
00175 *     ..
00176 *     .. Local Scalars ..
00177       INTEGER            INFO
00178       REAL               ANORM, BNORM, EPS, XNORM, YNORM, DNORM, UNFL
00179 *     ..
00180 *     .. External Functions ..
00181       REAL               SCASUM, SLAMCH, CLANGE
00182       EXTERNAL           SCASUM, SLAMCH, CLANGE
00183 *     ..
00184 *     .. External Subroutines ..
00185       EXTERNAL           CLACPY
00186 *
00187 *     .. Intrinsic Functions ..
00188       INTRINSIC          MAX
00189 *     ..
00190 *     .. Executable Statements ..
00191 *
00192       EPS = SLAMCH( 'Epsilon' )
00193       UNFL = SLAMCH( 'Safe minimum' )
00194       ANORM = MAX( CLANGE( '1', N, M, A, LDA, RWORK ), UNFL )
00195       BNORM = MAX( CLANGE( '1', N, P, B, LDB, RWORK ), UNFL )
00196 *
00197 *     Copy the matrices A and B to the arrays AF and BF,
00198 *     and the vector D the array DF.
00199 *
00200       CALL CLACPY( 'Full', N, M, A, LDA, AF, LDA )
00201       CALL CLACPY( 'Full', N, P, B, LDB, BF, LDB )
00202       CALL CCOPY( N, D, 1, DF, 1 )
00203 *
00204 *     Solve GLM problem
00205 *
00206       CALL CGGGLM( N, M, P, AF, LDA, BF, LDB, DF, X, U, WORK, LWORK,
00207      $             INFO )
00208 *
00209 *     Test the residual for the solution of LSE
00210 *
00211 *                       norm( d - A*x - B*u )
00212 *       RESULT = -----------------------------------------
00213 *                (norm(A)+norm(B))*(norm(x)+norm(u))*EPS
00214 *
00215       CALL CCOPY( N, D, 1, DF, 1 )
00216       CALL CGEMV( 'No transpose', N, M, -CONE, A, LDA, X, 1, CONE,
00217      $            DF, 1 )
00218 *
00219       CALL CGEMV( 'No transpose', N, P, -CONE, B, LDB, U, 1, CONE,
00220      $            DF, 1 )
00221 *
00222       DNORM = SCASUM( N, DF, 1 )
00223       XNORM = SCASUM( M, X, 1 ) + SCASUM( P, U, 1 )
00224       YNORM = ANORM + BNORM
00225 *
00226       IF( XNORM.LE.ZERO ) THEN
00227          RESULT = ZERO
00228       ELSE
00229          RESULT =  ( ( DNORM / YNORM ) / XNORM ) /EPS
00230       END IF
00231 *
00232       RETURN
00233 *
00234 *     End of CGLMTS
00235 *
00236       END
 All Files Functions