121 parameter( two = 2.0e+0, one = 1.0e+0, zero = 0.0e+0 )
125 REAL ALPHI, ALPHR, BETA, BIGNUM, SMLNUM, XNORM
129 REAL SCNRM2, SLAMCH, SLAPY3, SLAPY2
131 EXTERNAL scnrm2, slamch, slapy3, slapy2, cladiv
134 INTRINSIC abs, aimag, cmplx, real, sign
146 xnorm = scnrm2( n-1, x, incx )
147 alphr = real( alpha )
148 alphi = aimag( alpha )
150 IF( xnorm.EQ.zero )
THEN
154 IF( alphi.EQ.zero )
THEN
155 IF( alphr.GE.zero )
THEN
165 x( 1 + (j-1)*incx ) = zero
171 xnorm = slapy2( alphr, alphi )
172 tau = cmplx( one - alphr / xnorm, -alphi / xnorm )
174 x( 1 + (j-1)*incx ) = zero
182 beta = sign( slapy3( alphr, alphi, xnorm ), alphr )
183 smlnum = slamch(
'S' ) / slamch(
'E' )
184 bignum = one / smlnum
187 IF( abs( beta ).LT.smlnum )
THEN
193 CALL csscal( n-1, bignum, x, incx )
197 IF( (abs( beta ).LT.smlnum) .AND. (knt .LT. 20) )
202 xnorm = scnrm2( n-1, x, incx )
203 alpha = cmplx( alphr, alphi )
204 beta = sign( slapy3( alphr, alphi, xnorm ), alphr )
208 IF( beta.LT.zero )
THEN
212 alphr = alphi * (alphi/real( alpha ))
213 alphr = alphr + xnorm * (xnorm/real( alpha ))
214 tau = cmplx( alphr/beta, -alphi/beta )
215 alpha = cmplx( -alphr, alphi )
217 alpha = cladiv( cmplx( one ), alpha )
219 IF ( abs(tau).LE.smlnum )
THEN
228 alphr = real( savealpha )
229 alphi = aimag( savealpha )
230 IF( alphi.EQ.zero )
THEN
231 IF( alphr.GE.zero )
THEN
236 x( 1 + (j-1)*incx ) = zero
238 beta = real( -savealpha )
241 xnorm = slapy2( alphr, alphi )
242 tau = cmplx( one - alphr / xnorm, -alphi / xnorm )
244 x( 1 + (j-1)*incx ) = zero
253 CALL cscal( n-1, alpha, x, incx )
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine clarfgp(N, ALPHA, X, INCX, TAU)
CLARFGP generates an elementary reflector (Householder matrix) with non-negative beta.