![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SERRQRTP 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 SERRQRTP( 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 *> SERRQRTP tests the error exits for the REAL routines 00025 *> that use the QRT decomposition of a triangular-pentagonal 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 single_lin 00054 * 00055 * ===================================================================== 00056 SUBROUTINE SERRQRTP( 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 REAL A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ), 00080 $ B( NMAX, NMAX ), C( NMAX, NMAX ) 00081 * .. 00082 * .. External Subroutines .. 00083 EXTERNAL ALAESM, CHKXER, STPQRT2, STPQRT, 00084 $ STPMQRT 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 FLOAT 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.0 / FLOAT( I+J ) 00108 C( I, J ) = 1.0 / FLOAT( I+J ) 00109 T( I, J ) = 1.0 / FLOAT( I+J ) 00110 END DO 00111 W( J ) = 0.0 00112 END DO 00113 OK = .TRUE. 00114 * 00115 * Error exits for TPQRT factorization 00116 * 00117 * STPQRT 00118 * 00119 SRNAMT = 'STPQRT' 00120 INFOT = 1 00121 CALL STPQRT( -1, 1, 0, 1, A, 1, B, 1, T, 1, W, INFO ) 00122 CALL CHKXER( 'STPQRT', INFOT, NOUT, LERR, OK ) 00123 INFOT = 2 00124 CALL STPQRT( 1, -1, 0, 1, A, 1, B, 1, T, 1, W, INFO ) 00125 CALL CHKXER( 'STPQRT', INFOT, NOUT, LERR, OK ) 00126 INFOT = 3 00127 CALL STPQRT( 0, 1, -1, 1, A, 1, B, 1, T, 1, W, INFO ) 00128 CALL CHKXER( 'STPQRT', INFOT, NOUT, LERR, OK ) 00129 INFOT = 3 00130 CALL STPQRT( 0, 1, 1, 1, A, 1, B, 1, T, 1, W, INFO ) 00131 CALL CHKXER( 'STPQRT', INFOT, NOUT, LERR, OK ) 00132 INFOT = 4 00133 CALL STPQRT( 0, 1, 0, 0, A, 1, B, 1, T, 1, W, INFO ) 00134 CALL CHKXER( 'STPQRT', INFOT, NOUT, LERR, OK ) 00135 INFOT = 4 00136 CALL STPQRT( 0, 1, 0, 2, A, 1, B, 1, T, 1, W, INFO ) 00137 CALL CHKXER( 'STPQRT', INFOT, NOUT, LERR, OK ) 00138 INFOT = 6 00139 CALL STPQRT( 1, 2, 0, 2, A, 1, B, 1, T, 1, W, INFO ) 00140 CALL CHKXER( 'STPQRT', INFOT, NOUT, LERR, OK ) 00141 INFOT = 8 00142 CALL STPQRT( 2, 1, 0, 1, A, 1, B, 1, T, 1, W, INFO ) 00143 CALL CHKXER( 'STPQRT', INFOT, NOUT, LERR, OK ) 00144 INFOT = 10 00145 CALL STPQRT( 2, 2, 1, 2, A, 2, B, 2, T, 1, W, INFO ) 00146 CALL CHKXER( 'STPQRT', INFOT, NOUT, LERR, OK ) 00147 * 00148 * STPQRT2 00149 * 00150 SRNAMT = 'STPQRT2' 00151 INFOT = 1 00152 CALL STPQRT2( -1, 0, 0, A, 1, B, 1, T, 1, INFO ) 00153 CALL CHKXER( 'STPQRT2', INFOT, NOUT, LERR, OK ) 00154 INFOT = 2 00155 CALL STPQRT2( 0, -1, 0, A, 1, B, 1, T, 1, INFO ) 00156 CALL CHKXER( 'STPQRT2', INFOT, NOUT, LERR, OK ) 00157 INFOT = 3 00158 CALL STPQRT2( 0, 0, -1, A, 1, B, 1, T, 1, INFO ) 00159 CALL CHKXER( 'STPQRT2', INFOT, NOUT, LERR, OK ) 00160 INFOT = 5 00161 CALL STPQRT2( 2, 2, 0, A, 1, B, 2, T, 2, INFO ) 00162 CALL CHKXER( 'STPQRT2', INFOT, NOUT, LERR, OK ) 00163 INFOT = 7 00164 CALL STPQRT2( 2, 2, 0, A, 2, B, 1, T, 2, INFO ) 00165 CALL CHKXER( 'STPQRT2', INFOT, NOUT, LERR, OK ) 00166 INFOT = 9 00167 CALL STPQRT2( 2, 2, 0, A, 2, B, 2, T, 1, INFO ) 00168 CALL CHKXER( 'STPQRT2', INFOT, NOUT, LERR, OK ) 00169 * 00170 * STPMQRT 00171 * 00172 SRNAMT = 'STPMQRT' 00173 INFOT = 1 00174 CALL STPMQRT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, 00175 $ W, INFO ) 00176 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00177 INFOT = 2 00178 CALL STPMQRT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, 00179 $ W, INFO ) 00180 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00181 INFOT = 3 00182 CALL STPMQRT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, 00183 $ W, INFO ) 00184 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00185 INFOT = 4 00186 CALL STPMQRT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, 00187 $ W, INFO ) 00188 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00189 INFOT = 5 00190 CALL STPMQRT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, 00191 $ W, INFO ) 00192 INFOT = 6 00193 CALL STPMQRT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, 00194 $ W, INFO ) 00195 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00196 INFOT = 7 00197 CALL STPMQRT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, 00198 $ W, INFO ) 00199 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00200 INFOT = 9 00201 CALL STPMQRT( 'R', 'N', 1, 2, 1, 1, 1, A, 1, T, 1, B, 1, C, 1, 00202 $ W, INFO ) 00203 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00204 INFOT = 9 00205 CALL STPMQRT( 'L', 'N', 2, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 1, 00206 $ W, INFO ) 00207 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00208 INFOT = 11 00209 CALL STPMQRT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, 00210 $ W, INFO ) 00211 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00212 INFOT = 13 00213 CALL STPMQRT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, 00214 $ W, INFO ) 00215 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00216 INFOT = 15 00217 CALL STPMQRT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, 00218 $ W, INFO ) 00219 CALL CHKXER( 'STPMQRT', INFOT, NOUT, LERR, OK ) 00220 * 00221 * Print a summary line. 00222 * 00223 CALL ALAESM( PATH, OK, NOUT ) 00224 * 00225 RETURN 00226 * 00227 * End of SERRQRT 00228 * 00229 END