Example #1
0
void mexFunction(
      int nlhs,   mxArray  *plhs[], 
      int nrhs,   const mxArray  *prhs[] )

{    double   *A, *U, *V, *VT, *S, *flag, *work, *AA;  

     mwIndex  subs[2];
     mwSize   nsubs=2; 
     mwIndex  *irS, *jcS, *iwork; 
     mwSize   M, N, lwork, info, options, minMN, maxMN, k, j; 
     mwSize   LDA, LDU, LDVT, nU, mVT, mS, nS; 
     char     *jobz;

/* CHECK FOR PROPER NUMBER OF ARGUMENTS */

   if (nrhs > 2){
      mexErrMsgTxt("mexsvd: requires at most 2 input arguments."); }
   if (nlhs > 4){ 
      mexErrMsgTxt("mexsvd: requires at most 4 output argument."); }   

/* CHECK THE DIMENSIONS */

    M = mxGetM(prhs[0]); 
    N = mxGetN(prhs[0]); 
    if (mxIsSparse(prhs[0])) {
       mexErrMsgTxt("mexeig: sparse matrix not allowed."); }   
    A = mxGetPr(prhs[0]); 
    LDA = M; 
    minMN = MIN(M,N); 
    maxMN = MAX(M,N); 
    options = 0; 
    if (nrhs==2) { options = (int)*mxGetPr(prhs[1]); } 
    if (options==0) { 
        /***** economical SVD ******/
       jobz="S"; nU = minMN; mVT = minMN; mS = minMN; nS = minMN; 
    } else {
        /***** full SVD ******/
       jobz="A"; nU = M; mVT = N; mS = M; nS = N; 
    }   
    LDU  = M; 
    LDVT = mVT; 
    /***** create return argument *****/
    if (nlhs >=3) {
       /***** compute singular values and vectors ******/
       plhs[0] = mxCreateDoubleMatrix(M,nU,mxREAL); 
       U = mxGetPr(plhs[0]);  
       plhs[1] = mxCreateSparse(mS,nS,minMN,mxREAL); 
       S   = mxGetPr(plhs[1]); 
       irS = mxGetIr(plhs[1]); 
       jcS = mxGetJc(plhs[1]);
       plhs[2] = mxCreateDoubleMatrix(N,mVT,mxREAL);     
       V = mxGetPr(plhs[2]); 
       plhs[3] = mxCreateDoubleMatrix(1,1,mxREAL);     
       flag = mxGetPr(plhs[3]); 
    } else { 
       /***** compute only singular values ******/
       plhs[0]= mxCreateDoubleMatrix(minMN,1,mxREAL); 
       S = mxGetPr(plhs[0]); 
       plhs[1] = mxCreateDoubleMatrix(1,1,mxREAL);     
       flag = mxGetPr(plhs[1]); 
       U = mxCalloc(M*nU,sizeof(double)); 
       V = mxCalloc(N*mVT,sizeof(double)); 
       jobz="N";
    }
    /***** Do the computations in a subroutine *****/   
    lwork = 4*minMN*minMN + MAX(maxMN,5*minMN*minMN+4*minMN);  
    work  = mxCalloc(lwork,sizeof(double)); 
    iwork = mxCalloc(8*minMN,sizeof(int)); 
    VT = mxCalloc(mVT*N,sizeof(double)); 
    AA = mxCalloc(M*N,sizeof(double)); 
    memcpy(AA,mxGetPr(prhs[0]),(M*N)*sizeof(double));

    dgesdd(jobz,&M,&N, AA,&LDA,S,U,&LDU,VT,&LDVT,work,&lwork,iwork, &info); 

    flag[0] = (double)info; 
    if (nlhs >= 3) { 
       for (k=0; k<minMN; k++) { irS[k] = k; }
       jcS[0] = 0;
       for (k=1; k<=nS; k++) { 
         if (k<minMN) { jcS[k] = k; } else { jcS[k] = minMN; }
       }  
       for (k=0; k<mVT; k++) { 
          for (j=0; j<N; j++) { V[j+k*N] = VT[k+j*mVT]; }
       }
    }
    return;
 }
int main(void)
{
#define MMAX 8
#define NMAX 8
  const long lda=MMAX;
  long i, info, j, m, n, minmn;
  double a[MMAX*NMAX], s[MMAX+NMAX], u[1], vt[1];

  /* This macro allows access to a 1-d array as though
     it is a 2-d array stored in column-major order,
     as required by ACML C routines. */
#define A(I,J) a[((J)-1)*lda+(I)-1]

  printf("ACML example: SVD of a matrix A using dgesdd\n");
  printf("--------------------------------------------\n");
  printf("\n");

  /* Initialize matrix A */
  m = 4;
  n = 4;
  A(1,1) = -0.57;
  A(1,2) = -1.28;
  A(1,3) = -0.39;
  A(1,4) = 0.25;
  A(2,1) = -1.93;
  A(2,2) = 1.08;
  A(2,3) = -0.31;
  A(2,4) = -2.14;
  A(3,1) = 2.30;
  A(3,2) = 0.24;
  A(3,3) = 0.40;
  A(3,4) = -0.35;
  A(4,1) = -1.93;
  A(4,2) = 0.64;
  A(4,3) = -0.66;
  A(4,4) = 0.08;

  printf("Matrix A:\n");
  for (i = 1; i <= m; i++)
    {
      for (j = 1; j <= n; j++)
        printf("%8.4f ", A(i,j));
      printf("\n");
    }

  /* Compute singular value decomposition of A */
  dgesdd('n',m,n,a,lda,s,u,1,vt,1,&info);

  /* Print solution */
  if (m < n)
    minmn = m;
  else
    minmn = n;
  printf("\n");
  printf("Singular values of matrix A:\n");
  for (i = 0; i < minmn; i++)
    printf("%8.4f ", s[i]);
  printf("\n");

  return 0;
}