Actual source code: aobasic.c
1: /*$Id: aobasic.c,v 1.60 2001/03/23 23:24:52 balay Exp $*/
3: /*
4: The most basic AO application ordering routines. These store the
5: entire orderings on each processor.
6: */
8: #include "src/dm/ao/aoimpl.h" /*I "petscao.h" I*/
9: #include "petscsys.h"
11: typedef struct {
12: int N;
13: int *app,*petsc; /* app[i] is the partner for the ith PETSc slot */
14: /* petsc[j] is the partner for the jth app slot */
15: } AO_Basic;
17: int AOBasicGetIndices_Private(AO ao,int **app,int **petsc)
18: {
19: AO_Basic *basic = (AO_Basic*)ao->data;
22: if (app) *app = basic->app;
23: if (petsc) *petsc = basic->petsc;
24: return(0);
25: }
27: int AODestroy_Basic(AO ao)
28: {
29: AO_Basic *aodebug = (AO_Basic*)ao->data;
30: int ierr;
33: PetscFree(aodebug->app);
34: PetscFree(ao->data);
35: PetscLogObjectDestroy(ao);
36: PetscHeaderDestroy(ao);
37: return(0);
38: }
40: /*
41: All processors have the same data so processor 1 prints it
42: */
43: int AOView_Basic(AO ao,PetscViewer viewer)
44: {
45: int rank,ierr,i;
46: AO_Basic *aodebug = (AO_Basic*)ao->data;
47: PetscTruth isascii;
50: MPI_Comm_rank(ao->comm,&rank);
51: if (!rank){
52: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
53: if (isascii) {
54: PetscViewerASCIIPrintf(viewer,"Number of elements in ordering %dn",aodebug->N);
55: PetscViewerASCIIPrintf(viewer," App. PETScn");
56: for (i=0; i<aodebug->N; i++) {
57: PetscViewerASCIIPrintf(viewer,"%d %d %dn",i,aodebug->app[i],aodebug->petsc[i]);
58: }
59: } else {
60: SETERRQ1(1,"Viewer type %s not supported for AOData basic",((PetscObject)viewer)->type_name);
61: }
62: }
63: PetscViewerFlush(viewer);
64: return(0);
65: }
67: int AOPetscToApplication_Basic(AO ao,int n,int *ia)
68: {
69: int i;
70: AO_Basic *aodebug = (AO_Basic*)ao->data;
73: for (i=0; i<n; i++) {
74: if (ia[i] >= 0) {ia[i] = aodebug->app[ia[i]];}
75: }
76: return(0);
77: }
79: int AOApplicationToPetsc_Basic(AO ao,int n,int *ia)
80: {
81: int i;
82: AO_Basic *aodebug = (AO_Basic*)ao->data;
85: for (i=0; i<n; i++) {
86: if (ia[i] >= 0) {ia[i] = aodebug->petsc[ia[i]];}
87: }
88: return(0);
89: }
91: static struct _AOOps myops = {AOPetscToApplication_Basic,
92: AOApplicationToPetsc_Basic};
94: /*@C
95: AOCreateBasic - Creates a basic application ordering using two integer arrays.
97: Collective on MPI_Comm
99: Input Parameters:
100: + comm - MPI communicator that is to share AO
101: . napp - size of integer arrays
102: . myapp - integer array that defines an ordering
103: - mypetsc - integer array that defines another ordering (may be PETSC_NULL to
104: indicate the natural ordering)
106: Output Parameter:
107: . aoout - the new application ordering
109: Options Database Key:
110: . -ao_view - call AOView() at the conclusion of AOCreateBasic()
112: Level: beginner
114: .keywords: AO, create
116: .seealso: AOCreateBasicIS(), AODestroy()
117: @*/
118: int AOCreateBasic(MPI_Comm comm,int napp,int *myapp,int *mypetsc,AO *aoout)
119: {
120: AO_Basic *aodebug;
121: AO ao;
122: int *lens,size,rank,N,i,ierr,*petsc,start;
123: int *allpetsc,*allapp,*disp,ip,ia;
124: PetscTruth flg1;
127: *aoout = 0;
128: PetscHeaderCreate(ao,_p_AO,struct _AOOps,AO_COOKIE,AO_BASIC,"AO",comm,AODestroy,AOView);
129: PetscLogObjectCreate(ao);
130: PetscNew(AO_Basic,&aodebug);
131: PetscLogObjectMemory(ao,sizeof(struct _p_AO) + sizeof(AO_Basic));
133: ierr = PetscMemcpy(ao->ops,&myops,sizeof(myops));
134: ao->ops->destroy = AODestroy_Basic;
135: ao->ops->view = AOView_Basic;
136: ao->data = (void *)aodebug;
138: /* transmit all lengths to all processors */
139: MPI_Comm_size(comm,&size);
140: MPI_Comm_rank(comm,&rank);
141: PetscMalloc(2*size*sizeof(int),&lens);
142: disp = lens + size;
143: MPI_Allgather(&napp,1,MPI_INT,lens,1,MPI_INT,comm);
144: N = 0;
145: for (i=0; i<size; i++) {
146: disp[i] = N;
147: N += lens[i];
148: }
149: aodebug->N = N;
151: /*
152: If mypetsc is 0 then use "natural" numbering
153: */
154: if (!mypetsc) {
155: start = disp[rank];
156: ierr = PetscMalloc((napp+1)*sizeof(int),&petsc);
157: for (i=0; i<napp; i++) {
158: petsc[i] = start + i;
159: }
160: } else {
161: petsc = mypetsc;
162: }
164: /* get all indices on all processors */
165: ierr = PetscMalloc(2*N*sizeof(int),&allpetsc);
166: allapp = allpetsc + N;
167: ierr = MPI_Allgatherv(petsc,napp,MPI_INT,allpetsc,lens,disp,MPI_INT,comm);
168: ierr = MPI_Allgatherv(myapp,napp,MPI_INT,allapp,lens,disp,MPI_INT,comm);
169: ierr = PetscFree(lens);
171: /* generate a list of application and PETSc node numbers */
172: PetscMalloc(2*N*sizeof(int),&aodebug->app);
173: PetscLogObjectMemory(ao,2*N*sizeof(int));
174: aodebug->petsc = aodebug->app + N;
175: ierr = PetscMemzero(aodebug->app,2*N*sizeof(int));
176: for (i=0; i<N; i++) {
177: ip = allpetsc[i]; ia = allapp[i];
178: /* check there are no duplicates */
179: if (aodebug->app[ip]) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Duplicate in PETSc ordering");
180: aodebug->app[ip] = ia + 1;
181: if (aodebug->petsc[ia]) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Duplicate in Application ordering");
182: aodebug->petsc[ia] = ip + 1;
183: }
184: if (!mypetsc) {PetscFree(petsc);}
185: PetscFree(allpetsc);
186: /* shift indices down by one */
187: for (i=0; i<N; i++) {
188: aodebug->app[i]--;
189: aodebug->petsc[i]--;
190: }
192: PetscOptionsHasName(PETSC_NULL,"-ao_view",&flg1);
193: if (flg1) {AOView(ao,PETSC_VIEWER_STDOUT_SELF);}
195: *aoout = ao; return(0);
196: }
198: /*@C
199: AOCreateBasicIS - Creates a basic application ordering using two index sets.
201: Collective on IS
203: Input Parameters:
204: + isapp - index set that defines an ordering
205: - ispetsc - index set that defines another ordering (may be PETSC_NULL to use the
206: natural ordering)
208: Output Parameter:
209: . aoout - the new application ordering
211: Options Database Key:
212: - -ao_view - call AOView() at the conclusion of AOCreateBasicIS()
214: Level: beginner
216: .keywords: AO, create
218: .seealso: AOCreateBasic(), AODestroy()
219: @*/
220: int AOCreateBasicIS(IS isapp,IS ispetsc,AO *aoout)
221: {
222: int *mypetsc = 0,*myapp,ierr,napp,npetsc;
223: MPI_Comm comm;
226: PetscObjectGetComm((PetscObject)isapp,&comm);
227: ISGetLocalSize(isapp,&napp);
228: if (ispetsc) {
229: ISGetLocalSize(ispetsc,&npetsc);
230: if (napp != npetsc) SETERRQ(PETSC_ERR_ARG_SIZ,"Local IS lengths must match");
231: ISGetIndices(ispetsc,&mypetsc);
232: }
233: ISGetIndices(isapp,&myapp);
235: AOCreateBasic(comm,napp,myapp,mypetsc,aoout);
237: ISRestoreIndices(isapp,&myapp);
238: if (ispetsc) {
239: ISRestoreIndices(ispetsc,&mypetsc);
240: }
241: return(0);
242: }