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