PetscInt main(PetscInt argc,char **args) { Mat A,A_dense,B; Vec *evecs; PetscBool flg,TestZHEEV=PETSC_TRUE,TestZHEEVX=PETSC_FALSE,TestZHEGV=PETSC_FALSE,TestZHEGVX=PETSC_FALSE; PetscErrorCode ierr; PetscBool isSymmetric; PetscScalar sigma,*arrayA,*arrayB,*evecs_array=NULL,*work; PetscReal *evals,*rwork; PetscMPIInt size; PetscInt m,i,j,nevs,il,iu,cklvl=2; PetscReal vl,vu,abstol=1.e-8; PetscBLASInt *iwork,*ifail,lwork,lierr,bn; PetscReal tols[2]; PetscInt nzeros[2],nz; PetscReal ratio; PetscScalar v,none = -1.0,sigma2,pfive = 0.5,*xa; PetscRandom rctx; PetscReal h2,sigma1 = 100.0; PetscInt dim,Ii,J,Istart,Iend,n = 6,its,use_random,one=1; PetscInitialize(&argc,&args,(char*)0,help); #if !defined(PETSC_USE_COMPLEX) SETERRQ(PETSC_COMM_WORLD,1,"This example requires complex numbers"); #endif ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size != 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"This is a uniprocessor example only!"); ierr = PetscOptionsHasName(NULL, "-test_zheevx", &flg);CHKERRQ(ierr); if (flg) { TestZHEEV = PETSC_FALSE; TestZHEEVX = PETSC_TRUE; } ierr = PetscOptionsHasName(NULL, "-test_zhegv", &flg);CHKERRQ(ierr); if (flg) { TestZHEEV = PETSC_FALSE; TestZHEGV = PETSC_TRUE; } ierr = PetscOptionsHasName(NULL, "-test_zhegvx", &flg);CHKERRQ(ierr); if (flg) { TestZHEEV = PETSC_FALSE; TestZHEGVX = PETSC_TRUE; } ierr = PetscOptionsGetReal(NULL,"-sigma1",&sigma1,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr); dim = n*n; ierr = MatCreate(PETSC_COMM_SELF,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr); ierr = MatSetType(A,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,"-norandom",&flg);CHKERRQ(ierr); if (flg) use_random = 0; else use_random = 1; if (use_random) { ierr = PetscRandomCreate(PETSC_COMM_SELF,&rctx);CHKERRQ(ierr); ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr); ierr = PetscRandomSetInterval(rctx,0.0,PETSC_i);CHKERRQ(ierr); } else { sigma2 = 10.0*PETSC_i; } h2 = 1.0/((n+1)*(n+1)); for (Ii=0; Ii<dim; Ii++) { v = -1.0; i = Ii/n; j = Ii - i*n; if (i>0) { J = Ii-n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr); } if (i<n-1) { J = Ii+n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr); } if (j>0) { J = Ii-1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr); } if (j<n-1) { J = Ii+1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr); } if (use_random) {ierr = PetscRandomGetValue(rctx,&sigma2);CHKERRQ(ierr);} v = 4.0 - sigma1*h2; ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr); } /* make A complex Hermitian */ v = sigma2*h2; Ii = 0; J = 1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr); v = -sigma2*h2; ierr = MatSetValues(A,1,&J,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr); if (use_random) {ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);} ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); m = n = dim; /* Check whether A is symmetric */ ierr = PetscOptionsHasName(NULL, "-check_symmetry", &flg);CHKERRQ(ierr); if (flg) { Mat Trans; ierr = MatTranspose(A,MAT_INITIAL_MATRIX, &Trans); ierr = MatEqual(A, Trans, &isSymmetric); if (!isSymmetric) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"A must be symmetric"); ierr = MatDestroy(&Trans);CHKERRQ(ierr); } /* Convert aij matrix to MatSeqDense for LAPACK */ ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&flg);CHKERRQ(ierr); if (flg) { ierr = MatDuplicate(A,MAT_COPY_VALUES,&A_dense);CHKERRQ(ierr); } else { ierr = MatConvert(A,MATSEQDENSE,MAT_INITIAL_MATRIX,&A_dense);CHKERRQ(ierr); } ierr = MatCreate(PETSC_COMM_SELF,&B);CHKERRQ(ierr); ierr = MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr); ierr = MatSetType(B,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSetFromOptions(B);CHKERRQ(ierr); v = 1.0; for (Ii=0; Ii<dim; Ii++) { ierr = MatSetValues(B,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr); } /* Solve standard eigenvalue problem: A*x = lambda*x */ /*===================================================*/ ierr = PetscBLASIntCast(2*n,&lwork);CHKERRQ(ierr); ierr = PetscBLASIntCast(n,&bn);CHKERRQ(ierr); ierr = PetscMalloc(n*sizeof(PetscReal),&evals);CHKERRQ(ierr); ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr); ierr = MatDenseGetArray(A_dense,&arrayA);CHKERRQ(ierr); if (TestZHEEV) { /* test zheev() */ printf(" LAPACKsyev: compute all %d eigensolutions...\n",m); ierr = PetscMalloc((3*n-2)*sizeof(PetscReal),&rwork);CHKERRQ(ierr); LAPACKsyev_("V","U",&bn,arrayA,&bn,evals,work,&lwork,rwork,&lierr); ierr = PetscFree(rwork);CHKERRQ(ierr); evecs_array = arrayA; nevs = m; il =1; iu=m; } if (TestZHEEVX) { il = 1; ierr = PetscBLASIntCast((0.2*m),&iu);CHKERRQ(ierr); printf(" LAPACKsyevx: compute %d to %d-th eigensolutions...\n",il,iu); ierr = PetscMalloc((m*n+1)*sizeof(PetscScalar),&evecs_array);CHKERRQ(ierr); ierr = PetscMalloc((7*n+1)*sizeof(PetscReal),&rwork);CHKERRQ(ierr); ierr = PetscMalloc((5*n+1)*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr); ierr = PetscMalloc((n+1)*sizeof(PetscBLASInt),&ifail);CHKERRQ(ierr); /* in the case "I", vl and vu are not referenced */ vl = 0.0; vu = 8.0; LAPACKsyevx_("V","I","U",&bn,arrayA,&bn,&vl,&vu,&il,&iu,&abstol,&nevs,evals,evecs_array,&n,work,&lwork,rwork,iwork,ifail,&lierr); ierr = PetscFree(iwork);CHKERRQ(ierr); ierr = PetscFree(ifail);CHKERRQ(ierr); ierr = PetscFree(rwork);CHKERRQ(ierr); } if (TestZHEGV) { printf(" LAPACKsygv: compute all %d eigensolutions...\n",m); ierr = PetscMalloc((3*n+1)*sizeof(PetscReal),&rwork);CHKERRQ(ierr); ierr = MatDenseGetArray(B,&arrayB);CHKERRQ(ierr); LAPACKsygv_(&one,"V","U",&bn,arrayA,&bn,arrayB,&bn,evals,work,&lwork,rwork,&lierr); evecs_array = arrayA; nevs = m; il = 1; iu=m; ierr = MatDenseRestoreArray(B,&arrayB);CHKERRQ(ierr); ierr = PetscFree(rwork);CHKERRQ(ierr); } if (TestZHEGVX) { il = 1; ierr = PetscBLASIntCast((0.2*m),&iu);CHKERRQ(ierr); printf(" LAPACKsygv: compute %d to %d-th eigensolutions...\n",il,iu); ierr = PetscMalloc((m*n+1)*sizeof(PetscScalar),&evecs_array);CHKERRQ(ierr); ierr = PetscMalloc((6*n+1)*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr); ifail = iwork + 5*n; ierr = PetscMalloc((7*n+1)*sizeof(PetscReal),&rwork);CHKERRQ(ierr); ierr = MatDenseGetArray(B,&arrayB);CHKERRQ(ierr); vl = 0.0; vu = 8.0; LAPACKsygvx_(&one,"V","I","U",&bn,arrayA,&bn,arrayB,&bn,&vl,&vu,&il,&iu,&abstol,&nevs,evals,evecs_array,&n,work,&lwork,rwork,iwork,ifail,&lierr); ierr = MatDenseRestoreArray(B,&arrayB);CHKERRQ(ierr); ierr = PetscFree(iwork);CHKERRQ(ierr); ierr = PetscFree(rwork);CHKERRQ(ierr); } ierr = MatDenseRestoreArray(A_dense,&arrayA);CHKERRQ(ierr); if (nevs <= 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_CONV_FAILED, "nev=%d, no eigensolution has found", nevs); /* View evals */ ierr = PetscOptionsHasName(NULL, "-eig_view", &flg);CHKERRQ(ierr); if (flg) { printf(" %d evals: \n",nevs); for (i=0; i<nevs; i++) printf("%d %G\n",i+il,evals[i]); } /* Check residuals and orthogonality */ ierr = PetscMalloc((nevs+1)*sizeof(Vec),&evecs);CHKERRQ(ierr); for (i=0; i<nevs; i++) { ierr = VecCreate(PETSC_COMM_SELF,&evecs[i]);CHKERRQ(ierr); ierr = VecSetSizes(evecs[i],PETSC_DECIDE,n);CHKERRQ(ierr); ierr = VecSetFromOptions(evecs[i]);CHKERRQ(ierr); ierr = VecPlaceArray(evecs[i],evecs_array+i*n);CHKERRQ(ierr); } tols[0] = 1.e-8; tols[1] = 1.e-8; ierr = CkEigenSolutions(cklvl,A,il-1,iu-1,evals,evecs,tols);CHKERRQ(ierr); for (i=0; i<nevs; i++) { ierr = VecDestroy(&evecs[i]);CHKERRQ(ierr);} ierr = PetscFree(evecs);CHKERRQ(ierr); /* Free work space. */ if (TestZHEEVX || TestZHEGVX) { ierr = PetscFree(evecs_array);CHKERRQ(ierr); } ierr = PetscFree(evals);CHKERRQ(ierr); ierr = PetscFree(work);CHKERRQ(ierr); ierr = MatDestroy(&A_dense);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&B);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
int main(int argc,char **args) { PetscErrorCode ierr; #if defined(PETSC_USE_COMPLEX) || defined(PETSC_MISSING_LAPACK_DSTEBZ) || defined(PETSC_MISSING_LAPACK_STEIN) ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr; SETERRQ(PETSC_COMM_WORLD,1,"This example requires LAPACK routines dstebz and stien and real numbers"); #else PetscReal *work,tols[2]; PetscInt i,j; PetscBLASInt n,il=1,iu=5,*iblock,*isplit,*iwork,nevs,*ifail,cklvl=2; PetscMPIInt size; PetscBool flg; Vec *evecs; PetscScalar *evecs_array,*D,*E,*evals; Mat T; PetscReal vl=0.0,vu=4.0,tol= 1000*PETSC_MACHINE_EPSILON; PetscBLASInt nsplit,info; ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr; ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size != 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"This is a uniprocessor example only!"); n = 100; nevs = iu - il; ierr = PetscMalloc1(3*n+1,&D);CHKERRQ(ierr); E = D + n; evals = E + n; ierr = PetscMalloc1(5*n+1,&work);CHKERRQ(ierr); ierr = PetscMalloc1(3*n+1,&iwork);CHKERRQ(ierr); ierr = PetscMalloc1(3*n+1,&iblock);CHKERRQ(ierr); isplit = iblock + n; /* Set symmetric tridiagonal matrix */ for (i=0; i<n; i++) { D[i] = 2.0; E[i] = 1.0; } /* Solve eigenvalue problem: A*evec = eval*evec */ ierr = PetscPrintf(PETSC_COMM_SELF," LAPACKstebz_: compute %d eigenvalues...\n",nevs);CHKERRQ(ierr); LAPACKstebz_("I","E",&n,&vl,&vu,&il,&iu,&tol,(PetscReal*)D,(PetscReal*)E,&nevs,&nsplit,(PetscReal*)evals,iblock,isplit,work,iwork,&info); if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"LAPACKstebz_ fails. info %d",info); ierr = PetscPrintf(PETSC_COMM_SELF," LAPACKstein_: compute %d found eigenvectors...\n",nevs);CHKERRQ(ierr); ierr = PetscMalloc1(n*nevs,&evecs_array);CHKERRQ(ierr); ierr = PetscMalloc1(nevs,&ifail);CHKERRQ(ierr); LAPACKstein_(&n,(PetscReal*)D,(PetscReal*)E,&nevs,(PetscReal*)evals,iblock,isplit,evecs_array,&n,work,iwork,ifail,&info); if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"LAPACKstein_ fails. info %d",info); /* View evals */ ierr = PetscOptionsHasName(NULL,NULL, "-eig_view", &flg);CHKERRQ(ierr); if (flg) { ierr = PetscPrintf(PETSC_COMM_SELF," %d evals: \n",nevs);CHKERRQ(ierr); for (i=0; i<nevs; i++) {ierr = PetscPrintf(PETSC_COMM_SELF,"%D %g\n",i,(double)evals[i]);CHKERRQ(ierr);} } /* Check residuals and orthogonality */ ierr = MatCreate(PETSC_COMM_SELF,&T);CHKERRQ(ierr); ierr = MatSetSizes(T,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr); ierr = MatSetType(T,MATSBAIJ);CHKERRQ(ierr); ierr = MatSetFromOptions(T);CHKERRQ(ierr); ierr = MatSetUp(T);CHKERRQ(ierr); for (i=0; i<n; i++) { ierr = MatSetValues(T,1,&i,1,&i,&D[i],INSERT_VALUES);CHKERRQ(ierr); if (i != n-1) { j = i+1; ierr = MatSetValues(T,1,&i,1,&j,&E[i],INSERT_VALUES);CHKERRQ(ierr); } } ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscMalloc1(nevs+1,&evecs);CHKERRQ(ierr); for (i=0; i<nevs; i++) { ierr = VecCreate(PETSC_COMM_SELF,&evecs[i]);CHKERRQ(ierr); ierr = VecSetSizes(evecs[i],PETSC_DECIDE,n);CHKERRQ(ierr); ierr = VecSetFromOptions(evecs[i]);CHKERRQ(ierr); ierr = VecPlaceArray(evecs[i],evecs_array+i*n);CHKERRQ(ierr); } tols[0] = 1.e-8; tols[1] = 1.e-8; ierr = CkEigenSolutions(cklvl,T,il-1,iu-1,evals,evecs,tols);CHKERRQ(ierr); for (i=0; i<nevs; i++) { ierr = VecResetArray(evecs[i]);CHKERRQ(ierr); } /* free space */ ierr = MatDestroy(&T);CHKERRQ(ierr); for (i=0; i<nevs; i++) { ierr = VecDestroy(&evecs[i]);CHKERRQ(ierr);} ierr = PetscFree(evecs);CHKERRQ(ierr); ierr = PetscFree(D);CHKERRQ(ierr); ierr = PetscFree(work);CHKERRQ(ierr); ierr = PetscFree(iwork);CHKERRQ(ierr); ierr = PetscFree(iblock);CHKERRQ(ierr); ierr = PetscFree(evecs_array);CHKERRQ(ierr); ierr = PetscFree(ifail);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; #endif }