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
 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: }