cgesdd man page on OpenIndiana

Man page or keyword search:  
man Server   20441 pages
apropos Keyword Search (all sections)
Output format
OpenIndiana logo
[printable version]

cgesdd(3P)		    Sun Performance Library		    cgesdd(3P)

NAME
       cgesdd - compute the singular value decomposition (SVD) of a complex M-
       by-N matrix A, optionally computing the left and/or right singular vec‐
       tors, by using divide-and-conquer method

SYNOPSIS
       SUBROUTINE CGESDD(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK,
	     LWORK, RWORK, IWORK, INFO)

       CHARACTER * 1 JOBZ
       COMPLEX A(LDA,*), U(LDU,*), VT(LDVT,*), WORK(*)
       INTEGER M, N, LDA, LDU, LDVT, LWORK, INFO
       INTEGER IWORK(*)
       REAL S(*), RWORK(*)

       SUBROUTINE CGESDD_64(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK,
	     LWORK, RWORK, IWORK, INFO)

       CHARACTER * 1 JOBZ
       COMPLEX A(LDA,*), U(LDU,*), VT(LDVT,*), WORK(*)
       INTEGER*8 M, N, LDA, LDU, LDVT, LWORK, INFO
       INTEGER*8 IWORK(*)
       REAL S(*), RWORK(*)

   F95 INTERFACE
       SUBROUTINE GESDD(JOBZ, [M], [N], A, [LDA], S, U, [LDU], VT, [LDVT],
	      [WORK], [LWORK], [RWORK], [IWORK], [INFO])

       CHARACTER(LEN=1) :: JOBZ
       COMPLEX, DIMENSION(:) :: WORK
       COMPLEX, DIMENSION(:,:) :: A, U, VT
       INTEGER :: M, N, LDA, LDU, LDVT, LWORK, INFO
       INTEGER, DIMENSION(:) :: IWORK
       REAL, DIMENSION(:) :: S, RWORK

       SUBROUTINE GESDD_64(JOBZ, [M], [N], A, [LDA], S, U, [LDU], VT, [LDVT],
	      [WORK], [LWORK], [RWORK], [IWORK], [INFO])

       CHARACTER(LEN=1) :: JOBZ
       COMPLEX, DIMENSION(:) :: WORK
       COMPLEX, DIMENSION(:,:) :: A, U, VT
       INTEGER(8) :: M, N, LDA, LDU, LDVT, LWORK, INFO
       INTEGER(8), DIMENSION(:) :: IWORK
       REAL, DIMENSION(:) :: S, RWORK

   C INTERFACE
       #include <sunperf.h>

       void  cgesdd(char  jobz,	 int  m, int n, complex *a, int lda, float *s,
		 complex *u, int ldu, complex *vt, int ldvt, int *info);

       void cgesdd_64(char jobz, long m, long n, complex *a, long  lda,	 float
		 *s,  complex  *u,  long  ldu,	complex	 *vt,  long ldvt, long
		 *info);

PURPOSE
       cgesdd computes the singular value decomposition (SVD) of a complex  M-
       by-N matrix A, optionally computing the left and/or right singular vec‐
       tors, by using divide-and-conquer method. The SVD is written
	= U * SIGMA * conjugate-transpose(V)

       where SIGMA is an M-by-N matrix which is zero except for	 its  min(m,n)
       diagonal	 elements,  U  is an M-by-M unitary matrix, and V is an N-by-N
       unitary matrix.	The diagonal elements of SIGMA are the singular values
       of  A;  they  are real and non-negative, and are returned in descending
       order.  The first min(m,n) columns of U and V are the  left  and	 right
       singular vectors of A.

       Note that the routine returns VT = V**H, not V.

       The  divide  and	 conquer  algorithm  makes very mild assumptions about
       floating point arithmetic. It will work on machines with a guard	 digit
       in add/subtract, or on those binary machines without guard digits which
       subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2. It	 could
       conceivably  fail on hexadecimal or decimal machines without guard dig‐
       its, but we know of none.

ARGUMENTS
       JOBZ (input)
		 Specifies options for computing all or part of the matrix U:
		 = 'A':	 all M columns of  U  and  all	N  rows	 of  V**H  are
		 returned  in  the arrays U and VT; = 'S':  the first min(M,N)
		 columns of U and the first min(M,N) rows of V**H are returned
		 in  the  arrays U and VT; = 'O':  If M >= N, the first N col‐
		 umns of U are overwritten on the array A and all rows of V**H
		 are returned in the array VT; otherwise, all columns of U are
		 returned in the array U and the first	M  rows	 of  V**H  are
		 overwritten  on  the array A; = 'N':  no columns of U or rows
		 of V**H are computed.

       M (input) The number of rows of the input matrix A.  M >= 0.

       N (input) The number of columns of the input matrix A.  N >= 0.

       A (input/output)
		 On entry, the M-by-N matrix A.	 On exit, if JOBZ = 'O',  A is
		 overwritten  with the first N columns of U (the left singular
		 vectors, stored columnwise) if M >= N; A is overwritten  with
		 the  first M rows of V**H (the right singular vectors, stored
		 rowwise) otherwise.  if JOBZ .ne. 'O', the contents of A  are
		 destroyed.

       LDA (input)
		 The leading dimension of the array A.	LDA >= max(1,M).

       S (output)
		 The singular values of A, sorted so that S(i) >= S(i+1).

       U (output)
		 UCOL  =  M  if	 JOBZ  =  'A'  or JOBZ = 'O' and M < N; UCOL =
		 min(M,N) if JOBZ = 'S'.  If JOBZ = 'A' or JOBZ = 'O' and M  <
		 N,  U	contains the M-by-M unitary matrix U; if JOBZ = 'S', U
		 contains the first min(M,N) columns of U (the	left  singular
		 vectors,  stored  columnwise);	 if  JOBZ = 'O' and M >= N, or
		 JOBZ = 'N', U is not referenced.

       LDU (input)
		 The leading dimension of the array U.	LDU >= 1;  if  JOBZ  =
		 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M.

       VT (output)
		 If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the N-by-
		 N unitary matrix V**H; if JOBZ = 'S', VT contains  the	 first
		 min(M,N)  rows	 of  V**H  (the right singular vectors, stored
		 rowwise); if JOBZ = 'O' and M < N, or JOBZ = 'N', VT  is  not
		 referenced.

       LDVT (input)
		 The  leading dimension of the array VT.  LDVT >= 1; if JOBZ =
		 'A' or JOBZ = 'O' and M >= N, LDVT >= N; if JOBZ = 'S',  LDVT
		 >= min(M,N).

       WORK (workspace)
		 On exit, if INFO = 0, WORK(1) returns the optimal LWORK.

       LWORK (input)
		 The  dimension of the array WORK. LWORK >= 1.	If LWORK = -1,
		 then a workspace query is assumed.  In this case, the routine
		 only  calculates  the optimal size of the work array, returns
		 this value as the first entry of the WORK array, and no error
		 message  related  to  LWORK is issued.	 The minimum workspace
		 size requirement is as follows:

		 If M is much larger than N such that M >= (N*17/9)):
		   if JOBZ = 'N', LWORK >= 3*N
		   if JOBZ = 'O', LWORK >= 2*N*N + 3*N
		   if JOBZ = 'S', LWORK >= N*N + 3*N
		   if JOBZ = 'A', LWORK >= N*N + 2*N + M Else if ((N*17/9) > M
		 >= N):
		   if JOBZ = 'N', LWORK >= 2*N + M
		   if JOBZ = 'O', LWORK >= 2*N + M + N*N
		   if JOBZ = 'S', LWORK >= 2*N + M
		   if  JOBZ  =	'A', LWORK >= 2*N + M Else if N is much larger
		 than M such that N >= (M*17/9)):
		   if JOBZ = 'N', LWORK >= 3*M
		   if JOBZ = 'O', LWORK >= 2*M*M + 3*M
		   if JOBZ = 'S', LWORK >= M*M + 3*M
		   if JOBZ = 'A', LWORK >= M*M + 2*M + N Else if ((M*17/9) > N
		 >= M):
		   if JOBZ = 'N', LWORK >= 2*M + N
		   if JOBZ = 'O', LWORK >= 2*M+N + M*M
		   if JOBZ = 'S', LWORK >= 2*M + N
		   if JOBZ = 'A', LWORK >= 2*M + N

       RWORK (workspace)
		 The  size  of	workspace RWORK is not checked in the routine.
		 If JOBZ = 'N', RWORK must be at least 7*min(M,N).  Otherwise,
		 RWORK must be at least 5*min(M,N)*min(M,N) + 5*min(M,N)

       IWORK (workspace)
		 dimension(8*MIN(M,N))

       INFO (output)
		 = 0:  successful exit.
		 < 0:  if INFO = -i, the i-th argument had an illegal value.
		 > 0:  The updating process of SBDSDC did not converge.

FURTHER DETAILS
       Based on contributions by
	  Ming Gu and Huan Ren, Computer Science Division, University of
	  California at Berkeley, USA

				  6 Mar 2009			    cgesdd(3P)
[top]

List of man pages available for OpenIndiana

Copyright (c) for man pages and the logo by the respective OS vendor.

For those who want to learn more, the polarhome community provides shell access and support.

[legal] [privacy] [GNU] [policy] [cookies] [netiquette] [sponsors] [FAQ]
Tweet
Polarhome, production since 1999.
Member of Polarhome portal.
Based on Fawad Halim's script.
....................................................................
Vote for polarhome
Free Shell Accounts :: the biggest list on the net