1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
|
*> \brief \b SERRORHR_COL
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE SERRORHR_COL( PATH, NUNIT )
*
* .. Scalar Arguments ..
* CHARACTER*3 PATH
* INTEGER NUNIT
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> SERRORHR_COL tests the error exits for SORHR_COL that does
*> Householder reconstruction from the output of tall-skinny
*> factorization SLATSQR.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] PATH
*> \verbatim
*> PATH is CHARACTER*3
*> The LAPACK path name for the routines to be tested.
*> \endverbatim
*>
*> \param[in] NUNIT
*> \verbatim
*> NUNIT is INTEGER
*> The unit number for output.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup singlr_lin
*
* =====================================================================
SUBROUTINE SERRORHR_COL( PATH, NUNIT )
IMPLICIT NONE
*
* -- LAPACK test routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
* .. Scalar Arguments ..
CHARACTER(LEN=3) PATH
INTEGER NUNIT
* ..
*
* =====================================================================
*
* .. Parameters ..
INTEGER NMAX
PARAMETER ( NMAX = 2 )
* ..
* .. Local Scalars ..
INTEGER I, INFO, J
* ..
* .. Local Arrays ..
REAL A( NMAX, NMAX ), T( NMAX, NMAX ), D(NMAX)
* ..
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, SORHR_COL
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
CHARACTER(LEN=32) SRNAMT
INTEGER INFOT, NOUT
* ..
* .. Common blocks ..
COMMON / INFOC / INFOT, NOUT, OK, LERR
COMMON / SRNAMC / SRNAMT
* ..
* .. Intrinsic Functions ..
INTRINSIC REAL
* ..
* .. Executable Statements ..
*
NOUT = NUNIT
WRITE( NOUT, FMT = * )
*
* Set the variables to innocuous values.
*
DO J = 1, NMAX
DO I = 1, NMAX
A( I, J ) = 1.E+0 / REAL( I+J )
T( I, J ) = 1.E+0 / REAL( I+J )
END DO
D( J ) = 0.E+0
END DO
OK = .TRUE.
*
* Error exits for Householder reconstruction
*
* SORHR_COL
*
SRNAMT = 'SORHR_COL'
*
INFOT = 1
CALL SORHR_COL( -1, 0, 1, A, 1, T, 1, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
*
INFOT = 2
CALL SORHR_COL( 0, -1, 1, A, 1, T, 1, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
CALL SORHR_COL( 1, 2, 1, A, 1, T, 1, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
*
INFOT = 3
CALL SORHR_COL( 0, 0, -1, A, 1, T, 1, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
*
CALL SORHR_COL( 0, 0, 0, A, 1, T, 1, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
*
INFOT = 5
CALL SORHR_COL( 0, 0, 1, A, -1, T, 1, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
*
CALL SORHR_COL( 0, 0, 1, A, 0, T, 1, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
*
CALL SORHR_COL( 2, 0, 1, A, 1, T, 1, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
*
INFOT = 7
CALL SORHR_COL( 0, 0, 1, A, 1, T, -1, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
*
CALL SORHR_COL( 0, 0, 1, A, 1, T, 0, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
*
CALL SORHR_COL( 4, 3, 2, A, 4, T, 1, D, INFO )
CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK )
*
* Print a summary line.
*
CALL ALAESM( PATH, OK, NOUT )
*
RETURN
*
* End of SERRORHR_COL
*
END
|