![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DERRQRT 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 DERRQRT( PATH, NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER*3 PATH 00015 * INTEGER NUNIT 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> DERRQRT tests the error exits for the DOUBLE PRECISION routines 00025 *> that use the QRT decomposition of a general matrix. 00026 *> \endverbatim 00027 * 00028 * Arguments: 00029 * ========== 00030 * 00031 *> \param[in] PATH 00032 *> \verbatim 00033 *> PATH is CHARACTER*3 00034 *> The LAPACK path name for the routines to be tested. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] NUNIT 00038 *> \verbatim 00039 *> NUNIT is INTEGER 00040 *> The unit number for output. 00041 *> \endverbatim 00042 * 00043 * Authors: 00044 * ======== 00045 * 00046 *> \author Univ. of Tennessee 00047 *> \author Univ. of California Berkeley 00048 *> \author Univ. of Colorado Denver 00049 *> \author NAG Ltd. 00050 * 00051 *> \date November 2011 00052 * 00053 *> \ingroup double_lin 00054 * 00055 * ===================================================================== 00056 SUBROUTINE DERRQRT( PATH, NUNIT ) 00057 IMPLICIT NONE 00058 * 00059 * -- LAPACK test routine (version 3.4.0) -- 00060 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00061 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00062 * November 2011 00063 * 00064 * .. Scalar Arguments .. 00065 CHARACTER*3 PATH 00066 INTEGER NUNIT 00067 * .. 00068 * 00069 * ===================================================================== 00070 * 00071 * .. Parameters .. 00072 INTEGER NMAX 00073 PARAMETER ( NMAX = 2 ) 00074 * .. 00075 * .. Local Scalars .. 00076 INTEGER I, INFO, J 00077 * .. 00078 * .. Local Arrays .. 00079 DOUBLE PRECISION A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ), 00080 $ C( NMAX, NMAX ) 00081 * .. 00082 * .. External Subroutines .. 00083 EXTERNAL ALAESM, CHKXER, DGEQRT2, DGEQRT3, DGEQRT, 00084 $ DGEMQRT 00085 * .. 00086 * .. Scalars in Common .. 00087 LOGICAL LERR, OK 00088 CHARACTER*32 SRNAMT 00089 INTEGER INFOT, NOUT 00090 * .. 00091 * .. Common blocks .. 00092 COMMON / INFOC / INFOT, NOUT, OK, LERR 00093 COMMON / SRNAMC / SRNAMT 00094 * .. 00095 * .. Intrinsic Functions .. 00096 INTRINSIC DBLE 00097 * .. 00098 * .. Executable Statements .. 00099 * 00100 NOUT = NUNIT 00101 WRITE( NOUT, FMT = * ) 00102 * 00103 * Set the variables to innocuous values. 00104 * 00105 DO J = 1, NMAX 00106 DO I = 1, NMAX 00107 A( I, J ) = 1.D0 / DBLE( I+J ) 00108 C( I, J ) = 1.D0 / DBLE( I+J ) 00109 T( I, J ) = 1.D0 / DBLE( I+J ) 00110 END DO 00111 W( J ) = 0.D0 00112 END DO 00113 OK = .TRUE. 00114 * 00115 * Error exits for QRT factorization 00116 * 00117 * DGEQRT 00118 * 00119 SRNAMT = 'DGEQRT' 00120 INFOT = 1 00121 CALL DGEQRT( -1, 0, 1, A, 1, T, 1, W, INFO ) 00122 CALL CHKXER( 'DGEQRT', INFOT, NOUT, LERR, OK ) 00123 INFOT = 2 00124 CALL DGEQRT( 0, -1, 1, A, 1, T, 1, W, INFO ) 00125 CALL CHKXER( 'DGEQRT', INFOT, NOUT, LERR, OK ) 00126 INFOT = 3 00127 CALL DGEQRT( 0, 0, 0, A, 1, T, 1, W, INFO ) 00128 CALL CHKXER( 'DGEQRT', INFOT, NOUT, LERR, OK ) 00129 INFOT = 5 00130 CALL DGEQRT( 2, 1, 1, A, 1, T, 1, W, INFO ) 00131 CALL CHKXER( 'DGEQRT', INFOT, NOUT, LERR, OK ) 00132 INFOT = 7 00133 CALL DGEQRT( 2, 2, 2, A, 2, T, 1, W, INFO ) 00134 CALL CHKXER( 'DGEQRT', INFOT, NOUT, LERR, OK ) 00135 * 00136 * DGEQRT2 00137 * 00138 SRNAMT = 'DGEQRT2' 00139 INFOT = 1 00140 CALL DGEQRT2( -1, 0, A, 1, T, 1, INFO ) 00141 CALL CHKXER( 'DGEQRT2', INFOT, NOUT, LERR, OK ) 00142 INFOT = 2 00143 CALL DGEQRT2( 0, -1, A, 1, T, 1, INFO ) 00144 CALL CHKXER( 'DGEQRT2', INFOT, NOUT, LERR, OK ) 00145 INFOT = 4 00146 CALL DGEQRT2( 2, 1, A, 1, T, 1, INFO ) 00147 CALL CHKXER( 'DGEQRT2', INFOT, NOUT, LERR, OK ) 00148 INFOT = 6 00149 CALL DGEQRT2( 2, 2, A, 2, T, 1, INFO ) 00150 CALL CHKXER( 'DGEQRT2', INFOT, NOUT, LERR, OK ) 00151 * 00152 * DGEQRT3 00153 * 00154 SRNAMT = 'DGEQRT3' 00155 INFOT = 1 00156 CALL DGEQRT3( -1, 0, A, 1, T, 1, INFO ) 00157 CALL CHKXER( 'DGEQRT3', INFOT, NOUT, LERR, OK ) 00158 INFOT = 2 00159 CALL DGEQRT3( 0, -1, A, 1, T, 1, INFO ) 00160 CALL CHKXER( 'DGEQRT3', INFOT, NOUT, LERR, OK ) 00161 INFOT = 4 00162 CALL DGEQRT3( 2, 1, A, 1, T, 1, INFO ) 00163 CALL CHKXER( 'DGEQRT3', INFOT, NOUT, LERR, OK ) 00164 INFOT = 6 00165 CALL DGEQRT3( 2, 2, A, 2, T, 1, INFO ) 00166 CALL CHKXER( 'DGEQRT3', INFOT, NOUT, LERR, OK ) 00167 * 00168 * DGEMQRT 00169 * 00170 SRNAMT = 'DGEMQRT' 00171 INFOT = 1 00172 CALL DGEMQRT( '/', 'N', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 00173 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00174 INFOT = 2 00175 CALL DGEMQRT( 'L', '/', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 00176 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00177 INFOT = 3 00178 CALL DGEMQRT( 'L', 'N', -1, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 00179 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00180 INFOT = 4 00181 CALL DGEMQRT( 'L', 'N', 0, -1, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 00182 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00183 INFOT = 5 00184 CALL DGEMQRT( 'L', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO ) 00185 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00186 INFOT = 5 00187 CALL DGEMQRT( 'R', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO ) 00188 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00189 INFOT = 6 00190 CALL DGEMQRT( 'L', 'N', 0, 0, 0, 0, A, 1, T, 1, C, 1, W, INFO ) 00191 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00192 INFOT = 8 00193 CALL DGEMQRT( 'R', 'N', 1, 2, 1, 1, A, 1, T, 1, C, 1, W, INFO ) 00194 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00195 INFOT = 8 00196 CALL DGEMQRT( 'L', 'N', 2, 1, 1, 1, A, 1, T, 1, C, 1, W, INFO ) 00197 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00198 INFOT = 10 00199 CALL DGEMQRT( 'R', 'N', 1, 1, 1, 1, A, 1, T, 0, C, 1, W, INFO ) 00200 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00201 INFOT = 12 00202 CALL DGEMQRT( 'L', 'N', 1, 1, 1, 1, A, 1, T, 1, C, 0, W, INFO ) 00203 CALL CHKXER( 'DGEMQRT', INFOT, NOUT, LERR, OK ) 00204 * 00205 * Print a summary line. 00206 * 00207 CALL ALAESM( PATH, OK, NOUT ) 00208 * 00209 RETURN 00210 * 00211 * End of DERRQRT 00212 * 00213 END