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.

      IMPLICIT NONE
*
      INTEGER            LDX, M, P, Q
      INTEGER            ISEED( 4 )
      REAL               THETA( * )
      COMPLEX            WORK( * ), X( LDX, * )
*
      COMPLEX            ONE, ZERO
      parameter( one = (1.0e0,0.0e0), zero = (0.0e0,0.0e0) )
*
      INTEGER            I, INFO, R
*
      r = min( p, m-p, q, m-q )
*
      CALL claset( 'Full', m, m, zero, zero, x, ldx )
*
      DO i = 1, min(p,q)-r
         x(i,i) = one
      END DO
      DO i = 1, r
         x(min(p,q)-r+i,min(p,q)-r+i) = cmplx( cos(theta(i)), 0.0e0 )
      END DO
      DO i = 1, min(p,m-q)-r
         x(p-i+1,m-i+1) = -one
      END DO
      DO i = 1, r
         x(p-(min(p,m-q)-r)+1-i,m-(min(p,m-q)-r)+1-i) =
     $      cmplx( -sin(theta(r-i+1)), 0.0e0 )
      END DO
      DO i = 1, min(m-p,q)-r
         x(m-i+1,q-i+1) = one
      END DO
      DO i = 1, r
         x(m-(min(m-p,q)-r)+1-i,q-(min(m-p,q)-r)+1-i) =
     $      cmplx( sin(theta(r-i+1)), 0.0e0 )
      END DO
      DO i = 1, min(m-p,m-q)-r
         x(p+i,q+i) = one
      END DO
      DO i = 1, r
         x(p+(min(m-p,m-q)-r)+i,q+(min(m-p,m-q)-r)+i) =
     $      cmplx( cos(theta(i)), 0.0e0 )
      END DO
      CALL claror( 'Left', 'No init', p, m, x, ldx, iseed, work, info )
      CALL claror( 'Left', 'No init', m-p, m, x(p+1,1), ldx,
     $             iseed, work, info )
      CALL claror( 'Right', 'No init', m, q, x, ldx, iseed,
     $             work, info )
      CALL claror( 'Right', 'No init', m, m-q,
     $             x(1,q+1), ldx, iseed, work, info )
*

Here is the call graph for this function:

Here is the caller graph for this function: