LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
serrqp.f
Go to the documentation of this file.
00001 *> \brief \b SERRQP
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 SERRQP( 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 *> SERRQP tests the error exits for SGEQPF and SGEQP3.
00025 *> \endverbatim
00026 *
00027 *  Arguments:
00028 *  ==========
00029 *
00030 *> \param[in] PATH
00031 *> \verbatim
00032 *>          PATH is CHARACTER*3
00033 *>          The LAPACK path name for the routines to be tested.
00034 *> \endverbatim
00035 *>
00036 *> \param[in] NUNIT
00037 *> \verbatim
00038 *>          NUNIT is INTEGER
00039 *>          The unit number for output.
00040 *> \endverbatim
00041 *
00042 *  Authors:
00043 *  ========
00044 *
00045 *> \author Univ. of Tennessee 
00046 *> \author Univ. of California Berkeley 
00047 *> \author Univ. of Colorado Denver 
00048 *> \author NAG Ltd. 
00049 *
00050 *> \date November 2011
00051 *
00052 *> \ingroup single_lin
00053 *
00054 *  =====================================================================
00055       SUBROUTINE SERRQP( PATH, NUNIT )
00056 *
00057 *  -- LAPACK test routine (version 3.4.0) --
00058 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00059 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00060 *     November 2011
00061 *
00062 *     .. Scalar Arguments ..
00063       CHARACTER*3        PATH
00064       INTEGER            NUNIT
00065 *     ..
00066 *
00067 *  =====================================================================
00068 *
00069 *     .. Parameters ..
00070       INTEGER            NMAX
00071       PARAMETER          ( NMAX = 3 )
00072 *     ..
00073 *     .. Local Scalars ..
00074       CHARACTER*2        C2
00075       INTEGER            INFO, LW
00076 *     ..
00077 *     .. Local Arrays ..
00078       INTEGER            IP( NMAX )
00079       REAL               A( NMAX, NMAX ), TAU( NMAX ), W( 3*NMAX+1 )
00080 *     ..
00081 *     .. External Functions ..
00082       LOGICAL            LSAMEN
00083       EXTERNAL           LSAMEN
00084 *     ..
00085 *     .. External Subroutines ..
00086       EXTERNAL           ALAESM, CHKXER, SGEQP3, SGEQPF
00087 *     ..
00088 *     .. Scalars in Common ..
00089       LOGICAL            LERR, OK
00090       CHARACTER*32       SRNAMT
00091       INTEGER            INFOT, NOUT
00092 *     ..
00093 *     .. Common blocks ..
00094       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00095       COMMON             / SRNAMC / SRNAMT
00096 *     ..
00097 *     .. Executable Statements ..
00098 *
00099       NOUT = NUNIT
00100       WRITE( NOUT, FMT = * )
00101       C2 = PATH( 2: 3 )
00102       LW = 3*NMAX + 1
00103       A( 1, 1 ) = 1.0E+0
00104       A( 1, 2 ) = 2.0E+0
00105       A( 2, 2 ) = 3.0E+0
00106       A( 2, 1 ) = 4.0E+0
00107       OK = .TRUE.
00108 *
00109       IF( LSAMEN( 2, C2, 'QP' ) ) THEN
00110 *
00111 *        Test error exits for QR factorization with pivoting
00112 *
00113 *        SGEQPF
00114 *
00115          SRNAMT = 'SGEQPF'
00116          INFOT = 1
00117          CALL SGEQPF( -1, 0, A, 1, IP, TAU, W, INFO )
00118          CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
00119          INFOT = 2
00120          CALL SGEQPF( 0, -1, A, 1, IP, TAU, W, INFO )
00121          CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
00122          INFOT = 4
00123          CALL SGEQPF( 2, 0, A, 1, IP, TAU, W, INFO )
00124          CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
00125 *
00126 *        SGEQP3
00127 *
00128          SRNAMT = 'SGEQP3'
00129          INFOT = 1
00130          CALL SGEQP3( -1, 0, A, 1, IP, TAU, W, LW, INFO )
00131          CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
00132          INFOT = 2
00133          CALL SGEQP3( 1, -1, A, 1, IP, TAU, W, LW, INFO )
00134          CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
00135          INFOT = 4
00136          CALL SGEQP3( 2, 3, A, 1, IP, TAU, W, LW, INFO )
00137          CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
00138          INFOT = 8
00139          CALL SGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, INFO )
00140          CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
00141       END IF
00142 *
00143 *     Print a summary line.
00144 *
00145       CALL ALAESM( PATH, OK, NOUT )
00146 *
00147       RETURN
00148 *
00149 *     End of SERRQP
00150 *
00151       END
 All Files Functions