LAPACK  3.10.1 LAPACK: Linear Algebra PACKage

## ◆ clacsg()

 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 352 of file cckcsd.f.

353  IMPLICIT NONE
354 *
355  INTEGER LDX, M, P, Q
356  INTEGER ISEED( 4 )
357  REAL THETA( * )
358  COMPLEX WORK( * ), X( LDX, * )
359 *
360  COMPLEX ONE, ZERO
361  parameter( one = (1.0e0,0.0e0), zero = (0.0e0,0.0e0) )
362 *
363  INTEGER I, INFO, R
364 *
365  r = min( p, m-p, q, m-q )
366 *
367  CALL claset( '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) = cmplx( cos(theta(i)), 0.0e0 )
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  \$ cmplx( -sin(theta(r-i+1)), 0.0e0 )
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  \$ cmplx( sin(theta(r-i+1)), 0.0e0 )
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  \$ cmplx( cos(theta(i)), 0.0e0 )
395  END DO
396  CALL claror( 'Left', 'No init', p, m, x, ldx, iseed, work, info )
397  CALL claror( 'Left', 'No init', m-p, m, x(p+1,1), ldx,
398  \$ iseed, work, info )
399  CALL claror( 'Right', 'No init', m, q, x, ldx, iseed,
400  \$ work, info )
401  CALL claror( 'Right', 'No init', m, m-q,
402  \$ x(1,q+1), ldx, iseed, work, info )
403 *
subroutine claror(SIDE, INIT, M, N, A, LDA, ISEED, X, INFO)
CLAROR
Definition: claror.f:158
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:106
Here is the call graph for this function:
Here is the caller graph for this function: