1*> \brief \b ZERRUNHR_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 ZERRUNHR_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*> ZERRUNHR_COL tests the error exits for ZUNHR_COL that does 25*> Householder reconstruction from the output of tall-skinny 26*> factorization ZLATSQR. 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*> \ingroup complex16_lin 53* 54* ===================================================================== 55 SUBROUTINE ZERRUNHR_COL( PATH, NUNIT ) 56 IMPLICIT NONE 57* 58* -- LAPACK test routine -- 59* -- LAPACK is a software package provided by Univ. of Tennessee, -- 60* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 61* 62* .. Scalar Arguments .. 63 CHARACTER(LEN=3) PATH 64 INTEGER NUNIT 65* .. 66* 67* ===================================================================== 68* 69* .. Parameters .. 70 INTEGER NMAX 71 PARAMETER ( NMAX = 2 ) 72* .. 73* .. Local Scalars .. 74 INTEGER I, INFO, J 75* .. 76* .. Local Arrays .. 77 COMPLEX*16 A( NMAX, NMAX ), T( NMAX, NMAX ), D(NMAX) 78* .. 79* .. External Subroutines .. 80 EXTERNAL ALAESM, CHKXER, ZUNHR_COL 81* .. 82* .. Scalars in Common .. 83 LOGICAL LERR, OK 84 CHARACTER(LEN=32) SRNAMT 85 INTEGER INFOT, NOUT 86* .. 87* .. Common blocks .. 88 COMMON / INFOC / INFOT, NOUT, OK, LERR 89 COMMON / SRNAMC / SRNAMT 90* .. 91* .. Intrinsic Functions .. 92 INTRINSIC DBLE, DCMPLX 93* .. 94* .. Executable Statements .. 95* 96 NOUT = NUNIT 97 WRITE( NOUT, FMT = * ) 98* 99* Set the variables to innocuous values. 100* 101 DO J = 1, NMAX 102 DO I = 1, NMAX 103 A( I, J ) = DCMPLX( 1.D+0 / DBLE( I+J ) ) 104 T( I, J ) = DCMPLX( 1.D+0 / DBLE( I+J ) ) 105 END DO 106 D( J ) = ( 0.D+0, 0.D+0 ) 107 END DO 108 OK = .TRUE. 109* 110* Error exits for Householder reconstruction 111* 112* ZUNHR_COL 113* 114 SRNAMT = 'ZUNHR_COL' 115* 116 INFOT = 1 117 CALL ZUNHR_COL( -1, 0, 1, A, 1, T, 1, D, INFO ) 118 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 119* 120 INFOT = 2 121 CALL ZUNHR_COL( 0, -1, 1, A, 1, T, 1, D, INFO ) 122 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 123 CALL ZUNHR_COL( 1, 2, 1, A, 1, T, 1, D, INFO ) 124 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 125* 126 INFOT = 3 127 CALL ZUNHR_COL( 0, 0, -1, A, 1, T, 1, D, INFO ) 128 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 129* 130 CALL ZUNHR_COL( 0, 0, 0, A, 1, T, 1, D, INFO ) 131 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 132* 133 INFOT = 5 134 CALL ZUNHR_COL( 0, 0, 1, A, -1, T, 1, D, INFO ) 135 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 136* 137 CALL ZUNHR_COL( 0, 0, 1, A, 0, T, 1, D, INFO ) 138 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 139* 140 CALL ZUNHR_COL( 2, 0, 1, A, 1, T, 1, D, INFO ) 141 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 142* 143 INFOT = 7 144 CALL ZUNHR_COL( 0, 0, 1, A, 1, T, -1, D, INFO ) 145 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 146* 147 CALL ZUNHR_COL( 0, 0, 1, A, 1, T, 0, D, INFO ) 148 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 149* 150 CALL ZUNHR_COL( 4, 3, 2, A, 4, T, 1, D, INFO ) 151 CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) 152* 153* Print a summary line. 154* 155 CALL ALAESM( PATH, OK, NOUT ) 156* 157 RETURN 158* 159* End of ZERRUNHR_COL 160* 161 END 162