void peigs_dlasq1( Integer n, DoublePrecision *dplus, DoublePrecision *lplus, DoublePrecision *eval, DoublePrecision *work, Integer *info) { Integer i, j, iii, me, nproc; DoublePrecision *dptr; extern void dlasq1_(); FILE *file; char filename[40]; extern int close(); me = mxmynd_(); nproc = mxnprc_(); for ( i = 0; i < n; i++ ) work[i]=sqrt(dplus[i]); dptr = &work[n]; for(i = 0; i < n-1 ; i++) { dptr[i]=lplus[i] * work[i]; } dlasq1_( &n, &work[0], &work[n], &work[n+n], info ); if ( *info != 0 ) { printf(" error in dlasq1 info = %d \n", *info ); sprintf( filename, "pdspevx.%d", me); file = fopen(filename, "w"); for ( iii = 0; iii < n; iii++) fprintf(file, " %d %20.16f %20.16f \n", iii, dplus[iii], lplus[iii]); fclose(file); fflush(file); fflush(stdout); } j = n-1; for(i = 0; i < n; i++) { eval[i] = work[j] * work[j]; --j; } return; /* dlasq1_( n, work, work+ *n, work+2* *n, info ); j = *n-1; if( fabs(psgn - 1.0) < eps ) for(i = 0;i < *n;i++){ eval[i] = work[j] * work[j]; --j; } else{ for(i = 0;i < *n;i++){ eval[i] = -(work[j] * work[j]); --j; } */ }
void main1_() { /* for xpress.com */ static Integer three = (Integer) 3, IONE = (Integer) 1; static Integer IZERO = (Integer) 0; static DoublePrecision DZERO = (DoublePrecision) 0.0e0; Integer index; Integer nocare_, norder_, nonode_, ihost_, ialnod_, ialprc_; Integer me_, host_, nproc_; char range, order; Integer n, ii, me, indx, k, i, jndx, iii; Integer iseed[4]; Integer *mapA, *mapB, *mapZ; Integer *mapvecA, *mapvecB, *mapvecZ; Integer *iscratch; DoublePrecision **iptr; Integer is_size, rsize, ptr_size; Integer nprocs, isize; Integer info; DoublePrecision *scratch, *eval, *dptr; DoublePrecision *diagA, *subdiagA, *diagB, *subdiagB; DoublePrecision *matrixA, *matrixB, *matrixZ; DoublePrecision **vecA, **vecB, **vecZ; DoublePrecision **vecAA, **vecBB, **vecZZ; DoublePrecision res, t_com; DoublePrecision time1, time2; DoublePrecision mxclock_(); #ifdef TIMING extern TIMINGG test_timing; #endif static Integer countlist(); extern void geneig_res(); extern void b_ortho(); extern void tim_com(); extern void mxend_(); extern void mxinit_(), mxtime_(); extern void mxpara_(); extern Integer mxnprc_(); extern Integer mxmynd_(); extern void memreq_(); extern Integer nnodes_(); extern Integer ci_size_(); extern void pdsygv_(); extern DoublePrecision dlarnd_(); extern DoublePrecision dasum_(); extern DoublePrecision fabs(); /* extern char malloc(); */ extern void dspgv2_(); mxinit_(); me = mxmynd_(); nprocs = mxnprc_(); #ifdef TIMING test_timing.choleski = 0.0e0; test_timing.inverse = 0.0e0; test_timing.conjug = 0.0e0; test_timing.householder = 0.0e0; test_timing.pstebz = 0.0e0; test_timing.pstein = 0.0e0; test_timing.mxm5x = 0.0e0; test_timing.mxm25 = 0.0e0; test_timing.pdspevx = 0.0e0; test_timing.pdspgvx = 0.0e0; #endif k = 0; n = 500; diagA = (DoublePrecision *) malloc( n * sizeof(DoublePrecision)); subdiagA = (DoublePrecision *) malloc( n * sizeof(DoublePrecision)); diagB = (DoublePrecision *) malloc( n * sizeof(DoublePrecision)); subdiagB = (DoublePrecision *) malloc( n * sizeof(DoublePrecision)); if( diagA == NULL || subdiagA == NULL || diagB == NULL || subdiagB == NULL ) { fprintf(stderr, " me = %d: ERROR not enough memory for diagA or subdiagA, ...\n", me ); exit(-1); } iscratch = (Integer *) malloc ( (4*n + 100) * sizeof(Integer)); if ((mapA = (Integer *) malloc( n * sizeof(Integer))) == NULL ) { fprintf(stderr, " me = %d: ERROR not enough memory for mapA %d \n", me, n ); exit(-1); } if ((mapB = (Integer *) malloc( n * sizeof(Integer))) == NULL ) { fprintf(stderr, " me = %d: ERROR in memory allocation, not enough memory for mapB \n"); exit(-1); } if ((mapZ = (Integer *) malloc( n * sizeof(Integer))) == NULL ) { fprintf(stderr, " ERROR in memory allocation, not enough memory for mapZ \n"); exit(-1); } /* set the column mapping of processors */ for ( ii = 0; ii < n; ii++ ) { indx = ( ii % nprocs); mapA[ii] = 0; mapB[ii] = 0; } for ( ii = 0 ; ii < n; ii++ ) { indx = ( ii % nprocs); mapZ[ii] = 0; } /* if ( nprocs > 2 ) { mapZ[0] = nprocs-1; for ( ii = 1; ii < n; ii++) { indx = ( ii % (nprocs - 1)); mapZ[ii] = indx; } } else { for ( ii = 0; ii < n; ii++) { indx = ( ii % nprocs ); mapZ[ii] = indx; } } */ for ( i = 0; i < 3; i++ ) iseed[i] = 1; iseed[3] = 2*me*100 + 3; /* for symmetric matrix with this data distribution */ ii = ci_size_( &me, &n, mapA ); if ( ii > 0 ) { if ( (matrixA = (DoublePrecision *) malloc( ii * sizeof(DoublePrecision))) == NULL ) { fprintf(stderr, " me %d ERROR in memory allocation, not enough memory for matrixA memory size = %d \n", me, ii); exit(-1); } } dptr = matrixA; for ( indx = 0; indx < ii; indx++ ) { *( dptr++ ) = 0.0e0; } ii = countlist ( me, mapA, &n ); if ( ii > 0 ) { if ( ( vecA = ( DoublePrecision ** ) malloc ( ii * sizeof(DoublePrecision *))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for vecA %d \n", me, ii ); exit(-1); } } else { if ( ( vecA = ( DoublePrecision ** ) malloc ( n * sizeof(DoublePrecision *))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for vecA %d \n", me, n ); exit(-1); } } i = 0; dptr = matrixA; for ( indx = 0; indx < n; indx++ ) { if ( mapA[indx] == me ) { vecA[i] = dptr; i++; dptr += ( n - indx); } } i = 0; for ( indx = 0; indx < n; indx++ ){ /* * A is symmetric, tri-diagonal. Set diagA, subdiagA equal * to diagonal and subdiagonal parts of matrix. * diagA and subdiagA are used to compute residual. */ diagA[indx] = 1.0/( indx + 1 ); subdiagA[indx] = -1.0e0; if ( mapA[indx] == me ) { vecA[i][0] = 1.0/( indx + 1 ); if ( indx != (n-1)) vecA[i][1] = -1.0e0; i++; } } subdiagA[0] = 0.0e0; ii = ci_size_( &me, &n, mapB ); if ( (matrixB = (DoublePrecision *) malloc( ii * sizeof(DoublePrecision))) == NULL ) { fprintf(stderr, " me %d ERROR in memory allocation, not enough memory for matrixB \n", me); exit(-1); } zero_out ( ii, matrixB); dptr = matrixB; for ( indx = 0; indx < ii; indx++ ) { *( dptr++ ) = 0.0e0; } ii = countlist ( me, mapB, &n ); if ( ( vecB = ( DoublePrecision ** ) malloc ( ii * sizeof(DoublePrecision *))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for vecA \n", me); exit(-1); } i = 0; dptr = matrixB; for ( indx = 0; indx < n; indx++ ) { /* * B is symmetric, tri-diagonal. Set diagB, subdiagB equal * to diagonal and subdiagonal parts of matrix. * diagB and subdiagB are used to compute residual. */ diagB[indx] = 20.0e0; subdiagB[indx] = -1.0e0; if ( mapB[indx] == me ) { /* column */ vecB[i] = dptr; vecB[i][0] = 20.0e0; if ( indx != ( n-1)) vecB[i][1]= -1.0e0; dptr += ( n-indx); i++; } } subdiagB[0] = 0.0e0; /* use the utility routine count_list to determine the number of columns of Z that are stored on this processor using the above distribution */ ii = countlist ( me, mapZ, &n ); if ( ( vecZ = ( DoublePrecision ** ) malloc ( ii * sizeof(DoublePrecision *))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for vecA allocation = %d \n", me, ii); exit(-1); } if ( (matrixZ = (DoublePrecision *) malloc( ii * n * sizeof(DoublePrecision))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for matrixZ \n", me); exit(-1); } dptr = matrixZ; i = ii*n; zero_out( i, matrixZ ); dptr = matrixZ; k = 0; for ( i = 0; i < ii; i++ ) { vecZ[i] = dptr; dptr += n; } if ( (eval = (DoublePrecision *) malloc( n * sizeof(DoublePrecision ))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for eigenvalue space \n", me); exit(-1); } index = 0; /* * fprintf(stderr, "me = %d: just before memreq \n", me); */ rsize = 0; isize = 0; ptr_size = 0; /* for ( iii = 0; iii < n; iii++ ) fprintf(stderr, " me = %ld iii = %ld mapA = %ld mapB = %ld mapZ = %ld \n", me, iii, mapA[iii], mapB[iii], mapZ[iii]); */ memreq_( &index, &n, mapA, mapB, mapZ, &isize, &rsize, &ptr_size, iscratch ); /* * fprintf(stderr, "me = %d: just after memreq isize = %d rsize = %d ptr_size %d \n", me, isize, rsize, ptr_size); */ free(iscratch); if ( (iscratch = (Integer *) malloc( 2*isize * sizeof(Integer))) == NULL ) { fprintf(stderr, " me = %d ERROR in memory allocation, not enough memory for integer scratch space \n", me); exit(-1); } rsize = 2 * rsize; if ( (scratch = (DoublePrecision *) malloc( rsize * sizeof(DoublePrecision))) == NULL ) { fprintf(stderr, " me %d ERROR in memory allocation, not enough memory for DoublePrecision scratch space \n", me); exit(-1); } if ( (iptr = (DoublePrecision **) malloc( 2*ptr_size * sizeof(DoublePrecision *))) == NULL ) { fprintf(stderr, " me %d ERROR in memory allocation, not enough memory for pointer scratch space \n", me); exit(-1); } mxsync_(); if( me == 0 ) fprintf(stderr, " geneig_la \n" ); #ifdef TIMING mxsync_(); time1 = mxclock_(); #endif time1 = mxclock_(); /* * indx = 1; * for ( iii = 0; iii < 1; iii++ ){ * mxtime_( &IZERO, &t_com ); * pdspgv ( &indx, &n, vecA, mapA, vecB, mapB, vecZ, mapZ, eval, iscratch, * &isize, iptr, &ptr_size ,scratch, &rsize, &info); * } */ indx = 1; range = 'V'; order = 'L'; dspgv2_( &indx, &range, &order, &n, matrixA, matrixB, eval, matrixZ, &n, scratch, iscratch, &info); fflush(stdout); #ifdef TIMING mxsync_(); test_timing.pdspgvx = mxclock_() - time1; mxtime_( &IONE, &t_com ); ii = 0; if ( n < 30 ){ if ( info == 0 ) { for ( k = 0; k < n; k++ ) { if ( mapZ[k] == me ) { *scratch = dasum_( &n , vecZ[ii], &IONE ); ii++; } } } } if (me == 0 ){ fprintf(stderr, " n = %d nprocs = %d \n", n, nprocs); fprintf(stderr, " pdspgvx = %f \n", test_timing.pdspgvx); } #endif geneig_res( &n, diagA, subdiagA, diagB, subdiagB, vecZ, mapZ, eval, iscratch, scratch, &res, &info); if (me == 0 ) fprintf(stderr, " A Z - D B Z residual = %g \n", res); i = 0; for ( indx = 0; indx < n; indx++ ) { if ( mapB[indx] == me ) { ii = n-indx; zero_out( ii, vecB[i] ); vecB[i][0] = 20.0e0; if ( indx != ( n-1)) vecB[i][1]= -1.0e0; i++; } } mxsync_(); b_ortho( &n, vecB, mapB, &n, vecZ, mapZ, iptr, iscratch, scratch, &res, &info); if( me == 0 ) fprintf(stderr, " Z' B Z - I residual = %g \n", res); ii = 0; if ( n < 30 ){ if ( info == 0 ) { for ( k = 0; k < n; k++ ) { if ( mapZ[k] == me ) { *scratch = dasum_( &n , vecZ[ii], &IONE ); ii++; } } } } free(iptr); free(scratch); free(iscratch); free(eval); free(matrixZ); free(vecZ); free(vecB); free(matrixB); free(vecA); free(matrixA); free(mapZ); free(mapB); free(mapA); return; /* mxpend_(); */ }
void main1_() #endif { /* for xpress.com */ static Integer IZERO = (Integer) 0; Integer index, icounter; Integer n, ii, me, indx, k, i, neleZ, neleA; Integer *mapA, mapB[1], *mapZ; Integer *iscratch; DoublePrecision **iptr; DoublePrecision *dd, *ee; Integer rsize, ptr_size; Integer nprocs, isize; Integer info, m; DoublePrecision *scratch, *eval, *dptr; DoublePrecision *matrixA, *matrixZ; DoublePrecision **vecA, **vecZ; DoublePrecision res, t_com; #ifdef TIMING static Integer IONE = (Integer) 1; DoublePrecision time1, time2, timex; extern TIMINGG test_timing; #endif extern void tim_com(); extern void mxend_(); extern void mxinit_(), mxtime_(); extern DoublePrecision mxclock_(); extern void mxpara_(); extern Integer mxnprc_(); extern Integer mxmynd_(); extern void memreq_(); extern Integer ci_size_(); extern DoublePrecision dasum_(); extern void pdspev(); extern void tresid(), ortho(); mxinit_(); me = mxmynd_(); nprocs = mxnprc_(); #ifdef TIMING test_timing.choleski = 0.0e0; test_timing.inverse = 0.0e0; test_timing.conjug = 0.0e0; test_timing.householder = 0.0e0; test_timing.pstebz = 0.0e0; test_timing.pstein = 0.0e0; test_timing.mxm5x = 0.0e0; test_timing.mxm25 = 0.0e0; test_timing.pdspevx = 0.0e0; test_timing.pdspgvx = 0.0e0; #endif /* while (1) { */ icounter = 20; m = 20; while(1) { n = 2*icounter + 1; nprocs = mxnprc_(); printf(" n = %d nprocs = %d \n", n, nprocs); if ((dd = (DoublePrecision *) malloc( n * sizeof(DoublePrecision))) == NULL ) { fprintf(stderr, " me = %d: ERROR in memory allocation, not enough memory for dd %d \n", me, n ); exit(-1); } if ((ee = (DoublePrecision *) malloc( n * sizeof(DoublePrecision))) == NULL ) { fprintf(stderr, " me = %d: ERROR in memory allocation, not enough memory for ee %d \n", me, n ); exit(-1); } if ((mapA = (Integer *) malloc( n * sizeof(Integer))) == NULL ) { fprintf(stderr, " me = %d: ERROR in memory allocation, not enough memory for mapA %d \n", me, n ); exit(-1); } if ((mapZ = (Integer *) malloc( n * sizeof(Integer))) == NULL ) { fprintf(stderr, " ERROR in memory allocation, not enough memory for mapZ \n"); exit(-1); } /* set the column mapping of processors */ for ( ii = 0; ii < n; ii++ ) { indx = ( ii % nprocs); mapA[ii] = indx; } for ( ii = 0 ; ii < n; ii++ ) { indx = ( ii % nprocs); mapZ[ii] = indx; } /* for symmetric matrix with this data distribution */ ii = ci_size_( &me, &n, mapA ); neleA = ii; if ( ii > 0 ) { if ( (matrixA = (DoublePrecision *) malloc( ii * sizeof(DoublePrecision))) == NULL ) { fprintf(stderr, " me %d ERROR in memory allocation, not enough memory for matrixA memory size = %d \n", me, ii); exit(-1); } } ii = countlist ( me, mapA, &n ); if ( ii > 0 ) { if ( ( vecA = ( DoublePrecision ** ) malloc ( ii * sizeof(DoublePrecision *))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for vecA %d \n", me, ii ); exit(-1); } } else { if ( ( vecA = ( DoublePrecision ** ) malloc ( n * sizeof(DoublePrecision *))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for vecA %d \n", me, n ); exit(-1); } } i = 0; dptr = matrixA; for ( indx = 0; indx < n; indx++ ) { if ( mapA[indx] == me ) { vecA[i] = dptr; i++; dptr += ( n - indx); } } /* wilkinson's matrix */ ee[0] = 0.e0; for ( indx = 1; indx < n; indx++) ee[indx] = 1.0e0; /* ee[indx] = 1.e0; */ i = 0; for ( indx = 0; indx < m; indx++){ dd[indx] = (DoublePrecision) ( m-indx ); if ( mapA[indx] == me ){ vecA[i][0] = (DoublePrecision) ( m-indx ); vecA[i][1] = 1.; i++; } } dd[m] = 0.e0; if ( mapA[m] == me ) { vecA[i][0] = 0.; vecA[i][1] = 1.; i++; } for ( indx = m+1; indx < n; indx++){ dd[indx] = (DoublePrecision) indx-m; if ( mapA[indx] == me ){ vecA[i][0] = (DoublePrecision) indx-m; if ( indx != n-1) vecA[i][1] = 1; i++; } } /* use the utility routine count_list to determine the number of columns of Z that are stored on this processor using the cve distribution */ ii = countlist ( me, mapZ, &n ); if ( ( vecZ = ( DoublePrecision ** ) malloc ( ii * sizeof(DoublePrecision *))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for vecA allocation = %d \n", me, ii); exit(-1); } if ( (matrixZ = (DoublePrecision *) malloc( ii * n * sizeof(DoublePrecision))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for matrixZ \n", me); exit(-1); } neleZ = ii*n; dptr = matrixZ; k = 0; for ( i = 0; i < ii; i++ ) { vecZ[i] = dptr; dptr += n; } if ( (eval = (DoublePrecision *) malloc( n * sizeof(DoublePrecision ))) == NULL ) { fprintf(stderr, "me = %d: ERROR in memory allocation, not enough memory for eigenvalue space \n", me); exit(-1); } index = 1; /* fprintf(stderr, "me = %d: just before memreq \n", me); */ rsize = 0; isize = 0; ptr_size = 0; iscratch = ( Integer *) malloc( 6*n*sizeof(Integer)); memreq_( &index, &n, mapA, mapB, mapZ, &isize, &rsize, &ptr_size, iscratch ); /* fprintf(stderr, "me = %d: just after memreq isize = %d rsize = %d ptr_size %d \n", me, isize, rsize, ptr_size); */ free(iscratch); if ( (iscratch = (Integer *) malloc( 4* isize * sizeof(Integer))) == NULL ) { fprintf(stderr, " me = %d ERROR in memory allocation, not enough memory for integer scratch space \n", me); exit(-1); } if ( (scratch = (DoublePrecision *) malloc( 4*rsize * sizeof(DoublePrecision))) == NULL ) { fprintf(stderr, " me %d ERROR in memory allocation, not enough memory for DoublePrecision scratch space \n", me); exit(-1); } if ( (iptr = (DoublePrecision **) malloc( 4*ptr_size * sizeof(DoublePrecision *))) == NULL ) { fprintf(stderr, " me %d ERROR in memory allocation, not enough memory for pointer scratch space \n", me); exit(-1); } if( me == 0 ) fprintf(stderr, " Wilkinson \n" ); for ( ii = 0; ii < 1; ii++ ) { /* set data modified by pdspevx */ zero_out( neleZ, matrixZ ); zero_out( neleA, matrixA ); for ( k = 0; k < n; k++ ) { indx = ( k % nprocs); mapZ[k] = indx; } k = 0; for ( indx = 0; indx < n; indx++ ){ if ( me == mapA[indx] ) { vecA[k][0] = dd[indx]; if ( indx != n-1 ) vecA[k][1] = ee[indx+1]; k++; } } #ifdef TIMING time1 = mxclock_(); mxsync_(); time1 = mxclock_(); #endif mxtime_( &IZERO, &t_com ); pdspev( &n, vecA, mapA, vecZ, mapZ, eval, iscratch, &isize, iptr, &ptr_size ,scratch, &rsize, &info); if ( me == 0 ) for ( k = 0; k < n; k++ ) printf(" driver wilk k = %d eval %f \n", k, eval[k]); mxsync_(); #ifdef TIMING timex = mxclock_(); mxtime_( &IONE, &t_com ); if( ii == 0 ) time2 = timex - time1; #endif if (!NO_EVEC){ tresid( &n, &n, dd, ee, vecZ, mapZ, eval, iscratch, scratch, &res, &info); if( me == 0 ) fprintf(stderr, " iteration # %d : A Z - Z D residual = %g \n", ii, res); ortho( &n, &n, vecZ, mapZ, iptr, iscratch, scratch, &res, &info); if( me == 0 ) fprintf(stderr, " iteration # %d : Z' Z - I residual = %g \n", ii, res); } } #ifdef TIMING test_timing.pdspevx = timex - time1; if (!NO_EVEC){ ii = 0; if ( info == 0 ) { for ( k = 0; k < n; k++ ) { if ( mapZ[k] == me ) { *scratch = dasum_( &n , vecZ[ii], &IONE ); ii++; } } } } if (me == 0 ){ fprintf(stderr, " n = %d nprocs = %d \n", n, nprocs); fprintf(stderr, " time1 = %f \n", time2); fprintf(stderr, " pdspgvx = %f \n", test_timing.pdspgvx); fprintf(stderr, " pdspevx = %f \n", test_timing.pdspevx); fprintf(stderr, " choleski = %f \n", test_timing.choleski); fprintf(stderr, " inverse = %f \n", test_timing.inverse); fprintf(stderr, " conjug = %f \n", test_timing.conjug); fprintf(stderr, " householder = %f \n", test_timing.householder); fprintf(stderr, " mxm5x = %f \n", test_timing.mxm5x); fprintf(stderr, " mxm25 = %f \n", test_timing.mxm25); fprintf(stderr, " pstein = %f \n", test_timing.pstein); fprintf(stderr, " pstebz = %f \n", test_timing.pstebz); } /* Compute and print commmunication time */ tim_com( test_timing.pdspevx, t_com, iscratch, scratch ); #endif free(iptr); free(scratch); free(iscratch); free(eval); free(matrixZ); free(vecZ); free(vecA); free(matrixA); free(mapZ); free(mapA); icounter+=abs(random() % 31 ); } return; }