LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ zlacsg()

 subroutine zlacsg ( integer M, integer P, integer Q, double precision, dimension( * ) THETA, integer, dimension( 4 ) ISEED, complex*16, dimension( ldx, * ) X, integer LDX, complex*16, dimension( * ) WORK )

Definition at line 352 of file zckcsd.f.

353 IMPLICIT NONE
354*
355 INTEGER LDX, M, P, Q
356 INTEGER ISEED( 4 )
357 DOUBLE PRECISION THETA( * )
358 COMPLEX*16 WORK( * ), X( LDX, * )
359*
360 COMPLEX*16 ONE, ZERO
361 parameter( one = (1.0d0,0.0d0), zero = (0.0d0,0.0d0) )
362*
363 INTEGER I, INFO, R
364*
365 r = min( p, m-p, q, m-q )
366*
367 CALL zlaset( 'Full', m, m, zero, zero, x, ldx )
368*
369 DO i = 1, min(p,q)-r
370 x(i,i) = one
371 END DO
372 DO i = 1, r
373 x(min(p,q)-r+i,min(p,q)-r+i) = dcmplx( cos(theta(i)), 0.0d0 )
374 END DO
375 DO i = 1, min(p,m-q)-r
376 x(p-i+1,m-i+1) = -one
377 END DO
378 DO i = 1, r
379 x(p-(min(p,m-q)-r)+1-i,m-(min(p,m-q)-r)+1-i) =
380 \$ dcmplx( -sin(theta(r-i+1)), 0.0d0 )
381 END DO
382 DO i = 1, min(m-p,q)-r
383 x(m-i+1,q-i+1) = one
384 END DO
385 DO i = 1, r
386 x(m-(min(m-p,q)-r)+1-i,q-(min(m-p,q)-r)+1-i) =
387 \$ dcmplx( sin(theta(r-i+1)), 0.0d0 )
388 END DO
389 DO i = 1, min(m-p,m-q)-r
390 x(p+i,q+i) = one
391 END DO
392 DO i = 1, r
393 x(p+(min(m-p,m-q)-r)+i,q+(min(m-p,m-q)-r)+i) =
394 \$ dcmplx( cos(theta(i)), 0.0d0 )
395 END DO
396 CALL zlaror( 'Left', 'No init', p, m, x, ldx, iseed, work, info )
397 CALL zlaror( 'Left', 'No init', m-p, m, x(p+1,1), ldx,
398 \$ iseed, work, info )
399 CALL zlaror( 'Right', 'No init', m, q, x, ldx, iseed,
400 \$ work, info )
401 CALL zlaror( 'Right', 'No init', m, m-q,
402 \$ x(1,q+1), ldx, iseed, work, info )
403*
subroutine zlaror(SIDE, INIT, M, N, A, LDA, ISEED, X, INFO)
ZLAROR
Definition: zlaror.f:158
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: zlaset.f:106
Here is the call graph for this function:
Here is the caller graph for this function: