PetscErrorCode MatGetMultiProcBlock_MPIBAIJ(Mat mat, MPI_Comm subComm, MatReuse scall,Mat *subMat) { PetscErrorCode ierr; Mat_MPIBAIJ *aij = (Mat_MPIBAIJ*)mat->data; Mat_SeqBAIJ *aijB = (Mat_SeqBAIJ*)aij->B->data; PetscMPIInt commRank,subCommSize,subCommRank; PetscMPIInt *commRankMap,subRank,rank,commsize; PetscInt *garrayCMap,col,i,j,*nnz,newRow,newCol,*newbRow,*newbCol,k,k1; PetscInt bs=mat->rmap->bs; PetscScalar *vals,*aijBvals; PetscFunctionBegin; ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&commsize);CHKERRQ(ierr); ierr = MPI_Comm_size(subComm,&subCommSize);CHKERRQ(ierr); /* create subMat object with the relavent layout */ if (scall == MAT_INITIAL_MATRIX) { ierr = MatCreate(subComm,subMat);CHKERRQ(ierr); ierr = MatSetType(*subMat,MATMPIBAIJ);CHKERRQ(ierr); ierr = MatSetSizes(*subMat,mat->rmap->n,mat->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); ierr = MatSetBlockSizes(*subMat,mat->rmap->bs,mat->cmap->bs);CHKERRQ(ierr); /* need to setup rmap and cmap before Preallocation */ ierr = PetscLayoutSetBlockSize((*subMat)->rmap,mat->rmap->bs);CHKERRQ(ierr); ierr = PetscLayoutSetBlockSize((*subMat)->cmap,mat->cmap->bs);CHKERRQ(ierr); ierr = PetscLayoutSetUp((*subMat)->rmap);CHKERRQ(ierr); ierr = PetscLayoutSetUp((*subMat)->cmap);CHKERRQ(ierr); } /* create a map of comm_rank from subComm to comm - should commRankMap and garrayCMap be kept for reused? */ ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&commRank);CHKERRQ(ierr); ierr = MPI_Comm_rank(subComm,&subCommRank);CHKERRQ(ierr); ierr = PetscMalloc1(subCommSize,&commRankMap);CHKERRQ(ierr); ierr = MPI_Allgather(&commRank,1,MPI_INT,commRankMap,1,MPI_INT,subComm);CHKERRQ(ierr); /* Traverse garray and identify blocked column indices [of offdiag mat] that should be discarded. For the ones not discarded, store the newCol+1 value in garrayCMap */ ierr = PetscMalloc1(aij->B->cmap->n/bs,&garrayCMap);CHKERRQ(ierr); ierr = PetscMemzero(garrayCMap,aij->B->cmap->n/bs*sizeof(PetscInt));CHKERRQ(ierr); for (i=0; i<aij->B->cmap->n/bs; i++) { col = aij->garray[i]; /* blocked column index */ for (subRank=0; subRank<subCommSize; subRank++) { rank = commRankMap[subRank]; if ((col >= mat->cmap->range[rank]/bs) && (col < mat->cmap->range[rank+1]/bs)) { garrayCMap[i] = (((*subMat)->cmap->range[subRank]- mat->cmap->range[rank])/bs + col + 1); break; } } } if (scall == MAT_INITIAL_MATRIX) { /* Now compute preallocation for the offdiag mat */ ierr = PetscMalloc1(aij->B->rmap->n/bs,&nnz);CHKERRQ(ierr); ierr = PetscMemzero(nnz,aij->B->rmap->n/bs*sizeof(PetscInt));CHKERRQ(ierr); for (i=0; i<aij->B->rmap->n/bs; i++) { for (j=aijB->i[i]; j<aijB->i[i+1]; j++) { if (garrayCMap[aijB->j[j]]) nnz[i]++; } } ierr = MatMPIBAIJSetPreallocation(*(subMat),bs,0,NULL,0,nnz);CHKERRQ(ierr); /* reuse diag block with the new submat */ ierr = MatDestroy(&((Mat_MPIBAIJ*)((*subMat)->data))->A);CHKERRQ(ierr); ((Mat_MPIBAIJ*)((*subMat)->data))->A = aij->A; ierr = PetscObjectReference((PetscObject)aij->A);CHKERRQ(ierr); } else if (((Mat_MPIBAIJ*)(*subMat)->data)->A != aij->A) { PetscObject obj = (PetscObject)((Mat_MPIBAIJ*)((*subMat)->data))->A; ierr = PetscObjectReference((PetscObject)obj);CHKERRQ(ierr); ((Mat_MPIBAIJ*)((*subMat)->data))->A = aij->A; ierr = PetscObjectReference((PetscObject)aij->A);CHKERRQ(ierr); } /* Now traverse aij->B and insert values into subMat */ ierr = PetscMalloc3(bs,&newbRow,bs,&newbCol,bs*bs,&vals);CHKERRQ(ierr); for (i=0; i<aij->B->rmap->n/bs; i++) { newRow = (*subMat)->rmap->range[subCommRank] + i*bs; for (j=aijB->i[i]; j<aijB->i[i+1]; j++) { newCol = garrayCMap[aijB->j[j]]; if (newCol) { newCol--; /* remove the increment */ newCol *= bs; for (k=0; k<bs; k++) { newbRow[k] = newRow + k; newbCol[k] = newCol + k; } /* copy column-oriented aijB->a into row-oriented vals */ aijBvals = aijB->a + j*bs*bs; for (k1=0; k1<bs; k1++) { for (k=0; k<bs; k++) { vals[k1+k*bs] = *aijBvals++; } } ierr = MatSetValues(*subMat,bs,newbRow,bs,newbCol,vals,INSERT_VALUES);CHKERRQ(ierr); } } } ierr = MatAssemblyBegin(*subMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(*subMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* deallocate temporary data */ ierr = PetscFree3(newbRow,newbCol,vals);CHKERRQ(ierr); ierr = PetscFree(commRankMap);CHKERRQ(ierr); ierr = PetscFree(garrayCMap);CHKERRQ(ierr); if (scall == MAT_INITIAL_MATRIX) { ierr = PetscFree(nnz);CHKERRQ(ierr); } PetscFunctionReturn(0); }
int main(int argc,char **args) { Mat A,C,Bdense,Cdense; PetscErrorCode ierr; PetscViewer fd; /* viewer */ char file[PETSC_MAX_PATH_LEN]; /* input file name */ PetscBool flg,viewmats=PETSC_FALSE; PetscMPIInt rank,size; PetscReal fill=1.0; PetscInt m,n,i,j,BN=10,rstart,rend,*rows,*cols; PetscScalar *Barray,*Carray,rval,*array; Vec x,y; PetscRandom rand; PetscInitialize(&argc,&args,(char*)0,help); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); /* Determine file from which we read the matrix A */ ierr = PetscOptionsGetString(NULL,"-f",file,PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PETSC_COMM_WORLD,1,"Must indicate binary file with the -f option"); /* Load matrix A */ ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file,FILE_MODE_READ,&fd);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatLoad(A,fd);CHKERRQ(ierr); ierr = PetscViewerDestroy(&fd);CHKERRQ(ierr); /* Print (for testing only) */ ierr = PetscOptionsHasName(NULL, "-view_mats", &viewmats);CHKERRQ(ierr); if (viewmats) { if (!rank) printf("A_aij:\n"); ierr = MatView(A,0);CHKERRQ(ierr); } /* Test MatTransposeMatMult_aij_aij() */ ierr = MatTransposeMatMult(A,A,MAT_INITIAL_MATRIX,fill,&C);CHKERRQ(ierr); if (viewmats) { if (!rank) printf("\nC = A_aij^T * A_aij:\n"); ierr = MatView(C,0);CHKERRQ(ierr); } ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr); /* create a dense matrix Bdense */ ierr = MatCreate(PETSC_COMM_WORLD,&Bdense);CHKERRQ(ierr); ierr = MatSetSizes(Bdense,m,PETSC_DECIDE,PETSC_DECIDE,BN);CHKERRQ(ierr); ierr = MatSetType(Bdense,MATDENSE);CHKERRQ(ierr); ierr = MatSetFromOptions(Bdense);CHKERRQ(ierr); ierr = MatSetUp(Bdense);CHKERRQ(ierr); ierr = MatGetOwnershipRange(Bdense,&rstart,&rend);CHKERRQ(ierr); //printf("[%d] rstart/end %d %d; local size %d %d\n",rank,rstart,rend,m,n); ierr = PetscMalloc3(m,PetscInt,&rows,BN,PetscInt,&cols,m*BN,PetscScalar,&array);CHKERRQ(ierr); for (i=0; i<m; i++) rows[i] = rstart + i; ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rand);CHKERRQ(ierr); ierr = PetscRandomSetFromOptions(rand);CHKERRQ(ierr); for (j=0; j<BN; j++) { cols[j] = j; for (i=0; i<m; i++) { ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr); array[m*j+i] = rval; } } ierr = MatSetValues(Bdense,m,rows,BN,cols,array,INSERT_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(Bdense,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(Bdense,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscRandomDestroy(&rand);CHKERRQ(ierr); ierr = PetscFree3(rows,cols,array);CHKERRQ(ierr); if (viewmats) { if (!rank) printf("\nBdense:\n"); ierr = MatView(Bdense,0);CHKERRQ(ierr); } /* Test MatTransposeMatMult_aij_dense() */ ierr = MatTransposeMatMult(A,Bdense,MAT_INITIAL_MATRIX,fill,&C);CHKERRQ(ierr); ierr = MatTransposeMatMult(A,Bdense,MAT_REUSE_MATRIX,fill,&C);CHKERRQ(ierr); if (viewmats) { if (!rank) printf("\nC=A^T*Bdense:\n"); ierr = MatView(C,0);CHKERRQ(ierr); } /* Check accuracy */ ierr = MatCreate(PETSC_COMM_WORLD,&Cdense);CHKERRQ(ierr); ierr = MatSetSizes(Cdense,n,PETSC_DECIDE,PETSC_DECIDE,BN);CHKERRQ(ierr); ierr = MatSetType(Cdense,MATDENSE);CHKERRQ(ierr); ierr = MatSetFromOptions(Cdense);CHKERRQ(ierr); ierr = MatSetUp(Cdense);CHKERRQ(ierr); ierr = MatAssemblyBegin(Cdense,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(Cdense,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size == 1) { ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,m,NULL,&x);CHKERRQ(ierr); ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,n,NULL,&y);CHKERRQ(ierr); } else { ierr = VecCreateMPIWithArray(PETSC_COMM_WORLD,1,m,PETSC_DECIDE,NULL,&x);CHKERRQ(ierr); ierr = VecCreateMPIWithArray(PETSC_COMM_WORLD,1,n,PETSC_DECIDE,NULL,&y);CHKERRQ(ierr); } /* Cdense[:,j] = A^T * Bdense[:,j] */ ierr = MatDenseGetArray(Bdense,&Barray);CHKERRQ(ierr); ierr = MatDenseGetArray(Cdense,&Carray);CHKERRQ(ierr); for (j=0; j<BN; j++) { ierr = VecPlaceArray(x,Barray);CHKERRQ(ierr); ierr = VecPlaceArray(y,Carray);CHKERRQ(ierr); ierr = MatMultTranspose(A,x,y);CHKERRQ(ierr); ierr = VecResetArray(x);CHKERRQ(ierr); ierr = VecResetArray(y);CHKERRQ(ierr); Barray += m; Carray += n; } ierr = MatDenseRestoreArray(Bdense,&Barray);CHKERRQ(ierr); ierr = MatDenseRestoreArray(Cdense,&Carray);CHKERRQ(ierr); if (viewmats) { if (!rank) printf("\nCdense:\n"); ierr = MatView(Cdense,0);CHKERRQ(ierr); } ierr = MatEqual(C,Cdense,&flg);CHKERRQ(ierr); if (!flg) { if (!rank) printf(" C != Cdense\n"); } /* Free data structures */ ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = MatDestroy(&Bdense);CHKERRQ(ierr); ierr = MatDestroy(&Cdense);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&y);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
int main(int argc,char **argv) { Mat A,A11,A12,A21,A22; Vec X,X1,X2,Y,Z,Z1,Z2; PetscScalar *a,*b,*x,*y,*z,v,one=1; PetscReal nrm; PetscErrorCode ierr; PetscInt size=8,size1=6,size2=2, i,j; PetscInitialize(&argc,&argv,0,0); /* * Create matrix and three vectors: these are all normal */ ierr = PetscMalloc(size*size*sizeof(PetscScalar),&a);CHKERRQ(ierr); ierr = PetscMalloc(size*size*sizeof(PetscScalar),&b);CHKERRQ(ierr); for (i=0; i<size; i++) { for (j=0; j<size; j++) { a[i+j*size] = rand(); b[i+j*size] = a[i+j*size]; } } ierr = MatCreate(MPI_COMM_SELF,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,size,size,size,size);CHKERRQ(ierr); ierr = MatSetType(A,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSeqDenseSetPreallocation(A,a);CHKERRQ(ierr); ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscMalloc(size*sizeof(PetscScalar),&x);CHKERRQ(ierr); for (i=0; i<size; i++) { x[i] = one; } ierr = VecCreateSeqWithArray(MPI_COMM_SELF,size,x,&X);CHKERRQ(ierr); ierr = VecAssemblyBegin(X);CHKERRQ(ierr); ierr = VecAssemblyEnd(X);CHKERRQ(ierr); ierr = PetscMalloc(size*sizeof(PetscScalar),&y);CHKERRQ(ierr); ierr = VecCreateSeqWithArray(MPI_COMM_SELF,size,y,&Y);CHKERRQ(ierr); ierr = VecAssemblyBegin(Y);CHKERRQ(ierr); ierr = VecAssemblyEnd(Y);CHKERRQ(ierr); ierr = PetscMalloc(size*sizeof(PetscScalar),&z);CHKERRQ(ierr); ierr = VecCreateSeqWithArray(MPI_COMM_SELF,size,z,&Z);CHKERRQ(ierr); ierr = VecAssemblyBegin(Z);CHKERRQ(ierr); ierr = VecAssemblyEnd(Z);CHKERRQ(ierr); /* * Now create submatrices and subvectors */ ierr = MatCreate(MPI_COMM_SELF,&A11);CHKERRQ(ierr); ierr = MatSetSizes(A11,size1,size1,size1,size1);CHKERRQ(ierr); ierr = MatSetType(A11,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSeqDenseSetPreallocation(A11,b);CHKERRQ(ierr); ierr = MatSeqDenseSetLDA(A11,size);CHKERRQ(ierr); ierr = MatAssemblyBegin(A11,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A11,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatCreate(MPI_COMM_SELF,&A12);CHKERRQ(ierr); ierr = MatSetSizes(A12,size1,size2,size1,size2);CHKERRQ(ierr); ierr = MatSetType(A12,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSeqDenseSetPreallocation(A12,b+size1*size);CHKERRQ(ierr); ierr = MatSeqDenseSetLDA(A12,size);CHKERRQ(ierr); ierr = MatAssemblyBegin(A12,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A12,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatCreate(MPI_COMM_SELF,&A21);CHKERRQ(ierr); ierr = MatSetSizes(A21,size2,size1,size2,size1);CHKERRQ(ierr); ierr = MatSetType(A21,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSeqDenseSetPreallocation(A21,b+size1);CHKERRQ(ierr); ierr = MatSeqDenseSetLDA(A21,size);CHKERRQ(ierr); ierr = MatAssemblyBegin(A21,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A21,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatCreate(MPI_COMM_SELF,&A22);CHKERRQ(ierr); ierr = MatSetSizes(A22,size2,size2,size2,size2);CHKERRQ(ierr); ierr = MatSetType(A22,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSeqDenseSetPreallocation(A22,b+size1*size+size1);CHKERRQ(ierr); ierr = MatSeqDenseSetLDA(A22,size);CHKERRQ(ierr); ierr = MatAssemblyBegin(A22,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A22,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = VecCreateSeqWithArray(MPI_COMM_SELF,size1,x,&X1);CHKERRQ(ierr); ierr = VecCreateSeqWithArray(MPI_COMM_SELF,size2,x+size1,&X2);CHKERRQ(ierr); ierr = VecCreateSeqWithArray(MPI_COMM_SELF,size1,z,&Z1);CHKERRQ(ierr); ierr = VecCreateSeqWithArray(MPI_COMM_SELF,size2,z+size1,&Z2);CHKERRQ(ierr); /* * Now multiple matrix times input in two ways; * compare the results */ ierr = MatMult(A,X,Y);CHKERRQ(ierr); ierr = MatMult(A11,X1,Z1);CHKERRQ(ierr); ierr = MatMultAdd(A12,X2,Z1,Z1);CHKERRQ(ierr); ierr = MatMult(A22,X2,Z2);CHKERRQ(ierr); ierr = MatMultAdd(A21,X1,Z2,Z2);CHKERRQ(ierr); ierr = VecAXPY(Z,-1.0,Y);CHKERRQ(ierr); ierr = VecNorm(Z,NORM_2,&nrm); printf("Test1; error norm=%e\n",nrm); /* printf("MatMult the usual way:\n"); VecView(Y,0); printf("MatMult by subblock:\n"); VecView(Z,0); */ /* * Next test: change both matrices */ v = rand(); i=1; j=size-2; ierr = MatSetValues(A,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr); j -= size1; ierr = MatSetValues(A12,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr); v = rand(); i=j=size1+1; ierr = MatSetValues(A,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr); i=j=1; ierr = MatSetValues(A22,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyBegin(A12,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A12,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyBegin(A22,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A22,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatMult(A,X,Y);CHKERRQ(ierr); ierr = MatMult(A11,X1,Z1);CHKERRQ(ierr); ierr = MatMultAdd(A12,X2,Z1,Z1);CHKERRQ(ierr); ierr = MatMult(A22,X2,Z2);CHKERRQ(ierr); ierr = MatMultAdd(A21,X1,Z2,Z2);CHKERRQ(ierr); ierr = VecAXPY(Z,-1.0,Y);CHKERRQ(ierr); ierr = VecNorm(Z,NORM_2,&nrm); printf("Test2; error norm=%e\n",nrm); /* * Transpose product */ ierr = MatMultTranspose(A,X,Y);CHKERRQ(ierr); ierr = MatMultTranspose(A11,X1,Z1);CHKERRQ(ierr); ierr = MatMultTransposeAdd(A21,X2,Z1,Z1);CHKERRQ(ierr); ierr = MatMultTranspose(A22,X2,Z2);CHKERRQ(ierr); ierr = MatMultTransposeAdd(A12,X1,Z2,Z2);CHKERRQ(ierr); ierr = VecAXPY(Z,-1.0,Y);CHKERRQ(ierr); ierr = VecNorm(Z,NORM_2,&nrm); printf("Test3; error norm=%e\n",nrm); ierr = PetscFree(a);CHKERRQ(ierr); ierr = PetscFree(b);CHKERRQ(ierr); ierr = PetscFree(x);CHKERRQ(ierr); ierr = PetscFree(y);CHKERRQ(ierr); ierr = PetscFree(z);CHKERRQ(ierr); ierr = MatDestroy(A);CHKERRQ(ierr); ierr = MatDestroy(A11);CHKERRQ(ierr); ierr = MatDestroy(A12);CHKERRQ(ierr); ierr = MatDestroy(A21);CHKERRQ(ierr); ierr = MatDestroy(A22);CHKERRQ(ierr); ierr = VecDestroy(X);CHKERRQ(ierr); ierr = VecDestroy(Y);CHKERRQ(ierr); ierr = VecDestroy(Z);CHKERRQ(ierr); ierr = VecDestroy(X1);CHKERRQ(ierr); ierr = VecDestroy(X2);CHKERRQ(ierr); ierr = VecDestroy(Z1);CHKERRQ(ierr); ierr = VecDestroy(Z2);CHKERRQ(ierr); /*ierr = PetscLogPrintSummary(MPI_COMM_SELF,"ex2.log");CHKERRQ(ierr);*/ ierr = PetscFinalize();CHKERRQ(ierr); return 0; }
PetscErrorCode ResidualJacobian(SNES snes,Vec X,Mat J,Mat B,void *ctx) { PetscErrorCode ierr; Userctx *user=(Userctx*)ctx; Vec Xgen,Xnet; PetscScalar *xgen,*xnet; PetscInt i,idx=0; PetscScalar Vr,Vi,Vm,Vm2; PetscScalar Eqp,Edp,delta; /* Generator variables */ PetscScalar Efd; PetscScalar Id,Iq; /* Generator dq axis currents */ PetscScalar Vd,Vq; PetscScalar val[10]; PetscInt row[2],col[10]; PetscInt net_start=user->neqs_gen; PetscFunctionBegin; ierr = MatZeroEntries(B);CHKERRQ(ierr); ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr); ierr = DMCompositeScatter(user->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr); ierr = VecGetArray(Xgen,&xgen);CHKERRQ(ierr); ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr); /* Generator subsystem */ for (i=0; i < ngen; i++) { Eqp = xgen[idx]; Edp = xgen[idx+1]; delta = xgen[idx+2]; Id = xgen[idx+4]; Iq = xgen[idx+5]; Efd = xgen[idx+6]; /* fgen[idx] = (Eqp + (Xd[i] - Xdp[i])*Id - Efd)/Td0p[i]; */ row[0] = idx; col[0] = idx; col[1] = idx+4; col[2] = idx+6; val[0] = 1/ Td0p[i]; val[1] = (Xd[i] - Xdp[i])/ Td0p[i]; val[2] = -1/Td0p[i]; ierr = MatSetValues(J,1,row,3,col,val,INSERT_VALUES);CHKERRQ(ierr); /* fgen[idx+1] = (Edp - (Xq[i] - Xqp[i])*Iq)/Tq0p[i]; */ row[0] = idx + 1; col[0] = idx + 1; col[1] = idx+5; val[0] = 1/Tq0p[i]; val[1] = -(Xq[i] - Xqp[i])/Tq0p[i]; ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr); /* fgen[idx+2] = - w + w_s; */ row[0] = idx + 2; col[0] = idx + 2; col[1] = idx + 3; val[0] = 0; val[1] = -1; ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr); /* fgen[idx+3] = (-TM[i] + Edp*Id + Eqp*Iq + (Xqp[i] - Xdp[i])*Id*Iq + D[i]*(w - w_s))/M[i]; */ row[0] = idx + 3; col[0] = idx; col[1] = idx + 1; col[2] = idx + 3; col[3] = idx + 4; col[4] = idx + 5; val[0] = Iq/M[i]; val[1] = Id/M[i]; val[2] = D[i]/M[i]; val[3] = (Edp + (Xqp[i]-Xdp[i])*Iq)/M[i]; val[4] = (Eqp + (Xqp[i] - Xdp[i])*Id)/M[i]; ierr = MatSetValues(J,1,row,5,col,val,INSERT_VALUES);CHKERRQ(ierr); Vr = xnet[2*gbus[i]]; /* Real part of generator terminal voltage */ Vi = xnet[2*gbus[i]+1]; /* Imaginary part of the generator terminal voltage */ ierr = ri2dq(Vr,Vi,delta,&Vd,&Vq);CHKERRQ(ierr); PetscScalar Zdq_inv[4],det; det = Rs[i]*Rs[i] + Xdp[i]*Xqp[i]; Zdq_inv[0] = Rs[i]/det; Zdq_inv[1] = Xqp[i]/det; Zdq_inv[2] = -Xdp[i]/det; Zdq_inv[3] = Rs[i]/det; PetscScalar dVd_dVr,dVd_dVi,dVq_dVr,dVq_dVi,dVd_ddelta,dVq_ddelta; dVd_dVr = PetscSinScalar(delta); dVd_dVi = -PetscCosScalar(delta); dVq_dVr = PetscCosScalar(delta); dVq_dVi = PetscSinScalar(delta); dVd_ddelta = Vr*PetscCosScalar(delta) + Vi*PetscSinScalar(delta); dVq_ddelta = -Vr*PetscSinScalar(delta) + Vi*PetscCosScalar(delta); /* fgen[idx+4] = Zdq_inv[0]*(-Edp + Vd) + Zdq_inv[1]*(-Eqp + Vq) + Id; */ row[0] = idx+4; col[0] = idx; col[1] = idx+1; col[2] = idx + 2; val[0] = -Zdq_inv[1]; val[1] = -Zdq_inv[0]; val[2] = Zdq_inv[0]*dVd_ddelta + Zdq_inv[1]*dVq_ddelta; col[3] = idx + 4; col[4] = net_start+2*gbus[i]; col[5] = net_start + 2*gbus[i]+1; val[3] = 1; val[4] = Zdq_inv[0]*dVd_dVr + Zdq_inv[1]*dVq_dVr; val[5] = Zdq_inv[0]*dVd_dVi + Zdq_inv[1]*dVq_dVi; ierr = MatSetValues(J,1,row,6,col,val,INSERT_VALUES);CHKERRQ(ierr); /* fgen[idx+5] = Zdq_inv[2]*(-Edp + Vd) + Zdq_inv[3]*(-Eqp + Vq) + Iq; */ row[0] = idx+5; col[0] = idx; col[1] = idx+1; col[2] = idx + 2; val[0] = -Zdq_inv[3]; val[1] = -Zdq_inv[2]; val[2] = Zdq_inv[2]*dVd_ddelta + Zdq_inv[3]*dVq_ddelta; col[3] = idx + 5; col[4] = net_start+2*gbus[i]; col[5] = net_start + 2*gbus[i]+1; val[3] = 1; val[4] = Zdq_inv[2]*dVd_dVr + Zdq_inv[3]*dVq_dVr; val[5] = Zdq_inv[2]*dVd_dVi + Zdq_inv[3]*dVq_dVi; ierr = MatSetValues(J,1,row,6,col,val,INSERT_VALUES);CHKERRQ(ierr); PetscScalar dIGr_ddelta,dIGi_ddelta,dIGr_dId,dIGr_dIq,dIGi_dId,dIGi_dIq; dIGr_ddelta = Id*PetscCosScalar(delta) - Iq*PetscSinScalar(delta); dIGi_ddelta = Id*PetscSinScalar(delta) + Iq*PetscCosScalar(delta); dIGr_dId = PetscSinScalar(delta); dIGr_dIq = PetscCosScalar(delta); dIGi_dId = -PetscCosScalar(delta); dIGi_dIq = PetscSinScalar(delta); /* fnet[2*gbus[i]] -= IGi; */ row[0] = net_start + 2*gbus[i]; col[0] = idx+2; col[1] = idx + 4; col[2] = idx + 5; val[0] = -dIGi_ddelta; val[1] = -dIGi_dId; val[2] = -dIGi_dIq; ierr = MatSetValues(J,1,row,3,col,val,INSERT_VALUES);CHKERRQ(ierr); /* fnet[2*gbus[i]+1] -= IGr; */ row[0] = net_start + 2*gbus[i]+1; col[0] = idx+2; col[1] = idx + 4; col[2] = idx + 5; val[0] = -dIGr_ddelta; val[1] = -dIGr_dId; val[2] = -dIGr_dIq; ierr = MatSetValues(J,1,row,3,col,val,INSERT_VALUES);CHKERRQ(ierr); Vm = PetscSqrtScalar(Vd*Vd + Vq*Vq); Vm2 = Vm*Vm; /* fgen[idx+6] = (KE[i]*Efd + SE - VR)/TE[i]; */ /* SE = k1[i]*PetscExpScalar(k2[i]*Efd); */ PetscScalar dSE_dEfd; dSE_dEfd = k1[i]*k2[i]*PetscExpScalar(k2[i]*Efd); row[0] = idx + 6; col[0] = idx + 6; col[1] = idx + 8; val[0] = (KE[i] + dSE_dEfd)/TE[i]; val[1] = -1/TE[i]; ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr); /* Exciter differential equations */ /* fgen[idx+7] = (RF - KF[i]*Efd/TF[i])/TF[i]; */ row[0] = idx + 7; col[0] = idx + 6; col[1] = idx + 7; val[0] = (-KF[i]/TF[i])/TF[i]; val[1] = 1/TF[i]; ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr); /* fgen[idx+8] = (VR - KA[i]*RF + KA[i]*KF[i]*Efd/TF[i] - KA[i]*(Vref[i] - Vm))/TA[i]; */ /* Vm = (Vd^2 + Vq^2)^0.5; */ PetscScalar dVm_dVd,dVm_dVq,dVm_dVr,dVm_dVi; dVm_dVd = Vd/Vm; dVm_dVq = Vq/Vm; dVm_dVr = dVm_dVd*dVd_dVr + dVm_dVq*dVq_dVr; dVm_dVi = dVm_dVd*dVd_dVi + dVm_dVq*dVq_dVi; row[0] = idx + 8; col[0] = idx + 6; col[1] = idx + 7; col[2] = idx + 8; val[0] = (KA[i]*KF[i]/TF[i])/TA[i]; val[1] = -KA[i]/TA[i]; val[2] = 1/TA[i]; col[3] = net_start + 2*gbus[i]; col[4] = net_start + 2*gbus[i]+1; val[3] = KA[i]*dVm_dVr/TA[i]; val[4] = KA[i]*dVm_dVi/TA[i]; ierr = MatSetValues(J,1,row,5,col,val,INSERT_VALUES);CHKERRQ(ierr); idx = idx + 9; } PetscInt ncols; const PetscInt *cols; const PetscScalar *yvals; PetscInt k; for (i=0; i<nbus; i++) { ierr = MatGetRow(user->Ybus,2*i,&ncols,&cols,&yvals);CHKERRQ(ierr); row[0] = net_start + 2*i; for (k=0; k<ncols; k++) { col[k] = net_start + cols[k]; val[k] = yvals[k]; } ierr = MatSetValues(J,1,row,ncols,col,val,INSERT_VALUES);CHKERRQ(ierr); ierr = MatRestoreRow(user->Ybus,2*i,&ncols,&cols,&yvals);CHKERRQ(ierr); ierr = MatGetRow(user->Ybus,2*i+1,&ncols,&cols,&yvals);CHKERRQ(ierr); row[0] = net_start + 2*i+1; for (k=0; k<ncols; k++) { col[k] = net_start + cols[k]; val[k] = yvals[k]; } ierr = MatSetValues(J,1,row,ncols,col,val,INSERT_VALUES);CHKERRQ(ierr); ierr = MatRestoreRow(user->Ybus,2*i+1,&ncols,&cols,&yvals);CHKERRQ(ierr); } ierr = MatAssemblyBegin(J,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(J,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr); PetscScalar PD,QD,Vm0,*v0,Vm4; PetscScalar dPD_dVr,dPD_dVi,dQD_dVr,dQD_dVi; PetscScalar dIDr_dVr,dIDr_dVi,dIDi_dVr,dIDi_dVi; ierr = VecGetArray(user->V0,&v0);CHKERRQ(ierr); for (i=0; i < nload; i++) { Vr = xnet[2*lbus[i]]; /* Real part of load bus voltage */ Vi = xnet[2*lbus[i]+1]; /* Imaginary part of the load bus voltage */ Vm = PetscSqrtScalar(Vr*Vr + Vi*Vi); Vm2 = Vm*Vm; Vm4 = Vm2*Vm2; Vm0 = PetscSqrtScalar(v0[2*lbus[i]]*v0[2*lbus[i]] + v0[2*lbus[i]+1]*v0[2*lbus[i]+1]); PD = QD = 0.0; dPD_dVr = dPD_dVi = dQD_dVr = dQD_dVi = 0.0; for (k=0; k < ld_nsegsp[i]; k++) { PD += ld_alphap[k]*PD0[i]*PetscPowScalar((Vm/Vm0),ld_betap[k]); dPD_dVr += ld_alphap[k]*ld_betap[k]*PD0[i]*PetscPowScalar((1/Vm0),ld_betap[k])*Vr*PetscPowScalar(Vm,(ld_betap[k]-2)); dPD_dVi += ld_alphap[k]*ld_betap[k]*PD0[i]*PetscPowScalar((1/Vm0),ld_betap[k])*Vi*PetscPowScalar(Vm,(ld_betap[k]-2)); } for (k=0; k < ld_nsegsq[i]; k++) { QD += ld_alphaq[k]*QD0[i]*PetscPowScalar((Vm/Vm0),ld_betaq[k]); dQD_dVr += ld_alphaq[k]*ld_betaq[k]*QD0[i]*PetscPowScalar((1/Vm0),ld_betaq[k])*Vr*PetscPowScalar(Vm,(ld_betaq[k]-2)); dQD_dVi += ld_alphaq[k]*ld_betaq[k]*QD0[i]*PetscPowScalar((1/Vm0),ld_betaq[k])*Vi*PetscPowScalar(Vm,(ld_betaq[k]-2)); } /* IDr = (PD*Vr + QD*Vi)/Vm2; */ /* IDi = (-QD*Vr + PD*Vi)/Vm2; */ dIDr_dVr = (dPD_dVr*Vr + dQD_dVr*Vi + PD)/Vm2 - ((PD*Vr + QD*Vi)*2*Vr)/Vm4; dIDr_dVi = (dPD_dVi*Vr + dQD_dVi*Vi + QD)/Vm2 - ((PD*Vr + QD*Vi)*2*Vi)/Vm4; dIDi_dVr = (-dQD_dVr*Vr + dPD_dVr*Vi - QD)/Vm2 - ((-QD*Vr + PD*Vi)*2*Vr)/Vm4; dIDi_dVi = (-dQD_dVi*Vr + dPD_dVi*Vi + PD)/Vm2 - ((-QD*Vr + PD*Vi)*2*Vi)/Vm4; /* fnet[2*lbus[i]] += IDi; */ row[0] = net_start + 2*lbus[i]; col[0] = net_start + 2*lbus[i]; col[1] = net_start + 2*lbus[i]+1; val[0] = dIDi_dVr; val[1] = dIDi_dVi; ierr = MatSetValues(J,1,row,2,col,val,ADD_VALUES);CHKERRQ(ierr); /* fnet[2*lbus[i]+1] += IDr; */ row[0] = net_start + 2*lbus[i]+1; col[0] = net_start + 2*lbus[i]; col[1] = net_start + 2*lbus[i]+1; val[0] = dIDr_dVr; val[1] = dIDr_dVi; ierr = MatSetValues(J,1,row,2,col,val,ADD_VALUES);CHKERRQ(ierr); } ierr = VecRestoreArray(user->V0,&v0);CHKERRQ(ierr); ierr = VecRestoreArray(Xgen,&xgen);CHKERRQ(ierr); ierr = VecRestoreArray(Xnet,&xnet);CHKERRQ(ierr); ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr); ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode DMPlexPreallocateOperator(DM dm, PetscInt bs, PetscSection section, PetscSection sectionGlobal, PetscInt dnz[], PetscInt onz[], PetscInt dnzu[], PetscInt onzu[], Mat A, PetscBool fillMatrix) { MPI_Comm comm; MatType mtype; PetscSF sf, sfDof, sfAdj; PetscSection leafSectionAdj, rootSectionAdj, sectionAdj, anchorSectionAdj; PetscInt nroots, nleaves, l, p; const PetscInt *leaves; const PetscSFNode *remotes; PetscInt dim, pStart, pEnd, numDof, globalOffStart, globalOffEnd, numCols; PetscInt *tmpAdj = NULL, *adj, *rootAdj, *anchorAdj = NULL, *cols, *remoteOffsets; PetscInt adjSize; PetscLayout rLayout; PetscInt locRows, rStart, rEnd, r; PetscMPIInt size; PetscBool doCommLocal, doComm, debug = PETSC_FALSE, isSymBlock, isSymSeqBlock, isSymMPIBlock; PetscBool useAnchors; PetscErrorCode ierr; PetscFunctionBegin; PetscValidHeaderSpecific(dm, DM_CLASSID, 1); PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 3); PetscValidHeaderSpecific(sectionGlobal, PETSC_SECTION_CLASSID, 4); PetscValidHeaderSpecific(A, MAT_CLASSID, 9); if (dnz) PetscValidPointer(dnz,5); if (onz) PetscValidPointer(onz,6); if (dnzu) PetscValidPointer(dnzu,7); if (onzu) PetscValidPointer(onzu,8); ierr = PetscLogEventBegin(DMPLEX_Preallocate,dm,0,0,0);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL, "-dm_view_preallocation", &debug, NULL);CHKERRQ(ierr); ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr); ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr); ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr); doCommLocal = (size > 1) && (nroots >= 0) ? PETSC_TRUE : PETSC_FALSE; ierr = MPI_Allreduce(&doCommLocal, &doComm, 1, MPIU_BOOL, MPI_LAND, comm);CHKERRQ(ierr); /* Create dof SF based on point SF */ if (debug) { ierr = PetscPrintf(comm, "Input Section for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSectionView(section, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Input Global Section for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSectionView(sectionGlobal, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Input SF for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSFView(sf, NULL);CHKERRQ(ierr); } ierr = PetscSFCreateRemoteOffsets(sf, section, section, &remoteOffsets);CHKERRQ(ierr); ierr = PetscSFCreateSectionSF(sf, section, remoteOffsets, section, &sfDof);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Dof SF for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSFView(sfDof, NULL);CHKERRQ(ierr); } /* Create section for dof adjacency (dof ==> # adj dof) */ ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr); ierr = PetscSectionGetStorageSize(section, &numDof);CHKERRQ(ierr); ierr = PetscSectionCreate(comm, &leafSectionAdj);CHKERRQ(ierr); ierr = PetscSectionSetChart(leafSectionAdj, 0, numDof);CHKERRQ(ierr); ierr = PetscSectionCreate(comm, &rootSectionAdj);CHKERRQ(ierr); ierr = PetscSectionSetChart(rootSectionAdj, 0, numDof);CHKERRQ(ierr); /* Fill in the ghost dofs on the interface */ ierr = PetscSFGetGraph(sf, NULL, &nleaves, &leaves, &remotes);CHKERRQ(ierr); /* use constraints in finding adjacency in this routine */ ierr = DMPlexGetAdjacencyUseAnchors(dm,&useAnchors);CHKERRQ(ierr); ierr = DMPlexSetAdjacencyUseAnchors(dm,PETSC_TRUE);CHKERRQ(ierr); /* section - maps points to (# dofs, local dofs) sectionGlobal - maps points to (# dofs, global dofs) leafSectionAdj - maps unowned local dofs to # adj dofs rootSectionAdj - maps owned local dofs to # adj dofs adj - adj global dofs indexed by leafSectionAdj rootAdj - adj global dofs indexed by rootSectionAdj sf - describes shared points across procs sfDof - describes shared dofs across procs sfAdj - describes shared adjacent dofs across procs ** The bootstrapping process involves six rounds with similar structure of visiting neighbors of each point. (0). If there are point-to-point constraints, add the adjacencies of constrained points to anchors in anchorAdj (This is done in DMPlexComputeAnchorAdjacencies()) 1. Visit unowned points on interface, count adjacencies placing in leafSectionAdj Reduce those counts to rootSectionAdj (now redundantly counting some interface points) 2. Visit owned points on interface, count adjacencies placing in rootSectionAdj Create sfAdj connecting rootSectionAdj and leafSectionAdj 3. Visit unowned points on interface, write adjacencies to adj Gather adj to rootAdj (note that there is redundancy in rootAdj when multiple procs find the same adjacencies) 4. Visit owned points on interface, write adjacencies to rootAdj Remove redundancy in rootAdj ** The last two traversals use transitive closure 5. Visit all owned points in the subdomain, count dofs for each point (sectionAdj) Allocate memory addressed by sectionAdj (cols) 6. Visit all owned points in the subdomain, insert dof adjacencies into cols ** Knowing all the column adjacencies, check ownership and sum into dnz and onz */ ierr = DMPlexComputeAnchorAdjacencies(dm,section,sectionGlobal,&anchorSectionAdj,&anchorAdj);CHKERRQ(ierr); for (l = 0; l < nleaves; ++l) { PetscInt dof, off, d, q, anDof; PetscInt p = leaves[l], numAdj = PETSC_DETERMINE; if ((p < pStart) || (p >= pEnd)) continue; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(leafSectionAdj, d, ndof-ncdof);CHKERRQ(ierr); } } ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); if (anDof) { for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(leafSectionAdj, d, anDof);CHKERRQ(ierr); } } } ierr = PetscSectionSetUp(leafSectionAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjacency Section for Preallocation on Leaves:\n");CHKERRQ(ierr); ierr = PetscSectionView(leafSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Get maximum remote adjacency sizes for owned dofs on interface (roots) */ if (doComm) { ierr = PetscSFReduceBegin(sfDof, MPIU_INT, leafSectionAdj->atlasDof, rootSectionAdj->atlasDof, MPI_SUM);CHKERRQ(ierr); ierr = PetscSFReduceEnd(sfDof, MPIU_INT, leafSectionAdj->atlasDof, rootSectionAdj->atlasDof, MPI_SUM);CHKERRQ(ierr); } if (debug) { ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots:\n");CHKERRQ(ierr); ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Add in local adjacency sizes for owned dofs on interface (roots) */ for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, adof, dof, off, d, q, anDof; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); if (!dof) continue; ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr); if (adof <= 0) continue; ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(rootSectionAdj, d, ndof-ncdof);CHKERRQ(ierr); } } ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); if (anDof) { for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(rootSectionAdj, d, anDof);CHKERRQ(ierr); } } } ierr = PetscSectionSetUp(rootSectionAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots after local additions:\n");CHKERRQ(ierr); ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Create adj SF based on dof SF */ ierr = PetscSFCreateRemoteOffsets(sfDof, rootSectionAdj, leafSectionAdj, &remoteOffsets);CHKERRQ(ierr); ierr = PetscSFCreateSectionSF(sfDof, rootSectionAdj, remoteOffsets, leafSectionAdj, &sfAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjacency SF for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSFView(sfAdj, NULL);CHKERRQ(ierr); } ierr = PetscSFDestroy(&sfDof);CHKERRQ(ierr); /* Create leaf adjacency */ ierr = PetscSectionSetUp(leafSectionAdj);CHKERRQ(ierr); ierr = PetscSectionGetStorageSize(leafSectionAdj, &adjSize);CHKERRQ(ierr); ierr = PetscCalloc1(adjSize, &adj);CHKERRQ(ierr); for (l = 0; l < nleaves; ++l) { PetscInt dof, off, d, q, anDof, anOff; PetscInt p = leaves[l], numAdj = PETSC_DETERMINE; if ((p < pStart) || (p >= pEnd)) continue; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(anchorSectionAdj, p, &anOff);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { PetscInt aoff, i = 0; ierr = PetscSectionGetOffset(leafSectionAdj, d, &aoff);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, ngoff, nd; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr); for (nd = 0; nd < ndof-ncdof; ++nd) { adj[aoff+i] = (ngoff < 0 ? -(ngoff+1) : ngoff) + nd; ++i; } } for (q = 0; q < anDof; q++) { adj[aoff+i] = anchorAdj[anOff+q]; ++i; } } } /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Leaf adjacency indices\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, adj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Gather adjacent indices to root */ ierr = PetscSectionGetStorageSize(rootSectionAdj, &adjSize);CHKERRQ(ierr); ierr = PetscMalloc1(adjSize, &rootAdj);CHKERRQ(ierr); for (r = 0; r < adjSize; ++r) rootAdj[r] = -1; if (doComm) { const PetscInt *indegree; PetscInt *remoteadj, radjsize = 0; ierr = PetscSFComputeDegreeBegin(sfAdj, &indegree);CHKERRQ(ierr); ierr = PetscSFComputeDegreeEnd(sfAdj, &indegree);CHKERRQ(ierr); for (p = 0; p < adjSize; ++p) radjsize += indegree[p]; ierr = PetscMalloc1(radjsize, &remoteadj);CHKERRQ(ierr); ierr = PetscSFGatherBegin(sfAdj, MPIU_INT, adj, remoteadj);CHKERRQ(ierr); ierr = PetscSFGatherEnd(sfAdj, MPIU_INT, adj, remoteadj);CHKERRQ(ierr); for (p = 0, l = 0, r = 0; p < adjSize; ++p, l = PetscMax(p, l + indegree[p-1])) { PetscInt s; for (s = 0; s < indegree[p]; ++s, ++r) rootAdj[l+s] = remoteadj[r]; } if (r != radjsize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Inconsistency in communication %d != %d", r, radjsize); if (l != adjSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Inconsistency in communication %d != %d", l, adjSize); ierr = PetscFree(remoteadj);CHKERRQ(ierr); } ierr = PetscSFDestroy(&sfAdj);CHKERRQ(ierr); ierr = PetscFree(adj);CHKERRQ(ierr); /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Root adjacency indices after gather\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Add in local adjacency indices for owned dofs on interface (roots) */ for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, adof, dof, off, d, q, anDof, anOff; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); if (!dof) continue; ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr); if (adof <= 0) continue; ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(anchorSectionAdj, p, &anOff);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { PetscInt adof, aoff, i; ierr = PetscSectionGetDof(rootSectionAdj, d, &adof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(rootSectionAdj, d, &aoff);CHKERRQ(ierr); i = adof-1; for (q = 0; q < anDof; q++) { rootAdj[aoff+i] = anchorAdj[anOff+q]; --i; } for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, ngoff, nd; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr); for (nd = 0; nd < ndof-ncdof; ++nd) { rootAdj[aoff+i] = ngoff < 0 ? -(ngoff+1)+nd : ngoff+nd; --i; } } } } /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Root adjacency indices\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Compress indices */ ierr = PetscSectionSetUp(rootSectionAdj);CHKERRQ(ierr); for (p = pStart; p < pEnd; ++p) { PetscInt dof, cdof, off, d; PetscInt adof, aoff; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); if (!dof) continue; ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr); if (adof <= 0) continue; for (d = off; d < off+dof-cdof; ++d) { ierr = PetscSectionGetDof(rootSectionAdj, d, &adof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(rootSectionAdj, d, &aoff);CHKERRQ(ierr); ierr = PetscSortRemoveDupsInt(&adof, &rootAdj[aoff]);CHKERRQ(ierr); ierr = PetscSectionSetDof(rootSectionAdj, d, adof);CHKERRQ(ierr); } } /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots after compression:\n");CHKERRQ(ierr); ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Root adjacency indices after compression\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Build adjacency section: Maps global indices to sets of adjacent global indices */ ierr = PetscSectionGetOffsetRange(sectionGlobal, &globalOffStart, &globalOffEnd);CHKERRQ(ierr); ierr = PetscSectionCreate(comm, §ionAdj);CHKERRQ(ierr); ierr = PetscSectionSetChart(sectionAdj, globalOffStart, globalOffEnd);CHKERRQ(ierr); for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, dof, cdof, off, goff, d, q, anDof; PetscBool found = PETSC_TRUE; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr); for (d = 0; d < dof-cdof; ++d) { PetscInt ldof, rdof; ierr = PetscSectionGetDof(leafSectionAdj, off+d, &ldof);CHKERRQ(ierr); ierr = PetscSectionGetDof(rootSectionAdj, off+d, &rdof);CHKERRQ(ierr); if (ldof > 0) { /* We do not own this point */ } else if (rdof > 0) { ierr = PetscSectionSetDof(sectionAdj, goff+d, rdof);CHKERRQ(ierr); } else { found = PETSC_FALSE; } } if (found) continue; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr); ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, noff; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, padj, &noff);CHKERRQ(ierr); for (d = goff; d < goff+dof-cdof; ++d) { ierr = PetscSectionAddDof(sectionAdj, d, ndof-ncdof);CHKERRQ(ierr); } } ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); if (anDof) { for (d = goff; d < goff+dof-cdof; ++d) { ierr = PetscSectionAddDof(sectionAdj, d, anDof);CHKERRQ(ierr); } } } ierr = PetscSectionSetUp(sectionAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjacency Section for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSectionView(sectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Get adjacent indices */ ierr = PetscSectionGetStorageSize(sectionAdj, &numCols);CHKERRQ(ierr); ierr = PetscMalloc1(numCols, &cols);CHKERRQ(ierr); for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, dof, cdof, off, goff, d, q, anDof, anOff; PetscBool found = PETSC_TRUE; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr); for (d = 0; d < dof-cdof; ++d) { PetscInt ldof, rdof; ierr = PetscSectionGetDof(leafSectionAdj, off+d, &ldof);CHKERRQ(ierr); ierr = PetscSectionGetDof(rootSectionAdj, off+d, &rdof);CHKERRQ(ierr); if (ldof > 0) { /* We do not own this point */ } else if (rdof > 0) { PetscInt aoff, roff; ierr = PetscSectionGetOffset(sectionAdj, goff+d, &aoff);CHKERRQ(ierr); ierr = PetscSectionGetOffset(rootSectionAdj, off+d, &roff);CHKERRQ(ierr); ierr = PetscMemcpy(&cols[aoff], &rootAdj[roff], rdof * sizeof(PetscInt));CHKERRQ(ierr); } else { found = PETSC_FALSE; } } if (found) continue; ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(anchorSectionAdj, p, &anOff);CHKERRQ(ierr); for (d = goff; d < goff+dof-cdof; ++d) { PetscInt adof, aoff, i = 0; ierr = PetscSectionGetDof(sectionAdj, d, &adof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionAdj, d, &aoff);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, ngoff, nd; const PetscInt *ncind; /* Adjacent points may not be in the section chart */ if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintIndices(section, padj, &ncind);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr); for (nd = 0; nd < ndof-ncdof; ++nd, ++i) { cols[aoff+i] = ngoff < 0 ? -(ngoff+1)+nd : ngoff+nd; } } for (q = 0; q < anDof; q++, i++) { cols[aoff+i] = anchorAdj[anOff + q]; } if (i != adof) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of entries %D != %D for dof %D (point %D)", i, adof, d, p); } } ierr = PetscSectionDestroy(&anchorSectionAdj);CHKERRQ(ierr); ierr = PetscSectionDestroy(&leafSectionAdj);CHKERRQ(ierr); ierr = PetscSectionDestroy(&rootSectionAdj);CHKERRQ(ierr); ierr = PetscFree(anchorAdj);CHKERRQ(ierr); ierr = PetscFree(rootAdj);CHKERRQ(ierr); ierr = PetscFree(tmpAdj);CHKERRQ(ierr); /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Column indices\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, numCols, cols, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Create allocation vectors from adjacency graph */ ierr = MatGetLocalSize(A, &locRows, NULL);CHKERRQ(ierr); ierr = PetscLayoutCreate(PetscObjectComm((PetscObject)A), &rLayout);CHKERRQ(ierr); ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr); ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr); ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr); ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr); ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr); /* Only loop over blocks of rows */ if (rStart%bs || rEnd%bs) SETERRQ3(PetscObjectComm((PetscObject)A), PETSC_ERR_ARG_WRONG, "Invalid layout [%d, %d) for matrix, must be divisible by block size %d", rStart, rEnd, bs); for (r = rStart/bs; r < rEnd/bs; ++r) { const PetscInt row = r*bs; PetscInt numCols, cStart, c; ierr = PetscSectionGetDof(sectionAdj, row, &numCols);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionAdj, row, &cStart);CHKERRQ(ierr); for (c = cStart; c < cStart+numCols; ++c) { if ((cols[c] >= rStart*bs) && (cols[c] < rEnd*bs)) { ++dnz[r-rStart]; if (cols[c] >= row) ++dnzu[r-rStart]; } else { ++onz[r-rStart]; if (cols[c] >= row) ++onzu[r-rStart]; } } } if (bs > 1) { for (r = 0; r < locRows/bs; ++r) { dnz[r] /= bs; onz[r] /= bs; dnzu[r] /= bs; onzu[r] /= bs; } } /* Set matrix pattern */ ierr = MatXAIJSetPreallocation(A, bs, dnz, onz, dnzu, onzu);CHKERRQ(ierr); ierr = MatSetOption(A, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); /* Check for symmetric storage */ ierr = MatGetType(A, &mtype);CHKERRQ(ierr); ierr = PetscStrcmp(mtype, MATSBAIJ, &isSymBlock);CHKERRQ(ierr); ierr = PetscStrcmp(mtype, MATSEQSBAIJ, &isSymSeqBlock);CHKERRQ(ierr); ierr = PetscStrcmp(mtype, MATMPISBAIJ, &isSymMPIBlock);CHKERRQ(ierr); if (isSymBlock || isSymSeqBlock || isSymMPIBlock) {ierr = MatSetOption(A, MAT_IGNORE_LOWER_TRIANGULAR, PETSC_TRUE);CHKERRQ(ierr);} /* Fill matrix with zeros */ if (fillMatrix) { PetscScalar *values; PetscInt maxRowLen = 0; for (r = rStart; r < rEnd; ++r) { PetscInt len; ierr = PetscSectionGetDof(sectionAdj, r, &len);CHKERRQ(ierr); maxRowLen = PetscMax(maxRowLen, len); } ierr = PetscCalloc1(maxRowLen, &values);CHKERRQ(ierr); for (r = rStart; r < rEnd; ++r) { PetscInt numCols, cStart; ierr = PetscSectionGetDof(sectionAdj, r, &numCols);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionAdj, r, &cStart);CHKERRQ(ierr); ierr = MatSetValues(A, 1, &r, numCols, &cols[cStart], values, INSERT_VALUES);CHKERRQ(ierr); } ierr = PetscFree(values);CHKERRQ(ierr); ierr = MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } /* restore original useAnchors */ ierr = DMPlexSetAdjacencyUseAnchors(dm,useAnchors);CHKERRQ(ierr); ierr = PetscSectionDestroy(§ionAdj);CHKERRQ(ierr); ierr = PetscFree(cols);CHKERRQ(ierr); ierr = PetscLogEventEnd(DMPLEX_Preallocate,dm,0,0,0);CHKERRQ(ierr); PetscFunctionReturn(0); }
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,NULL, "-test_zheevx", &flg);CHKERRQ(ierr); if (flg) { TestZHEEV = PETSC_FALSE; TestZHEEVX = PETSC_TRUE; } ierr = PetscOptionsHasName(NULL,NULL, "-test_zhegv", &flg);CHKERRQ(ierr); if (flg) { TestZHEEV = PETSC_FALSE; TestZHEGV = PETSC_TRUE; } ierr = PetscOptionsHasName(NULL,NULL, "-test_zhegvx", &flg);CHKERRQ(ierr); if (flg) { TestZHEEV = PETSC_FALSE; TestZHEGVX = PETSC_TRUE; } ierr = PetscOptionsGetReal(NULL,NULL,"-sigma1",&sigma1,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,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,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,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 = PetscMalloc1(n,&evals);CHKERRQ(ierr); ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr); ierr = MatDenseGetArray(A_dense,&arrayA);CHKERRQ(ierr); if (TestZHEEV) { /* test zheev() */ printf(" LAPACKsyev: compute all %d eigensolutions...\n",m); ierr = PetscMalloc1(3*n-2,&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 = PetscMalloc1(m*n+1,&evecs_array);CHKERRQ(ierr); ierr = PetscMalloc1(7*n+1,&rwork);CHKERRQ(ierr); ierr = PetscMalloc1(5*n+1,&iwork);CHKERRQ(ierr); ierr = PetscMalloc1(n+1,&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 = PetscMalloc1(3*n+1,&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 = PetscMalloc1(m*n+1,&evecs_array);CHKERRQ(ierr); ierr = PetscMalloc1(6*n+1,&iwork);CHKERRQ(ierr); ifail = iwork + 5*n; ierr = PetscMalloc1(7*n+1,&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,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,(double)evals[i]); } /* Check residuals and orthogonality */ 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,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) { Mat C; PetscErrorCode ierr; PetscInt N = 2,rowidx,colidx; Vec u,b,r; KSP ksp; PetscReal norm; PetscMPIInt rank,size; PetscScalar v; ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr; ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); /* create stiffness matrix C = [1 2; 2 3] */ ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr); ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,N,N);CHKERRQ(ierr); ierr = MatSetFromOptions(C);CHKERRQ(ierr); ierr = MatSetUp(C);CHKERRQ(ierr); if (!rank) { rowidx = 0; colidx = 0; v = 1.0; ierr = MatSetValues(C,1,&rowidx,1,&colidx,&v,INSERT_VALUES);CHKERRQ(ierr); rowidx = 0; colidx = 1; v = 2.0; ierr = MatSetValues(C,1,&rowidx,1,&colidx,&v,INSERT_VALUES);CHKERRQ(ierr); rowidx = 1; colidx = 0; v = 2.0; ierr = MatSetValues(C,1,&rowidx,1,&colidx,&v,INSERT_VALUES);CHKERRQ(ierr); rowidx = 1; colidx = 1; v = 3.0; ierr = MatSetValues(C,1,&rowidx,1,&colidx,&v,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* create right hand side and solution */ ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr); ierr = VecSetSizes(u,PETSC_DECIDE,N);CHKERRQ(ierr); ierr = VecSetFromOptions(u);CHKERRQ(ierr); ierr = VecDuplicate(u,&b);CHKERRQ(ierr); ierr = VecDuplicate(u,&r);CHKERRQ(ierr); ierr = VecSet(u,0.0);CHKERRQ(ierr); ierr = VecSet(b,1.0);CHKERRQ(ierr); /* solve linear system C*u = b */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,C,C);CHKERRQ(ierr); ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); ierr = KSPSolve(ksp,b,u);CHKERRQ(ierr); /* check residual r = C*u - b */ ierr = MatMult(C,u,r);CHKERRQ(ierr); ierr = VecAXPY(r,-1.0,b);CHKERRQ(ierr); ierr = VecNorm(r,NORM_2,&norm);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"|| C*u - b|| = %g\n",(double)norm);CHKERRQ(ierr); /* solve C^T*u = b twice */ ierr = KSPSolveTranspose(ksp,b,u);CHKERRQ(ierr); /* check residual r = C^T*u - b */ ierr = MatMultTranspose(C,u,r);CHKERRQ(ierr); ierr = VecAXPY(r,-1.0,b);CHKERRQ(ierr); ierr = VecNorm(r,NORM_2,&norm);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"|| C^T*u - b|| = %g\n",(double)norm);CHKERRQ(ierr); ierr = KSPSolveTranspose(ksp,b,u);CHKERRQ(ierr); ierr = MatMultTranspose(C,u,r);CHKERRQ(ierr); ierr = VecAXPY(r,-1.0,b);CHKERRQ(ierr); ierr = VecNorm(r,NORM_2,&norm);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"|| C^T*u - b|| = %g\n",(double)norm);CHKERRQ(ierr); /* solve C*u = b again */ ierr = KSPSolve(ksp,b,u);CHKERRQ(ierr); ierr = MatMult(C,u,r);CHKERRQ(ierr); ierr = VecAXPY(r,-1.0,b);CHKERRQ(ierr); ierr = VecNorm(r,NORM_2,&norm);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"|| C*u - b|| = %g\n",(double)norm);CHKERRQ(ierr); ierr = KSPDestroy(&ksp);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&r);CHKERRQ(ierr); ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
int main(int argc,char **args) { const int iM11=0, iM12=1, iL11=2, iL22=3, iL21=4, ix=5; Mat M11,M12,L11,L22,L21; /* matrix */ Vec x,y; /* input and output vectors */ Vec omg1,omg2,omg3,omg4; /* temporary vectors for the operation y=Ax */ KSP ksp; /* linear solver context */ PetscViewer fd[5]; /* viewer */ char file[6][PETSC_MAX_PATH_LEN]; /* input file name */ PetscErrorCode ierr; PetscInt M, N; /* number of rows and columns of the GLOBAL matrices (they should be the same) */ PetscInt m, n; /* number of rows and columns of the LOCAL matrices */ PetscInt istart, iend; /* ownership row range of the process using GLOBAL indexes */ PetscScalar one=1.0; PetscMPIInt rank, size; PetscBool flg[6]; PetscInitialize(&argc,&args,(char *)0,help); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); PetscPrintf(PETSC_COMM_WORLD, "Number of processes size=%d\n", size); // ************ READ MATRICES AND VECTOR x FROM INPUT ***** // M11 and M12 ierr = PetscOptionsGetString(PETSC_NULL,"-m11",file[iM11],PETSC_MAX_PATH_LEN,&flg[iM11]);CHKERRQ(ierr); ierr = PetscOptionsGetString(PETSC_NULL,"-m12",file[iM12],PETSC_MAX_PATH_LEN,&flg[iM12]);CHKERRQ(ierr); // L11 L22 and L21 ierr = PetscOptionsGetString(PETSC_NULL,"-l11",file[iL11],PETSC_MAX_PATH_LEN,&flg[iL11]);CHKERRQ(ierr); ierr = PetscOptionsGetString(PETSC_NULL,"-l22",file[iL22],PETSC_MAX_PATH_LEN,&flg[iL22]);CHKERRQ(ierr); ierr = PetscOptionsGetString(PETSC_NULL,"-l21",file[iL21],PETSC_MAX_PATH_LEN,&flg[iL21]);CHKERRQ(ierr); // All of the matrix have to be defined by the user. // If the user don't specify none of them, it will generate laplacian matrices. if (flg[iM11] && flg[iM12] && flg[iL11] && flg[iL22] && flg[iL21]){ ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[iM11],FILE_MODE_READ,\ &fd[iM11]);CHKERRQ(ierr); ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[iM12],FILE_MODE_READ,\ &fd[iM12]);CHKERRQ(ierr); ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[iL11],FILE_MODE_READ,\ &fd[iL11]);CHKERRQ(ierr); ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[iL22],FILE_MODE_READ,\ &fd[iL22]);CHKERRQ(ierr); ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[iL21],FILE_MODE_READ,\ &fd[iL21]);CHKERRQ(ierr); // Load the matrix and vector; then destroy the viewer. // M11 and M12 ierr = MatCreate(PETSC_COMM_WORLD,&M11);CHKERRQ(ierr); ierr = MatSetType(M11,MATAIJ);CHKERRQ(ierr); ierr = MatSetFromOptions(M11);CHKERRQ(ierr); ierr = MatLoad(M11,fd[iM11]);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&M12);CHKERRQ(ierr); ierr = MatSetType(M12,MATAIJ);CHKERRQ(ierr); ierr = MatSetFromOptions(M12);CHKERRQ(ierr); ierr = MatLoad(M12,fd[iM12]);CHKERRQ(ierr); // L11 L22 and L21 ierr = MatCreate(PETSC_COMM_WORLD,&L11);CHKERRQ(ierr); ierr = MatSetType(L11,MATAIJ);CHKERRQ(ierr); ierr = MatSetFromOptions(L11);CHKERRQ(ierr); ierr = MatLoad(L11,fd[iL11]);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&L22);CHKERRQ(ierr); ierr = MatSetType(L22,MATAIJ);CHKERRQ(ierr); ierr = MatSetFromOptions(L22);CHKERRQ(ierr); ierr = MatLoad(L22,fd[iL22]);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&L21);CHKERRQ(ierr); ierr = MatSetType(L21,MATAIJ);CHKERRQ(ierr); ierr = MatSetFromOptions(L21);CHKERRQ(ierr); ierr = MatLoad(L21,fd[iL21]);CHKERRQ(ierr); ierr = PetscViewerDestroy(&fd[iM11]);CHKERRQ(ierr); ierr = PetscViewerDestroy(&fd[iM12]);CHKERRQ(ierr); ierr = PetscViewerDestroy(&fd[iL11]);CHKERRQ(ierr); ierr = PetscViewerDestroy(&fd[iL22]);CHKERRQ(ierr); ierr = PetscViewerDestroy(&fd[iL21]);CHKERRQ(ierr); } else if(!flg[iM11] && !flg[iM12] && !flg[iL11] && !flg[iL22] && !flg[iL21]){ // ******************* CREATING FAKE MATRICES ***************** PetscInt i,col[3]; M = N = 100; PetscScalar value[3]; ierr = MatCreate(PETSC_COMM_WORLD,&M11);CHKERRQ(ierr); ierr = MatSetSizes(M11,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); ierr = MatSetFromOptions(M11);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&M12);CHKERRQ(ierr); ierr = MatSetSizes(M12,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); ierr = MatSetFromOptions(M12);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&L11);CHKERRQ(ierr); ierr = MatSetSizes(L11,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); ierr = MatSetFromOptions(L11);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&L22);CHKERRQ(ierr); ierr = MatSetSizes(L22,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); ierr = MatSetFromOptions(L22);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&L21);CHKERRQ(ierr); ierr = MatSetSizes(L21,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); ierr = MatSetFromOptions(L21);CHKERRQ(ierr); // Set values for them value[0] = -1.0; value[1] = 2.0; value[2] = -1.0; for (i=1; i<M-1; i++) { col[0] = i-1; col[1] = i; col[2] = i+1; ierr = MatSetValues(M11,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(M12,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(L11,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(L22,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(L21,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); } i = N - 1; col[0] = N - 2; col[1] = N - 1; ierr = MatSetValues(M11,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(M12,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(L11,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(L22,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(L21,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); i = 0; col[0] = 0; col[1] = 1; value[0] = 2.0; value[1] = -1.0; ierr = MatSetValues(M11,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(M12,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(L11,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(L22,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(L21,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(M11,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(M11,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyBegin(M12,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(M12,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyBegin(L11,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(L11,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyBegin(L22,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(L22,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyBegin(L21,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(L21,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); // ******************** END CREATING FAKE MATRICES ************* } else{ SETERRQ(PETSC_COMM_WORLD,1,"You must either indicate the ascii file for each matrix M11 M12 L11 L22 L21 using the option -m11 -m12 .... or without any of these options."); PetscFinalize(); return 1; } // Get some information about the partitioning of the matrix ierr = MatGetSize(M11,&M,&N);CHKERRQ(ierr); printf("Global dimension of the matrix M11 M=%d N=%d\n",M,N); ierr = MatGetLocalSize(M11,&m,&n); printf("Local dimension of the matrix M11 m=%d n=%d\n",m,n); ierr = MatGetOwnershipRange(M11,&istart,&iend); printf("Ownership range of the rows for process %d istart=%d iend=%d\n",rank,istart,iend); // Read vector x from input. If it's not specified by the user, the vector x will be a unitary vector. ierr = PetscOptionsGetString(PETSC_NULL,"-x",file[ix],PETSC_MAX_PATH_LEN,&flg[ix]);CHKERRQ(ierr); if(!flg[ix]){ ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,M);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecSet(x,one);CHKERRQ(ierr); /*ierr = VecAssemblyBegin(x);CHKERRQ(ierr);*/ /*ierr = VecAssemblyEnd(x);CHKERRQ(ierr);*/ } else{ ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[ix],FILE_MODE_READ,&fd[ix]);CHKERRQ(ierr); ierr = VecLoad(x,fd[ix]);CHKERRQ(ierr); } ierr = PetscObjectSetName((PetscObject) x, "The input vector");CHKERRQ(ierr); // ************ END READ MATRICES AND VECTOR x FROM INPUT ***** // Create the temporary vectors and y ierr = VecDuplicate(x,&y);CHKERRQ(ierr); ierr = VecDuplicate(x,&omg1);CHKERRQ(ierr); ierr = VecDuplicate(x,&omg2);CHKERRQ(ierr); ierr = VecDuplicate(x,&omg3);CHKERRQ(ierr); ierr = VecDuplicate(x,&omg4);CHKERRQ(ierr); // ****************** COMPUTE y=Ax ******************* // Set the Krylov object ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); // Set operators. Here the matrix that defines the linear system // also serves as the preconditioning matrix. ierr = KSPSetOperators(ksp,L22,L22,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); // Set runtime options, e.g., // -ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol> // These options will override those specified above as long as // KSPSetFromOptions() is called _after_ any other customization // routines. ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); // Multiplication y = A*x // omg1 = M11*x // omg2 = L21*x // L22*omg3 = omg2 // omg4 = omg1 + M12*omg3 // L11*y = omg4 ierr = MatMult(M11, x, omg1);CHKERRQ(ierr); ierr = MatMult(L21, x, omg2);CHKERRQ(ierr); ierr = KSPSolve(ksp,omg2,omg3);CHKERRQ(ierr); ierr = MatMult(M12, omg3, omg4);CHKERRQ(ierr); ierr = VecAXPY(omg4, one, omg1);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,L11,L11,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = KSPSolve(ksp,omg4,y);CHKERRQ(ierr); // ****************** END COMPUTE y=Ax ************************** /*ierr = VecView(y, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);*/ PetscBool test = PETSC_FALSE; ierr = PetscOptionsGetBool(PETSC_NULL,"-test",&test,PETSC_NULL);CHKERRQ(ierr); if(test){ // ******************** TESTING ********************************* // the testing doesn't work if the number of process are more than one // because the type of the matrices must be different from matmpiaij. Let's try matseqaij Mat L11_inv, L22_inv, I; Mat A; Mat M11_d; Vec y2; PetscInt i; PetscScalar val; // Create identity matrix ierr = MatCreate(PETSC_COMM_WORLD,&I);CHKERRQ(ierr); ierr = MatSetType(I, MATDENSE); ierr = MatSetSizes(I,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); ierr = MatSetFromOptions(I);CHKERRQ(ierr); val = 1.0; for (i=0; i<M; i++) { ierr = MatSetValues(I,1,&i,1,&i,&val,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(I,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(I,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); // Create L11_inv ierr = MatCreate(PETSC_COMM_WORLD,&L11_inv);CHKERRQ(ierr); ierr = MatSetType(L11_inv, MATDENSE); ierr = MatSetSizes(L11_inv,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); ierr = MatSetFromOptions(L11_inv);CHKERRQ(ierr); ierr = MatAssemblyBegin(L11_inv,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(L11_inv,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); // Create L22_inv ierr = MatCreate(PETSC_COMM_WORLD,&L22_inv);CHKERRQ(ierr); ierr = MatSetType(L22_inv, MATDENSE); ierr = MatSetSizes(L22_inv,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); ierr = MatSetFromOptions(L22_inv);CHKERRQ(ierr); ierr = MatAssemblyBegin(L22_inv,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(L22_inv,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); // Create A ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); // Define M11_d ierr = MatCreate(PETSC_COMM_WORLD,&M11_d);CHKERRQ(ierr); ierr = MatSetType(M11_d, MATDENSE); ierr = MatSetSizes(M11_d,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); ierr = MatSetFromOptions(M11_d);CHKERRQ(ierr); ierr = MatAssemblyBegin(M11_d,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(M11_d,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); // Calculate A = L11^{-1}*(M11 + M12*L22^{-1}*L21) IS perm, iperm; MatFactorInfo info; ierr = MatGetOrdering(L11,MATORDERINGNATURAL,&perm,&iperm);CHKERRQ(ierr); ierr = MatFactorInfoInitialize(&info); CHKERRQ(ierr); ierr = MatLUFactor(L11, perm, iperm, &info); CHKERRQ(ierr); ierr = MatMatSolve(L11, I, L11_inv);CHKERRQ(ierr); // TODO try to convert L11_inv to be sparse such as matseqaij // ierr = MatView(L11_inv, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); ierr = MatGetOrdering(L22,MATORDERINGNATURAL,&perm,&iperm);CHKERRQ(ierr); ierr = MatFactorInfoInitialize(&info); CHKERRQ(ierr); ierr = MatLUFactor(L22, perm, iperm, &info); CHKERRQ(ierr); ierr = MatMatSolve(L22, I, L22_inv);CHKERRQ(ierr); ierr = MatMatMult(M12, L22_inv, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &A);CHKERRQ(ierr); ierr = MatMatMult(A, L21, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &A);CHKERRQ(ierr); ierr = MatConvert(M11, MATDENSE, MAT_INITIAL_MATRIX, &M11_d); ierr = MatAXPY(A,1.0,M11_d,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatMatMult(L11_inv, A, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &A);CHKERRQ(ierr); ierr = VecDuplicate(x,&y2);CHKERRQ(ierr); ierr = MatMult(A, x, y2);CHKERRQ(ierr); /*ierr = VecView(y2, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);*/ // Check the error PetscReal norm; ierr = VecAXPY(y2,-1.0,y);CHKERRQ(ierr); ierr = VecNorm(y2,NORM_2,&norm);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %A\n", norm);CHKERRQ(ierr); // ******************** END TESTING ***************************** } PetscFinalize(); return 0; }
/* FormJacobian - Evaluates Jacobian matrix. Input Parameters: . snes - the SNES context . x - input vector . dummy - optional user-defined context (not used here) Output Parameters: . jac - Jacobian matrix . B - optionally different preconditioning matrix . flag - flag indicating matrix structure */ PetscErrorCode FormJacobian(SNES snes,Vec x,Mat jac,Mat B,void *ctx) { ApplicationCtx *user = (ApplicationCtx*) ctx; PetscScalar *xx,d,A[3]; PetscErrorCode ierr; PetscInt i,j[3],M,xs,xm; DM da = user->da; PetscFunctionBeginUser; /* Get pointer to vector data */ ierr = DMDAVecGetArrayRead(da,x,&xx);CHKERRQ(ierr); ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr); /* Get range of locally owned matrix */ ierr = DMDAGetInfo(da,NULL,&M,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr); /* Determine starting and ending local indices for interior grid points. Set Jacobian entries for boundary points. */ if (xs == 0) { /* left boundary */ i = 0; A[0] = 1.0; ierr = MatSetValues(jac,1,&i,1,&i,A,INSERT_VALUES);CHKERRQ(ierr); xs++;xm--; } if (xs+xm == M) { /* right boundary */ i = M-1; A[0] = 1.0; ierr = MatSetValues(jac,1,&i,1,&i,A,INSERT_VALUES);CHKERRQ(ierr); xm--; } /* Interior grid points - Note that in this case we set all elements for a particular row at once. */ d = 1.0/(user->h*user->h); for (i=xs; i<xs+xm; i++) { j[0] = i - 1; j[1] = i; j[2] = i + 1; A[0] = A[2] = d; A[1] = -2.0*d + 2.0*xx[i]; ierr = MatSetValues(jac,1,&i,3,j,A,INSERT_VALUES);CHKERRQ(ierr); } /* Assemble matrix, using the 2-step process: MatAssemblyBegin(), MatAssemblyEnd(). By placing code between these two statements, computations can be done while messages are in transition. Also, restore vector. */ ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = DMDAVecRestoreArrayRead(da,x,&xx);CHKERRQ(ierr); ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc,char **args) { Mat C; PetscErrorCode ierr; PetscInt i,m = 2,N,M,its,idx[4],count,*rows; PetscScalar val,Ke[16],r[4]; PetscReal x,y,h,norm,tol=1.e-14; Vec u,ustar,b; KSP ksp; PetscInitialize(&argc,&args,(char *)0,help); ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr); N = (m+1)*(m+1); /* dimension of matrix */ M = m*m; /* number of elements */ h = 1.0/m; /* mesh width */ /* create stiffness matrix */ ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,N,N,9,PETSC_NULL,&C);CHKERRQ(ierr); ierr = MatSetUp(C);CHKERRQ(ierr); /* forms the element stiffness for the Laplacian */ ierr = FormElementStiffness(h*h,Ke);CHKERRQ(ierr); for (i=0; i<M; i++) { /* location of lower left corner of element */ x = h*(i % m); y = h*(i/m); /* node numbers for the four corners of element */ idx[0] = (m+1)*(i/m) + (i % m); idx[1] = idx[0]+1; idx[2] = idx[1] + m + 1; idx[3] = idx[2] - 1; ierr = MatSetValues(C,4,idx,4,idx,Ke,ADD_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* create right hand side and solution */ ierr = VecCreateSeq(PETSC_COMM_SELF,N,&u);CHKERRQ(ierr); ierr = VecDuplicate(u,&b);CHKERRQ(ierr); ierr = VecDuplicate(b,&ustar);CHKERRQ(ierr); ierr = VecSet(u,0.0);CHKERRQ(ierr); ierr = VecSet(b,0.0);CHKERRQ(ierr); for (i=0; i<M; i++) { /* location of lower left corner of element */ x = h*(i % m); y = h*(i/m); /* node numbers for the four corners of element */ idx[0] = (m+1)*(i/m) + (i % m); idx[1] = idx[0]+1; idx[2] = idx[1] + m + 1; idx[3] = idx[2] - 1; ierr = FormElementRhs(x,y,h*h,r);CHKERRQ(ierr); ierr = VecSetValues(b,4,idx,r,ADD_VALUES);CHKERRQ(ierr); } ierr = VecAssemblyBegin(b);CHKERRQ(ierr); ierr = VecAssemblyEnd(b);CHKERRQ(ierr); /* modify matrix and rhs for Dirichlet boundary conditions */ ierr = PetscMalloc((4*m+1)*sizeof(PetscInt),&rows);CHKERRQ(ierr); for (i=0; i<m+1; i++) { rows[i] = i; /* bottom */ rows[3*m - 1 +i] = m*(m+1) + i; /* top */ } count = m+1; /* left side */ for (i=m+1; i<m*(m+1); i+= m+1) { rows[count++] = i; } count = 2*m; /* left side */ for (i=2*m+1; i<m*(m+1); i+= m+1) { rows[count++] = i; } for (i=0; i<4*m; i++) { x = h*(rows[i] % (m+1)); y = h*(rows[i]/(m+1)); val = y; ierr = VecSetValues(u,1,&rows[i],&val,INSERT_VALUES);CHKERRQ(ierr); ierr = VecSetValues(b,1,&rows[i],&val,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatZeroRows(C,4*m,rows,1.0,0,0);CHKERRQ(ierr); ierr = PetscFree(rows);CHKERRQ(ierr); ierr = VecAssemblyBegin(u);CHKERRQ(ierr); ierr = VecAssemblyEnd(u);CHKERRQ(ierr); ierr = VecAssemblyBegin(b);CHKERRQ(ierr); ierr = VecAssemblyEnd(b);CHKERRQ(ierr); /* solve linear system */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,C,C,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr); ierr = KSPSolve(ksp,b,u);CHKERRQ(ierr); /* check error */ for (i=0; i<N; i++) { x = h*(i % (m+1)); y = h*(i/(m+1)); val = y; ierr = VecSetValues(ustar,1,&i,&val,INSERT_VALUES);CHKERRQ(ierr); } ierr = VecAssemblyBegin(ustar);CHKERRQ(ierr); ierr = VecAssemblyEnd(ustar);CHKERRQ(ierr); ierr = VecAXPY(u,-1.0,ustar);CHKERRQ(ierr); ierr = VecNorm(u,NORM_2,&norm);CHKERRQ(ierr); ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr); if (norm > tol){ ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %G Iterations %D\n",norm*h,its);CHKERRQ(ierr); } ierr = KSPDestroy(&ksp);CHKERRQ(ierr); ierr = VecDestroy(&ustar);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
int main(int argc, char * argv[]) { typedef MPI::HGeometryForest<DIM,DOW> forest_t; typedef MPI::BirdView<forest_t> ir_mesh_t; typedef FEMSpace<double,DIM,DOW> fe_space_t; typedef MPI::DOF::GlobalIndex<forest_t, fe_space_t> global_index_t; PetscInitialize(&argc, &argv, (char *)NULL, help); forest_t forest(PETSC_COMM_WORLD); forest.readMesh(argv[1]); ir_mesh_t ir_mesh(forest); int round = 0; if (argc >= 3) round = atoi(argv[2]); ir_mesh.globalRefine(round); ir_mesh.semiregularize(); ir_mesh.regularize(false); setenv("AFEPACK_TEMPLATE_PATH", "/usr/local/AFEPack/template/triangle", 1); TemplateGeometry<DIM> tri; tri.readData("triangle.tmp_geo"); CoordTransform<DIM,DIM> tri_ct; tri_ct.readData("triangle.crd_trs"); TemplateDOF<DIM> tri_td(tri); tri_td.readData("triangle.1.tmp_dof"); BasisFunctionAdmin<double,DIM,DIM> tri_bf(tri_td); tri_bf.readData("triangle.1.bas_fun"); std::vector<TemplateElement<double,DIM,DIM> > tmp_ele(1); tmp_ele[0].reinit(tri, tri_td, tri_ct, tri_bf); RegularMesh<DIM,DOW>& mesh = ir_mesh.regularMesh(); fe_space_t fem_space(mesh, tmp_ele); u_int n_ele = mesh.n_geometry(DIM); fem_space.element().resize(n_ele); for (int i = 0;i < n_ele;i ++) { fem_space.element(i).reinit(fem_space, i, 0); } fem_space.buildElement(); fem_space.buildDof(); fem_space.buildDofBoundaryMark(); std::cout << "Building global indices ... " << std::flush; global_index_t global_index(forest, fem_space); global_index.build(); std::cout << "OK!" << std::endl; std::cout << "Building the linear system ... " << std::flush; Mat A; Vec x, b; MatCreateMPIAIJ(PETSC_COMM_WORLD, global_index.n_primary_dof(), global_index.n_primary_dof(), PETSC_DECIDE, PETSC_DECIDE, 0, PETSC_NULL, 0, PETSC_NULL, &A); VecCreateMPI(PETSC_COMM_WORLD, global_index.n_primary_dof(), PETSC_DECIDE, &b); fe_space_t::ElementIterator the_ele = fem_space.beginElement(), end_ele = fem_space.endElement(); for (;the_ele != end_ele;++ the_ele) { double vol = the_ele->templateElement().volume(); const QuadratureInfo<DIM>& qi = the_ele->findQuadratureInfo(5); std::vector<Point<DIM> > q_pnt = the_ele->local_to_global(qi.quadraturePoint()); int n_q_pnt = qi.n_quadraturePoint(); std::vector<double> jac = the_ele->local_to_global_jacobian(qi.quadraturePoint()); std::vector<std::vector<double> > bas_val = the_ele->basis_function_value(q_pnt); std::vector<std::vector<std::vector<double> > > bas_grad = the_ele->basis_function_gradient(q_pnt); const std::vector<int>& ele_dof = the_ele->dof(); u_int n_ele_dof = ele_dof.size(); FullMatrix<double> ele_mat(n_ele_dof, n_ele_dof); Vector<double> ele_rhs(n_ele_dof); for (u_int l = 0;l < n_q_pnt;++ l) { double JxW = vol*jac[l]*qi.weight(l); double f_val = _f_(q_pnt[l]); for (u_int i = 0;i < n_ele_dof;++ i) { for (u_int j = 0;j < n_ele_dof;++ j) { ele_mat(i, j) += JxW*(bas_val[i][l]*bas_val[j][l] + innerProduct(bas_grad[i][l], bas_grad[j][l])); } ele_rhs(i) += JxW*f_val*bas_val[i][l]; } } /** * 此处将单元矩阵和单元载荷先计算好,然后向全局的矩阵和载荷向量上 * 集中,可以提高效率。 */ std::vector<int> indices(n_ele_dof); for (u_int i = 0;i < n_ele_dof;++ i) { indices[i] = global_index(ele_dof[i]); } MatSetValues(A, n_ele_dof, &indices[0], n_ele_dof, &indices[0], &ele_mat(0,0), ADD_VALUES); VecSetValues(b, n_ele_dof, &indices[0], &ele_rhs(0), ADD_VALUES); } MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY); VecAssemblyBegin(b); MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY); VecAssemblyEnd(b); VecDuplicate(b, &x); std::cout << "OK!" << std::endl; KSP solver; KSPCreate(PETSC_COMM_WORLD, &solver); KSPSetOperators(solver, A, A, SAME_NONZERO_PATTERN); KSPSetType(solver, KSPCG); KSPSetFromOptions(solver); KSPSolve(solver, b, x); if (forest.rank() == 0) { KSPConvergedReason reason; KSPGetConvergedReason(solver,&reason); if (reason == KSP_DIVERGED_INDEFINITE_PC) { printf("\nDivergence because of indefinite preconditioner;\n"); printf("Run the executable again but with -pc_ilu_shift option.\n"); } else if (reason<0) { printf("\nOther kind of divergence: this should not happen.\n"); } else { PetscInt its; KSPGetIterationNumber(solver,&its); printf("\nConvergence in %d iterations.\n",(int)its); } printf("\n"); } MatDestroy(A); VecDestroy(b); KSPDestroy(solver); /// 准备解函数 FEMFunction<double,DIM> u_h(fem_space); Vec X; VecCreateSeqWithArray(PETSC_COMM_SELF, global_index.n_local_dof(), &u_h(0), &X); /// 将 PETSc 解出来的向量取出到有限元函数 u_h 中来 std::vector<int> primary_idx(global_index.n_primary_dof()); global_index.build_primary_index(&primary_idx[0]); IS is; ISCreateGeneralWithArray(forest.communicator(), global_index.n_local_dof(), &global_index(0), &is); VecScatter scatter; VecScatterCreate(x, is, X, PETSC_NULL, &scatter); VecScatterBegin(scatter, x, X, INSERT_VALUES, SCATTER_FORWARD); VecScatterEnd(scatter, x, X, INSERT_VALUES, SCATTER_FORWARD); /// 清理 PETSc 的变量 VecDestroy(x); VecDestroy(X); VecScatterDestroy(scatter); ISDestroy(is); char filename[1024]; sprintf(filename, "u_h%d.dx", forest.rank()); u_h.writeOpenDXData(filename); PetscFinalize(); return 0; }
int main(int argc,char **args) { Mat C; Vec s,u,w,x,y,z; PetscErrorCode ierr; PetscInt i,j,m = 8,n,rstart,rend,vstart,vend; PetscScalar one = 1.0,negone = -1.0,v,alpha=0.1; PetscReal norm, tol = PETSC_SQRT_MACHINE_EPSILON; PetscBool flg; ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr; ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-m",&m,NULL);CHKERRQ(ierr); n = m; ierr = PetscOptionsHasName(NULL,NULL,"-rectA",&flg);CHKERRQ(ierr); if (flg) n += 2; ierr = PetscOptionsHasName(NULL,NULL,"-rectB",&flg);CHKERRQ(ierr); if (flg) n -= 2; /* ---------- Assemble matrix and vectors ----------- */ ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr); ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,m,n);CHKERRQ(ierr); ierr = MatSetFromOptions(C);CHKERRQ(ierr); ierr = MatSetUp(C);CHKERRQ(ierr); ierr = MatGetOwnershipRange(C,&rstart,&rend);CHKERRQ(ierr); ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,m);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&z);CHKERRQ(ierr); ierr = VecDuplicate(x,&w);CHKERRQ(ierr); ierr = VecCreate(PETSC_COMM_WORLD,&y);CHKERRQ(ierr); ierr = VecSetSizes(y,PETSC_DECIDE,n);CHKERRQ(ierr); ierr = VecSetFromOptions(y);CHKERRQ(ierr); ierr = VecDuplicate(y,&u);CHKERRQ(ierr); ierr = VecDuplicate(y,&s);CHKERRQ(ierr); ierr = VecGetOwnershipRange(y,&vstart,&vend);CHKERRQ(ierr); /* Assembly */ for (i=rstart; i<rend; i++) { v = 100*(i+1); ierr = VecSetValues(z,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); for (j=0; j<n; j++) { v = 10*(i+1)+j+1; ierr = MatSetValues(C,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr); } } /* Flush off proc Vec values and do more assembly */ ierr = VecAssemblyBegin(z);CHKERRQ(ierr); for (i=vstart; i<vend; i++) { v = one*((PetscReal)i); ierr = VecSetValues(y,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); v = 100.0*i; ierr = VecSetValues(u,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); } /* Flush off proc Mat values and do more assembly */ ierr = MatAssemblyBegin(C,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr); for (i=rstart; i<rend; i++) { for (j=0; j<n; j++) { v = 10*(i+1)+j+1; ierr = MatSetValues(C,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr); } } /* Try overlap Coomunication with the next stage XXXSetValues */ ierr = VecAssemblyEnd(z);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr); CHKMEMQ; /* The Assembly for the second Stage */ ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = VecAssemblyBegin(y);CHKERRQ(ierr); ierr = VecAssemblyEnd(y);CHKERRQ(ierr); ierr = MatScale(C,alpha);CHKERRQ(ierr); ierr = VecAssemblyBegin(u);CHKERRQ(ierr); ierr = VecAssemblyEnd(u);CHKERRQ(ierr); /* ------------ Test MatMult(), MatMultAdd() ---------- */ ierr = PetscPrintf(PETSC_COMM_WORLD,"testing MatMult()\n");CHKERRQ(ierr); CHKMEMQ; ierr = MatMult(C,y,x);CHKERRQ(ierr); CHKMEMQ; ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"testing MatMultAdd()\n");CHKERRQ(ierr); ierr = MatMultAdd(C,y,z,w);CHKERRQ(ierr); ierr = VecAXPY(x,one,z);CHKERRQ(ierr); ierr = VecAXPY(x,negone,w);CHKERRQ(ierr); ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr); if (norm > tol) { ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error difference = %g\n",(double)norm);CHKERRQ(ierr); } /* ------- Test MatMultTranspose(), MatMultTransposeAdd() ------- */ for (i=rstart; i<rend; i++) { v = one*((PetscReal)i); ierr = VecSetValues(x,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); } ierr = VecAssemblyBegin(x);CHKERRQ(ierr); ierr = VecAssemblyEnd(x);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"testing MatMultTranspose()\n");CHKERRQ(ierr); ierr = MatMultTranspose(C,x,y);CHKERRQ(ierr); ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"testing MatMultTransposeAdd()\n");CHKERRQ(ierr); ierr = MatMultTransposeAdd(C,x,u,s);CHKERRQ(ierr); ierr = VecAXPY(y,one,u);CHKERRQ(ierr); ierr = VecAXPY(y,negone,s);CHKERRQ(ierr); ierr = VecNorm(y,NORM_2,&norm);CHKERRQ(ierr); if (norm > tol) { ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error difference = %g\n",(double)norm);CHKERRQ(ierr); } /* -------------------- Test MatGetDiagonal() ------------------ */ ierr = PetscPrintf(PETSC_COMM_WORLD,"testing MatGetDiagonal(), MatDiagonalScale()\n");CHKERRQ(ierr); ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = VecSet(x,one);CHKERRQ(ierr); ierr = MatGetDiagonal(C,x);CHKERRQ(ierr); ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); for (i=vstart; i<vend; i++) { v = one*((PetscReal)(i+1)); ierr = VecSetValues(y,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); } /* -------------------- Test () MatDiagonalScale ------------------ */ ierr = PetscOptionsHasName(NULL,NULL,"-test_diagonalscale",&flg);CHKERRQ(ierr); if (flg) { ierr = MatDiagonalScale(C,x,y);CHKERRQ(ierr); ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Free data structures */ ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&s);CHKERRQ(ierr); ierr = VecDestroy(&w);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&y);CHKERRQ(ierr); ierr = VecDestroy(&z);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
int main(int argc,char **args) { Vec x, b, u; /* approx solution, RHS, exact solution */ Mat A; /* linear system matrix */ KSP ksp; /* linear solver context */ PC pc; /* preconditioner context */ PetscReal norm; /* norm of solution error */ PetscErrorCode ierr; PetscInt i,n = 10,col[3],its,rstart,rend,nlocal; PetscScalar neg_one = -1.0,one = 1.0,value[3]; PetscBool TEST_PROCEDURAL=PETSC_FALSE; PetscInitialize(&argc,&args,(char*)0,help); ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,"-procedural",&TEST_PROCEDURAL,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Compute the matrix and right-hand-side vector that define the linear system, Ax = b. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Create vectors. Note that we form 1 vector from scratch and then duplicate as needed. For this simple case let PETSc decide how many elements of the vector are stored on each processor. The second argument to VecSetSizes() below causes PETSc to decide. */ ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,n);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&b);CHKERRQ(ierr); ierr = VecDuplicate(x,&u);CHKERRQ(ierr); /* Identify the starting and ending mesh points on each processor for the interior part of the mesh. We let PETSc decide above. */ ierr = VecGetOwnershipRange(x,&rstart,&rend);CHKERRQ(ierr); ierr = VecGetLocalSize(x,&nlocal);CHKERRQ(ierr); /* Create a tridiagonal matrix. See ../tutorials/ex23.c */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,nlocal,nlocal,n,n);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); /* Assemble matrix */ if (!rstart) { rstart = 1; i = 0; col[0] = 0; col[1] = 1; value[0] = 2.0; value[1] = -1.0; ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); } if (rend == n) { rend = n-1; i = n-1; col[0] = n-2; col[1] = n-1; value[0] = -1.0; value[1] = 2.0; ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); } /* Set entries corresponding to the mesh interior */ value[0] = -1.0; value[1] = 2.0; value[2] = -1.0; for (i=rstart; i<rend; i++) { col[0] = i-1; col[1] = i; col[2] = i+1; ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* Set exact solution; then compute right-hand-side vector. */ ierr = VecSet(u,one);CHKERRQ(ierr); ierr = MatMult(A,u,b);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create the linear solver and set various options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); /* Set linear solver defaults for this problem (optional). - By extracting the KSP and PC contexts from the KSP context, we can then directly call any KSP and PC routines to set various options. - The following statements are optional; all of these parameters could alternatively be specified at runtime via KSPSetFromOptions(); */ if (TEST_PROCEDURAL) { /* Example of runtime options: '-pc_redundant_number 3 -redundant_ksp_type gmres -redundant_pc_type bjacobi' */ PetscMPIInt size,rank,subsize; Mat A_redundant; KSP innerksp; PC innerpc; MPI_Comm subcomm; ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr); ierr = PCSetType(pc,PCREDUNDANT);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); if (size < 3) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ, "Num of processes %d must greater than 2",size); ierr = PCRedundantSetNumber(pc,size-2);CHKERRQ(ierr); ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); /* Get subcommunicator and redundant matrix */ ierr = KSPSetUp(ksp);CHKERRQ(ierr); ierr = PCRedundantGetKSP(pc,&innerksp);CHKERRQ(ierr); ierr = KSPGetPC(innerksp,&innerpc);CHKERRQ(ierr); ierr = PCGetOperators(innerpc,NULL,&A_redundant,NULL);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)A_redundant,&subcomm);CHKERRQ(ierr); ierr = MPI_Comm_size(subcomm,&subsize);CHKERRQ(ierr); if (subsize==1 && !rank) { printf("A_redundant:\n"); ierr = MatView(A_redundant,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); } } else { ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); } /* Solve linear system */ ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr); /* Check the error */ ierr = VecAXPY(x,neg_one,u);CHKERRQ(ierr); ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr); ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr); if (norm > 1.e-14) { ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %G, Iterations %D\n",norm,its);CHKERRQ(ierr); } /* Free work space. */ ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = KSPDestroy(&ksp);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
/*@ KSPComputeEigenvaluesExplicitly - Computes all of the eigenvalues of the preconditioned operator using LAPACK. Collective on KSP Input Parameter: + ksp - iterative context obtained from KSPCreate() - n - size of arrays r and c Output Parameters: + r - real part of computed eigenvalues, provided by user with a dimension at least of n - c - complex part of computed eigenvalues, provided by user with a dimension at least of n Notes: This approach is very slow but will generally provide accurate eigenvalue estimates. This routine explicitly forms a dense matrix representing the preconditioned operator, and thus will run only for relatively small problems, say n < 500. Many users may just want to use the monitoring routine KSPMonitorSingularValue() (which can be set with option -ksp_monitor_singular_value) to print the singular values at each iteration of the linear solve. The preconditoner operator, rhs vector, solution vectors should be set before this routine is called. i.e use KSPSetOperators(),KSPSolve() or KSPSetOperators() Level: advanced .keywords: KSP, compute, eigenvalues, explicitly .seealso: KSPComputeEigenvalues(), KSPMonitorSingularValue(), KSPComputeExtremeSingularValues(), KSPSetOperators(), KSPSolve() @*/ PetscErrorCode KSPComputeEigenvaluesExplicitly(KSP ksp,PetscInt nmax,PetscReal r[],PetscReal c[]) { Mat BA; PetscErrorCode ierr; PetscMPIInt size,rank; MPI_Comm comm; PetscScalar *array; Mat A; PetscInt m,row,nz,i,n,dummy; const PetscInt *cols; const PetscScalar *vals; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)ksp,&comm);CHKERRQ(ierr); ierr = KSPComputeExplicitOperator(ksp,&BA);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); ierr = MatGetSize(BA,&n,&n);CHKERRQ(ierr); if (size > 1) { /* assemble matrix on first processor */ ierr = MatCreate(PetscObjectComm((PetscObject)ksp),&A);CHKERRQ(ierr); if (!rank) { ierr = MatSetSizes(A,n,n,n,n);CHKERRQ(ierr); } else { ierr = MatSetSizes(A,0,0,n,n);CHKERRQ(ierr); } ierr = MatSetType(A,MATMPIDENSE);CHKERRQ(ierr); ierr = MatMPIDenseSetPreallocation(A,NULL);CHKERRQ(ierr); ierr = PetscLogObjectParent((PetscObject)BA,(PetscObject)A);CHKERRQ(ierr); ierr = MatGetOwnershipRange(BA,&row,&dummy);CHKERRQ(ierr); ierr = MatGetLocalSize(BA,&m,&dummy);CHKERRQ(ierr); for (i=0; i<m; i++) { ierr = MatGetRow(BA,row,&nz,&cols,&vals);CHKERRQ(ierr); ierr = MatSetValues(A,1,&row,nz,cols,vals,INSERT_VALUES);CHKERRQ(ierr); ierr = MatRestoreRow(BA,row,&nz,&cols,&vals);CHKERRQ(ierr); row++; } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatDenseGetArray(A,&array);CHKERRQ(ierr); } else { ierr = MatDenseGetArray(BA,&array);CHKERRQ(ierr); } #if defined(PETSC_HAVE_ESSL) /* ESSL has a different calling sequence for dgeev() and zgeev() than standard LAPACK */ if (!rank) { PetscScalar sdummy,*cwork; PetscReal *work,*realpart; PetscBLASInt clen,idummy,lwork,bn,zero = 0; PetscInt *perm; #if !defined(PETSC_USE_COMPLEX) clen = n; #else clen = 2*n; #endif ierr = PetscMalloc1(clen,&cwork);CHKERRQ(ierr); idummy = -1; /* unused */ ierr = PetscBLASIntCast(n,&bn);CHKERRQ(ierr); lwork = 5*n; ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr); ierr = PetscMalloc1(n,&realpart);CHKERRQ(ierr); ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_(&zero,array,&bn,cwork,&sdummy,&idummy,&idummy,&bn,work,&lwork)); ierr = PetscFPTrapPop();CHKERRQ(ierr); ierr = PetscFree(work);CHKERRQ(ierr); /* For now we stick with the convention of storing the real and imaginary components of evalues separately. But is this what we really want? */ ierr = PetscMalloc1(n,&perm);CHKERRQ(ierr); #if !defined(PETSC_USE_COMPLEX) for (i=0; i<n; i++) { realpart[i] = cwork[2*i]; perm[i] = i; } ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr); for (i=0; i<n; i++) { r[i] = cwork[2*perm[i]]; c[i] = cwork[2*perm[i]+1]; } #else for (i=0; i<n; i++) { realpart[i] = PetscRealPart(cwork[i]); perm[i] = i; } ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr); for (i=0; i<n; i++) { r[i] = PetscRealPart(cwork[perm[i]]); c[i] = PetscImaginaryPart(cwork[perm[i]]); } #endif ierr = PetscFree(perm);CHKERRQ(ierr); ierr = PetscFree(realpart);CHKERRQ(ierr); ierr = PetscFree(cwork);CHKERRQ(ierr); } #elif !defined(PETSC_USE_COMPLEX) if (!rank) { PetscScalar *work; PetscReal *realpart,*imagpart; PetscBLASInt idummy,lwork; PetscInt *perm; idummy = n; lwork = 5*n; ierr = PetscMalloc2(n,&realpart,n,&imagpart);CHKERRQ(ierr); ierr = PetscMalloc1(5*n,&work);CHKERRQ(ierr); #if defined(PETSC_MISSING_LAPACK_GEEV) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values."); #else { PetscBLASInt lierr; PetscScalar sdummy; PetscBLASInt bn; ierr = PetscBLASIntCast(n,&bn);CHKERRQ(ierr); ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_("N","N",&bn,array,&bn,realpart,imagpart,&sdummy,&idummy,&sdummy,&idummy,work,&lwork,&lierr)); if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in LAPACK routine %d",(int)lierr); ierr = PetscFPTrapPop();CHKERRQ(ierr); } #endif ierr = PetscFree(work);CHKERRQ(ierr); ierr = PetscMalloc1(n,&perm);CHKERRQ(ierr); for (i=0; i<n; i++) perm[i] = i; ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr); for (i=0; i<n; i++) { r[i] = realpart[perm[i]]; c[i] = imagpart[perm[i]]; } ierr = PetscFree(perm);CHKERRQ(ierr); ierr = PetscFree2(realpart,imagpart);CHKERRQ(ierr); } #else if (!rank) { PetscScalar *work,*eigs; PetscReal *rwork; PetscBLASInt idummy,lwork; PetscInt *perm; idummy = n; lwork = 5*n; ierr = PetscMalloc1(5*n,&work);CHKERRQ(ierr); ierr = PetscMalloc1(2*n,&rwork);CHKERRQ(ierr); ierr = PetscMalloc1(n,&eigs);CHKERRQ(ierr); #if defined(PETSC_MISSING_LAPACK_GEEV) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values."); #else { PetscBLASInt lierr; PetscScalar sdummy; PetscBLASInt nb; ierr = PetscBLASIntCast(n,&nb);CHKERRQ(ierr); ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_("N","N",&nb,array,&nb,eigs,&sdummy,&idummy,&sdummy,&idummy,work,&lwork,rwork,&lierr)); if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in LAPACK routine %d",(int)lierr); ierr = PetscFPTrapPop();CHKERRQ(ierr); } #endif ierr = PetscFree(work);CHKERRQ(ierr); ierr = PetscFree(rwork);CHKERRQ(ierr); ierr = PetscMalloc1(n,&perm);CHKERRQ(ierr); for (i=0; i<n; i++) perm[i] = i; for (i=0; i<n; i++) r[i] = PetscRealPart(eigs[i]); ierr = PetscSortRealWithPermutation(n,r,perm);CHKERRQ(ierr); for (i=0; i<n; i++) { r[i] = PetscRealPart(eigs[perm[i]]); c[i] = PetscImaginaryPart(eigs[perm[i]]); } ierr = PetscFree(perm);CHKERRQ(ierr); ierr = PetscFree(eigs);CHKERRQ(ierr); } #endif if (size > 1) { ierr = MatDenseRestoreArray(A,&array);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); } else { ierr = MatDenseRestoreArray(BA,&array);CHKERRQ(ierr); } ierr = MatDestroy(&BA);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc,char **args) { Mat C; PetscInt i,j,m = 3,n = 3,Ii,J; PetscErrorCode ierr; PetscBool flg; PetscScalar v; IS perm,iperm; Vec x,u,b,y; PetscReal norm,tol=PETSC_SMALL; MatFactorInfo info; PetscMPIInt size; PetscInitialize(&argc,&args,(char*)0,help); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size); CHKERRQ(ierr); if (size != 1) SETERRQ(PETSC_COMM_WORLD,1,"This is a uniprocessor example only!"); ierr = MatCreate(PETSC_COMM_WORLD,&C); CHKERRQ(ierr); ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n); CHKERRQ(ierr); ierr = MatSetFromOptions(C); CHKERRQ(ierr); ierr = MatSetUp(C); CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,"-symmetric",&flg); CHKERRQ(ierr); if (flg) { /* Treat matrix as symmetric only if we set this flag */ ierr = MatSetOption(C,MAT_SYMMETRIC,PETSC_TRUE); CHKERRQ(ierr); ierr = MatSetOption(C,MAT_SYMMETRY_ETERNAL,PETSC_TRUE); CHKERRQ(ierr); } /* Create the matrix for the five point stencil, YET AGAIN */ for (i=0; i<m; i++) { for (j=0; j<n; j++) { v = -1.0; Ii = j + n*i; if (i>0) { J = Ii - n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES); CHKERRQ(ierr); } if (i<m-1) { J = Ii + n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES); CHKERRQ(ierr); } if (j>0) { J = Ii - 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES); CHKERRQ(ierr); } if (j<n-1) { J = Ii + 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES); CHKERRQ(ierr); } v = 4.0; ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,INSERT_VALUES); CHKERRQ(ierr); } } ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); ierr = MatGetOrdering(C,MATORDERINGRCM,&perm,&iperm); CHKERRQ(ierr); ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD); CHKERRQ(ierr); ierr = ISView(perm,PETSC_VIEWER_STDOUT_SELF); CHKERRQ(ierr); ierr = VecCreateSeq(PETSC_COMM_SELF,m*n,&u); CHKERRQ(ierr); ierr = VecSet(u,1.0); CHKERRQ(ierr); ierr = VecDuplicate(u,&x); CHKERRQ(ierr); ierr = VecDuplicate(u,&b); CHKERRQ(ierr); ierr = VecDuplicate(u,&y); CHKERRQ(ierr); ierr = MatMult(C,u,b); CHKERRQ(ierr); ierr = VecCopy(b,y); CHKERRQ(ierr); ierr = VecScale(y,2.0); CHKERRQ(ierr); ierr = MatNorm(C,NORM_FROBENIUS,&norm); CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_SELF,"Frobenius norm of matrix %g\n",(double)norm); CHKERRQ(ierr); ierr = MatNorm(C,NORM_1,&norm); CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_SELF,"One norm of matrix %g\n",(double)norm); CHKERRQ(ierr); ierr = MatNorm(C,NORM_INFINITY,&norm); CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_SELF,"Infinity norm of matrix %g\n",(double)norm); CHKERRQ(ierr); ierr = MatFactorInfoInitialize(&info); CHKERRQ(ierr); info.fill = 2.0; info.dtcol = 0.0; info.zeropivot = 1.e-14; info.pivotinblocks = 1.0; ierr = MatLUFactor(C,perm,iperm,&info); CHKERRQ(ierr); /* Test MatSolve */ ierr = MatSolve(C,b,x); CHKERRQ(ierr); ierr = VecView(b,PETSC_VIEWER_STDOUT_SELF); CHKERRQ(ierr); ierr = VecView(x,PETSC_VIEWER_STDOUT_SELF); CHKERRQ(ierr); ierr = VecAXPY(x,-1.0,u); CHKERRQ(ierr); ierr = VecNorm(x,NORM_2,&norm); CHKERRQ(ierr); if (norm > tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"MatSolve: Norm of error %g\n",(double)norm); CHKERRQ(ierr); } /* Test MatSolveAdd */ ierr = MatSolveAdd(C,b,y,x); CHKERRQ(ierr); ierr = VecAXPY(x,-1.0,y); CHKERRQ(ierr); ierr = VecAXPY(x,-1.0,u); CHKERRQ(ierr); ierr = VecNorm(x,NORM_2,&norm); CHKERRQ(ierr); if (norm > tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"MatSolveAdd(): Norm of error %g\n",(double)norm); CHKERRQ(ierr); } ierr = ISDestroy(&perm); CHKERRQ(ierr); ierr = ISDestroy(&iperm); CHKERRQ(ierr); ierr = VecDestroy(&u); CHKERRQ(ierr); ierr = VecDestroy(&y); CHKERRQ(ierr); ierr = VecDestroy(&b); CHKERRQ(ierr); ierr = VecDestroy(&x); CHKERRQ(ierr); ierr = MatDestroy(&C); CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
int main(int argc,char **args) { Mat C; PetscScalar v,none = -1.0; PetscInt i,j,Ii,J,Istart,Iend,N,m = 4,n = 4,its,k; PetscErrorCode ierr; PetscMPIInt size,rank; PetscReal err_norm,res_norm,err_tol=1.e-7,res_tol=1.e-6; Vec x,b,u,u_tmp; PetscRandom r; PC pc; KSP ksp; PetscInitialize(&argc,&args,(char *)0,help); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr); N = m*n; /* Generate matrix */ ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr); ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,N,N);CHKERRQ(ierr); ierr = MatSetFromOptions(C);CHKERRQ(ierr); ierr = MatSetUp(C);CHKERRQ(ierr); ierr = MatGetOwnershipRange(C,&Istart,&Iend);CHKERRQ(ierr); for (Ii=Istart; Ii<Iend; Ii++) { v = -1.0; i = Ii/n; j = Ii - i*n; if (i>0) {J = Ii - n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);} if (i<m-1) {J = Ii + n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);} if (j>0) {J = Ii - 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);} if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);} v = 4.0; ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* a shift can make C indefinite. Preconditioners LU, ILU (for BAIJ format) and ICC may fail */ /* ierr = MatShift(C,alpha);CHKERRQ(ierr); */ /* ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); */ /* Setup and solve for system */ /* Create vectors. */ ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,N);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&b);CHKERRQ(ierr); ierr = VecDuplicate(x,&u);CHKERRQ(ierr); ierr = VecDuplicate(x,&u_tmp);CHKERRQ(ierr); /* Set exact solution u; then compute right-hand-side vector b. */ ierr = PetscRandomCreate(PETSC_COMM_SELF,&r);CHKERRQ(ierr); ierr = PetscRandomSetFromOptions(r);CHKERRQ(ierr); ierr = VecSetRandom(u,r);CHKERRQ(ierr); ierr = PetscRandomDestroy(&r);CHKERRQ(ierr); ierr = MatMult(C,u,b);CHKERRQ(ierr); for (k=0; k<3; k++){ if (k == 0){ /* CG */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,C,C,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n CG: \n");CHKERRQ(ierr); ierr = KSPSetType(ksp,KSPCG);CHKERRQ(ierr); } else if (k == 1){ /* MINRES */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,C,C,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n MINRES: \n");CHKERRQ(ierr); ierr = KSPSetType(ksp,KSPMINRES);CHKERRQ(ierr); } else { /* SYMMLQ */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,C,C,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n SYMMLQ: \n");CHKERRQ(ierr); ierr = KSPSetType(ksp,KSPSYMMLQ);CHKERRQ(ierr); } ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr); /* ierr = PCSetType(pc,PCICC);CHKERRQ(ierr); */ ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr); ierr = KSPSetTolerances(ksp,1.e-7,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr); /* Set runtime options, e.g., -ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol> These options will override those specified above as long as KSPSetFromOptions() is called _after_ any other customization routines. */ ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); /* Solve linear system; */ ierr = KSPSetUp(ksp);CHKERRQ(ierr); ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr); ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr); /* Check error */ ierr = VecCopy(u,u_tmp);CHKERRQ(ierr); ierr = VecAXPY(u_tmp,none,x);CHKERRQ(ierr); ierr = VecNorm(u_tmp,NORM_2,&err_norm);CHKERRQ(ierr); ierr = MatMult(C,x,u_tmp);CHKERRQ(ierr); ierr = VecAXPY(u_tmp,none,b);CHKERRQ(ierr); ierr = VecNorm(u_tmp,NORM_2,&res_norm);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"Number of iterations = %3D\n",its);CHKERRQ(ierr); if (res_norm > res_tol){ ierr = PetscPrintf(PETSC_COMM_WORLD,"Residual norm %G;",res_norm);CHKERRQ(ierr); } if (err_norm > err_tol){ ierr = PetscPrintf(PETSC_COMM_WORLD," Error norm %G.\n",err_norm);CHKERRQ(ierr); } ierr = KSPDestroy(&ksp);CHKERRQ(ierr); } /* Free work space. All PETSc objects should be destroyed when they are no longer needed. */ ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&u_tmp);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
/*@C SNESComputeJacobianDefault - Computes the Jacobian using finite differences. Collective on SNES Input Parameters: + x1 - compute Jacobian at this point - ctx - application's function context, as set with SNESSetFunction() Output Parameters: + J - Jacobian matrix (not altered in this routine) - B - newly computed Jacobian matrix to use with preconditioner (generally the same as J) Options Database Key: + -snes_fd - Activates SNESComputeJacobianDefault() . -snes_test_err - Square root of function error tolerance, default square root of machine epsilon (1.e-8 in double, 3.e-4 in single) - -mat_fd_type - Either wp or ds (see MATMFFD_WP or MATMFFD_DS) Notes: This routine is slow and expensive, and is not currently optimized to take advantage of sparsity in the problem. Although SNESComputeJacobianDefault() is not recommended for general use in large-scale applications, It can be useful in checking the correctness of a user-provided Jacobian. An alternative routine that uses coloring to exploit matrix sparsity is SNESComputeJacobianDefaultColor(). Level: intermediate .keywords: SNES, finite differences, Jacobian .seealso: SNESSetJacobian(), SNESComputeJacobianDefaultColor(), MatCreateSNESMF() @*/ PetscErrorCode SNESComputeJacobianDefault(SNES snes,Vec x1,Mat J,Mat B,void *ctx) { Vec j1a,j2a,x2; PetscErrorCode ierr; PetscInt i,N,start,end,j,value,root; PetscScalar dx,*y,wscale; const PetscScalar *xx; PetscReal amax,epsilon = PETSC_SQRT_MACHINE_EPSILON; PetscReal dx_min = 1.e-16,dx_par = 1.e-1,unorm; MPI_Comm comm; PetscBool assembled,use_wp = PETSC_TRUE,flg; const char *list[2] = {"ds","wp"}; PetscMPIInt size; const PetscInt *ranges; PetscFunctionBegin; /* Since this Jacobian will possibly have "extra" nonzero locations just turn off errors for these locations */ ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE);CHKERRQ(ierr); ierr = PetscOptionsGetReal(((PetscObject)snes)->prefix,"-snes_test_err",&epsilon,0);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)x1,&comm);CHKERRQ(ierr); ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MatAssembled(B,&assembled);CHKERRQ(ierr); if (assembled) { ierr = MatZeroEntries(B);CHKERRQ(ierr); } if (!snes->nvwork) { snes->nvwork = 3; ierr = VecDuplicateVecs(x1,snes->nvwork,&snes->vwork);CHKERRQ(ierr); ierr = PetscLogObjectParents(snes,snes->nvwork,snes->vwork);CHKERRQ(ierr); } j1a = snes->vwork[0]; j2a = snes->vwork[1]; x2 = snes->vwork[2]; ierr = VecGetSize(x1,&N);CHKERRQ(ierr); ierr = VecGetOwnershipRange(x1,&start,&end);CHKERRQ(ierr); ierr = SNESComputeFunction(snes,x1,j1a);CHKERRQ(ierr); ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)snes),((PetscObject)snes)->prefix,"Differencing options","SNES");CHKERRQ(ierr); ierr = PetscOptionsEList("-mat_fd_type","Algorithm to compute difference parameter","SNESComputeJacobianDefault",list,2,"wp",&value,&flg);CHKERRQ(ierr); ierr = PetscOptionsEnd();CHKERRQ(ierr); if (flg && !value) use_wp = PETSC_FALSE; if (use_wp) { ierr = VecNorm(x1,NORM_2,&unorm);CHKERRQ(ierr); } /* Compute Jacobian approximation, 1 column at a time. x1 = current iterate, j1a = F(x1) x2 = perturbed iterate, j2a = F(x2) */ for (i=0; i<N; i++) { ierr = VecCopy(x1,x2);CHKERRQ(ierr); if (i>= start && i<end) { ierr = VecGetArrayRead(x1,&xx);CHKERRQ(ierr); if (use_wp) dx = PetscSqrtReal(1.0 + unorm); else dx = xx[i-start]; ierr = VecRestoreArrayRead(x1,&xx);CHKERRQ(ierr); if (PetscAbsScalar(dx) < dx_min) dx = (PetscRealPart(dx) < 0. ? -1. : 1.) * dx_par; dx *= epsilon; wscale = 1.0/dx; ierr = VecSetValues(x2,1,&i,&dx,ADD_VALUES);CHKERRQ(ierr); } else { wscale = 0.0; } ierr = VecAssemblyBegin(x2);CHKERRQ(ierr); ierr = VecAssemblyEnd(x2);CHKERRQ(ierr); ierr = SNESComputeFunction(snes,x2,j2a);CHKERRQ(ierr); ierr = VecAXPY(j2a,-1.0,j1a);CHKERRQ(ierr); /* Communicate scale=1/dx_i to all processors */ ierr = VecGetOwnershipRanges(x1,&ranges);CHKERRQ(ierr); root = size; for (j=size-1; j>-1; j--) { root--; if (i>=ranges[j]) break; } ierr = MPI_Bcast(&wscale,1,MPIU_SCALAR,root,comm);CHKERRQ(ierr); ierr = VecScale(j2a,wscale);CHKERRQ(ierr); ierr = VecNorm(j2a,NORM_INFINITY,&amax);CHKERRQ(ierr); amax *= 1.e-14; ierr = VecGetArray(j2a,&y);CHKERRQ(ierr); for (j=start; j<end; j++) { if (PetscAbsScalar(y[j-start]) > amax || j == i) { ierr = MatSetValues(B,1,&j,1,&i,y+j-start,INSERT_VALUES);CHKERRQ(ierr); } } ierr = VecRestoreArray(j2a,&y);CHKERRQ(ierr); } ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); if (B != J) { ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } PetscFunctionReturn(0); }
static PetscErrorCode ComputeSubdomainMatrix(DomainData dd, GLLData glldata, Mat *local_mat) { PetscErrorCode ierr; PetscInt localsize,zloc,yloc,xloc,auxnex,auxney,auxnez; PetscInt ie,je,ke,i,j,k,ig,jg,kg,ii,ming; PetscInt *indexg,*cols,*colsg; PetscScalar *vals; Mat temp_local_mat,elem_mat_DBC=0,*usedmat; IS submatIS; PetscFunctionBeginUser; ierr = MatGetSize(glldata.elem_mat,&i,&j);CHKERRQ(ierr); ierr = PetscMalloc1(i,&indexg);CHKERRQ(ierr); ierr = PetscMalloc1(i,&colsg);CHKERRQ(ierr); /* get submatrix of elem_mat without dirichlet nodes */ if (!dd.pure_neumann && !dd.DBC_zerorows && !dd.ipx) { xloc = dd.p+1; yloc = 1; zloc = 1; if (dd.dim>1) yloc = dd.p+1; if (dd.dim>2) zloc = dd.p+1; ii = 0; for (k=0;k<zloc;k++) { for (j=0;j<yloc;j++) { for (i=1;i<xloc;i++) { indexg[ii]=k*xloc*yloc+j*xloc+i; ii++; } } } ierr = ISCreateGeneral(PETSC_COMM_SELF,ii,indexg,PETSC_COPY_VALUES,&submatIS);CHKERRQ(ierr); ierr = MatGetSubMatrix(glldata.elem_mat,submatIS,submatIS,MAT_INITIAL_MATRIX,&elem_mat_DBC);CHKERRQ(ierr); ierr = ISDestroy(&submatIS);CHKERRQ(ierr); } /* Assemble subdomain matrix */ localsize = dd.xm_l*dd.ym_l*dd.zm_l; ierr = MatCreate(PETSC_COMM_SELF,&temp_local_mat);CHKERRQ(ierr); ierr = MatSetSizes(temp_local_mat,localsize,localsize,localsize,localsize);CHKERRQ(ierr); ierr = MatSetOptionsPrefix(temp_local_mat,"subdomain_");CHKERRQ(ierr); /* set local matrices type: here we use SEQSBAIJ primarily for testing purpose */ /* in order to avoid conversions inside the BDDC code, use SeqAIJ if possible */ if (dd.DBC_zerorows && !dd.ipx) { /* in this case, we need to zero out some of the rows, so use seqaij */ ierr = MatSetType(temp_local_mat,MATSEQAIJ);CHKERRQ(ierr); } else { ierr = MatSetType(temp_local_mat,MATSEQSBAIJ);CHKERRQ(ierr); } ierr = MatSetFromOptions(temp_local_mat);CHKERRQ(ierr); i = PetscPowRealInt(3.0*(dd.p+1.0),dd.dim); ierr = MatSeqAIJSetPreallocation(temp_local_mat,i,NULL);CHKERRQ(ierr); /* very overestimated */ ierr = MatSeqSBAIJSetPreallocation(temp_local_mat,1,i,NULL);CHKERRQ(ierr); /* very overestimated */ ierr = MatSetOption(temp_local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr); yloc = dd.p+1; zloc = dd.p+1; if (dd.dim < 3) zloc = 1; if (dd.dim < 2) yloc = 1; auxnez = dd.nez_l; auxney = dd.ney_l; auxnex = dd.nex_l; if (dd.dim < 3) auxnez = 1; if (dd.dim < 2) auxney = 1; for (ke=0; ke<auxnez; ke++) { for (je=0; je<auxney; je++) { for (ie=0; ie<auxnex; ie++) { /* customize element accounting for BC */ xloc = dd.p+1; ming = 0; usedmat = &glldata.elem_mat; if (!dd.pure_neumann && !dd.DBC_zerorows && !dd.ipx) { if (ie == 0) { xloc = dd.p; usedmat = &elem_mat_DBC; } else { ming = -1; usedmat = &glldata.elem_mat; } } /* local to the element/global to the subdomain indexing */ for (k=0; k<zloc; k++) { kg = ke*dd.p+k; for (j=0; j<yloc; j++) { jg = je*dd.p+j; for (i=0; i<xloc; i++) { ig = ie*dd.p+i+ming; ii = k*xloc*yloc+j*xloc+i; indexg[ii] = kg*dd.xm_l*dd.ym_l+jg*dd.xm_l+ig; } } } /* Set values */ for (i=0; i<xloc*yloc*zloc; i++) { ierr = MatGetRow(*usedmat,i,&j,(const PetscInt**)&cols,(const PetscScalar**)&vals);CHKERRQ(ierr); for (k=0; k<j; k++) colsg[k] = indexg[cols[k]]; ierr = MatSetValues(temp_local_mat,1,&indexg[i],j,colsg,vals,ADD_VALUES);CHKERRQ(ierr); ierr = MatRestoreRow(*usedmat,i,&j,(const PetscInt**)&cols,(const PetscScalar**)&vals);CHKERRQ(ierr); } } } } ierr = PetscFree(indexg);CHKERRQ(ierr); ierr = PetscFree(colsg);CHKERRQ(ierr); ierr = MatAssemblyBegin(temp_local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd (temp_local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); #if DEBUG { Vec lvec,rvec; PetscReal norm; ierr = MatCreateVecs(temp_local_mat,&lvec,&rvec);CHKERRQ(ierr); ierr = VecSet(lvec,1.0);CHKERRQ(ierr); ierr = MatMult(temp_local_mat,lvec,rvec);CHKERRQ(ierr); ierr = VecNorm(rvec,NORM_INFINITY,&norm);CHKERRQ(ierr); printf("Test null space of local mat % 1.14e\n",norm); ierr = VecDestroy(&lvec);CHKERRQ(ierr); ierr = VecDestroy(&rvec);CHKERRQ(ierr); } #endif *local_mat = temp_local_mat; ierr = MatDestroy(&elem_mat_DBC);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc,char **args) { Vec x,b; Mat A,U,V,LR; PetscInt i,j,Ii,J,Istart,Iend,m = 8,n = 7,rstart,rend; PetscErrorCode ierr; PetscBool flg; PetscScalar *u,a; PetscInitialize(&argc,&args,(char *)0,help); ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create the sparse matrix - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr); for (Ii=Istart; Ii<Iend; Ii++) { a = -1.0; i = Ii/n; j = Ii - i*n; if (i>0) {J = Ii - n; ierr = MatSetValues(A,1,&Ii,1,&J,&a,INSERT_VALUES);CHKERRQ(ierr);} if (i<m-1) {J = Ii + n; ierr = MatSetValues(A,1,&Ii,1,&J,&a,INSERT_VALUES);CHKERRQ(ierr);} if (j>0) {J = Ii - 1; ierr = MatSetValues(A,1,&Ii,1,&J,&a,INSERT_VALUES);CHKERRQ(ierr);} if (j<n-1) {J = Ii + 1; ierr = MatSetValues(A,1,&Ii,1,&J,&a,INSERT_VALUES);CHKERRQ(ierr);} a = 4.0; ierr = MatSetValues(A,1,&Ii,1,&Ii,&a,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create the dense matrices - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&U);CHKERRQ(ierr); ierr = MatSetSizes(U,PETSC_DECIDE,PETSC_DECIDE,m*n,3);CHKERRQ(ierr); ierr = MatSetType(U,MATDENSE);CHKERRQ(ierr); ierr = MatSetUp(U);CHKERRQ(ierr); ierr = MatGetOwnershipRange(U,&rstart,&rend);CHKERRQ(ierr); ierr = MatDenseGetArray(U,&u);CHKERRQ(ierr); for (i=rstart; i<rend; i++) { u[i-rstart] = (PetscReal)i; u[i+rend-2*rstart] = (PetscReal)1000*i; u[i+2*rend-3*rstart] = (PetscReal)100000*i; } ierr = MatDenseRestoreArray(U,&u);CHKERRQ(ierr); ierr = MatAssemblyBegin(U,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(U,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&V);CHKERRQ(ierr); ierr = MatSetSizes(V,PETSC_DECIDE,PETSC_DECIDE,m*n,3);CHKERRQ(ierr); ierr = MatSetType(V,MATDENSE);CHKERRQ(ierr); ierr = MatSetUp(V);CHKERRQ(ierr); ierr = MatGetOwnershipRange(U,&rstart,&rend);CHKERRQ(ierr); ierr = MatDenseGetArray(V,&u);CHKERRQ(ierr); for (i=rstart; i<rend; i++) { u[i-rstart] = (PetscReal)i; u[i+rend-2*rstart] = (PetscReal)1.2*i; u[i+2*rend-3*rstart] = (PetscReal)1.67*i+2; } ierr = MatDenseRestoreArray(V,&u);CHKERRQ(ierr); ierr = MatAssemblyBegin(V,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(V,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create low rank created matrix - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreateLRC(A,U,V,&LR);CHKERRQ(ierr); ierr = MatSetUp(LR);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create test vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,m*n);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&b);CHKERRQ(ierr); ierr = VecGetOwnershipRange(x,&rstart,&rend);CHKERRQ(ierr); ierr = VecGetArray(x,&u);CHKERRQ(ierr); for (i=rstart; i<rend; i++) u[i-rstart] = (PetscScalar)i; ierr = VecRestoreArray(x,&u);CHKERRQ(ierr); ierr = MatMult(LR,x,b);CHKERRQ(ierr); /* View the product if desired */ ierr = PetscOptionsHasName(PETSC_NULL,"-view_product",&flg);CHKERRQ(ierr); if (flg) {ierr = VecView(b,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);} ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&b);CHKERRQ(ierr); /* you can destroy the matrices in any order you like */ ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&U);CHKERRQ(ierr); ierr = MatDestroy(&V);CHKERRQ(ierr); ierr = MatDestroy(&LR);CHKERRQ(ierr); /* Always call PetscFinalize() before exiting a program. This routine - finalizes the PETSc libraries as well as MPI - provides summary and diagnostic information if certain runtime options are chosen (e.g., -log_summary). */ ierr = PetscFinalize(); return 0; }
PetscErrorCode RHSJacobian(TS ts, PetscReal t, Vec X, Mat J, Mat B, void *ptr) { AppCtx *user = (AppCtx*)ptr; PetscInt nb_cells, i, idx; PetscReal alpha, beta; PetscReal mu_a, D_a; PetscReal mu_h, D_h; PetscReal a, h; const PetscScalar *x; PetscScalar va[4], vh[4]; PetscInt ca[4], ch[4], rowa, rowh; PetscErrorCode ierr; PetscFunctionBegin; nb_cells = user->nb_cells; alpha = user->alpha; beta = user->beta; mu_a = user->mu_a; D_a = user->D_a; mu_h = user->mu_h; D_h = user->D_h; ierr = VecGetArrayRead(X, &x);CHKERRQ(ierr); for(i = 0; i < nb_cells ; ++i) { rowa = 2*i; rowh = 2*i+1; a = x[2*i]; h = x[2*i+1]; ca[0] = ch[1] = 2*i; va[0] = 2*alpha*a / (1.+beta*h) - mu_a; vh[1] = 2*alpha*a; ca[1] = ch[0] = 2*i+1; va[1] = -beta*alpha*a*a / ((1.+beta*h)*(1.+beta*h)); vh[0] = -mu_h; idx = 2; if(i > 0) { ca[idx] = 2*(i-1); ch[idx] = 2*(i-1)+1; va[idx] = D_a; vh[idx] = D_h; va[0] -= D_a; vh[0] -= D_h; idx++; } if(i < nb_cells-1) { ca[idx] = 2*(i+1); ch[idx] = 2*(i+1)+1; va[idx] = D_a; vh[idx] = D_h; va[0] -= D_a; vh[0] -= D_h; idx++; } ierr = MatSetValues(B, 1, &rowa, idx, ca, va, INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(B, 1, &rowh, idx, ch, vh, INSERT_VALUES);CHKERRQ(ierr); } ierr = VecRestoreArrayRead(X, &x);CHKERRQ(ierr); ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); if (J != B) { ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } PetscFunctionReturn(0); }
PetscErrorCode heavyEdgeMatchAgg(IS perm,Mat a_Gmat,PetscInt verbose,PetscCoarsenData **a_locals_llist) { PetscErrorCode ierr; PetscBool isMPI; MPI_Comm wcomm = ((PetscObject)a_Gmat)->comm; PetscInt sub_it,kk,n,ix,*idx,*ii,iter,Iend,my0; PetscMPIInt rank,size; const PetscInt nloc = a_Gmat->rmap->n,n_iter=6; /* need to figure out how to stop this */ PetscInt *lid_cprowID,*lid_gid; PetscBool *lid_matched; Mat_SeqAIJ *matA, *matB=0; Mat_MPIAIJ *mpimat=0; PetscScalar one=1.; PetscCoarsenData *agg_llists = PETSC_NULL,*deleted_list = PETSC_NULL; Mat cMat,tMat,P; MatScalar *ap; PetscMPIInt tag1,tag2; PetscFunctionBegin; ierr = MPI_Comm_rank(wcomm, &rank);CHKERRQ(ierr); ierr = MPI_Comm_size(wcomm, &size);CHKERRQ(ierr); ierr = MatGetOwnershipRange(a_Gmat, &my0, &Iend);CHKERRQ(ierr); ierr = PetscCommGetNewTag(wcomm, &tag1);CHKERRQ(ierr); ierr = PetscCommGetNewTag(wcomm, &tag2);CHKERRQ(ierr); ierr = PetscMalloc(nloc*sizeof(PetscInt), &lid_gid);CHKERRQ(ierr); /* explicit array needed */ ierr = PetscMalloc(nloc*sizeof(PetscInt), &lid_cprowID);CHKERRQ(ierr); ierr = PetscMalloc(nloc*sizeof(PetscBool), &lid_matched);CHKERRQ(ierr); ierr = PetscCDCreate(nloc, &agg_llists);CHKERRQ(ierr); /* ierr = PetscCDSetChuckSize(agg_llists, nloc+1);CHKERRQ(ierr); */ *a_locals_llist = agg_llists; ierr = PetscCDCreate(size, &deleted_list);CHKERRQ(ierr); ierr = PetscCDSetChuckSize(deleted_list, 100);CHKERRQ(ierr); /* setup 'lid_gid' for scatters and add self to all lists */ for (kk=0;kk<nloc;kk++) { lid_gid[kk] = kk + my0; ierr = PetscCDAppendID(agg_llists, kk, my0+kk);CHKERRQ(ierr); } /* make a copy of the graph, this gets destroyed in iterates */ ierr = MatDuplicate(a_Gmat,MAT_COPY_VALUES,&cMat);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)a_Gmat, MATMPIAIJ, &isMPI);CHKERRQ(ierr); iter = 0; while(iter++ < n_iter) { PetscScalar *cpcol_gid,*cpcol_max_ew,*cpcol_max_pe,*lid_max_ew; PetscBool *cpcol_matched; PetscMPIInt *cpcol_pe,proc; Vec locMaxEdge,locMaxPE,ghostMaxEdge,ghostMaxPE; PetscInt nEdges,n_nz_row,jj; Edge *Edges; PetscInt gid; const PetscInt *perm_ix, n_sub_its = 120; /* get submatrices of cMat */ if (isMPI) { mpimat = (Mat_MPIAIJ*)cMat->data; matA = (Mat_SeqAIJ*)mpimat->A->data; matB = (Mat_SeqAIJ*)mpimat->B->data; /* force compressed storage of B */ matB->compressedrow.check = PETSC_TRUE; ierr = MatCheckCompressedRow(mpimat->B,&matB->compressedrow,matB->i,cMat->rmap->n,-1.0);CHKERRQ(ierr); assert(matB->compressedrow.use); } else { matA = (Mat_SeqAIJ*)cMat->data; } assert(matA && !matA->compressedrow.use); assert(matB==0 || matB->compressedrow.use); /* set max edge on nodes */ ierr = MatGetVecs(cMat, &locMaxEdge, 0);CHKERRQ(ierr); ierr = MatGetVecs(cMat, &locMaxPE, 0);CHKERRQ(ierr); /* get 'cpcol_pe' & 'cpcol_gid' & init. 'cpcol_matched' using 'mpimat->lvec' */ if (mpimat) { Vec vec; PetscScalar vval; ierr = MatGetVecs(cMat, &vec, 0);CHKERRQ(ierr); /* cpcol_pe */ vval = (PetscScalar)(rank); for (kk=0,gid=my0;kk<nloc;kk++,gid++) { ierr = VecSetValues(vec, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); /* set with GID */ } ierr = VecAssemblyBegin(vec);CHKERRQ(ierr); ierr = VecAssemblyEnd(vec);CHKERRQ(ierr); ierr = VecScatterBegin(mpimat->Mvctx,vec,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(mpimat->Mvctx,vec,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecGetArray(mpimat->lvec, &cpcol_gid);CHKERRQ(ierr); /* get proc ID in 'cpcol_gid' */ ierr = VecGetLocalSize(mpimat->lvec, &n);CHKERRQ(ierr); ierr = PetscMalloc(n*sizeof(PetscInt), &cpcol_pe);CHKERRQ(ierr); for (kk=0;kk<n;kk++) cpcol_pe[kk] = (PetscMPIInt)PetscRealPart(cpcol_gid[kk]); ierr = VecRestoreArray(mpimat->lvec, &cpcol_gid);CHKERRQ(ierr); /* cpcol_gid */ for (kk=0,gid=my0;kk<nloc;kk++,gid++) { vval = (PetscScalar)(gid); ierr = VecSetValues(vec, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); /* set with GID */ } ierr = VecAssemblyBegin(vec);CHKERRQ(ierr); ierr = VecAssemblyEnd(vec);CHKERRQ(ierr); ierr = VecScatterBegin(mpimat->Mvctx,vec,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(mpimat->Mvctx,vec,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecDestroy(&vec);CHKERRQ(ierr); ierr = VecGetArray(mpimat->lvec, &cpcol_gid);CHKERRQ(ierr); /* get proc ID in 'cpcol_gid' */ /* cpcol_matched */ ierr = VecGetLocalSize(mpimat->lvec, &n);CHKERRQ(ierr); ierr = PetscMalloc(n*sizeof(PetscBool), &cpcol_matched);CHKERRQ(ierr); for (kk=0;kk<n;kk++) cpcol_matched[kk] = PETSC_FALSE; } /* need an inverse map - locals */ for (kk=0;kk<nloc;kk++) lid_cprowID[kk] = -1; /* set index into compressed row 'lid_cprowID' */ if (matB) { ii = matB->compressedrow.i; for (ix=0; ix<matB->compressedrow.nrows; ix++) { lid_cprowID[matB->compressedrow.rindex[ix]] = ix; } } /* get removed IS, use '' */ /* if (iter==1) { */ /* PetscInt *lid_rem,idx; */ /* ierr = PetscMalloc(nloc*sizeof(PetscInt), &lid_rem);CHKERRQ(ierr); */ /* for (kk=idx=0;kk<nloc;kk++){ */ /* PetscInt nn,lid=kk; */ /* ii = matA->i; nn = ii[lid+1] - ii[lid]; */ /* if ((ix=lid_cprowID[lid]) != -1) { /\* if I have any ghost neighbors *\/ */ /* ii = matB->compressedrow.i; */ /* nn += ii[ix+1] - ii[ix]; */ /* } */ /* if (nn < 2) { */ /* lid_rem[idx++] = kk + my0; */ /* } */ /* } */ /* ierr = PetscCDSetRemovedIS(agg_llists, wcomm, idx, lid_rem);CHKERRQ(ierr); */ /* ierr = PetscFree(lid_rem);CHKERRQ(ierr); */ /* } */ /* compute 'locMaxEdge' & 'locMaxPE', and create list of edges, count edges' */ for (nEdges=0,kk=0,gid=my0;kk<nloc;kk++,gid++){ PetscReal max_e = 0., tt; PetscScalar vval; PetscInt lid = kk; PetscMPIInt max_pe=rank,pe; ii = matA->i; n = ii[lid+1] - ii[lid]; idx = matA->j + ii[lid]; ap = matA->a + ii[lid]; for (jj=0; jj<n; jj++) { PetscInt lidj = idx[jj]; if (lidj != lid && PetscRealPart(ap[jj]) > max_e) max_e = PetscRealPart(ap[jj]); if (lidj > lid) nEdges++; } if ((ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */ ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix]; ap = matB->a + ii[ix]; idx = matB->j + ii[ix]; for (jj=0 ; jj<n ; jj++) { if ((tt=PetscRealPart(ap[jj])) > max_e) max_e = tt; nEdges++; if ((pe=cpcol_pe[idx[jj]]) > max_pe) max_pe = pe; } } vval = max_e; ierr = VecSetValues(locMaxEdge, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); vval = (PetscScalar)max_pe; ierr = VecSetValues(locMaxPE, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); } ierr = VecAssemblyBegin(locMaxEdge);CHKERRQ(ierr); ierr = VecAssemblyEnd(locMaxEdge);CHKERRQ(ierr); ierr = VecAssemblyBegin(locMaxPE);CHKERRQ(ierr); ierr = VecAssemblyEnd(locMaxPE);CHKERRQ(ierr); /* get 'cpcol_max_ew' & 'cpcol_max_pe' */ if (mpimat) { ierr = VecDuplicate(mpimat->lvec, &ghostMaxEdge);CHKERRQ(ierr); ierr = VecScatterBegin(mpimat->Mvctx,locMaxEdge,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(mpimat->Mvctx,locMaxEdge,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecGetArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr); ierr = VecDuplicate(mpimat->lvec, &ghostMaxPE);CHKERRQ(ierr); ierr = VecScatterBegin(mpimat->Mvctx,locMaxPE,ghostMaxPE,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(mpimat->Mvctx,locMaxPE,ghostMaxPE,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecGetArray(ghostMaxPE, &cpcol_max_pe);CHKERRQ(ierr); } /* setup sorted list of edges */ ierr = PetscMalloc(nEdges*sizeof(Edge), &Edges);CHKERRQ(ierr); ierr = ISGetIndices(perm, &perm_ix);CHKERRQ(ierr); for (nEdges=n_nz_row=kk=0;kk<nloc;kk++){ PetscInt nn, lid = perm_ix[kk]; ii = matA->i; nn = n = ii[lid+1] - ii[lid]; idx = matA->j + ii[lid]; ap = matA->a + ii[lid]; for (jj=0; jj<n; jj++) { PetscInt lidj = idx[jj]; assert(PetscRealPart(ap[jj])>0.); if (lidj > lid) { Edges[nEdges].lid0 = lid; Edges[nEdges].gid1 = lidj + my0; Edges[nEdges].cpid1 = -1; Edges[nEdges].weight = PetscRealPart(ap[jj]); nEdges++; } } if ((ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */ ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix]; ap = matB->a + ii[ix]; idx = matB->j + ii[ix]; nn += n; for (jj=0 ; jj<n ; jj++) { assert(PetscRealPart(ap[jj])>0.); Edges[nEdges].lid0 = lid; Edges[nEdges].gid1 = (PetscInt)PetscRealPart(cpcol_gid[idx[jj]]); Edges[nEdges].cpid1 = idx[jj]; Edges[nEdges].weight = PetscRealPart(ap[jj]); nEdges++; } } if (nn > 1) n_nz_row++; else if (iter == 1){ /* should select this because it is technically in the MIS but lets not */ ierr = PetscCDRemoveAll(agg_llists, lid);CHKERRQ(ierr); } } ierr = ISRestoreIndices(perm,&perm_ix);CHKERRQ(ierr); qsort(Edges, nEdges, sizeof(Edge), gamg_hem_compare); /* projection matrix */ ierr = MatCreateAIJ(wcomm, nloc, nloc, PETSC_DETERMINE, PETSC_DETERMINE, 1, 0, 1, 0, &P);CHKERRQ(ierr); /* clear matched flags */ for (kk=0;kk<nloc;kk++) lid_matched[kk] = PETSC_FALSE; /* process - communicate - process */ for (sub_it=0;sub_it<n_sub_its;sub_it++){ PetscInt nactive_edges; ierr = VecGetArray(locMaxEdge, &lid_max_ew);CHKERRQ(ierr); for (kk=nactive_edges=0;kk<nEdges;kk++){ /* HEM */ const Edge *e = &Edges[kk]; const PetscInt lid0=e->lid0,gid1=e->gid1,cpid1=e->cpid1,gid0=lid0+my0,lid1=gid1-my0; PetscBool isOK = PETSC_TRUE; /* skip if either (local) vertex is done already */ if (lid_matched[lid0] || (gid1>=my0 && gid1<Iend && lid_matched[gid1-my0])) { continue; } /* skip if ghost vertex is done */ if (cpid1 != -1 && cpcol_matched[cpid1]) { continue; } nactive_edges++; /* skip if I have a bigger edge someplace (lid_max_ew gets updated) */ if (PetscRealPart(lid_max_ew[lid0]) > e->weight + 1.e-12) { continue; } if (cpid1 == -1) { if (PetscRealPart(lid_max_ew[lid1]) > e->weight + 1.e-12) { continue; } } else { /* see if edge might get matched on other proc */ PetscReal g_max_e = PetscRealPart(cpcol_max_ew[cpid1]); if (g_max_e > e->weight + 1.e-12) { continue; } else if (e->weight > g_max_e - 1.e-12 && (PetscMPIInt)PetscRealPart(cpcol_max_pe[cpid1]) > rank) { /* check for max_e == to this edge and larger processor that will deal with this */ continue; } } /* check ghost for v0 */ if (isOK){ PetscReal max_e,ew; if ((ix=lid_cprowID[lid0]) != -1) { /* if I have any ghost neighbors */ ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix]; ap = matB->a + ii[ix]; idx = matB->j + ii[ix]; for (jj=0 ; jj<n && isOK; jj++) { PetscInt lidj = idx[jj]; if (cpcol_matched[lidj]) continue; ew = PetscRealPart(ap[jj]); max_e = PetscRealPart(cpcol_max_ew[lidj]); /* check for max_e == to this edge and larger processor that will deal with this */ if (ew > max_e - 1.e-12 && ew > PetscRealPart(lid_max_ew[lid0]) - 1.e-12 && (PetscMPIInt)PetscRealPart(cpcol_max_pe[lidj]) > rank){ isOK = PETSC_FALSE; } } } /* for v1 */ if (cpid1 == -1 && isOK){ if ((ix=lid_cprowID[lid1]) != -1) { /* if I have any ghost neighbors */ ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix]; ap = matB->a + ii[ix]; idx = matB->j + ii[ix]; for (jj=0 ; jj<n && isOK ; jj++) { PetscInt lidj = idx[jj]; if (cpcol_matched[lidj]) continue; ew = PetscRealPart(ap[jj]); max_e = PetscRealPart(cpcol_max_ew[lidj]); /* check for max_e == to this edge and larger processor that will deal with this */ if (ew > max_e - 1.e-12 && ew > PetscRealPart(lid_max_ew[lid1]) - 1.e-12 && (PetscMPIInt)PetscRealPart(cpcol_max_pe[lidj]) > rank) { isOK = PETSC_FALSE; } } } } } /* do it */ if (isOK){ if (cpid1 == -1) { lid_matched[lid1] = PETSC_TRUE; /* keep track of what we've done this round */ ierr = PetscCDAppendRemove(agg_llists, lid0, lid1);CHKERRQ(ierr); } else if (sub_it != n_sub_its-1) { /* add gid1 to list of ghost deleted by me -- I need their children */ proc = cpcol_pe[cpid1]; cpcol_matched[cpid1] = PETSC_TRUE; /* messing with VecGetArray array -- needed??? */ ierr = PetscCDAppendID(deleted_list, proc, cpid1);CHKERRQ(ierr); /* cache to send messages */ ierr = PetscCDAppendID(deleted_list, proc, lid0);CHKERRQ(ierr); } else { continue; } lid_matched[lid0] = PETSC_TRUE; /* keep track of what we've done this round */ /* set projection */ ierr = MatSetValues(P,1,&gid0,1,&gid0,&one,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(P,1,&gid1,1,&gid0,&one,INSERT_VALUES);CHKERRQ(ierr); } /* matched */ } /* edge loop */ /* deal with deleted ghost on first pass */ if (size>1 && sub_it != n_sub_its-1){ PetscCDPos pos; PetscBool ise = PETSC_FALSE; PetscInt nSend1, **sbuffs1,nSend2; #define REQ_BF_SIZE 100 MPI_Request *sreqs2[REQ_BF_SIZE],*rreqs2[REQ_BF_SIZE]; MPI_Status status; /* send request */ for (proc=0,nSend1=0;proc<size;proc++){ ierr = PetscCDEmptyAt(deleted_list,proc,&ise);CHKERRQ(ierr); if (!ise) nSend1++; } ierr = PetscMalloc(nSend1*sizeof(PetscInt*), &sbuffs1);CHKERRQ(ierr); /* ierr = PetscMalloc4(nSend1, PetscInt*, sbuffs1, nSend1, PetscInt*, rbuffs1, nSend1, MPI_Request*, sreqs1, nSend1, MPI_Request*, rreqs1);CHKERRQ(ierr); */ /* PetscFree4(sbuffs1,rbuffs1,sreqs1,rreqs1); */ for (proc=0,nSend1=0;proc<size;proc++){ /* count ghosts */ ierr = PetscCDSizeAt(deleted_list,proc,&n);CHKERRQ(ierr); if (n>0){ #define CHUNCK_SIZE 100 PetscInt *sbuff,*pt; MPI_Request *request; assert(n%2==0); n /= 2; ierr = PetscMalloc((2 + 2*n + n*CHUNCK_SIZE)*sizeof(PetscInt) + 2*sizeof(MPI_Request), &sbuff);CHKERRQ(ierr); /* PetscMalloc4(2+2*n,PetscInt,sbuffs1[nSend1],n*CHUNCK_SIZE,PetscInt,rbuffs1[nSend1],1,MPI_Request,rreqs2[nSend1],1,MPI_Request,sreqs2[nSend1]); */ /* save requests */ sbuffs1[nSend1] = sbuff; request = (MPI_Request*)sbuff; sbuff = pt = (PetscInt*)(request+1); *pt++ = n; *pt++ = rank; ierr = PetscCDGetHeadPos(deleted_list,proc,&pos);CHKERRQ(ierr); while(pos){ PetscInt lid0, cpid, gid; ierr = PetscLLNGetID(pos, &cpid);CHKERRQ(ierr); gid = (PetscInt)PetscRealPart(cpcol_gid[cpid]); ierr = PetscCDGetNextPos(deleted_list,proc,&pos);CHKERRQ(ierr); ierr = PetscLLNGetID(pos, &lid0);CHKERRQ(ierr); ierr = PetscCDGetNextPos(deleted_list,proc,&pos);CHKERRQ(ierr); *pt++ = gid; *pt++ = lid0; } /* send request tag1 [n, proc, n*[gid1,lid0] ] */ ierr = MPI_Isend(sbuff, 2*n+2, MPIU_INT, proc, tag1, wcomm, request);CHKERRQ(ierr); /* post recieve */ request = (MPI_Request*)pt; rreqs2[nSend1] = request; /* cache recv request */ pt = (PetscInt*)(request+1); ierr = MPI_Irecv(pt, n*CHUNCK_SIZE, MPIU_INT, proc, tag2, wcomm, request);CHKERRQ(ierr); /* clear list */ ierr = PetscCDRemoveAll(deleted_list, proc);CHKERRQ(ierr); nSend1++; } } /* recieve requests, send response, clear lists */ kk = nactive_edges; ierr = MPI_Allreduce(&kk,&nactive_edges,1,MPIU_INT,MPI_SUM,wcomm);CHKERRQ(ierr); /* not correct syncronization and global */ nSend2 = 0; while(1){ #define BF_SZ 10000 PetscMPIInt flag,count; PetscInt rbuff[BF_SZ],*pt,*pt2,*pt3,count2,*sbuff,count3; MPI_Request *request; ierr = MPI_Iprobe(MPI_ANY_SOURCE, tag1, wcomm, &flag, &status);CHKERRQ(ierr); if (!flag) break; ierr = MPI_Get_count(&status, MPIU_INT, &count);CHKERRQ(ierr); if (count > BF_SZ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"buffer too small for recieve: %d",count); proc = status.MPI_SOURCE; /* recieve request tag1 [n, proc, n*[gid1,lid0] ] */ ierr = MPI_Recv(rbuff, count, MPIU_INT, proc, tag1, wcomm, &status);CHKERRQ(ierr); /* count sends */ pt = rbuff; count3 = count2 = 0; n = *pt++; kk = *pt++; assert(kk==proc); while(n--){ PetscInt gid1=*pt++, lid1=gid1-my0; kk=*pt++; assert(lid1>=0 && lid1<nloc); if (lid_matched[lid1]){ PetscPrintf(PETSC_COMM_SELF,"\t *** [%d]%s %d) ERROR recieved deleted gid %d, deleted by (lid) %d from proc %d\n",rank,__FUNCT__,sub_it,gid1,kk); PetscSleep(1); } assert(!lid_matched[lid1]); lid_matched[lid1] = PETSC_TRUE; /* keep track of what we've done this round */ ierr = PetscCDSizeAt(agg_llists, lid1, &kk);CHKERRQ(ierr); count2 += kk + 2; count3++; /* number of verts requested (n) */ } assert(pt-rbuff==count); if (count2 > count3*CHUNCK_SIZE) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Irecv will be too small: %d",count2); /* send tag2 *[lid0, n, n*[gid] ] */ ierr = PetscMalloc(count2*sizeof(PetscInt) + sizeof(MPI_Request), &sbuff);CHKERRQ(ierr); request = (MPI_Request*)sbuff; sreqs2[nSend2++] = request; /* cache request */ if (nSend2==REQ_BF_SIZE) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"buffer too small for requests: %d",nSend2); pt2 = sbuff = (PetscInt*)(request+1); pt = rbuff; n = *pt++; kk = *pt++; assert(kk==proc); while(n--){ /* read [n, proc, n*[gid1,lid0] */ PetscInt gid1=*pt++, lid1=gid1-my0, lid0=*pt++; assert(lid1>=0 && lid1<nloc); /* write [lid0, n, n*[gid] ] */ *pt2++ = lid0; pt3 = pt2++; /* save pointer for later */ /* for (pos=PetscCDGetHeadPos(agg_llists,lid1) ; pos ; pos=PetscCDGetNextPos(agg_llists,lid1,pos)){ */ ierr = PetscCDGetHeadPos(agg_llists,lid1,&pos);CHKERRQ(ierr); while(pos){ PetscInt gid; ierr = PetscLLNGetID(pos, &gid);CHKERRQ(ierr); ierr = PetscCDGetNextPos(agg_llists,lid1,&pos);CHKERRQ(ierr); *pt2++ = gid; } *pt3 = (pt2-pt3)-1; /* clear list */ ierr = PetscCDRemoveAll(agg_llists, lid1);CHKERRQ(ierr); } assert(pt2-sbuff==count2); assert(pt-rbuff==count); /* send requested data tag2 *[lid0, n, n*[gid1] ] */ ierr = MPI_Isend(sbuff, count2, MPIU_INT, proc, tag2, wcomm, request);CHKERRQ(ierr); } /* recieve tag2 *[lid0, n, n*[gid] ] */ for (kk=0;kk<nSend1;kk++){ PetscMPIInt count; MPI_Request *request; PetscInt *pt, *pt2; request = rreqs2[kk]; /* no need to free -- buffer is in 'sbuffs1' */ ierr = MPI_Wait(request, &status);CHKERRQ(ierr); ierr = MPI_Get_count(&status, MPIU_INT, &count);CHKERRQ(ierr); pt = pt2 = (PetscInt*)(request+1); while(pt-pt2 < count){ PetscInt lid0 = *pt++, n = *pt++; assert(lid0>=0 && lid0<nloc); while(n--){ PetscInt gid1 = *pt++; ierr = PetscCDAppendID(agg_llists, lid0, gid1);CHKERRQ(ierr); } } assert(pt-pt2==count); } /* wait for tag1 isends */ while(nSend1--){ MPI_Request *request; request = (MPI_Request*)sbuffs1[nSend1]; ierr = MPI_Wait(request, &status);CHKERRQ(ierr); ierr = PetscFree(request);CHKERRQ(ierr); } ierr = PetscFree(sbuffs1);CHKERRQ(ierr); /* wait for tag2 isends */ while(nSend2--){ MPI_Request *request = sreqs2[nSend2]; ierr = MPI_Wait(request, &status);CHKERRQ(ierr); ierr = PetscFree(request);CHKERRQ(ierr); } ierr = VecRestoreArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr); ierr = VecRestoreArray(ghostMaxPE, &cpcol_max_pe);CHKERRQ(ierr); /* get 'cpcol_matched' - use locMaxPE, ghostMaxEdge, cpcol_max_ew */ for (kk=0,gid=my0;kk<nloc;kk++,gid++) { PetscScalar vval = lid_matched[kk] ? 1.0 : 0.0; ierr = VecSetValues(locMaxPE, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); /* set with GID */ } ierr = VecAssemblyBegin(locMaxPE);CHKERRQ(ierr); ierr = VecAssemblyEnd(locMaxPE);CHKERRQ(ierr); ierr = VecScatterBegin(mpimat->Mvctx,locMaxPE,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(mpimat->Mvctx,locMaxPE,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecGetArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr); ierr = VecGetLocalSize(mpimat->lvec, &n);CHKERRQ(ierr); for (kk=0;kk<n;kk++) { cpcol_matched[kk] = (PetscBool)(PetscRealPart(cpcol_max_ew[kk]) != 0.0); } ierr = VecRestoreArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr); } /* size > 1 */ /* compute 'locMaxEdge' */ ierr = VecRestoreArray(locMaxEdge, &lid_max_ew);CHKERRQ(ierr); for (kk=0,gid=my0;kk<nloc;kk++,gid++){ PetscReal max_e = 0.,tt; PetscScalar vval; PetscInt lid = kk; if (lid_matched[lid]) vval = 0.; else { ii = matA->i; n = ii[lid+1] - ii[lid]; idx = matA->j + ii[lid]; ap = matA->a + ii[lid]; for (jj=0; jj<n; jj++) { PetscInt lidj = idx[jj]; if (lid_matched[lidj]) continue; /* this is new - can change local max */ if (lidj != lid && PetscRealPart(ap[jj]) > max_e) max_e = PetscRealPart(ap[jj]); } if (lid_cprowID && (ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */ ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix]; ap = matB->a + ii[ix]; idx = matB->j + ii[ix]; for (jj=0 ; jj<n ; jj++) { PetscInt lidj = idx[jj]; if (cpcol_matched[lidj]) continue; if ((tt=PetscRealPart(ap[jj])) > max_e) max_e = tt; } } } vval = (PetscScalar)max_e; ierr = VecSetValues(locMaxEdge, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); /* set with GID */ } ierr = VecAssemblyBegin(locMaxEdge);CHKERRQ(ierr); ierr = VecAssemblyEnd(locMaxEdge);CHKERRQ(ierr); if (size>1 && sub_it != n_sub_its-1){ /* compute 'cpcol_max_ew' */ ierr = VecScatterBegin(mpimat->Mvctx,locMaxEdge,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(mpimat->Mvctx,locMaxEdge,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecGetArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr); ierr = VecGetArray(locMaxEdge, &lid_max_ew);CHKERRQ(ierr); /* compute 'cpcol_max_pe' */ for (kk=0,gid=my0;kk<nloc;kk++,gid++){ PetscInt lid = kk; PetscReal ew,v1_max_e,v0_max_e=PetscRealPart(lid_max_ew[lid]); PetscScalar vval; PetscMPIInt max_pe=rank,pe; if (lid_matched[lid]) vval = (PetscScalar)rank; else if ((ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */ ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix]; ap = matB->a + ii[ix]; idx = matB->j + ii[ix]; for (jj=0 ; jj<n ; jj++) { PetscInt lidj = idx[jj]; if (cpcol_matched[lidj]) continue; ew = PetscRealPart(ap[jj]); v1_max_e = PetscRealPart(cpcol_max_ew[lidj]); /* get max pe that has a max_e == to this edge w */ if ((pe=cpcol_pe[idx[jj]]) > max_pe && ew > v1_max_e - 1.e-12 && ew > v0_max_e - 1.e-12) max_pe = pe; assert(ew < v0_max_e + 1.e-12 && ew < v1_max_e + 1.e-12); } vval = (PetscScalar)max_pe; } ierr = VecSetValues(locMaxPE, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); } ierr = VecAssemblyBegin(locMaxPE);CHKERRQ(ierr); ierr = VecAssemblyEnd(locMaxPE);CHKERRQ(ierr); ierr = VecScatterBegin(mpimat->Mvctx,locMaxPE,ghostMaxPE,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(mpimat->Mvctx,locMaxPE,ghostMaxPE,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecGetArray(ghostMaxPE, &cpcol_max_pe);CHKERRQ(ierr); ierr = VecRestoreArray(locMaxEdge, &lid_max_ew);CHKERRQ(ierr); } /* deal with deleted ghost */ if (verbose>2) PetscPrintf(wcomm,"\t[%d]%s %d.%d: %d active edges.\n", rank,__FUNCT__,iter,sub_it,nactive_edges); if (!nactive_edges) break; } /* sub_it loop */ /* clean up iteration */ ierr = PetscFree(Edges);CHKERRQ(ierr); if (mpimat){ ierr = VecRestoreArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr); ierr = VecDestroy(&ghostMaxEdge);CHKERRQ(ierr); ierr = VecRestoreArray(ghostMaxPE, &cpcol_max_pe);CHKERRQ(ierr); ierr = VecDestroy(&ghostMaxPE);CHKERRQ(ierr); ierr = PetscFree(cpcol_pe);CHKERRQ(ierr); ierr = PetscFree(cpcol_matched);CHKERRQ(ierr); } ierr = VecDestroy(&locMaxEdge);CHKERRQ(ierr); ierr = VecDestroy(&locMaxPE);CHKERRQ(ierr); if (mpimat){ ierr = VecRestoreArray(mpimat->lvec, &cpcol_gid);CHKERRQ(ierr); } /* create next G if needed */ if (iter == n_iter) { /* hard wired test - need to look at full surrounded nodes or something */ ierr = MatDestroy(&P);CHKERRQ(ierr); ierr = MatDestroy(&cMat);CHKERRQ(ierr); break; } else { Vec diag; /* add identity for unmatched vertices so they stay alive */ for (kk=0,gid=my0;kk<nloc;kk++,gid++){ if (!lid_matched[kk]) { gid = kk+my0; ierr = MatGetRow(cMat,gid,&n,0,0);CHKERRQ(ierr); if (n>1){ ierr = MatSetValues(P,1,&gid,1,&gid,&one,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatRestoreRow(cMat,gid,&n,0,0);CHKERRQ(ierr); } } ierr = MatAssemblyBegin(P,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(P,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* project to make new graph with colapsed edges */ ierr = MatPtAP(cMat,P,MAT_INITIAL_MATRIX,1.0,&tMat);CHKERRQ(ierr); ierr = MatDestroy(&P);CHKERRQ(ierr); ierr = MatDestroy(&cMat);CHKERRQ(ierr); cMat = tMat; ierr = MatGetVecs(cMat, &diag, 0);CHKERRQ(ierr); ierr = MatGetDiagonal(cMat, diag);CHKERRQ(ierr); /* effectively PCJACOBI */ ierr = VecReciprocal(diag);CHKERRQ(ierr); ierr = VecSqrtAbs(diag);CHKERRQ(ierr); ierr = MatDiagonalScale(cMat, diag, diag);CHKERRQ(ierr); ierr = VecDestroy(&diag);CHKERRQ(ierr); } } /* coarsen iterator */ /* make fake matrix */ if (size>1){ Mat mat; PetscCDPos pos; PetscInt gid, NN, MM, jj = 0, mxsz = 0; for (kk=0;kk<nloc;kk++){ ierr = PetscCDSizeAt(agg_llists, kk, &jj);CHKERRQ(ierr); if (jj > mxsz) mxsz = jj; } ierr = MatGetSize(a_Gmat, &MM, &NN);CHKERRQ(ierr); if (mxsz > MM-nloc) mxsz = MM-nloc; ierr = MatCreateAIJ(wcomm, nloc, nloc,PETSC_DETERMINE, PETSC_DETERMINE,0, 0, mxsz, 0, &mat);CHKERRQ(ierr); /* */ for (kk=0,gid=my0;kk<nloc;kk++,gid++){ /* for (pos=PetscCDGetHeadPos(agg_llists,kk) ; pos ; pos=PetscCDGetNextPos(agg_llists,kk,pos)){ */ ierr = PetscCDGetHeadPos(agg_llists,kk,&pos);CHKERRQ(ierr); while(pos){ PetscInt gid1; ierr = PetscLLNGetID(pos, &gid1);CHKERRQ(ierr); ierr = PetscCDGetNextPos(agg_llists,kk,&pos);CHKERRQ(ierr); if (gid1 < my0 || gid1 >= my0+nloc) { ierr = MatSetValues(mat,1,&gid,1,&gid1,&one,ADD_VALUES);CHKERRQ(ierr); } } } ierr = MatAssemblyBegin(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscCDSetMat(agg_llists, mat);CHKERRQ(ierr); } ierr = PetscFree(lid_cprowID);CHKERRQ(ierr); ierr = PetscFree(lid_gid);CHKERRQ(ierr); ierr = PetscFree(lid_matched);CHKERRQ(ierr); ierr = PetscCDDestroy(deleted_list);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc,char **argv) { Mat A; /* problem matrix */ EPS eps; /* eigenproblem solver context */ EPSType type; PetscReal error,tol,re,im; PetscScalar kr,ki,value[3]; Vec xr,xi; PetscInt n=30,i,Istart,Iend,col[3],nev,maxit,its,nconv; PetscBool FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE; PetscErrorCode ierr; SlepcInitialize(&argc,&argv,(char*)0,help); ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n1-D Laplacian Eigenproblem, n=%D\n\n",n);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Compute the operator matrix that defines the eigensystem, Ax=kx - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr); if (Istart==0) FirstBlock=PETSC_TRUE; if (Iend==n) LastBlock=PETSC_TRUE; value[0]=-1.0; value[1]=2.0; value[2]=-1.0; for (i=(FirstBlock? Istart+1: Istart); i<(LastBlock? Iend-1: Iend); i++) { col[0]=i-1; col[1]=i; col[2]=i+1; ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); } if (LastBlock) { i=n-1; col[0]=n-2; col[1]=n-1; ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); } if (FirstBlock) { i=0; col[0]=0; col[1]=1; value[0]=2.0; value[1]=-1.0; ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatGetVecs(A,NULL,&xr);CHKERRQ(ierr); ierr = MatGetVecs(A,NULL,&xi);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create the eigensolver and set various options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Create eigensolver context */ ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr); /* Set operators. In this case, it is a standard eigenvalue problem */ ierr = EPSSetOperators(eps,A,NULL);CHKERRQ(ierr); ierr = EPSSetProblemType(eps,EPS_HEP);CHKERRQ(ierr); /* Set solver parameters at runtime */ ierr = EPSSetFromOptions(eps);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve the eigensystem - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = EPSSolve(eps);CHKERRQ(ierr); /* Optional: Get some information from the solver and display it */ ierr = EPSGetIterationNumber(eps,&its);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %D\n",its);CHKERRQ(ierr); ierr = EPSGetType(eps,&type);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr); ierr = EPSGetDimensions(eps,&nev,NULL,NULL);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %D\n",nev);CHKERRQ(ierr); ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%D\n",(double)tol,maxit);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Display solution and clean up - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Get number of converged approximate eigenpairs */ ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged eigenpairs: %D\n\n",nconv);CHKERRQ(ierr); if (nconv>0) { /* Display eigenvalues and relative errors */ ierr = PetscPrintf(PETSC_COMM_WORLD, " k ||Ax-kx||/||kx||\n" " ----------------- ------------------\n");CHKERRQ(ierr); for (i=0;i<nconv;i++) { /* Get converged eigenpairs: i-th eigenvalue is stored in kr (real part) and ki (imaginary part) */ ierr = EPSGetEigenpair(eps,i,&kr,&ki,xr,xi);CHKERRQ(ierr); /* Compute the relative error associated to each eigenpair */ ierr = EPSComputeRelativeError(eps,i,&error);CHKERRQ(ierr); #if defined(PETSC_USE_COMPLEX) re = PetscRealPart(kr); im = PetscImaginaryPart(kr); #else re = kr; im = ki; #endif if (im!=0.0) { ierr = PetscPrintf(PETSC_COMM_WORLD," %9f%+9f j %12g\n",(double)re,(double)im,(double)error);CHKERRQ(ierr); } else { ierr = PetscPrintf(PETSC_COMM_WORLD," %12f %12g\n",(double)re,(double)error);CHKERRQ(ierr); } } ierr = PetscPrintf(PETSC_COMM_WORLD,"\n");CHKERRQ(ierr); } /* Free work space */ ierr = EPSDestroy(&eps);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = VecDestroy(&xr);CHKERRQ(ierr); ierr = VecDestroy(&xi);CHKERRQ(ierr); ierr = SlepcFinalize(); return 0; }
int main(int argc,char **argv) { TS ts; SNES snes_alg; PetscErrorCode ierr; PetscMPIInt size; Userctx user; PetscViewer Xview,Ybusview; Vec X; Mat J; PetscInt i; ierr = PetscInitialize(&argc,&argv,"petscoptions",help);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs"); user.neqs_gen = 9*ngen; /* # eqs. for generator subsystem */ user.neqs_net = 2*nbus; /* # eqs. for network subsystem */ user.neqs_pgrid = user.neqs_gen + user.neqs_net; /* Create indices for differential and algebraic equations */ PetscInt *idx2; ierr = PetscMalloc1(7*ngen,&idx2);CHKERRQ(ierr); for (i=0; i<ngen; i++) { idx2[7*i] = 9*i; idx2[7*i+1] = 9*i+1; idx2[7*i+2] = 9*i+2; idx2[7*i+3] = 9*i+3; idx2[7*i+4] = 9*i+6; idx2[7*i+5] = 9*i+7; idx2[7*i+6] = 9*i+8; } ierr = ISCreateGeneral(PETSC_COMM_WORLD,7*ngen,idx2,PETSC_COPY_VALUES,&user.is_diff);CHKERRQ(ierr); ierr = ISComplement(user.is_diff,0,user.neqs_pgrid,&user.is_alg);CHKERRQ(ierr); ierr = PetscFree(idx2);CHKERRQ(ierr); /* Read initial voltage vector and Ybus */ ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"X.bin",FILE_MODE_READ,&Xview);CHKERRQ(ierr); ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"Ybus.bin",FILE_MODE_READ,&Ybusview);CHKERRQ(ierr); ierr = VecCreate(PETSC_COMM_WORLD,&user.V0);CHKERRQ(ierr); ierr = VecSetSizes(user.V0,PETSC_DECIDE,user.neqs_net);CHKERRQ(ierr); ierr = VecLoad(user.V0,Xview);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&user.Ybus);CHKERRQ(ierr); ierr = MatSetSizes(user.Ybus,PETSC_DECIDE,PETSC_DECIDE,user.neqs_net,user.neqs_net);CHKERRQ(ierr); ierr = MatSetType(user.Ybus,MATBAIJ);CHKERRQ(ierr); /* ierr = MatSetBlockSize(user.Ybus,2);CHKERRQ(ierr); */ ierr = MatLoad(user.Ybus,Ybusview);CHKERRQ(ierr); /* Set run time options */ ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Transient stability fault options","");CHKERRQ(ierr); { user.tfaulton = 1.0; user.tfaultoff = 1.2; user.Rfault = 0.0001; user.faultbus = 8; ierr = PetscOptionsReal("-tfaulton","","",user.tfaulton,&user.tfaulton,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-tfaultoff","","",user.tfaultoff,&user.tfaultoff,NULL);CHKERRQ(ierr); ierr = PetscOptionsInt("-faultbus","","",user.faultbus,&user.faultbus,NULL);CHKERRQ(ierr); user.t0 = 0.0; user.tmax = 5.0; ierr = PetscOptionsReal("-t0","","",user.t0,&user.t0,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-tmax","","",user.tmax,&user.tmax,NULL);CHKERRQ(ierr); } ierr = PetscOptionsEnd();CHKERRQ(ierr); ierr = PetscViewerDestroy(&Xview);CHKERRQ(ierr); ierr = PetscViewerDestroy(&Ybusview);CHKERRQ(ierr); /* Create DMs for generator and network subsystems */ ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_gen,1,1,NULL,&user.dmgen);CHKERRQ(ierr); ierr = DMSetOptionsPrefix(user.dmgen,"dmgen_");CHKERRQ(ierr); ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_net,1,1,NULL,&user.dmnet);CHKERRQ(ierr); ierr = DMSetOptionsPrefix(user.dmnet,"dmnet_");CHKERRQ(ierr); /* Create a composite DM packer and add the two DMs */ ierr = DMCompositeCreate(PETSC_COMM_WORLD,&user.dmpgrid);CHKERRQ(ierr); ierr = DMSetOptionsPrefix(user.dmpgrid,"pgrid_");CHKERRQ(ierr); ierr = DMCompositeAddDM(user.dmpgrid,user.dmgen);CHKERRQ(ierr); ierr = DMCompositeAddDM(user.dmpgrid,user.dmnet);CHKERRQ(ierr); ierr = DMCreateGlobalVector(user.dmpgrid,&X);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr); ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,user.neqs_pgrid,user.neqs_pgrid);CHKERRQ(ierr); ierr = MatSetFromOptions(J);CHKERRQ(ierr); ierr = PreallocateJacobian(J,&user);CHKERRQ(ierr); /* Create matrix to save solutions at each time step */ user.stepnum = 0; ierr = MatCreateSeqDense(PETSC_COMM_SELF,user.neqs_pgrid+1,1002,NULL,&user.Sol);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetEquationType(ts,TS_EQ_DAE_IMPLICIT_INDEX1);CHKERRQ(ierr); ierr = TSARKIMEXSetFullyImplicit(ts,PETSC_TRUE);CHKERRQ(ierr); ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,&user);CHKERRQ(ierr); ierr = TSSetIJacobian(ts,J,J,(TSIJacobian)IJacobian,&user);CHKERRQ(ierr); ierr = TSSetApplicationContext(ts,&user);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = SetInitialGuess(X,&user);CHKERRQ(ierr); /* Just to set up the Jacobian structure */ Vec Xdot; ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr); ierr = IJacobian(ts,0.0,X,Xdot,0.0,J,J,&user);CHKERRQ(ierr); ierr = VecDestroy(&Xdot);CHKERRQ(ierr); /* Save initial solution */ PetscScalar *x,*mat; PetscInt idx=user.stepnum*(user.neqs_pgrid+1); ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr); ierr = VecGetArray(X,&x);CHKERRQ(ierr); mat[idx] = 0.0; ierr = PetscMemcpy(mat+idx+1,x,user.neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr); ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr); ierr = VecRestoreArray(X,&x);CHKERRQ(ierr); user.stepnum++; ierr = TSSetDuration(ts,1000,user.tfaulton);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,0.01);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); ierr = TSSetPostStep(ts,SaveSolution);CHKERRQ(ierr); user.alg_flg = PETSC_FALSE; /* Prefault period */ ierr = TSSolve(ts,X);CHKERRQ(ierr); /* Create the nonlinear solver for solving the algebraic system */ /* Note that although the algebraic system needs to be solved only for Idq and V, we reuse the entire system including xgen. The xgen variables are held constant by setting their residuals to 0 and putting a 1 on the Jacobian diagonal for xgen rows */ Vec F_alg; ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr); ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr); ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,&user);CHKERRQ(ierr); ierr = MatZeroEntries(J);CHKERRQ(ierr); ierr = SNESSetJacobian(snes_alg,J,J,AlgJacobian,&user);CHKERRQ(ierr); ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr); ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr); /* Apply disturbance - resistive fault at user.faultbus */ /* This is done by adding shunt conductance to the diagonal location in the Ybus matrix */ PetscInt row_loc,col_loc; PetscScalar val; row_loc = 2*user.faultbus; col_loc = 2*user.faultbus+1; /* Location for G */ val = 1/user.Rfault; ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr); row_loc = 2*user.faultbus+1; col_loc = 2*user.faultbus; /* Location for G */ val = 1/user.Rfault; ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); user.alg_flg = PETSC_TRUE; /* Solve the algebraic equations */ ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr); /* Save fault-on solution */ idx = user.stepnum*(user.neqs_pgrid+1); ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr); ierr = VecGetArray(X,&x);CHKERRQ(ierr); mat[idx] = user.tfaulton; ierr = PetscMemcpy(mat+idx+1,x,user.neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr); ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr); ierr = VecRestoreArray(X,&x);CHKERRQ(ierr); user.stepnum++; /* Disturbance period */ ierr = TSSetDuration(ts,1000,user.tfaultoff);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,user.tfaulton,.01);CHKERRQ(ierr); user.alg_flg = PETSC_FALSE; ierr = TSSolve(ts,X);CHKERRQ(ierr); /* Remove the fault */ row_loc = 2*user.faultbus; col_loc = 2*user.faultbus+1; val = -1/user.Rfault; ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr); row_loc = 2*user.faultbus+1; col_loc = 2*user.faultbus; val = -1/user.Rfault; ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatZeroEntries(J);CHKERRQ(ierr); user.alg_flg = PETSC_TRUE; /* Solve the algebraic equations */ ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr); /* Save tfault off solution */ idx = user.stepnum*(user.neqs_pgrid+1); ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr); ierr = VecGetArray(X,&x);CHKERRQ(ierr); mat[idx] = user.tfaultoff; ierr = PetscMemcpy(mat+idx+1,x,user.neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr); ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr); ierr = VecRestoreArray(X,&x);CHKERRQ(ierr); user.stepnum++; /* Post-disturbance period */ ierr = TSSetDuration(ts,1000,user.tmax);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,user.tfaultoff,.01);CHKERRQ(ierr); user.alg_flg = PETSC_TRUE; ierr = TSSolve(ts,X);CHKERRQ(ierr); ierr = MatAssemblyBegin(user.Sol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(user.Sol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); Mat A; PetscScalar *amat; ierr = MatCreateSeqDense(PETSC_COMM_SELF,user.neqs_pgrid+1,user.stepnum,NULL,&A);CHKERRQ(ierr); ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr); ierr = MatDenseGetArray(A,&amat);CHKERRQ(ierr); ierr = PetscMemcpy(amat,mat,(user.stepnum*(user.neqs_pgrid+1))*sizeof(PetscScalar));CHKERRQ(ierr); ierr = MatDenseRestoreArray(A,&amat);CHKERRQ(ierr); ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr); PetscViewer viewer; ierr = PetscViewerBinaryOpen(PETSC_COMM_SELF,"out.bin",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr); ierr = MatView(A,viewer);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr); ierr = VecDestroy(&F_alg);CHKERRQ(ierr); ierr = MatDestroy(&J);CHKERRQ(ierr); ierr = MatDestroy(&user.Ybus);CHKERRQ(ierr); ierr = MatDestroy(&user.Sol);CHKERRQ(ierr); ierr = VecDestroy(&X);CHKERRQ(ierr); ierr = VecDestroy(&user.V0);CHKERRQ(ierr); ierr = DMDestroy(&user.dmgen);CHKERRQ(ierr); ierr = DMDestroy(&user.dmnet);CHKERRQ(ierr); ierr = DMDestroy(&user.dmpgrid);CHKERRQ(ierr); ierr = ISDestroy(&user.is_diff);CHKERRQ(ierr); ierr = ISDestroy(&user.is_alg);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = PetscFinalize(); return(0); }
int main(int argc,char **args) { Mat A,B,C; PetscInt i,j,k,m = 3,n = 3,bs = 1; PetscErrorCode ierr; PetscMPIInt size; ierr = PetscInitialize(&argc,&args,(char*)0,help);CHKERRQ(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!"); ierr = PetscOptionsGetInt(NULL,NULL,"-m",&m,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-bs",&bs,NULL);CHKERRQ(ierr); /* adjust sizes by block size */ if (m%bs) m += bs-m%bs; if (n%bs) n += bs-n%bs; ierr = MatCreate(PETSC_COMM_SELF,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,m*n,m*n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); ierr = MatSetBlockSize(A,bs);CHKERRQ(ierr); ierr = MatSetType(A,MATSEQAIJ);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_SELF,&B);CHKERRQ(ierr); ierr = MatSetSizes(B,m*n,m*n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); ierr = MatSetBlockSize(B,bs);CHKERRQ(ierr); ierr = MatSetType(B,MATSEQBAIJ);CHKERRQ(ierr); ierr = MatSetUp(B);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_SELF,&C);CHKERRQ(ierr); ierr = MatSetSizes(C,m*n,m*n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); ierr = MatSetBlockSize(C,bs);CHKERRQ(ierr); ierr = MatSetType(C,MATSEQSBAIJ);CHKERRQ(ierr); ierr = MatSetUp(C);CHKERRQ(ierr); ierr = MatSetOption(C,MAT_IGNORE_LOWER_TRIANGULAR,PETSC_TRUE);CHKERRQ(ierr); for (i=0; i<m; i++) { for (j=0; j<n; j++) { PetscScalar v = -1.0; PetscInt Ii = j + n*i,J; J = Ii - n; if (J>=0) { ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(B,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); } J = Ii + n; if (J<m*n) { ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(B,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); } J = Ii - 1; if (J>=0) { ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(B,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); } J = Ii + 1; if (J<m*n) { ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(B,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); } v = 4.0; ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(B,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr); } } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* test MatGetRowIJ for the three Mat types */ ierr = MatView(A,NULL);CHKERRQ(ierr); ierr = MatView(B,NULL);CHKERRQ(ierr); ierr = MatView(C,NULL);CHKERRQ(ierr); for (i=0;i<2;i++) { PetscInt shift = i; for (j=0;j<2;j++) { PetscBool symmetric = ((j>0) ? PETSC_FALSE : PETSC_TRUE); for (k=0;k<2;k++) { PetscBool compressed = ((k>0) ? PETSC_FALSE : PETSC_TRUE); ierr = DumpCSR(A,shift,symmetric,compressed);CHKERRQ(ierr); ierr = DumpCSR(B,shift,symmetric,compressed);CHKERRQ(ierr); ierr = DumpCSR(C,shift,symmetric,compressed);CHKERRQ(ierr); } } } ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&B);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
int main(int argc,char **args) { PetscErrorCode ierr; Mat mat,fact,B; PetscInt ind1[2],ind2[2]; PetscScalar temp[2*2]; PetscInt nnz[3]; IS perm,colp; MatFactorInfo info; PetscInitialize(&argc,&args,0,help); nnz[0]=2;nnz[1]=1;nnz[2]=1; ierr = MatCreateSeqSBAIJ(PETSC_COMM_SELF,2,6,6,0,nnz,&mat);CHKERRQ(ierr); ind1[0]=0;ind1[1]=1; temp[0]=3;temp[1]=2;temp[2]=0;temp[3]=3; ierr = MatSetValues(mat,2,ind1,2,ind1,temp,INSERT_VALUES);CHKERRQ(ierr); ind2[0]=4;ind2[1]=5; temp[0]=1;temp[1]=1;temp[2]=2;temp[3]=1; ierr = MatSetValues(mat,2,ind1,2,ind2,temp,INSERT_VALUES);CHKERRQ(ierr); ind1[0]=2;ind1[1]=3; temp[0]=4;temp[1]=1;temp[2]=1;temp[3]=5; ierr = MatSetValues(mat,2,ind1,2,ind1,temp,INSERT_VALUES);CHKERRQ(ierr); ind1[0]=4;ind1[1]=5; temp[0]=5;temp[1]=1;temp[2]=1;temp[3]=6; ierr = MatSetValues(mat,2,ind1,2,ind1,temp,INSERT_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatDuplicate(mat,MAT_SHARE_NONZERO_PATTERN,&B);CHKERRQ(ierr); ind1[0]=0;ind1[1]=1; temp[0]=3;temp[1]=2;temp[2]=0;temp[3]=3; ierr = MatSetValues(mat,2,ind1,2,ind1,temp,INSERT_VALUES);CHKERRQ(ierr); ind2[0]=4;ind2[1]=5; temp[0]=1;temp[1]=1;temp[2]=2;temp[3]=1; ierr = MatSetValues(mat,2,ind1,2,ind2,temp,INSERT_VALUES);CHKERRQ(ierr); ind1[0]=2;ind1[1]=3; temp[0]=4;temp[1]=1;temp[2]=1;temp[3]=5; ierr = MatSetValues(mat,2,ind1,2,ind1,temp,INSERT_VALUES);CHKERRQ(ierr); ind1[0]=4;ind1[1]=5; temp[0]=5;temp[1]=1;temp[2]=1;temp[3]=6; ierr = MatSetValues(mat,2,ind1,2,ind1,temp,INSERT_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"mat: \n");CHKERRQ(ierr); ierr = MatView(mat,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); // begin cholesky factorization ierr = MatGetOrdering(mat,MATORDERINGNATURAL,&perm,&colp);CHKERRQ(ierr); ierr = ISDestroy(&colp);CHKERRQ(ierr); info.fill=1.0; ierr = MatGetFactor(mat,MATSOLVERPETSC,MAT_FACTOR_CHOLESKY,&fact);CHKERRQ(ierr); ierr = MatCholeskyFactorSymbolic(fact,mat,perm,&info);CHKERRQ(ierr); ierr = MatCholeskyFactorNumeric(fact,mat,&info);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"Chol factor: \n"); ierr = MatView(fact, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); ierr = ISDestroy(&perm);CHKERRQ(ierr); ierr = MatDestroy(&mat);CHKERRQ(ierr); ierr = MatDestroy(&fact);CHKERRQ(ierr); ierr = MatDestroy(&B);CHKERRQ(ierr); PetscFinalize(); return 0; }
int main(int argc,char **argv) { KSP solver; PC prec; Mat A,M; Vec X,B,D; MPI_Comm comm; PetscScalar v; KSPConvergedReason reason; PetscInt i,j,its; PetscErrorCode ierr; ierr = PetscInitialize(&argc,&argv,0,help);if (ierr) return ierr; comm = MPI_COMM_SELF; /* * Construct the Kershaw matrix * and a suitable rhs / initial guess */ ierr = MatCreateSeqAIJ(comm,4,4,4,0,&A);CHKERRQ(ierr); ierr = VecCreateSeq(comm,4,&B);CHKERRQ(ierr); ierr = VecDuplicate(B,&X);CHKERRQ(ierr); for (i=0; i<4; i++) { v = 3; ierr = MatSetValues(A,1,&i,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); v = 1; ierr = VecSetValues(B,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = VecSetValues(X,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); } i=0; v=0; ierr = VecSetValues(X,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); for (i=0; i<3; i++) { v = -2; j=i+1; ierr = MatSetValues(A,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(A,1,&j,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); } i=0; j=3; v=2; ierr = MatSetValues(A,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(A,1,&j,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = VecAssemblyBegin(B);CHKERRQ(ierr); ierr = VecAssemblyEnd(B);CHKERRQ(ierr); /* * A Conjugate Gradient method * with ILU(0) preconditioning */ ierr = KSPCreate(comm,&solver);CHKERRQ(ierr); ierr = KSPSetOperators(solver,A,A);CHKERRQ(ierr); ierr = KSPSetType(solver,KSPCG);CHKERRQ(ierr); ierr = KSPSetInitialGuessNonzero(solver,PETSC_TRUE);CHKERRQ(ierr); /* * ILU preconditioner; * this will break down unless you add the Shift line, * or use the -pc_factor_shift_positive_definite option */ ierr = KSPGetPC(solver,&prec);CHKERRQ(ierr); ierr = PCSetType(prec,PCILU);CHKERRQ(ierr); /* ierr = PCFactorSetShiftType(prec,MAT_SHIFT_POSITIVE_DEFINITE);CHKERRQ(ierr); */ ierr = KSPSetFromOptions(solver);CHKERRQ(ierr); ierr = KSPSetUp(solver);CHKERRQ(ierr); /* * Now that the factorisation is done, show the pivots; * note that the last one is negative. This in itself is not an error, * but it will make the iterative method diverge. */ ierr = PCFactorGetMatrix(prec,&M);CHKERRQ(ierr); ierr = VecDuplicate(B,&D);CHKERRQ(ierr); ierr = MatGetDiagonal(M,D);CHKERRQ(ierr); /* * Solve the system; * without the shift this will diverge with * an indefinite preconditioner */ ierr = KSPSolve(solver,B,X);CHKERRQ(ierr); ierr = KSPGetConvergedReason(solver,&reason);CHKERRQ(ierr); if (reason==KSP_DIVERGED_INDEFINITE_PC) { ierr = PetscPrintf(PETSC_COMM_WORLD,"\nDivergence because of indefinite preconditioner;\n");CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"Run the executable again but with '-pc_factor_shift_type POSITIVE_DEFINITE' option.\n");CHKERRQ(ierr); } else if (reason<0) { ierr = PetscPrintf(PETSC_COMM_WORLD,"\nOther kind of divergence: this should not happen.\n");CHKERRQ(ierr); } else { ierr = KSPGetIterationNumber(solver,&its);CHKERRQ(ierr); } ierr = VecDestroy(&X);CHKERRQ(ierr); ierr = VecDestroy(&B);CHKERRQ(ierr); ierr = VecDestroy(&D);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = KSPDestroy(&solver);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
static PetscErrorCode triangulateAndFormProl(IS selected_2,PetscInt data_stride,PetscReal coords[],PetscInt nselected_1,const PetscInt clid_lid_1[],const PetscCoarsenData *agg_lists_1, const PetscInt crsGID[],PetscInt bs,Mat a_Prol,PetscReal *a_worst_best) { #if defined(PETSC_HAVE_TRIANGLE) PetscErrorCode ierr; PetscInt jj,tid,tt,idx,nselected_2; struct triangulateio in,mid; const PetscInt *selected_idx_2; PetscMPIInt rank; PetscInt Istart,Iend,nFineLoc,myFine0; int kk,nPlotPts,sid; MPI_Comm comm; PetscReal tm; PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)a_Prol,&comm);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); ierr = ISGetSize(selected_2, &nselected_2);CHKERRQ(ierr); if (nselected_2 == 1 || nselected_2 == 2) { /* 0 happens on idle processors */ *a_worst_best = 100.0; /* this will cause a stop, but not globalized (should not happen) */ } else *a_worst_best = 0.0; ierr = MPI_Allreduce(a_worst_best, &tm, 1, MPIU_REAL, MPIU_MAX, comm);CHKERRQ(ierr); if (tm > 0.0) { *a_worst_best = 100.0; PetscFunctionReturn(0); } ierr = MatGetOwnershipRange(a_Prol, &Istart, &Iend);CHKERRQ(ierr); nFineLoc = (Iend-Istart)/bs; myFine0 = Istart/bs; nPlotPts = nFineLoc; /* locals */ /* traingle */ /* Define input points - in*/ in.numberofpoints = nselected_2; in.numberofpointattributes = 0; /* get nselected points */ ierr = PetscMalloc1(2*nselected_2, &in.pointlist);CHKERRQ(ierr); ierr = ISGetIndices(selected_2, &selected_idx_2);CHKERRQ(ierr); for (kk=0,sid=0; kk<nselected_2; kk++,sid += 2) { PetscInt lid = selected_idx_2[kk]; in.pointlist[sid] = coords[lid]; in.pointlist[sid+1] = coords[data_stride + lid]; if (lid>=nFineLoc) nPlotPts++; } if (sid != 2*nselected_2) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"sid %D != 2*nselected_2 %D",sid,nselected_2); in.numberofsegments = 0; in.numberofedges = 0; in.numberofholes = 0; in.numberofregions = 0; in.trianglelist = 0; in.segmentmarkerlist = 0; in.pointattributelist = 0; in.pointmarkerlist = 0; in.triangleattributelist = 0; in.trianglearealist = 0; in.segmentlist = 0; in.holelist = 0; in.regionlist = 0; in.edgelist = 0; in.edgemarkerlist = 0; in.normlist = 0; /* triangulate */ mid.pointlist = 0; /* Not needed if -N switch used. */ /* Not needed if -N switch used or number of point attributes is zero: */ mid.pointattributelist = 0; mid.pointmarkerlist = 0; /* Not needed if -N or -B switch used. */ mid.trianglelist = 0; /* Not needed if -E switch used. */ /* Not needed if -E switch used or number of triangle attributes is zero: */ mid.triangleattributelist = 0; mid.neighborlist = 0; /* Needed only if -n switch used. */ /* Needed only if segments are output (-p or -c) and -P not used: */ mid.segmentlist = 0; /* Needed only if segments are output (-p or -c) and -P and -B not used: */ mid.segmentmarkerlist = 0; mid.edgelist = 0; /* Needed only if -e switch used. */ mid.edgemarkerlist = 0; /* Needed if -e used and -B not used. */ mid.numberoftriangles = 0; /* Triangulate the points. Switches are chosen to read and write a */ /* PSLG (p), preserve the convex hull (c), number everything from */ /* zero (z), assign a regional attribute to each element (A), and */ /* produce an edge list (e), a Voronoi diagram (v), and a triangle */ /* neighbor list (n). */ if (nselected_2 != 0) { /* inactive processor */ char args[] = "npczQ"; /* c is needed ? */ triangulate(args, &in, &mid, (struct triangulateio*) NULL); /* output .poly files for 'showme' */ if (!PETSC_TRUE) { static int level = 1; FILE *file; char fname[32]; sprintf(fname,"C%d_%d.poly",level,rank); file = fopen(fname, "w"); /*First line: <# of vertices> <dimension (must be 2)> <# of attributes> <# of boundary markers (0 or 1)>*/ fprintf(file, "%d %d %d %d\n",in.numberofpoints,2,0,0); /*Following lines: <vertex #> <x> <y> */ for (kk=0,sid=0; kk<in.numberofpoints; kk++,sid += 2) { fprintf(file, "%d %e %e\n",kk,in.pointlist[sid],in.pointlist[sid+1]); } /*One line: <# of segments> <# of boundary markers (0 or 1)> */ fprintf(file, "%d %d\n",0,0); /*Following lines: <segment #> <endpoint> <endpoint> [boundary marker] */ /* One line: <# of holes> */ fprintf(file, "%d\n",0); /* Following lines: <hole #> <x> <y> */ /* Optional line: <# of regional attributes and/or area constraints> */ /* Optional following lines: <region #> <x> <y> <attribute> <maximum area> */ fclose(file); /* elems */ sprintf(fname,"C%d_%d.ele",level,rank); file = fopen(fname, "w"); /* First line: <# of triangles> <nodes per triangle> <# of attributes> */ fprintf(file, "%d %d %d\n",mid.numberoftriangles,3,0); /* Remaining lines: <triangle #> <node> <node> <node> ... [attributes] */ for (kk=0,sid=0; kk<mid.numberoftriangles; kk++,sid += 3) { fprintf(file, "%d %d %d %d\n",kk,mid.trianglelist[sid],mid.trianglelist[sid+1],mid.trianglelist[sid+2]); } fclose(file); sprintf(fname,"C%d_%d.node",level,rank); file = fopen(fname, "w"); /* First line: <# of vertices> <dimension (must be 2)> <# of attributes> <# of boundary markers (0 or 1)> */ /* fprintf(file, "%d %d %d %d\n",in.numberofpoints,2,0,0); */ fprintf(file, "%d %d %d %d\n",nPlotPts,2,0,0); /*Following lines: <vertex #> <x> <y> */ for (kk=0,sid=0; kk<in.numberofpoints; kk++,sid+=2) { fprintf(file, "%d %e %e\n",kk,in.pointlist[sid],in.pointlist[sid+1]); } sid /= 2; for (jj=0; jj<nFineLoc; jj++) { PetscBool sel = PETSC_TRUE; for (kk=0; kk<nselected_2 && sel; kk++) { PetscInt lid = selected_idx_2[kk]; if (lid == jj) sel = PETSC_FALSE; } if (sel) fprintf(file, "%d %e %e\n",sid++,coords[jj],coords[data_stride + jj]); } fclose(file); if (sid != nPlotPts) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"sid %D != nPlotPts %D",sid,nPlotPts); level++; } } #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventBegin(petsc_gamg_setup_events[FIND_V],0,0,0,0);CHKERRQ(ierr); #endif { /* form P - setup some maps */ PetscInt clid,mm,*nTri,*node_tri; ierr = PetscMalloc2(nselected_2, &node_tri,nselected_2, &nTri);CHKERRQ(ierr); /* need list of triangles on node */ for (kk=0; kk<nselected_2; kk++) nTri[kk] = 0; for (tid=0,kk=0; tid<mid.numberoftriangles; tid++) { for (jj=0; jj<3; jj++) { PetscInt cid = mid.trianglelist[kk++]; if (nTri[cid] == 0) node_tri[cid] = tid; nTri[cid]++; } } #define EPS 1.e-12 /* find points and set prolongation */ for (mm = clid = 0; mm < nFineLoc; mm++) { PetscBool ise; ierr = PetscCDEmptyAt(agg_lists_1,mm,&ise);CHKERRQ(ierr); if (!ise) { const PetscInt lid = mm; /* for (clid_iterator=0;clid_iterator<nselected_1;clid_iterator++) { */ PetscScalar AA[3][3]; PetscBLASInt N=3,NRHS=1,LDA=3,IPIV[3],LDB=3,INFO; PetscCDPos pos; ierr = PetscCDGetHeadPos(agg_lists_1,lid,&pos);CHKERRQ(ierr); while (pos) { PetscInt flid; ierr = PetscLLNGetID(pos, &flid);CHKERRQ(ierr); ierr = PetscCDGetNextPos(agg_lists_1,lid,&pos);CHKERRQ(ierr); if (flid < nFineLoc) { /* could be a ghost */ PetscInt bestTID = -1; PetscReal best_alpha = 1.e10; const PetscInt fgid = flid + myFine0; /* compute shape function for gid */ const PetscReal fcoord[3] = {coords[flid],coords[data_stride+flid],1.0}; PetscBool haveit =PETSC_FALSE; PetscScalar alpha[3]; PetscInt clids[3]; /* look for it */ for (tid = node_tri[clid], jj=0; jj < 5 && !haveit && tid != -1; jj++) { for (tt=0; tt<3; tt++) { PetscInt cid2 = mid.trianglelist[3*tid + tt]; PetscInt lid2 = selected_idx_2[cid2]; AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0; clids[tt] = cid2; /* store for interp */ } for (tt=0; tt<3; tt++) alpha[tt] = (PetscScalar)fcoord[tt]; /* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */ PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO)); { PetscBool have=PETSC_TRUE; PetscReal lowest=1.e10; for (tt = 0, idx = 0; tt < 3; tt++) { if (PetscRealPart(alpha[tt]) > (1.0+EPS) || PetscRealPart(alpha[tt]) < -EPS) have = PETSC_FALSE; if (PetscRealPart(alpha[tt]) < lowest) { lowest = PetscRealPart(alpha[tt]); idx = tt; } } haveit = have; } tid = mid.neighborlist[3*tid + idx]; } if (!haveit) { /* brute force */ for (tid=0; tid<mid.numberoftriangles && !haveit; tid++) { for (tt=0; tt<3; tt++) { PetscInt cid2 = mid.trianglelist[3*tid + tt]; PetscInt lid2 = selected_idx_2[cid2]; AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0; clids[tt] = cid2; /* store for interp */ } for (tt=0; tt<3; tt++) alpha[tt] = fcoord[tt]; /* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */ PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO)); { PetscBool have=PETSC_TRUE; PetscReal worst=0.0, v; for (tt=0; tt<3 && have; tt++) { if (PetscRealPart(alpha[tt]) > 1.0+EPS || PetscRealPart(alpha[tt]) < -EPS) have=PETSC_FALSE; if ((v=PetscAbs(PetscRealPart(alpha[tt])-0.5)) > worst) worst = v; } if (worst < best_alpha) { best_alpha = worst; bestTID = tid; } haveit = have; } } } if (!haveit) { if (best_alpha > *a_worst_best) *a_worst_best = best_alpha; /* use best one */ for (tt=0; tt<3; tt++) { PetscInt cid2 = mid.trianglelist[3*bestTID + tt]; PetscInt lid2 = selected_idx_2[cid2]; AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0; clids[tt] = cid2; /* store for interp */ } for (tt=0; tt<3; tt++) alpha[tt] = fcoord[tt]; /* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */ PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO)); } /* put in row of P */ for (idx=0; idx<3; idx++) { PetscScalar shp = alpha[idx]; if (PetscAbs(PetscRealPart(shp)) > 1.e-6) { PetscInt cgid = crsGID[clids[idx]]; PetscInt jj = cgid*bs, ii = fgid*bs; /* need to gloalize */ for (tt=0; tt < bs; tt++, ii++, jj++) { ierr = MatSetValues(a_Prol,1,&ii,1,&jj,&shp,INSERT_VALUES);CHKERRQ(ierr); } } } } } /* aggregates iterations */ clid++; } /* a coarse agg */ } /* for all fine nodes */ ierr = ISRestoreIndices(selected_2, &selected_idx_2);CHKERRQ(ierr); ierr = MatAssemblyBegin(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscFree2(node_tri,nTri);CHKERRQ(ierr); } #if defined PETSC_GAMG_USE_LOG ierr = PetscLogEventEnd(petsc_gamg_setup_events[FIND_V],0,0,0,0);CHKERRQ(ierr); #endif free(mid.trianglelist); free(mid.neighborlist); ierr = PetscFree(in.pointlist);CHKERRQ(ierr); PetscFunctionReturn(0); #else SETERRQ(PetscObjectComm((PetscObject)a_Prol),PETSC_ERR_PLIB,"configure with TRIANGLE to use geometric MG"); #endif }
int main(int argc,char **args) { Mat A,LU; Vec x,y; PetscInt nnz[4]={2,1,1,1},col[4],i; PetscErrorCode ierr; PetscScalar values[4]; IS rowperm,colperm; PetscInitialize(&argc,&args,(char*)0,help); ierr = MatCreateSeqAIJ(PETSC_COMM_WORLD,4,4,2,nnz,&A);CHKERRQ(ierr); /* build test matrix */ values[0]=1.0;values[1]=-1.0; col[0] =0;col[1]=2; i=0; ierr = MatSetValues(A,1,&i,2,col,values,INSERT_VALUES);CHKERRQ(ierr); values[0]=1.0; col[0] =1;i=1; ierr = MatSetValues(A,1,&i,1,col,values,INSERT_VALUES);CHKERRQ(ierr); values[0]=-1.0; col[0] =3;i=2; ierr = MatSetValues(A,1,&i,1,col,values,INSERT_VALUES);CHKERRQ(ierr); values[0]=1.0; col[0] =2;i=3; ierr = MatSetValues(A,1,&i,1,col,values,INSERT_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatView(A,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); ierr = MatGetOrdering(A,MATORDERINGNATURAL,&rowperm,&colperm);CHKERRQ(ierr); ierr = MatReorderForNonzeroDiagonal(A,1.e-12,rowperm,colperm);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_SELF,"column and row perms\n");CHKERRQ(ierr); ierr = ISView(rowperm,0);CHKERRQ(ierr); ierr = ISView(colperm,0);CHKERRQ(ierr); ierr = MatGetFactor(A,MATSOLVERPETSC,MAT_FACTOR_LU,&LU);CHKERRQ(ierr); ierr = MatLUFactorSymbolic(LU,A,rowperm,colperm,NULL);CHKERRQ(ierr); ierr = MatLUFactorNumeric(LU,A,NULL);CHKERRQ(ierr); ierr = MatView(LU,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,4);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&y);CHKERRQ(ierr); values[0]=0;values[1]=1.0;values[2]=-1.0;values[3]=1.0; for (i=0; i<4; i++) col[i]=i; ierr = VecSetValues(x,4,col,values,INSERT_VALUES);CHKERRQ(ierr); ierr = VecAssemblyBegin(x);CHKERRQ(ierr); ierr = VecAssemblyEnd(x);CHKERRQ(ierr); ierr = VecView(x,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); ierr = MatSolve(LU,x,y);CHKERRQ(ierr); ierr = VecView(y,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); ierr = ISDestroy(&rowperm);CHKERRQ(ierr); ierr = ISDestroy(&colperm);CHKERRQ(ierr); ierr = MatDestroy(&LU);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&y);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
int main(int argc,char **args) { Mat C; PetscInt i,j,m = 5,n = 2,Ii,J; PetscErrorCode ierr; PetscMPIInt rank,size; PetscScalar v; Vec x,y; PetscInitialize(&argc,&args,(char *)0,help); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); n = 2*size; /* Create the matrix for the five point stencil, YET AGAIN */ ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr); ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr); ierr = MatSetFromOptions(C);CHKERRQ(ierr); for (i=0; i<m; i++) { for (j=2*rank; j<2*rank+2; j++) { v = -1.0; Ii = j + n*i; if (i>0) {J = Ii - n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} if (i<m-1) {J = Ii + n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} if (j>0) {J = Ii - 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} v = 4.0; ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr); } } ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); for (i=0; i<m; i++) { for (j=2*rank; j<2*rank+2; j++) { v = 1.0; Ii = j + n*i; if (i>0) {J = Ii - n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} if (i<m-1) {J = Ii + n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} if (j>0) {J = Ii - 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} v = -4.0; ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr); } } /* Introduce new nonzero that requires new construction for matrix-vector product */ if (rank) { Ii = rank-1; J = m*n-1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); /* Form a couple of vectors to test matrix-vector product */ ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,m*n);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&y);CHKERRQ(ierr); v = 1.0; ierr = VecSet(x,v);CHKERRQ(ierr); ierr = MatMult(C,x,y);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&y);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
Matrix C is copied from ~petsc/src/ksp/ksp/examples/tutorials/ex5.c\n\n"; /* Example: ./ex132 -mat_view_info */ #include <petscmat.h> #undef __FUNCT__ #define __FUNCT__ "main" int main(int argc,char **args) { Mat C,C1,C2; /* matrix */ PetscScalar v; PetscInt Ii,J,Istart,Iend; PetscErrorCode ierr; PetscInt i,j,m = 3,n = 2; PetscMPIInt size,rank; PetscBool mat_nonsymmetric = PETSC_FALSE; MatInfo info; PetscInitialize(&argc,&args,(char *)0,help); ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); n = 2*size; /* Set flag if we are doing a nonsymmetric problem; the default is symmetric. */ ierr = PetscOptionsGetBool(PETSC_NULL,"-mat_nonsym",&mat_nonsymmetric,PETSC_NULL);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr); ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr); ierr = MatSetFromOptions(C);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(C,5,PETSC_NULL);CHKERRQ(ierr); ierr = MatGetOwnershipRange(C,&Istart,&Iend);CHKERRQ(ierr); for (Ii=Istart; Ii<Iend; Ii++) { v = -1.0; i = Ii/n; j = Ii - i*n; if (i>0) {J = Ii - n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);} if (i<m-1) {J = Ii + n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);} if (j>0) {J = Ii - 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);} if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);} v = 4.0; ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,ADD_VALUES); } /* Make the matrix nonsymmetric if desired */ if (mat_nonsymmetric) { for (Ii=Istart; Ii<Iend; Ii++) { v = -1.5; i = Ii/n; if (i>1) {J = Ii-n-1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);} } } else { ierr = MatSetOption(C,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr); ierr = MatSetOption(C,MAT_SYMMETRY_ETERNAL,PETSC_TRUE);CHKERRQ(ierr); } ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* First, create C1 = 2.0*C1 + C, C1 has less non-zeros than C */ ierr = PetscPrintf(PETSC_COMM_WORLD, "\ncreate C1 = 2.0*C1 + C, C1 has less non-zeros than C \n"); ierr = MatCreate(PETSC_COMM_WORLD,&C1);CHKERRQ(ierr); ierr = MatSetSizes(C1,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr); ierr = MatSetFromOptions(C1);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(C1,1,PETSC_NULL);CHKERRQ(ierr); for (Ii=Istart; Ii<Iend; Ii++) { ierr = MatSetValues(C1,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(C1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," MatAXPY(C1,2.0,C,DIFFERENT_NONZERO_PATTERN)...\n"); ierr = MatAXPY(C1,2.0,C,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatGetInfo(C1,MAT_GLOBAL_SUM,&info);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," C1: nz_allocated = %g; nz_used = %g; nz_unneeded = %g\n",info.nz_allocated,info.nz_used, info.nz_unneeded); /* Secondly, create C2 = 2.0*C2 + C, C2 has non-zero pattern of C2 + C */ ierr = PetscPrintf(PETSC_COMM_WORLD, "\ncreate C2 = 2.0*C2 + C, C2 has non-zero pattern of C2 + C \n"); ierr = MatDuplicate(C,MAT_DO_NOT_COPY_VALUES,&C2);CHKERRQ(ierr); /* ierr = MatCreate(PETSC_COMM_WORLD,&C2);CHKERRQ(ierr); ierr = MatSetSizes(C2,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr); ierr = MatSetFromOptions(C2);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(C2,5,PETSC_NULL);CHKERRQ(ierr); */ for (Ii=Istart; Ii<Iend; Ii++) { v = 1.0; ierr = MatSetValues(C2,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(C2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); printf(" MatAXPY(C2,2.0,C,SUBSET_NONZERO_PATTERN)...\n"); ierr = MatAXPY(C2,2.0,C,SUBSET_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatGetInfo(C2,MAT_GLOBAL_SUM,&info);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD," C2: nz_allocated = %g; nz_used = %g; nz_unneeded = %g\n",info.nz_allocated,info.nz_used, info.nz_unneeded); ierr = MatDestroy(&C1);CHKERRQ(ierr); ierr = MatDestroy(&C2);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }