/* Test program
* created 23/09/2014
* author Alex Bombrun
*
* icc -O1 -o eigen.exe lapackReadStore.c mpiutil.c normals.c matrixBlockStore.c -mkl
* ./eigen.exe 4 4
*
*/
int main(int argc, char **argv) {
FILE* store;
FILE* scaStore;
int N , M;
int i, j;
int n_blocks;
int scalapack_size;
int NB, MB;
int i_block, j_block;
int dim[4];
double * mat; // local matrix block use for reading
int t, t_block;
const char* profileG_file_name= "./data/NormalsG/profile.txt";
const char* store_location = "./data/ReducedNormals";
const char* scaStore_location ="./data/DiagCholeskyReducedNormals";
int mp; // number of rows in the processor grid
int mla; // number of rows in the local array
int mb; // number of rows in a block
int np; // number of columns in the processor grid
int nla; // number of columns in the local array
int nb; // number of columns in a block
int mype,npe; // rank and total number of process
int idescal[9]; // matrix descriptors
double *la; // matrix values: al is the local array
int idescbl[9];
double *lb;
double normb;
int idescxl[9];
double *lx;
double normx;
int idesczl[9]; // matrix descriptors
double *lz; // matrix values: al is the local array
double *w;
int ierr; // error output
int mp_ret, np_ret, myrow, mycol; // to store grid info
int zero=0; // value used for the descriptor initialization
int one=1; // value used for the descriptor initialization
int m,n; // matrix A dimensions
double norm, cond;
double *work = NULL;
double * work2 = NULL;
int *iwork = NULL;
int lwork, liwork;
float ll,mm,cr,cc;
int ii,jj,pr,pc,h,g; // ii,jj coordinates of local array element
int rsrc=0,csrc=0; // assume that 0,0 element should be stored in the 0,0 process
int n_b = 1;
int index;
int icon; // scalapack cblacs context
char normJob, jobz, uplo, trans, diag;
double MPIt1, MPIt2, MPIelapsed;
jobz= 'N'; uplo='U';
Cblacs_pinfo( &mype, &npe );
if (argc == 3) {
//printf("%s %s %s\n", argv[0], argv[1], argv[2]);
n_blocks= (int) strtol(argv[1], NULL, 10);
scalapack_size= (int) strtol(argv[2], NULL, 10);
} else {
printf("Usage: expect 2 integers \n");
printf(" 1 : the number of diagonal blocks \n");
printf(" 2 : scalapack number to define block size (assume n is divisible by sqrt(p) and that n/sqrt(p) is divisible by this number)\n");
exit( -1);
}
printf("%d/%d: read store\n",mype,npe);
N = getNumberOfLine(profileG_file_name); // the dimension of the matrix;
M = N; // square matrix
m=M; //mla*mp;
n=N; //nla*np;
np = isqrt(npe); // assume that the number of process is a square
mp = np; // square grid
mla = m/mp; // assume that the matrix dimension if a multiple of the process grid dimension
nla = n/np;
mb = mla/scalapack_size; // assume that the dimension of the matrix is a multiple of the number of the number of diagonal blocks
nb = nla/scalapack_size;
// init CBLACS
Cblacs_get( -1, 0, &icon );
Cblacs_gridinit( &icon,"c", mp, np );
Cblacs_gridinfo( icon, &mp_ret, &np_ret, &myrow, &mycol);
// allocate local matrix
la=malloc(sizeof(double)*mla*nla);
printf("%d/%d: full matrix (%d,%d), local matrix (%d,%d), processor grid (%d,%d), block (%d,%d) \n", mype, npe, m, n, mla, nla, np, mp, mb, nb);
// set identity matrix
for(i = 0;i<M;i++){
for(j = i;j<i+1;j++){
cr = (float)( i/mb );
h = rsrc+(int)(cr);
pr = h%np;
cc = (float)( j/mb );
g = csrc+(int)(cc);
pc = g%mp;
// check if process should get this element
if (myrow == pr && mycol==pc){
// ii = x + l*mb
// jj = y + m*nb
ll = (float)( ( i/(np*mb) ) ); // thinks seems to be mixed up does not matter as long as the matrix, the block and the grid is symmetric
mm = (float)( ( j/(mp*nb) ) );
ii = i%mb + (int)(ll)*mb;
jj = j%nb + (int)(mm)*nb;
index=jj*mla+ii; // seems to be the transpose !?
//if(index<0) printf("%d/%d: negative index (%d,%d) \n",mype,npe,i,j);
//if(index>=mla*nla) printf("%d/%d: too large index (%d,%d) \n",mype,npe,i,j);
la[index] = 1;
}
}
}
/*
for(i_block=0;i_block<n_blocks;i_block++){
printf("%d/%d: process store block %d \n", mype, npe, i_block);
readStore(&store,i_block,store_location);
t_block = 0;
while(readNextBlockDimension(dim,store)!=-1) { // loop B over all block tasks
j_block = mpi_get_diag_block_id(i_block, t_block, n_blocks);
mat = malloc((dim[1]-dim[0])*(dim[3]-dim[2]) * sizeof(double));
readNextBlock(dim[0],dim[1],dim[2],dim[3],mat,store);
if (dim[0]==dim[2]){ // process only the diagonal blocks
// printf("%d/%d: read block (%d,%d) with global indices (%d,%d,%d,%d) \n",mype, npe, i_block,j_block,dim[0],dim[1],dim[2],dim[3]);
NB = dim[1]-dim[0];
MB = dim[3]-dim[2];
for(i = dim[0];i<dim[1];i++){
for(j = dim[2];j<dim[3];j++){
//matA[i*M+j] = mat[(i-dim[0])*MB+(j-dim[2])];
// finding out which pe gets this i,j element
cr = (float)( i/mb );
h = rsrc+(int)(cr);
pr = h%np;
cc = (float)( j/mb );
g = csrc+(int)(cc);
pc = g%mp;
// check if process should get this element
if (myrow == pr && mycol==pc){
// ii = x + l*mb
// jj = y + m*nb
ll = (float)( ( i/(np*mb) ) ); // thinks seems to be mixed up does not matter as long as the matrix, the block and the grid is symmetric
mm = (float)( ( j/(mp*nb) ) );
ii = i%mb + (int)(ll)*mb;
jj = j%nb + (int)(mm)*nb;
index=jj*mla+ii; // seems to be the transpose !?
//if(index<0) printf("%d/%d: negative index (%d,%d) \n",mype,npe,i,j);
//if(index>=mla*nla) printf("%d/%d: too large index (%d,%d) \n",mype,npe,i,j);
la[index] = mat[(i-dim[0])*MB+(j-dim[2])];
}
}
}
// transpose
if(j_block != i_block){
for(i = dim[0];i<dim[1];i++){
for(j = dim[2];j<dim[3];j++){
//matA[j*M+i] = mat[(i-dim[0])*MB+(j-dim[2])];
// finding out which pe gets this j,i element
cr = (float)( j/mb );
h = rsrc+(int)(cr);
pr = h%np;
cc = (float)( i/mb );
g = csrc+(int)(cc);
pc = g%mp;
// check if process should get this element
if (myrow == pr && mycol==pc){
// ii = x + l*mb
// jj = y + m*nb
ll = (float)( ( j/(np*mb) ) ); // thinks seems to be mixed up does not matter as long as the matrix, the block and the grid is symmetric
mm = (float)( ( i/(mp*nb) ) );
ii = j%mb + (int)(ll)*mb;
jj = i%nb + (int)(mm)*nb;
index=jj*mla+ii; // seems to be the transpose !?
//if(index<0) printf("%d/%d: negative index (%d,%d) \n",mype,npe,i,j);
//if(index>=mla*nla) printf("%d/%d: too large index (%d,%d) \n",mype,npe,i,j);
la[index] = mat[(i-dim[0])*MB+(j-dim[2])];
}
}
}
}
}
free(mat);
t_block++;
}
closeStore(store);
}
*/
printf("%d/%d: finished scaterring the matrix \n",mype,npe);
printf("%d/%d: start computing \n",mype,npe);
// set the matrix descriptor
ierr=0;
descinit_(idescal, &m, &n , &mb, &nb , &zero, &zero, &icon, &mla, &ierr); // processor grip id start at 0
if (mype==0) saveMatrixDescriptor(idescal, scaStore_location);
ierr=0;
descinit_(idescbl, &m, &one , &mb, &nb , &zero, &zero, &icon, &nla, &ierr); // processor grip id start at 0
lb = calloc(sizeof(double),mla);
ierr=0;
// set x
descinit_(idescxl, &n, &one , &mb, &nb , &zero, &zero, &icon, &nla, &ierr); // processor grip id start at 0
lx = calloc(sizeof(double),mla);
for(i=0;i<mla;i++){
lx[i] = 1.0/m;
}
pddot_(&n,&normx,lx,&one,&one,idescxl,&one,lx,&one,&one,idescxl,&one); // normx <- x'x
if (mype==0) printf("%d/%d: normx2 %E \n",mype,npe,normx);
ierr=0;
// set b
double alpha =1.0;
double beta =0.0;
trans = 'N';
pdgemv_(&trans,&m,&n,&alpha,la,&one,&one,idescal,lx,&one,&one,idescxl,&one,&beta,lb,&one,&one,idescbl,&one); // b <- A x
pddot_(&n,&normb,lb,&one,&one,idescbl,&one,lb,&one,&one,idescbl,&one); // norm <- b'b
if (mype==0) printf("%d/%d: normb2 %E \n",mype,npe,normb);
ierr = 0;
// compute norm 1 of the reduced normal matrix
/* DO NOT WORK
lwork = 2*mla+2*nla;
work = malloc(sizeof(double)*lwork);
normJob = '1';
norm = pdlansy_(&normJob, &uplo, &n, la, &one, &one, idescal, work); // matrix index start at one
printf("%d/%d: norm %f \n",mype,npe,norm);
free(work);
*/
ierr = 0;
// compute the cholesky decomposition
printf("%d/%d: start computing cholesky factor\n",mype,npe);
pdpotrf_(&uplo,&n,la,&one,&one,idescal,&ierr);
printf("%d/%d: finish computing cholesky factor\n",mype,npe);
openScalapackStore(&scaStore,myrow,mycol,scaStore_location);
saveLocalMatrix(la,nla,mla,scaStore);
double test=0.0;
for(i=0;i<nla*mla;i++){
test += la[i]*la[i];
}
printf("%d/%d: finished computing cholesky, test=%f \n",mype,npe,test);
ierr =0;
// assume x and b set
// assume cholesky decomposition
// compute the soluation A x = b
diag = 'N';
printf("%d/%d: start solving\n",mype,npe);
//pdpptrs_(&uplo, &trans , &diag , &n , &one , la , &one , &one , idescal , lb , &one , &one , idescbl , &ierr); // solve triangular system
//pdtrtrs (&uplo, &trans , &diag , &n , &n , la , &one , &one , idescal , lb , &one , &one , idescbl , &ierr);
pdpotrs_(&uplo, &n , &one , la , &one , &one , idescal , lb , &one , &one , idescbl , &ierr); // b<- A-1 b
alpha = -1.0;
normb=0;
pdaxpy_(&n,&alpha,lx,&one,&one,idescxl,&one,lb,&one,&one,idescbl,&one); // b<-b-x
pddot_(&n,&normb,lb,&one,&one,idescbl,&one,lb,&one,&one,idescbl,&one); // norm <- b'b
if (mype==0) printf("%d/%d: finish solving, norm2(sol-true) %E \n",mype,npe,normb);
ierr = 0;
/*
// compute the eigen values
jobz= 'N'; uplo='U'; // with N z is ignored
descinit_(idesczl, &m, &n , &mb, &nb , &zero, &zero, &icon, &mla, &ierr);
lz = malloc(sizeof(double)*mla*nla);
w = malloc(sizeof(double)*m);
lwork = -1;
work = malloc(sizeof(double)*2);
pdsyev_( &jobz, &uplo, &n, la, &one, &one, idescal, w, lz, &one, &one, idesczl, work, &lwork, &ierr); // only compute lwork
//pdsyev_( &jobz, &uplo, &n, A, &ione, &ione, descA, W, Z, &ione, &ione, descZ, work, &lwork, &info );
lwork= (int) work[0];
free(work);
work = (double *)calloc(lwork,sizeof(double)) ;
//MPIt1 = MPI_Wtime();
pdsyev_( &jobz, &uplo, &n, la, &one, &one, idescal, w, lz, &one, &one, idesczl, work, &lwork, &ierr); // compute the eigen values
//MPIt2 = MPI_Wtime();
//MPIelapsed=MPIt2-MPIt1;
if (mype == 0) {
saveMatrix(n,w,"eigenvalues.txt");
//printf("%d/%d: finished job in %8.2fs\n",mype,npe,MPIelapsed); // not working
}
*/
ierr = 0;
// compute the conditioner number assume that the norm and the cholesky decomposition have been computed
/* DO NOT WORK
lwork = 2*mla+3*nla;
printf("%d/%d: lwork=%d @%p\n",mype,npe,lwork,&lwork);
work2 = malloc(sizeof(double)*lwork);
liwork = 2*mla+3*nla;
iwork = malloc(sizeof(int)*liwork);
pdpocon_(&uplo,&n,la,&one,&one,idescal,&norm,&cond,work2,&lwork,iwork,&liwork,&ierr);
printf("%d/%d: condition number %f \n",mype,npe,cond);
*/
free(la);
Cblacs_gridexit(icon);
Cblacs_exit( 0 );
return 0;
}
int main (int argc, char **argv)
{
// double *A_local;
int A_descrip[DESC_SIZE];
// double *B_local;
int B_descrip[DESC_SIZE];
// double *C_local;
int C_descrip[DESC_SIZE];
int nproc_rows;
int nproc_cols;
int m, n, k;
int blacs_grid;
int myproc, nprocs;
char myname[MPI_MAX_PROCESSOR_NAME];
double *a, *b, *c;
/* Get input parameters */
m = GLOBAL_M;
n = GLOBAL_N;
k = GLOBAL_K; // 32
MPI_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
MPI_Comm_rank(MPI_COMM_WORLD, &myproc);
/* Ensure we have at least two processors */
if (nprocs < 2)
{
printf("Too few processors!\n");
exit (1);
}
if(gethostname (myname, MPI_MAX_PROCESSOR_NAME) != 0 )
printf("Error: gethostname failed!\n");
else if(HELLO)
printf("Hello from %2d of %2d on %s\n", myproc, nprocs, myname);
/* Set to HIGH frequency */
mapping(myproc%7, DVFS_HIGH);
Cblacs_get(0, 0, &blacs_grid);
int ldumap=PROC_NODE;
nproc_rows=PROC_NODE;
nproc_cols=PROC_NODE;
/* ROW MAJOR TILING */
if(MAJOR==1)
{
int usermap[64]= {0, 1, 8, 9, 16, 17, 24, 25,
2, 3, 10, 11, 18, 19, 26, 27,
4, 5, 12, 13, 20, 21, 28, 29,
6, 7, 14, 15, 22, 23, 30, 31,
32, 33, 40, 41, 48, 49, 56, 57,
34, 35, 42, 43, 50, 51, 58, 59,
36, 37, 44, 45, 52, 53, 60, 61,
38, 39, 46, 47, 54, 55, 62, 63};
Cblacs_gridmap(&blacs_grid, usermap, ldumap, nproc_rows, nproc_cols);
}
else if (MAJOR==2)
/* COLUMN MAJOR TILING*/
{
int usermap[64]={0, 1, 2, 3, 8, 9, 10, 11,
4, 5, 6, 7, 12, 13, 14, 15,
16, 17, 18, 19, 24, 25, 26, 27,
20, 21, 22, 23, 28, 29, 30, 31,
32, 33, 34, 35, 40, 41, 42, 43,
36, 37, 38, 39, 44, 45, 46, 47,
48, 49, 50, 51, 56, 57, 58, 59,
52, 53, 54, 55, 60, 61, 62, 63};
Cblacs_gridmap(&blacs_grid, usermap, ldumap, nproc_rows, nproc_cols);
}
else if(MAJOR==0)
Cblacs_gridinit(&blacs_grid, "R", nproc_rows, nproc_cols);
// Cblacs_pcoord(blacs_grid, myproc, &my_process_row, &my_process_col);
int local_m = m/nproc_rows;
int local_n = n/nproc_cols;
int local_k = k/nproc_cols;
if(myproc==SHOW1)
printf("local m n k = %d %d %d\n",local_m, local_n, local_k);
a = (double *) malloc (local_m*local_k * sizeof(double));
b = (double *) malloc (local_k*local_n * sizeof(double));
c = (double *) malloc (local_m*local_n * sizeof(double));
// A_local = (double *) malloc (local_m*local_k * sizeof(double));
// B_local = (double *) malloc (local_k*local_n * sizeof(double));
// C_local = (double *) malloc (local_m*local_n * sizeof(double));
if(!a||!b||!c)//||!A_local||!B_local||!C_local)
{
printf("out of memory!\n");
exit(-1);
}
Build_descrip(myproc, "A", A_descrip, m, k, local_m, local_k, blacs_grid, local_m);//MAX(local_m, local_k));
Build_descrip(myproc, "B", B_descrip, k, n, local_k, local_n, blacs_grid, local_k);//MAX(local_k, local_n));
Build_descrip(myproc, "C", C_descrip, m, n, local_m, local_n, blacs_grid, local_m);//MAX(local_m, local_n));
if(myproc==SHOW1)
{
printf("\nA_descrip = [ %d, %d, %d, %d, %d, %d, %d, %d, %d]\n",
A_descrip[0], A_descrip[1], A_descrip[2], A_descrip[3], A_descrip[4], A_descrip[5], A_descrip[6], A_descrip[7], A_descrip[8]);
printf("\nB_descrip = [ %d, %d, %d, %d, %d, %d, %d, %d, %d]\n",
B_descrip[0], B_descrip[1], B_descrip[2], B_descrip[3], B_descrip[4], B_descrip[5], B_descrip[6], B_descrip[7], B_descrip[8]);
printf("\nC_descrip = [ %d, %d, %d, %d, %d, %d, %d, %d, %d]\n\n",
C_descrip[0], C_descrip[1], C_descrip[2], C_descrip[3], C_descrip[4], C_descrip[5], C_descrip[6], C_descrip[7], C_descrip[8]);
}
int ij = 1;
char tran = 'N';
double alpha = 1.0, beta = 1.0;
double exetime=0;
MPI_Barrier(MPI_COMM_WORLD);
if(MEASURE && myproc==0)
{
system("/apps/power-bench/mclient -H 10.1.255.100 -d /tmp");
system("/apps/power-bench/mclient -H 10.1.255.100 -l pdgemm.ptr");
system("/apps/power-bench/mclient -H 10.1.255.100 -s pdgemm");
}
// Zeros(A_local, local_m, local_k);
// Zeros(B_local, local_k, local_n);
// Zeros(C_local, local_m, local_n);
// if(myproc%8==0)
// RndMatrix(A_local, local_m, local_k, myproc);
// if(myproc<8)
// RndMatrix(B_local, local_k, local_n, myproc);
MPI_Barrier(MPI_COMM_WORLD);
// exetime0 = -MPI_Wtime();
// ScaLAPACK pdgemm
if(!myproc)
printf("\nM = %d, N = %d, K = %d\n", m, n, k);
/*
pdgemm_(&tran, &tran, &m, &n, &k,
&alpha, A_local, &ij, &ij, A_descrip,
B_local, &ij, &ij, B_descrip,
&beta, C_local, &ij, &ij, C_descrip);
MPI_Barrier(MPI_COMM_WORLD);
exetime0 += MPI_Wtime();
CpyMatrix(A_local, a, local_m, local_k);
CpyMatrix(B_local, b, local_k, local_n);
Zeros(c, local_m, local_n);
*/
// if(myproc%8==0)
RndMatrix(a, local_m, local_k, myproc);
// if(myproc<8)
RndMatrix(b, local_k, local_n, myproc);
Zeros(c, local_m, local_n);
MPI_Barrier(MPI_COMM_WORLD);
exetime = -MPI_Wtime();
// My pdgemm
pdgemm(&tran, &tran, &m, &n, &k, &alpha, a, &ij, &ij, A_descrip, b, &ij, &ij, B_descrip, &beta, c, &ij, &ij, C_descrip);
//printf("MYPDGEMM finish\n");
MPI_Barrier(MPI_COMM_WORLD);
exetime += MPI_Wtime();
if(MEASURE && myproc==0)
{
system("/apps/power-bench/mclient -H 10.1.255.100 -e session");
system("/apps/power-bench/mclient -H 10.1.255.100 -e log");
}
mapping(myproc%7, DVFS_LOW);
mapping(0, DVFS_HIGH);
if(myproc == SHOW1)
{
sleep(1);
//printf("Total execution time of my_pdgemm is %.3f.\n", exetime);
printf("Total execution time of pdgemm is %.3f.\n", exetime);
int i, j;
/*
printf("My PDGEMM ID AAA = %d :\n",myproc);
for(i=0;i<DISP_SIZE;i++)
{
for(j=0;j<DISP_SIZE;j++)
printf("%8.5lf ", a[i*DISP_SIZE+j]);
printf("\n");
}
printf("My PDGEMM ID BBB = %d :\n",myproc);
for(i=0;i<DISP_SIZE;i++)
{
for(j=0;j<DISP_SIZE;j++)
printf("%8.5lf ", b[i*DISP_SIZE+j]);
printf("\n");
}
*/
/*
printf("My PDGEMM ID CCC = %d :\n",myproc);
for(i=0;i<DISP_SIZE;i++)
{
for(j=0;j<DISP_SIZE;j++)
printf("%10.5lf\t", c[i*DISP_SIZE+j]);
printf("\n");
}
*/
/*
}
if(myproc == SHOW2)
{
sleep(3);
printf("Total execution time of my_pdgemm is %.3f.\n", exetime);
printf("Total execution time of pdgemm is %.3f.\n", exetime0);
int i, j;
printf("PDGEMM ID AAA = %d :\n",myproc);
for(i=0;i<DISP_SIZE;i++)
{
for(j=0;j<DISP_SIZE;j++)
printf("%8.5lf ", A_local[i*DISP_SIZE+j]);
printf("\n");
}
printf("PDGEMM ID BBB = %d :\n",myproc);
for(i=0;i<DISP_SIZE;i++)
{
for(j=0;j<DISP_SIZE;j++)
printf("%8.5lf ", B_local[i*DISP_SIZE+j]);
printf("\n");
}
*/
printf("PDGEMM ID CCC = %d :\n",myproc);
for(i=0;i<DISP_SIZE;i++)
{
for(j=0;j<DISP_SIZE;j++)
printf("%10.5lf\t", c[i*DISP_SIZE+j]);
printf("\n");
}
}
// double diffa, diffb, diffc, diff_total=0.0;
//diffa=diff_norm(A_local, a, local_m, local_k);
//diffb=diff_norm(B_local, b, local_k, local_n);
//diffc=diff_norm(C_local, c, local_m, local_n);
//MPI_Reduce(&diffa, &diff_total, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
// sleep(1);
/*
if(!myproc)
printf("The total normal difference between my pdgemm A and ScaLAPACK pdgemm A is %e.\n", diff_total);
MPI_Reduce(&diffb, &diff_total, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
sleep(1);
if(!myproc)
printf("The total normal difference between my pdgemm B and ScaLAPACK pdgemm B is %e.\n", diff_total);
MPI_Reduce(&diffc, &diff_total, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
sleep(1);
if(!myproc)
printf("The total normal difference between my pdgemm C and ScaLAPACK pdgemm C is %e.\n", diff_total);
*/
free(a); free(b); free(c);
//free(A_local);free(B_local);free(C_local);
Cblacs_exit(1);
/* Clean-up and close down */
MPI_Barrier(MPI_COMM_WORLD);
//MPI_Comm_free(&my_row_comm);
//MPI_Comm_free(&my_column_comm);
MPI_Finalize();
return 0;
}
SEXP R_blacs_exit(SEXP CONT)
{
Cblacs_exit(INT(CONT));
return R_NilValue;
}
void Exit( bool finished )
{
int notDone = ( finished ? 0 : 1 );
Cblacs_exit( notDone );
}
