zckcsd.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	zckcsd (nm, mval, pval, qval, nmats, iseed, thresh, mmax, x, xf, u1, u2, v1t, v2t, theta, iwork, work, rwork, nin, nout, info)
	ZCKCSD
subroutine	zlacsg (m, p, q, theta, iseed, x, ldx, work)

Function/Subroutine Documentation

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.

      IMPLICIT NONE
*
      INTEGER            LDX, M, P, Q
      INTEGER            ISEED( 4 )
      DOUBLE PRECISION   THETA( * )
      COMPLEX*16         WORK( * ), X( LDX, * )
*
      COMPLEX*16         ONE, ZERO
      parameter( one = (1.0d0,0.0d0), zero = (0.0d0,0.0d0) )
*
      INTEGER            I, INFO, R
*
      r = min( p, m-p, q, m-q )
*
      CALL zlaset( '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) = dcmplx( cos(theta(i)), 0.0d0 )
      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) =
     $      dcmplx( -sin(theta(r-i+1)), 0.0d0 )
      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) =
     $      dcmplx( sin(theta(r-i+1)), 0.0d0 )
      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) =
     $      dcmplx( cos(theta(i)), 0.0d0 )
      END DO
      CALL zlaror( 'Left', 'No init', p, m, x, ldx, iseed, work, info )
      CALL zlaror( 'Left', 'No init', m-p, m, x(p+1,1), ldx,
     $             iseed, work, info )
      CALL zlaror( 'Right', 'No init', m, q, x, ldx, iseed,
     $             work, info )
      CALL zlaror( 'Right', 'No init', m, m-q,
     $             x(1,q+1), ldx, iseed, work, info )
*