LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine clacsg ( integer  M,
integer  P,
integer  Q,
real, dimension( * )  THETA,
integer, dimension( 4 )  ISEED,
complex, dimension( ldx, * )  X,
integer  LDX,
complex, dimension( * )  WORK 
)

Definition at line 355 of file cckcsd.f.

355  IMPLICIT NONE
356 *
357  INTEGER ldx, m, p, q
358  INTEGER iseed( 4 )
359  REAL theta( * )
360  COMPLEX work( * ), x( ldx, * )
361 *
362  COMPLEX one, zero
363  parameter ( one = (1.0e0,0.0e0), zero = (0.0e0,0.0e0) )
364 *
365  INTEGER i, info, r
366 *
367  r = min( p, m-p, q, m-q )
368 *
369  CALL claset( 'Full', m, m, zero, zero, x, ldx )
370 *
371  DO i = 1, min(p,q)-r
372  x(i,i) = one
373  END DO
374  DO i = 1, r
375  x(min(p,q)-r+i,min(p,q)-r+i) = cmplx( cos(theta(i)), 0.0e0 )
376  END DO
377  DO i = 1, min(p,m-q)-r
378  x(p-i+1,m-i+1) = -one
379  END DO
380  DO i = 1, r
381  x(p-(min(p,m-q)-r)+1-i,m-(min(p,m-q)-r)+1-i) =
382  $ cmplx( -sin(theta(r-i+1)), 0.0e0 )
383  END DO
384  DO i = 1, min(m-p,q)-r
385  x(m-i+1,q-i+1) = one
386  END DO
387  DO i = 1, r
388  x(m-(min(m-p,q)-r)+1-i,q-(min(m-p,q)-r)+1-i) =
389  $ cmplx( sin(theta(r-i+1)), 0.0e0 )
390  END DO
391  DO i = 1, min(m-p,m-q)-r
392  x(p+i,q+i) = one
393  END DO
394  DO i = 1, r
395  x(p+(min(m-p,m-q)-r)+i,q+(min(m-p,m-q)-r)+i) =
396  $ cmplx( cos(theta(i)), 0.0e0 )
397  END DO
398  CALL claror( 'Left', 'No init', p, m, x, ldx, iseed, work, info )
399  CALL claror( 'Left', 'No init', m-p, m, x(p+1,1), ldx,
400  $ iseed, work, info )
401  CALL claror( 'Right', 'No init', m, q, x, ldx, iseed,
402  $ work, info )
403  CALL claror( 'Right', 'No init', m, m-q,
404  $ x(1,q+1), ldx, iseed, work, info )
405 *
subroutine claror(SIDE, INIT, M, N, A, LDA, ISEED, X, INFO)
CLAROR
Definition: claror.f:160
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108

Here is the call graph for this function:

Here is the caller graph for this function: