 LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 subroutine clags2 ( logical UPPER, real A1, complex A2, real A3, real B1, complex B2, real B3, real CSU, complex SNU, real CSV, complex SNV, real CSQ, complex SNQ )

CLAGS2

Purpose:
``` CLAGS2 computes 2-by-2 unitary matrices U, V and Q, such
that if ( UPPER ) then

U**H *A*Q = U**H *( A1 A2 )*Q = ( x  0  )
( 0  A3 )     ( x  x  )
and
V**H*B*Q = V**H *( B1 B2 )*Q = ( x  0  )
( 0  B3 )     ( x  x  )

or if ( .NOT.UPPER ) then

U**H *A*Q = U**H *( A1 0  )*Q = ( x  x  )
( A2 A3 )     ( 0  x  )
and
V**H *B*Q = V**H *( B1 0  )*Q = ( x  x  )
( B2 B3 )     ( 0  x  )
where

U = (   CSU    SNU ), V = (  CSV    SNV ),
( -SNU**H  CSU )      ( -SNV**H CSV )

Q = (   CSQ    SNQ )
( -SNQ**H  CSQ )

The rows of the transformed A and B are parallel. Moreover, if the
input 2-by-2 matrix A is not zero, then the transformed (1,1) entry
of A is not zero. If the input matrices A and B are both not zero,
then the transformed (2,2) element of B is not zero, except when the
first rows of input A and B are parallel and the second rows are
zero.```
Parameters
 [in] UPPER ``` UPPER is LOGICAL = .TRUE.: the input matrices A and B are upper triangular. = .FALSE.: the input matrices A and B are lower triangular.``` [in] A1 ` A1 is REAL` [in] A2 ` A2 is COMPLEX` [in] A3 ``` A3 is REAL On entry, A1, A2 and A3 are elements of the input 2-by-2 upper (lower) triangular matrix A.``` [in] B1 ` B1 is REAL` [in] B2 ` B2 is COMPLEX` [in] B3 ``` B3 is REAL On entry, B1, B2 and B3 are elements of the input 2-by-2 upper (lower) triangular matrix B.``` [out] CSU ` CSU is REAL` [out] SNU ``` SNU is COMPLEX The desired unitary matrix U.``` [out] CSV ` CSV is REAL` [out] SNV ``` SNV is COMPLEX The desired unitary matrix V.``` [out] CSQ ` CSQ is REAL` [out] SNQ ``` SNQ is COMPLEX The desired unitary matrix Q.```
Date
November 2011

Definition at line 160 of file clags2.f.

160 *
161 * -- LAPACK auxiliary routine (version 3.4.0) --
162 * -- LAPACK is a software package provided by Univ. of Tennessee, --
163 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
164 * November 2011
165 *
166 * .. Scalar Arguments ..
167  LOGICAL upper
168  REAL a1, a3, b1, b3, csq, csu, csv
169  COMPLEX a2, b2, snq, snu, snv
170 * ..
171 *
172 * =====================================================================
173 *
174 * .. Parameters ..
175  REAL zero, one
176  parameter ( zero = 0.0e+0, one = 1.0e+0 )
177 * ..
178 * .. Local Scalars ..
179  REAL a, aua11, aua12, aua21, aua22, avb11, avb12,
180  \$ avb21, avb22, csl, csr, d, fb, fc, s1, s2, snl,
181  \$ snr, ua11r, ua22r, vb11r, vb22r
182  COMPLEX b, c, d1, r, t, ua11, ua12, ua21, ua22, vb11,
183  \$ vb12, vb21, vb22
184 * ..
185 * .. External Subroutines ..
186  EXTERNAL clartg, slasv2
187 * ..
188 * .. Intrinsic Functions ..
189  INTRINSIC abs, aimag, cmplx, conjg, real
190 * ..
191 * .. Statement Functions ..
192  REAL abs1
193 * ..
194 * .. Statement Function definitions ..
195  abs1( t ) = abs( REAL( T ) ) + abs( aimag( t ) )
196 * ..
197 * .. Executable Statements ..
198 *
199  IF( upper ) THEN
200 *
201 * Input matrices A and B are upper triangular matrices
202 *
203 * Form matrix C = A*adj(B) = ( a b )
204 * ( 0 d )
205 *
206  a = a1*b3
207  d = a3*b1
208  b = a2*b1 - a1*b2
209  fb = abs( b )
210 *
211 * Transform complex 2-by-2 matrix C to real matrix by unitary
212 * diagonal matrix diag(1,D1).
213 *
214  d1 = one
215  IF( fb.NE.zero )
216  \$ d1 = b / fb
217 *
218 * The SVD of real 2 by 2 triangular C
219 *
220 * ( CSL -SNL )*( A B )*( CSR SNR ) = ( R 0 )
221 * ( SNL CSL ) ( 0 D ) ( -SNR CSR ) ( 0 T )
222 *
223  CALL slasv2( a, fb, d, s1, s2, snr, csr, snl, csl )
224 *
225  IF( abs( csl ).GE.abs( snl ) .OR. abs( csr ).GE.abs( snr ) )
226  \$ THEN
227 *
228 * Compute the (1,1) and (1,2) elements of U**H *A and V**H *B,
229 * and (1,2) element of |U|**H *|A| and |V|**H *|B|.
230 *
231  ua11r = csl*a1
232  ua12 = csl*a2 + d1*snl*a3
233 *
234  vb11r = csr*b1
235  vb12 = csr*b2 + d1*snr*b3
236 *
237  aua12 = abs( csl )*abs1( a2 ) + abs( snl )*abs( a3 )
238  avb12 = abs( csr )*abs1( b2 ) + abs( snr )*abs( b3 )
239 *
240 * zero (1,2) elements of U**H *A and V**H *B
241 *
242  IF( ( abs( ua11r )+abs1( ua12 ) ).EQ.zero ) THEN
243  CALL clartg( -cmplx( vb11r ), conjg( vb12 ), csq, snq,
244  \$ r )
245  ELSE IF( ( abs( vb11r )+abs1( vb12 ) ).EQ.zero ) THEN
246  CALL clartg( -cmplx( ua11r ), conjg( ua12 ), csq, snq,
247  \$ r )
248  ELSE IF( aua12 / ( abs( ua11r )+abs1( ua12 ) ).LE.avb12 /
249  \$ ( abs( vb11r )+abs1( vb12 ) ) ) THEN
250  CALL clartg( -cmplx( ua11r ), conjg( ua12 ), csq, snq,
251  \$ r )
252  ELSE
253  CALL clartg( -cmplx( vb11r ), conjg( vb12 ), csq, snq,
254  \$ r )
255  END IF
256 *
257  csu = csl
258  snu = -d1*snl
259  csv = csr
260  snv = -d1*snr
261 *
262  ELSE
263 *
264 * Compute the (2,1) and (2,2) elements of U**H *A and V**H *B,
265 * and (2,2) element of |U|**H *|A| and |V|**H *|B|.
266 *
267  ua21 = -conjg( d1 )*snl*a1
268  ua22 = -conjg( d1 )*snl*a2 + csl*a3
269 *
270  vb21 = -conjg( d1 )*snr*b1
271  vb22 = -conjg( d1 )*snr*b2 + csr*b3
272 *
273  aua22 = abs( snl )*abs1( a2 ) + abs( csl )*abs( a3 )
274  avb22 = abs( snr )*abs1( b2 ) + abs( csr )*abs( b3 )
275 *
276 * zero (2,2) elements of U**H *A and V**H *B, and then swap.
277 *
278  IF( ( abs1( ua21 )+abs1( ua22 ) ).EQ.zero ) THEN
279  CALL clartg( -conjg( vb21 ), conjg( vb22 ), csq, snq, r )
280  ELSE IF( ( abs1( vb21 )+abs( vb22 ) ).EQ.zero ) THEN
281  CALL clartg( -conjg( ua21 ), conjg( ua22 ), csq, snq, r )
282  ELSE IF( aua22 / ( abs1( ua21 )+abs1( ua22 ) ).LE.avb22 /
283  \$ ( abs1( vb21 )+abs1( vb22 ) ) ) THEN
284  CALL clartg( -conjg( ua21 ), conjg( ua22 ), csq, snq, r )
285  ELSE
286  CALL clartg( -conjg( vb21 ), conjg( vb22 ), csq, snq, r )
287  END IF
288 *
289  csu = snl
290  snu = d1*csl
291  csv = snr
292  snv = d1*csr
293 *
294  END IF
295 *
296  ELSE
297 *
298 * Input matrices A and B are lower triangular matrices
299 *
300 * Form matrix C = A*adj(B) = ( a 0 )
301 * ( c d )
302 *
303  a = a1*b3
304  d = a3*b1
305  c = a2*b3 - a3*b2
306  fc = abs( c )
307 *
308 * Transform complex 2-by-2 matrix C to real matrix by unitary
309 * diagonal matrix diag(d1,1).
310 *
311  d1 = one
312  IF( fc.NE.zero )
313  \$ d1 = c / fc
314 *
315 * The SVD of real 2 by 2 triangular C
316 *
317 * ( CSL -SNL )*( A 0 )*( CSR SNR ) = ( R 0 )
318 * ( SNL CSL ) ( C D ) ( -SNR CSR ) ( 0 T )
319 *
320  CALL slasv2( a, fc, d, s1, s2, snr, csr, snl, csl )
321 *
322  IF( abs( csr ).GE.abs( snr ) .OR. abs( csl ).GE.abs( snl ) )
323  \$ THEN
324 *
325 * Compute the (2,1) and (2,2) elements of U**H *A and V**H *B,
326 * and (2,1) element of |U|**H *|A| and |V|**H *|B|.
327 *
328  ua21 = -d1*snr*a1 + csr*a2
329  ua22r = csr*a3
330 *
331  vb21 = -d1*snl*b1 + csl*b2
332  vb22r = csl*b3
333 *
334  aua21 = abs( snr )*abs( a1 ) + abs( csr )*abs1( a2 )
335  avb21 = abs( snl )*abs( b1 ) + abs( csl )*abs1( b2 )
336 *
337 * zero (2,1) elements of U**H *A and V**H *B.
338 *
339  IF( ( abs1( ua21 )+abs( ua22r ) ).EQ.zero ) THEN
340  CALL clartg( cmplx( vb22r ), vb21, csq, snq, r )
341  ELSE IF( ( abs1( vb21 )+abs( vb22r ) ).EQ.zero ) THEN
342  CALL clartg( cmplx( ua22r ), ua21, csq, snq, r )
343  ELSE IF( aua21 / ( abs1( ua21 )+abs( ua22r ) ).LE.avb21 /
344  \$ ( abs1( vb21 )+abs( vb22r ) ) ) THEN
345  CALL clartg( cmplx( ua22r ), ua21, csq, snq, r )
346  ELSE
347  CALL clartg( cmplx( vb22r ), vb21, csq, snq, r )
348  END IF
349 *
350  csu = csr
351  snu = -conjg( d1 )*snr
352  csv = csl
353  snv = -conjg( d1 )*snl
354 *
355  ELSE
356 *
357 * Compute the (1,1) and (1,2) elements of U**H *A and V**H *B,
358 * and (1,1) element of |U|**H *|A| and |V|**H *|B|.
359 *
360  ua11 = csr*a1 + conjg( d1 )*snr*a2
361  ua12 = conjg( d1 )*snr*a3
362 *
363  vb11 = csl*b1 + conjg( d1 )*snl*b2
364  vb12 = conjg( d1 )*snl*b3
365 *
366  aua11 = abs( csr )*abs( a1 ) + abs( snr )*abs1( a2 )
367  avb11 = abs( csl )*abs( b1 ) + abs( snl )*abs1( b2 )
368 *
369 * zero (1,1) elements of U**H *A and V**H *B, and then swap.
370 *
371  IF( ( abs1( ua11 )+abs1( ua12 ) ).EQ.zero ) THEN
372  CALL clartg( vb12, vb11, csq, snq, r )
373  ELSE IF( ( abs1( vb11 )+abs1( vb12 ) ).EQ.zero ) THEN
374  CALL clartg( ua12, ua11, csq, snq, r )
375  ELSE IF( aua11 / ( abs1( ua11 )+abs1( ua12 ) ).LE.avb11 /
376  \$ ( abs1( vb11 )+abs1( vb12 ) ) ) THEN
377  CALL clartg( ua12, ua11, csq, snq, r )
378  ELSE
379  CALL clartg( vb12, vb11, csq, snq, r )
380  END IF
381 *
382  csu = snr
383  snu = conjg( d1 )*csr
384  csv = snl
385  snv = conjg( d1 )*csl
386 *
387  END IF
388 *
389  END IF
390 *
391  RETURN
392 *
393 * End of CLAGS2
394 *
subroutine clartg(F, G, CS, SN, R)
CLARTG generates a plane rotation with real cosine and complex sine.
Definition: clartg.f:105
subroutine slasv2(F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL)
SLASV2 computes the singular value decomposition of a 2-by-2 triangular matrix.
Definition: slasv2.f:140

Here is the call graph for this function:

Here is the caller graph for this function: