int main(int argc, char *argv[]) {
int info;
int m = 6;
int n = 4;
if (argc > 2) {
m = boost::lexical_cast<int>(argv[1]);
n = boost::lexical_cast<int>(argv[2]);
}
std::cout << "m = " << m << "\nn = " << n << std::endl;
int k = std::min(m, n);
// generate random martix
matrix_t mat = matrix_t::Random(m, n);
std::cout << "Input random matrix A:\n" << mat << std::endl;
// singular value decomposition
matrix_t a = mat; // 'a' will be destroyed by dgesvd
vector_t s(k), superb(k);
matrix_t u(m, k), vt(k, n);
info = LAPACKE_zgesvd(LAPACK_COL_MAJOR, 'S', 'S', m, n, &a(0, 0), m, &s(0),
&u(0, 0), m, &vt(0, 0), k, &superb(0));
std::cout << "U:\n" << u << std::endl;
std::cout << "S:\n" << s << std::endl;
std::cout << "Vt:\n" << vt << std::endl;
// check correctness of SVD
matrix_t smat = matrix_t::Zero(k, k);
for (int i = 0; i < k; ++i) smat(i, i) = s(i);
matrix_t check = u * smat * vt;
std::cout << "U * S * Vt:\n" << check << std::endl;
std::cout << "| A - U * S * Vt | = " << (mat - check).norm() << std::endl;
}
void
doit_in_col_major (const char * description,
const int M, const int N, const int minMN,
double complex A[N][M],
double expected_S[1][N],
double complex expected_LSV[minMN][M],
double complex expected_VH[N][N])
{
/* Option: return all the M columns of U in the matrix U. */
const char jobU = 'A';
/* Option: return all the N rows of V^T in the matrix VH. */
const char jobVH = 'A';
const int Anrows = M;
const int Ancols = N;
const int ldA = Anrows;
/* Operand: a copy of A used as actual parameter to ZGESVD. It is
needed because the parameter is destroyed and we want to preserve
the original matrix in A. */
double complex A1[Ancols][Anrows];
/* Result: the singular values of A. This vector is equal to the main
diagonal of SIGMA. */
const int Snrows = Ancols;
const int Sncols = 1;
double S[Sncols][Snrows];
/* Result: orthogonal square matrix U. The MIN(M,N) columns of U are
the left singular vectors. */
const int Unrows = Anrows;
const int Uncols = Anrows;
const int ldU = Unrows;
double complex U[Uncols][Unrows];
/* Result: orthogonal square matrix V transposed. The MIN(M,N)
columns of V are the right singular vectors. */
const int VHnrows = Ancols;
const int VHncols = Ancols;
const int ldVH = VHnrows;
double complex VH[VHncols][VHnrows];
/* Result: first superdiagonal of an internal work matrix, see the
source code of "LAPACKE_dgesvd()". */
const int superBnrows = MIN(Anrows,Ancols) - 1;
const int superBncols = 1;
double superB[superBncols][superBnrows];
/* Reconstructed data: matrix having the singular values on the main
diagonal. */
const int SIGMAnrows = Anrows;
const int SIGMAncols = Ancols;
const int ldSIGMA = SIGMAnrows;
double complex SIGMA[SIGMAncols][SIGMAnrows];
/* Reconstructed data: left singular vector. The columns of this
matrix are the MIN(M,N) columns of U. */
const int LSVnrows = Anrows;
const int LSVncols = MIN(Anrows,Ancols);
/* const int ldLSV = Unrows; */
double complex LSV[LSVncols][LSVnrows];
/* Reconstructed data: matrix A recomputed using the results. */
double complex recomputed_A[Ancols][Anrows];
lapack_int info;
/* Load the input matrix A into the working array A1. */
memcpy(A1, A, sizeof(double complex) * Anrows * Ancols);
info = LAPACKE_zgesvd(LAPACK_COL_MAJOR, jobU, jobVH, Anrows, Ancols,
MREF(A1), ldA, MREF(S), MREF(U), ldU,
MREF(VH), ldVH, MREF(superB));
/* If something went wrong in the function call INFO is non-zero: exit
with failure. */
if (0 != info) {
printf("Error computing solution with col-major operands: INFO=%d.\n", info);
exit(EXIT_FAILURE);
}
/* Result validation by performing the inverse operation. We compute
"recomputed_A" starting from U, S and VH. */
{
/* Put the singular values on the main diagonal of SIGMA. */
for (int i=0; i<Anrows; ++i) {
for (int j=0; j<Ancols; ++j) {
SIGMA[j][i] = (i == j)? S[0][j] : CMPLX(+0.0,+0.0);
}
}
/* Put the left singular vectors from U in LSV. */
for (int i=0; i<LSVnrows; ++i) {
for (int j=0; j<LSVncols; ++j) {
LSV[j][i] = U[j][i];
}
}
/* Multiply U and SIGMA, then right-multiply the result by V^H to
* verify that the result is indeed A; we need CBLAS for this.
*/
/* In general ZGEMM does:
*
* C = \alpha A B + \beta C
*
* where A, B and C are matrices. We need to inspect both the
* header file "cblas.h" and the manual page "zgemm" for the
* documentation of the parameters; the prototype of "cblas_gemm()"
* is:
*
* void cblas_dgemm(const enum CBLAS_ORDER Order,
* const enum CBLAS_TRANSPOSE TransA,
* const enum CBLAS_TRANSPOSE TransB,
* const int M, const int N, const int K,
* const void *alpha,
* const void *A, const int lda,
* const void *B, const int ldb,
* const void *beta,
* double *C, const int ldc);
*
* In our case all the matrices are in row-major order and the
* representations in the arrays A and B are not transposed, so: M
* is the number of rows of A and C; N is the number of columns of B
* and C; K is the number of columns of A and rows of B. In other
* words:
*
* A has dimensions M x K
* B has dimensions K x N
* C has dimensions M x N
*
* obviously the product AB has dimensions M x N.
*/
/* Here we want to do (explicitating the dimensions):
*
* R1[N][M] = 1.0 U[M][M] SIGMA[N][M] + 0.0 R1[N][M]
* R2[N][M] = 1.0 R1[N][M] VH[N][N] + 0.0 R2[N][M]
*
* where R is a matrix whose contents at input are not important,
* and whose contents at output are the result of the operation.
*/
{
double complex R1[Ancols][Anrows];
double complex R2[Ancols][Anrows];
double complex alpha = CMPLX(1.0,0.0);
double complex beta = CMPLX(0.0,0.0);
cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans,
Anrows, Ancols, Uncols,
&alpha, MREF(U), ldU, MREF(SIGMA), ldSIGMA, &beta, MREF(R1), ldA);
cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans,
Anrows, Ancols, VHnrows,
&alpha, MREF(R1), ldA, MREF(VH), ldVH, &beta, MREF(R2), ldA);
memcpy(recomputed_A, R2, sizeof(double complex) * Anrows * Ancols);
}
}
printf("Results of col-major ZGESVD: %s:\n", description);
/* Comparison between computed results and expected results. */
if (1) {
compare_real_col_major_result_and_expected_result ("S, singular values",
Snrows, Sncols, S, expected_S);
compare_complex_col_major_result_and_expected_result ("recomputed A",
Anrows, Ancols, A, recomputed_A);
compare_complex_col_major_result_and_expected_result ("LSV, matrix of left singular vectors",
LSVnrows, LSVncols, LSV, expected_LSV);
compare_complex_col_major_result_and_expected_result ("V^H, conjugate-transposed matrix of right singular vectors",
VHnrows, VHncols, VH, expected_VH);
}
/* Result logging */
{
print_complex_col_major_matrix ("A, input matrix", Anrows, Ancols, A);
print_complex_col_major_matrix ("recomputed A (must be equal to the original A)",
Anrows, Ancols, recomputed_A);
if (0) {
print_complex_col_major_matrix ("A1, output matrix", Anrows, Ancols, A1);
}
print_real_col_major_matrix ("S, computed singular values", Snrows, Sncols, S);
print_complex_col_major_matrix ("SIGMA, matrix having singular values on the main diagonal",
SIGMAnrows, SIGMAncols, SIGMA);
print_complex_col_major_matrix ("U, the MIN(M,N) columns are the left singular vectors",
Unrows, Uncols, U);
print_complex_col_major_matrix ("V conjugate-transposed, the MIN(M,N) rows are the right singular vectors",
VHnrows, VHncols, VH);
print_real_col_major_matrix ("superB", superBnrows, superBncols, superB);
}
}
/* Main program */
int main(){
/* not Locals */
lapack_complex_double *a, *temp, * u, *vt;
lapack_int m = M, n = N, lda = LDA, ldu = LDU, ldvt = LDVT, info;
/* Local arrays */
//void prtdat();
double *s;
double *superb;
int svd_count=0;
int i, j ,ix ,iy, index, ii, jj ;
double x_min,
x_max,
y_min,
y_max,
stepx, /* step size for finding gridpoints coordinates in x and y dimension.*/
stepy;
double e=0.1;
/* Array used for the ploting of
* grid, as an input to the
* draw_pseudospectra function. */
double *plot;
//double plot[n][n];
COLOUR colour;
BITMAP4 col,grey = {128,128,128,0};
/* Memory alocations*/
temp = malloc((lda*m)*sizeof(lapack_complex_double));
a = malloc((lda*m)*sizeof(lapack_complex_double));
u = malloc((ldu*m)*sizeof(lapack_complex_double));
vt = malloc((ldvt*n)*sizeof(lapack_complex_double));
s = malloc(m*sizeof(double));
superb = malloc(min(m,n)*sizeof(double));
plot = malloc((NGRID*NGRID)*sizeof(double));
z = malloc((NGRID*NGRID)*sizeof(double _Complex));
//allocating the 2D array data.
if ((data = malloc(SCALE*NGRID*sizeof(double *))) == NULL) {
fprintf(stderr,"Failed to malloc space for the data\n");
exit(-1);
}
for (i=0;i<SCALE*NGRID;i++) {
if ((data[i] = malloc(SCALE*NGRID*sizeof(double))) == NULL) {
fprintf(stderr,"Failed to malloc space for the data\n");
exit(-1);
}
}
for (i=0;i<SCALE*NGRID;i++){
for (j=0;j<SCALE*NGRID;j++){
data[i][j] = 0;
// printf("%f\t",data[i][j]);
}
}
/*
printf("-------------------------------------------------\n");
printf(" --------------------------------- \n");
printf ("Starting Computing Pseudopsecta of grcar Matrix\n");
printf("Give the doundaries of the 2-dimenional domain\n");
printf("Insert the minimum value of x-axis\n");
clearerr(stdin);
scanf("%lf",&x_min);
//getchar();
printf("Insert the maximum value of x-axis\n");
scanf("%lf",&x_max);
printf("Insert the minimum value of y-axis\n");
scanf("%lf",&y_min);
printf("Insert the maximun value of y-axis\n");
scanf("%lf",&y_max);
//printf("Give the grid size you want:\n");
//scanf("%d",&n);
*/
/*if (x_min==0.0)*/ x_min=XMIN;
/*if (x_max==0.0)*/ x_max=XMAX;
/*if (y_min==0.0)*/ y_min=YMIN;
/*if (y_max==0.0)*/ y_max=YMAX;
/* Initialize grid */
printf("The size of the domain is: X=[%f-%f] Y=[%f-%f] \n",x_min,x_max,y_min,y_max);
stepx=(double)abs(x_max-x_min)/(NGRID-1);
stepy=(double)abs(y_max-y_min)/(NGRID-1);
printf("To stepx einai %f\n",stepx);
printf("To stepy einai %f\n",stepy);
for (i =0; i <NGRID*NGRID; i++){
z[i]=x_min+(i/n * stepx)+(y_min + (i%n * stepy))*I;
// z[i]=lapack_make_complex_double( i/n,i%n); just for testing
//** printf( " (%6.2f,%6.2f)", lapack_complex_double_real(z[i]), lapack_complex_double_imag(z[i]) );
}
memset(temp,0,(lda*m)*sizeof(*temp));
memset(a,0,(lda*m)*sizeof(*a));
memset(u,0,(ldu*m)*sizeof(*u));
memset(vt,0,(ldvt*m)*sizeof(*vt));
j=0;
for (i = 0; i < lda*m ; i=i+n ){
if(i==0){
a[i]=lapack_make_complex_double( 1,0);
a[i+1]=lapack_make_complex_double( 1,0);
a[i+2]=lapack_make_complex_double( 1,0);
a[i+3]=lapack_make_complex_double( 1,0);
}
else if(i == (n-3)*n ){
a[i+j]=lapack_make_complex_double( -1,0);
a[i+(j+1)]=lapack_make_complex_double( 1,0);
a[i+(j+2)]=lapack_make_complex_double( 1,0);
a[i+(j+3)]=lapack_make_complex_double( 1,0);
j++;
}
else if(i == (n-2)*n ){
a[i+j]=lapack_make_complex_double( -1,0);
a[i+(j+1)]=lapack_make_complex_double( 1,0);
a[i+(j+2)]=lapack_make_complex_double( 1,0);
j++;
}
else if(i == (n-1)*n ){
a[i+j]=lapack_make_complex_double( -1,0);
a[i+(j+1)]=lapack_make_complex_double( 1,0);
j++;
}
else{
a[i+j]=lapack_make_complex_double( -1,0);
a[i+(j+1)]=lapack_make_complex_double( 1,0);
a[i+(j+2)]=lapack_make_complex_double( 1,0);
a[i+(j+3)]=lapack_make_complex_double( 1,0);
a[i+(j+4)]=lapack_make_complex_double( 1,0);
j++;
}
}
//print_matrix("Entry Matrix A", m, n, a, lda );
for (iy = 0; iy < NGRID*NGRID; iy++){
//printf("temp size %d, a size %d",(lda*m)*sizeof(*temp),(lda*m)*sizeof(*a));
memcpy(temp, a ,(lda*m)*sizeof(*temp));
//~ print_matrix( "Entry Matrix Temp just after memcopy", m, n, temp, lda );
//~ print_matrix( "Entry Matrix A just after memcopy", m, n, a, lda );
// printf( "To z[%d](%6.4f,%6.4f)\n",iy,lapack_complex_double_real(z[iy]),lapack_complex_double_imag(z[iy]) );
for (i = 0; i < lda*m ; i=i+(n+1)){
//~ printf("%d",i);
//~ printf( "To a[%d](%6.2f,%6.2f)\t",i, lapack_complex_double_real(a[i]), lapack_complex_double_imag(a[i]) );
//~ printf( "To z[%d](%6.2f,%6.2f)\n",iy,lapack_complex_double_real(z[iy]),lapack_complex_double_imag(z[iy]) );
temp[i]=a[i]-z[iy];
//~ temp[index] = lapack_make_complex_double(lapack_complex_double_real(a[index])-lapack_complex_double_real(z[iy]), lapack_complex_double_imag(a[index])-lapack_complex_double_imag(z[iy]) );
//~ printf( " temp[%d](%6.2f,%6.2f)", i,lapack_complex_double_real(temp[i]), lapack_complex_double_imag(temp[i]) );
//~ printf( "\n");
}
//printf("GRCAR MATRIX AFTER SUBSTRACTION (%d,%d)\n",iy/n,iy%n);
//~ print_matrix( "Entry Matrix Temp just before", m, n, temp, lda );
/* Executable statements */
//~ print_matrix( "AT THE BEGINING OF THE FOR LOOP", m, n, a, lda );
printf( "LAPACKE_zgesvd (row-major, high-level) Example Program Results(%d,%d)\n",iy/NGRID,iy%NGRID);
/* Compute SVD */
info = LAPACKE_zgesvd( LAPACK_ROW_MAJOR, 'N', 'N', m, n, temp, lda, s, NULL, ldu, NULL, ldvt, superb );
svd_count++;
//~
//~ print_matrix( "IN THE MIDDLE OF THE FOR LOOP", m, n, a, lda );
//~ print_matrix( "IN THE MIDDLE OF THE FOR LOOP-TEMP", m, n, temp, lda );
/* Check for convergence */
if( info > 0 ) {
printf( "The algorithm computing SVD failed to converge.\n" );
exit( 1 );
}
/* Print singular values */
if( info == 0){
// printf("Solution\n");
for ( i= 0; i< m; i++ ) {
// printf(" s[ %d ] = %f\n", i, s[ i ] );
}
}
if(s[m-1] <= e){
printf("THIS ELEMENT BELONGS TO PSEUDOSPECTRA (%d,%d):%6.10f\n",(iy/NGRID+1),(iy%NGRID+1),s[m-1]);
/*to index tis parapanw ektupwshs anaferetai sto index tou antistoixou mhtrwou apo thn synarthsh ths matlab grcar_example.m*/
//~ plot[iy/n][iy%n]=s[m-1];
plot[iy]=s[m-1];
}
//~ else plot[iy/n][iy%n]=0;
else plot[iy]=0;
//~ print_rmatrix( "Singular values", 1, m, s, 1 );
/* Print left singular vectors */
// print_matrix( "Left singular vectors (stored columnwise)", m, m, u, ldu );
/* Print right singular vectors */
// print_matrix( "Right singular vectors (stored rowwise)", m, n, vt, ldvt );
}
prtdat(NGRID, NGRID, plot, "svd.data");
printf("Total number of svd evaluations in the %d,%d grid is:\t %d\n",NGRID,NGRID,svd_count);
//giving values to data from plot
for (i = 0; i<NGRID*NGRID; i++) data[SCALE*(i/NGRID)][SCALE*(i%NGRID)] = plot[i];
/////////////////
BITMAP4 black = {0,0,0,0};
Draw_Line(image,NGRID,NGRID,x_min,y_min,x_max,y_min,black);
//////////////////
//~ contours[0] = 0.1;
//~ contours[1] = 0.01;
//~ contours[2] = 0.001;
//~ contours[3] = 0.0001;
//~ contours[4] = 0.00001;
if ((image = Create_Bitmap(SCALE*NGRID,SCALE*NGRID)) == NULL) {
fprintf(stderr,"Malloc of bitmap failed\n");
exit(-1);
}
Erase_Bitmap(image,SCALE*NGRID,SCALE*NGRID,grey); /* Not strictly necessary */
for (j=0;j<SCALE*NGRID;j++) {
for (i=0;i<SCALE*NGRID;i++) {
colour = GetColour(data[i][j],0,0.1,1); /////////////////////////////////////////////
col.r = colour.r * 255;
// col.b = colour.b * 255;
// Draw_Pixel(image,SCALE*NGRID,SCALE*NGRID,(double)i,(double)j,col);
// colour = GetColour(data[i][j],0,0.0001,1); /////////////////////////////////////////////
// col.g = colour.g * 255;
Draw_Pixel(image,SCALE*NGRID,SCALE*NGRID,(double)i,(double)j,col);
}
}
/* Finally do the contouring */
CONREC(data,0,SCALE*NGRID-1,0,SCALE*NGRID-1,
z,NCONTOUR,contours,drawline);
fprintf(stderr,"Drew %d vectors\n",vectorsdrawn);
/*
Write the image as a TGA file
See bitmaplib.c for more details, or write "image"
in your own prefered format.
*/
if ((fp = fopen("image.tga","w")) == NULL) {
fprintf(stderr,"Failed to open output image\n");
exit(-1);
}
Write_Bitmap(fp,image,SCALE*NGRID,SCALE*NGRID,12);
fclose(fp);
exit(0);
} /* End of LAPACKE_zgesvd Example */