LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ slacsg()

subroutine slacsg ( integer  M,
integer  P,
integer  Q,
real, dimension( * )  THETA,
integer, dimension( 4 )  ISEED,
real, dimension( ldx, * )  X,
integer  LDX,
real, dimension( * )  WORK 
)

Definition at line 349 of file sckcsd.f.

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