152 SUBROUTINE slags2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV,
162 REAL A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, SNQ,
170 parameter ( zero = 0.0e+0 )
173 REAL A, AUA11, AUA12, AUA21, AUA22, AVB11, AVB12,
174 $ avb21, avb22, csl, csr, d, s1, s2, snl,
175 $ snr, ua11r, ua22r, vb11r, vb22r, b, c, r, ua11,
176 $ ua12, ua21, ua22, vb11, vb12, vb21, vb22
202 CALL slasv2( a, b, d, s1, s2, snr, csr, snl, csl )
204 IF( abs( csl ).GE.abs( snl ) .OR. abs( csr ).GE.abs( snr ) )
211 ua12 = csl*a2 + snl*a3
214 vb12 = csr*b2 + snr*b3
216 aua12 = abs( csl )*abs( a2 ) + abs( snl )*abs( a3 )
217 avb12 = abs( csr )*abs( b2 ) + abs( snr )*abs( b3 )
221 IF( ( abs( ua11r )+abs( ua12 ) ).NE.zero )
THEN
222 IF( aua12 / ( abs( ua11r )+abs( ua12 ) ).LE.avb12 /
223 $ ( abs( vb11r )+abs( vb12 ) ) )
THEN
224 CALL slartg( -ua11r, ua12, csq, snq, r )
226 CALL slartg( -vb11r, vb12, csq, snq, r )
229 CALL slartg( -vb11r, vb12, csq, snq, r )
243 ua22 = -snl*a2 + csl*a3
246 vb22 = -snr*b2 + csr*b3
248 aua22 = abs( snl )*abs( a2 ) + abs( csl )*abs( a3 )
249 avb22 = abs( snr )*abs( b2 ) + abs( csr )*abs( b3 )
253 IF( ( abs( ua21 )+abs( ua22 ) ).NE.zero )
THEN
254 IF( aua22 / ( abs( ua21 )+abs( ua22 ) ).LE.avb22 /
255 $ ( abs( vb21 )+abs( vb22 ) ) )
THEN
256 CALL slartg( -ua21, ua22, csq, snq, r )
258 CALL slartg( -vb21, vb22, csq, snq, r )
261 CALL slartg( -vb21, vb22, csq, snq, r )
287 CALL slasv2( a, c, d, s1, s2, snr, csr, snl, csl )
289 IF( abs( csr ).GE.abs( snr ) .OR. abs( csl ).GE.abs( snl ) )
295 ua21 = -snr*a1 + csr*a2
298 vb21 = -snl*b1 + csl*b2
301 aua21 = abs( snr )*abs( a1 ) + abs( csr )*abs( a2 )
302 avb21 = abs( snl )*abs( b1 ) + abs( csl )*abs( b2 )
306 IF( ( abs( ua21 )+abs( ua22r ) ).NE.zero )
THEN
307 IF( aua21 / ( abs( ua21 )+abs( ua22r ) ).LE.avb21 /
308 $ ( abs( vb21 )+abs( vb22r ) ) )
THEN
309 CALL slartg( ua22r, ua21, csq, snq, r )
311 CALL slartg( vb22r, vb21, csq, snq, r )
314 CALL slartg( vb22r, vb21, csq, snq, r )
327 ua11 = csr*a1 + snr*a2
330 vb11 = csl*b1 + snl*b2
333 aua11 = abs( csr )*abs( a1 ) + abs( snr )*abs( a2 )
334 avb11 = abs( csl )*abs( b1 ) + abs( snl )*abs( b2 )
338 IF( ( abs( ua11 )+abs( ua12 ) ).NE.zero )
THEN
339 IF( aua11 / ( abs( ua11 )+abs( ua12 ) ).LE.avb11 /
340 $ ( abs( vb11 )+abs( vb12 ) ) )
THEN
341 CALL slartg( ua12, ua11, csq, snq, r )
343 CALL slartg( vb12, vb11, csq, snq, r )
346 CALL slartg( vb12, vb11, csq, snq, r )
subroutine slartg(F, G, CS, SN, R)
SLARTG generates a plane rotation with real cosine and real sine.
subroutine slags2(UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, SNV, CSQ, SNQ)
SLAGS2 computes 2-by-2 orthogonal matrices U, V, and Q, and applies them to matrices A and B such tha...
subroutine slasv2(F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL)
SLASV2 computes the singular value decomposition of a 2-by-2 triangular matrix.