xref: /petsc/src/ts/characteristic/interface/characteristic.c (revision 8cbdbec6f8317ddf7886f91eb9c6bd083b543c50)
1 
2 #include <petsc-private/characteristicimpl.h> /*I "petsccharacteristic.h" I*/
3 
4 PetscClassId CHARACTERISTIC_CLASSID;
5 PetscLogEvent  CHARACTERISTIC_SetUp, CHARACTERISTIC_Solve, CHARACTERISTIC_QueueSetup, CHARACTERISTIC_DAUpdate;
6 PetscLogEvent  CHARACTERISTIC_HalfTimeLocal, CHARACTERISTIC_HalfTimeRemote, CHARACTERISTIC_HalfTimeExchange;
7 PetscLogEvent  CHARACTERISTIC_FullTimeLocal, CHARACTERISTIC_FullTimeRemote, CHARACTERISTIC_FullTimeExchange;
8 PetscBool   CharacteristicRegisterAllCalled = PETSC_FALSE;
9 /*
10    Contains the list of registered characteristic routines
11 */
12 PetscFList  CharacteristicList = PETSC_NULL;
13 
14 PetscErrorCode DMDAGetNeighborsRank(DM, PetscMPIInt []);
15 PetscInt DMDAGetNeighborRelative(DM, PassiveReal, PassiveReal);
16 PetscErrorCode DMDAMapToPeriodicDomain(DM, PetscScalar [] );
17 
18 PetscErrorCode CharacteristicHeapSort(Characteristic, Queue, PetscInt);
19 PetscErrorCode CharacteristicSiftDown(Characteristic, Queue, PetscInt, PetscInt);
20 
21 #undef __FUNCT__
22 #define __FUNCT__ "CharacteristicView"
23 PetscErrorCode CharacteristicView(Characteristic c, PetscViewer viewer)
24 {
25   PetscBool      iascii;
26   PetscErrorCode ierr;
27 
28   PetscFunctionBegin;
29   PetscValidHeaderSpecific(c, CHARACTERISTIC_CLASSID, 1);
30   if (!viewer) {
31     ierr = PetscViewerASCIIGetStdout(((PetscObject)c)->comm,&viewer);CHKERRQ(ierr);
32   }
33   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
34   PetscCheckSameComm(c, 1, viewer, 2);
35 
36   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
37   if (!iascii) {
38     if (c->ops->view) {
39       ierr = (*c->ops->view)(c, viewer);CHKERRQ(ierr);
40     }
41   }
42   PetscFunctionReturn(0);
43 }
44 
45 #undef __FUNCT__
46 #define __FUNCT__ "CharacteristicDestroy"
47 PetscErrorCode CharacteristicDestroy(Characteristic *c)
48 {
49   PetscErrorCode ierr;
50 
51   PetscFunctionBegin;
52   if (!*c) PetscFunctionReturn(0);
53   PetscValidHeaderSpecific(*c, CHARACTERISTIC_CLASSID, 1);
54   if (--((PetscObject)(*c))->refct > 0) PetscFunctionReturn(0);
55 
56   if ((*c)->ops->destroy) {
57     ierr = (*(*c)->ops->destroy)((*c));CHKERRQ(ierr);
58   }
59   ierr = MPI_Type_free(&(*c)->itemType);CHKERRQ(ierr);
60   ierr = PetscFree((*c)->queue);CHKERRQ(ierr);
61   ierr = PetscFree((*c)->queueLocal);CHKERRQ(ierr);
62   ierr = PetscFree((*c)->queueRemote);CHKERRQ(ierr);
63   ierr = PetscFree((*c)->neighbors);CHKERRQ(ierr);
64   ierr = PetscFree((*c)->needCount);CHKERRQ(ierr);
65   ierr = PetscFree((*c)->localOffsets);CHKERRQ(ierr);
66   ierr = PetscFree((*c)->fillCount);CHKERRQ(ierr);
67   ierr = PetscFree((*c)->remoteOffsets);CHKERRQ(ierr);
68   ierr = PetscFree((*c)->request);CHKERRQ(ierr);
69   ierr = PetscFree((*c)->status);CHKERRQ(ierr);
70   ierr = PetscHeaderDestroy(c);CHKERRQ(ierr);
71   PetscFunctionReturn(0);
72 }
73 
74 #undef __FUNCT__
75 #define __FUNCT__ "CharacteristicCreate"
76 PetscErrorCode CharacteristicCreate(MPI_Comm comm, Characteristic *c)
77 {
78   Characteristic newC;
79   PetscErrorCode ierr;
80 
81   PetscFunctionBegin;
82   PetscValidPointer(c, 2);
83   *c = PETSC_NULL;
84 #ifndef PETSC_USE_DYNAMIC_LIBRARIES
85   ierr = CharacteristicInitializePackage(PETSC_NULL);CHKERRQ(ierr);
86 #endif
87 
88   ierr = PetscHeaderCreate(newC, _p_Characteristic, struct _CharacteristicOps, CHARACTERISTIC_CLASSID, -1, "Characteristic", "Characteristic", "SemiLagrange", comm, CharacteristicDestroy, CharacteristicView);CHKERRQ(ierr);
89   ierr = PetscLogObjectCreate(newC);CHKERRQ(ierr);
90   *c = newC;
91 
92   newC->structured      = PETSC_TRUE;
93   newC->numIds          = 0;
94   newC->velocityDA      = PETSC_NULL;
95   newC->velocity        = PETSC_NULL;
96   newC->velocityOld     = PETSC_NULL;
97   newC->numVelocityComp = 0;
98   newC->velocityComp    = PETSC_NULL;
99   newC->velocityInterp  = PETSC_NULL;
100   newC->velocityInterpLocal = PETSC_NULL;
101   newC->velocityCtx     = PETSC_NULL;
102   newC->fieldDA         = PETSC_NULL;
103   newC->field           = PETSC_NULL;
104   newC->numFieldComp    = 0;
105   newC->fieldComp       = PETSC_NULL;
106   newC->fieldInterp     = PETSC_NULL;
107   newC->fieldInterpLocal    = PETSC_NULL;
108   newC->fieldCtx        = PETSC_NULL;
109   newC->itemType        = PETSC_NULL;
110   newC->queue           = PETSC_NULL;
111   newC->queueSize       = 0;
112   newC->queueMax        = 0;
113   newC->queueLocal      = PETSC_NULL;
114   newC->queueLocalSize  = 0;
115   newC->queueLocalMax   = 0;
116   newC->queueRemote     = PETSC_NULL;
117   newC->queueRemoteSize = 0;
118   newC->queueRemoteMax  = 0;
119   newC->numNeighbors    = 0;
120   newC->neighbors       = PETSC_NULL;
121   newC->needCount       = PETSC_NULL;
122   newC->localOffsets    = PETSC_NULL;
123   newC->fillCount       = PETSC_NULL;
124   newC->remoteOffsets   = PETSC_NULL;
125   newC->request         = PETSC_NULL;
126   newC->status          = PETSC_NULL;
127   PetscFunctionReturn(0);
128 }
129 
130 #undef __FUNCT__
131 #define __FUNCT__ "CharacteristicSetType"
132 /*@C
133    CharacteristicSetType - Builds Characteristic for a particular solver.
134 
135    Logically Collective on Characteristic
136 
137    Input Parameters:
138 +  c    - the method of characteristics context
139 -  type - a known method
140 
141    Options Database Key:
142 .  -characteristic_type <method> - Sets the method; use -help for a list
143     of available methods
144 
145    Notes:
146    See "include/petsccharacteristic.h" for available methods
147 
148   Normally, it is best to use the CharacteristicSetFromOptions() command and
149   then set the Characteristic type from the options database rather than by using
150   this routine.  Using the options database provides the user with
151   maximum flexibility in evaluating the many different Krylov methods.
152   The CharacteristicSetType() routine is provided for those situations where it
153   is necessary to set the iterative solver independently of the command
154   line or options database.  This might be the case, for example, when
155   the choice of iterative solver changes during the execution of the
156   program, and the user's application is taking responsibility for
157   choosing the appropriate method.  In other words, this routine is
158   not for beginners.
159 
160   Level: intermediate
161 
162 .keywords: Characteristic, set, method
163 
164 .seealso: CharacteristicType
165 
166 @*/
167 PetscErrorCode CharacteristicSetType(Characteristic c, CharacteristicType type)
168 {
169   PetscErrorCode ierr, (*r)(Characteristic);
170   PetscBool      match;
171 
172   PetscFunctionBegin;
173   PetscValidHeaderSpecific(c, CHARACTERISTIC_CLASSID, 1);
174   PetscValidCharPointer(type, 2);
175 
176   ierr = PetscObjectTypeCompare((PetscObject) c, type, &match);CHKERRQ(ierr);
177   if (match) PetscFunctionReturn(0);
178 
179   if (c->data) {
180     /* destroy the old private Characteristic context */
181     ierr = (*c->ops->destroy)(c);CHKERRQ(ierr);
182     c->ops->destroy = PETSC_NULL;
183     c->data = 0;
184   }
185 
186   ierr =  PetscFListFind(CharacteristicList, ((PetscObject)c)->comm,type,PETSC_TRUE, (void (**)(void)) &r);CHKERRQ(ierr);
187   if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown Characteristic type given: %s", type);
188   c->setupcalled = 0;
189   ierr = (*r)(c);CHKERRQ(ierr);
190   ierr = PetscObjectChangeTypeName((PetscObject) c, type);CHKERRQ(ierr);
191   PetscFunctionReturn(0);
192 }
193 
194 #undef __FUNCT__
195 #define __FUNCT__ "CharacteristicSetUp"
196 /*@
197    CharacteristicSetUp - Sets up the internal data structures for the
198    later use of an iterative solver.
199 
200    Collective on Characteristic
201 
202    Input Parameter:
203 .  ksp   - iterative context obtained from CharacteristicCreate()
204 
205    Level: developer
206 
207 .keywords: Characteristic, setup
208 
209 .seealso: CharacteristicCreate(), CharacteristicSolve(), CharacteristicDestroy()
210 @*/
211 PetscErrorCode CharacteristicSetUp(Characteristic c)
212 {
213   PetscErrorCode ierr;
214 
215   PetscFunctionBegin;
216   PetscValidHeaderSpecific(c, CHARACTERISTIC_CLASSID, 1);
217 
218   if (!((PetscObject)c)->type_name){
219     ierr = CharacteristicSetType(c, CHARACTERISTICDA);CHKERRQ(ierr);
220   }
221 
222   if (c->setupcalled == 2) PetscFunctionReturn(0);
223 
224   ierr = PetscLogEventBegin(CHARACTERISTIC_SetUp,c,0,0,0);CHKERRQ(ierr);
225   if (!c->setupcalled) {
226     ierr = (*c->ops->setup)(c);CHKERRQ(ierr);
227   }
228   ierr = PetscLogEventEnd(CHARACTERISTIC_SetUp,c,0,0,0);CHKERRQ(ierr);
229   c->setupcalled = 2;
230   PetscFunctionReturn(0);
231 }
232 
233 #undef __FUNCT__
234 #define __FUNCT__ "CharacteristicRegister"
235 /*@C
236   CharacteristicRegister - See CharacteristicRegisterDynamic()
237 
238   Level: advanced
239 @*/
240 PetscErrorCode CharacteristicRegister(const char sname[],const char path[],const char name[],PetscErrorCode (*function)(Characteristic))
241 {
242   PetscErrorCode ierr;
243   char           fullname[PETSC_MAX_PATH_LEN];
244 
245   PetscFunctionBegin;
246   ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr);
247   ierr = PetscFListAdd(&CharacteristicList,sname,fullname,(void (*)(void))function);CHKERRQ(ierr);
248   PetscFunctionReturn(0);
249 }
250 
251 #undef __FUNCT__
252 #define __FUNCT__ "CharacteristicSetVelocityInterpolation"
253 PetscErrorCode CharacteristicSetVelocityInterpolation(Characteristic c, DM da, Vec v, Vec vOld, PetscInt numComponents, PetscInt components[], PetscErrorCode (*interp)(Vec, PetscReal [], PetscInt, PetscInt [], PetscScalar [], void *), void *ctx)
254 {
255   PetscFunctionBegin;
256   c->velocityDA      = da;
257   c->velocity        = v;
258   c->velocityOld     = vOld;
259   c->numVelocityComp = numComponents;
260   c->velocityComp    = components;
261   c->velocityInterp  = interp;
262   c->velocityCtx     = ctx;
263   PetscFunctionReturn(0);
264 }
265 
266 #undef __FUNCT__
267 #define __FUNCT__ "CharacteristicSetVelocityInterpolationLocal"
268 PetscErrorCode CharacteristicSetVelocityInterpolationLocal(Characteristic c, DM da, Vec v, Vec vOld, PetscInt numComponents, PetscInt components[], PetscErrorCode (*interp)(void *, PetscReal [], PetscInt, PetscInt [], PetscScalar [], void *), void *ctx)
269 {
270   PetscFunctionBegin;
271   c->velocityDA          = da;
272   c->velocity            = v;
273   c->velocityOld         = vOld;
274   c->numVelocityComp     = numComponents;
275   c->velocityComp        = components;
276   c->velocityInterpLocal = interp;
277   c->velocityCtx         = ctx;
278   PetscFunctionReturn(0);
279 }
280 
281 #undef __FUNCT__
282 #define __FUNCT__ "CharacteristicSetFieldInterpolation"
283 PetscErrorCode CharacteristicSetFieldInterpolation(Characteristic c, DM da, Vec v, PetscInt numComponents, PetscInt components[], PetscErrorCode (*interp)(Vec, PetscReal [], PetscInt, PetscInt [], PetscScalar [], void *), void *ctx)
284 {
285   PetscFunctionBegin;
286 #if 0
287   if (numComponents > 2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP, "Fields with more than 2 components are not supported. Send mail to petsc-maint@mcs.anl.gov.");
288 #endif
289   c->fieldDA      = da;
290   c->field        = v;
291   c->numFieldComp = numComponents;
292   c->fieldComp    = components;
293   c->fieldInterp  = interp;
294   c->fieldCtx     = ctx;
295   PetscFunctionReturn(0);
296 }
297 
298 #undef __FUNCT__
299 #define __FUNCT__ "CharacteristicSetFieldInterpolationLocal"
300 PetscErrorCode CharacteristicSetFieldInterpolationLocal(Characteristic c, DM da, Vec v, PetscInt numComponents, PetscInt components[], PetscErrorCode (*interp)(void *, PetscReal [], PetscInt, PetscInt [], PetscScalar [], void *), void *ctx)
301 {
302   PetscFunctionBegin;
303 #if 0
304   if (numComponents > 2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP, "Fields with more than 2 components are not supported. Send mail to petsc-maint@mcs.anl.gov.");
305 #endif
306   c->fieldDA          = da;
307   c->field            = v;
308   c->numFieldComp     = numComponents;
309   c->fieldComp        = components;
310   c->fieldInterpLocal = interp;
311   c->fieldCtx         = ctx;
312   PetscFunctionReturn(0);
313 }
314 
315 #undef __FUNCT__
316 #define __FUNCT__ "CharacteristicSolve"
317 PetscErrorCode CharacteristicSolve(Characteristic c, PetscReal dt, Vec solution)
318 {
319   CharacteristicPointDA2D Qi;
320   DM                      da = c->velocityDA;
321   Vec                     velocityLocal, velocityLocalOld;
322   Vec                     fieldLocal;
323   DMDALocalInfo           info;
324   PetscScalar             **solArray;
325   void                    *velocityArray;
326   void                    *velocityArrayOld;
327   void                    *fieldArray;
328   PassiveScalar           *interpIndices;
329   PassiveScalar           *velocityValues, *velocityValuesOld;
330   PassiveScalar           *fieldValues;
331   PetscMPIInt             rank;
332   PetscInt                dim;
333   PetscMPIInt             neighbors[9];
334   PetscInt                dof;
335   PetscInt                gx, gy;
336   PetscInt                n, is, ie, js, je, comp;
337   PetscErrorCode          ierr;
338 
339   PetscFunctionBegin;
340   c->queueSize = 0;
341   ierr = MPI_Comm_rank(((PetscObject)c)->comm, &rank);CHKERRQ(ierr);
342   ierr = DMDAGetNeighborsRank(da, neighbors);CHKERRQ(ierr);
343   ierr = CharacteristicSetNeighbors(c, 9, neighbors);CHKERRQ(ierr);
344   ierr = CharacteristicSetUp(c);CHKERRQ(ierr);
345   /* global and local grid info */
346   ierr = DMDAGetInfo(da, &dim, &gx, &gy, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);CHKERRQ(ierr);
347   ierr = DMDAGetLocalInfo(da, &info);CHKERRQ(ierr);
348   is   = info.xs;          ie   = info.xs+info.xm;
349   js   = info.ys;          je   = info.ys+info.ym;
350   /* Allocation */
351   ierr = PetscMalloc(dim*sizeof(PetscScalar),                &interpIndices);CHKERRQ(ierr);
352   ierr = PetscMalloc(c->numVelocityComp*sizeof(PetscScalar), &velocityValues);CHKERRQ(ierr);
353   ierr = PetscMalloc(c->numVelocityComp*sizeof(PetscScalar), &velocityValuesOld);CHKERRQ(ierr);
354   ierr = PetscMalloc(c->numFieldComp*sizeof(PetscScalar),    &fieldValues);CHKERRQ(ierr);
355   ierr = PetscLogEventBegin(CHARACTERISTIC_Solve,0,0,0,0);CHKERRQ(ierr);
356 
357   /* -----------------------------------------------------------------------
358      PART 1, AT t-dt/2
359      -----------------------------------------------------------------------*/
360   ierr = PetscLogEventBegin(CHARACTERISTIC_QueueSetup,0,0,0,0);CHKERRQ(ierr);
361   /* GET POSITION AT HALF TIME IN THE PAST */
362   if (c->velocityInterpLocal) {
363     ierr = DMGetLocalVector(c->velocityDA, &velocityLocal);CHKERRQ(ierr);
364     ierr = DMGetLocalVector(c->velocityDA, &velocityLocalOld);CHKERRQ(ierr);
365     ierr = DMGlobalToLocalBegin(c->velocityDA, c->velocity, INSERT_VALUES, velocityLocal);CHKERRQ(ierr);
366     ierr = DMGlobalToLocalEnd(c->velocityDA, c->velocity, INSERT_VALUES, velocityLocal);CHKERRQ(ierr);
367     ierr = DMGlobalToLocalBegin(c->velocityDA, c->velocityOld, INSERT_VALUES, velocityLocalOld);CHKERRQ(ierr);
368     ierr = DMGlobalToLocalEnd(c->velocityDA, c->velocityOld, INSERT_VALUES, velocityLocalOld);CHKERRQ(ierr);
369     ierr = DMDAVecGetArray(c->velocityDA, velocityLocal,    &velocityArray);CHKERRQ(ierr);
370     ierr = DMDAVecGetArray(c->velocityDA, velocityLocalOld, &velocityArrayOld);CHKERRQ(ierr);
371   }
372   ierr = PetscInfo(PETSC_NULL, "Calculating position at t_{n - 1/2}\n");CHKERRQ(ierr);
373   for (Qi.j = js; Qi.j < je; Qi.j++) {
374     for (Qi.i = is; Qi.i < ie; Qi.i++) {
375       interpIndices[0] = Qi.i;
376       interpIndices[1] = Qi.j;
377       if (c->velocityInterpLocal) {
378         c->velocityInterpLocal(velocityArray, interpIndices, c->numVelocityComp, c->velocityComp, velocityValues, c->velocityCtx);
379       } else {
380         c->velocityInterp(c->velocity, interpIndices, c->numVelocityComp, c->velocityComp, velocityValues, c->velocityCtx);
381       }
382       Qi.x = Qi.i - velocityValues[0]*dt/2.0;
383       Qi.y = Qi.j - velocityValues[1]*dt/2.0;
384 
385       /* Determine whether the position at t - dt/2 is local */
386       Qi.proc = DMDAGetNeighborRelative(da, Qi.x, Qi.y);
387 
388       /* Check for Periodic boundaries and move all periodic points back onto the domain */
389       ierr = DMDAMapCoordsToPeriodicDomain(da,&(Qi.x),&(Qi.y));CHKERRQ(ierr);
390       ierr = CharacteristicAddPoint(c, &Qi);CHKERRQ(ierr);
391     }
392   }
393   ierr = PetscLogEventEnd(CHARACTERISTIC_QueueSetup,0,0,0,0);CHKERRQ(ierr);
394 
395   ierr = PetscLogEventBegin(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr);
396   ierr = CharacteristicSendCoordinatesBegin(c);CHKERRQ(ierr);
397   ierr = PetscLogEventEnd(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr);
398 
399   ierr = PetscLogEventBegin(CHARACTERISTIC_HalfTimeLocal,0,0,0,0);CHKERRQ(ierr);
400   /* Calculate velocity at t_n+1/2 (local values) */
401   ierr = PetscInfo(PETSC_NULL, "Calculating local velocities at t_{n - 1/2}\n");CHKERRQ(ierr);
402   for (n = 0; n < c->queueSize; n++) {
403     Qi = c->queue[n];
404     if (c->neighbors[Qi.proc] == rank) {
405       interpIndices[0] = Qi.x;
406       interpIndices[1] = Qi.y;
407       if (c->velocityInterpLocal) {
408         c->velocityInterpLocal(velocityArray,    interpIndices, c->numVelocityComp, c->velocityComp, velocityValues,    c->velocityCtx);
409         c->velocityInterpLocal(velocityArrayOld, interpIndices, c->numVelocityComp, c->velocityComp, velocityValuesOld, c->velocityCtx);
410       } else {
411         c->velocityInterp(c->velocity,    interpIndices, c->numVelocityComp, c->velocityComp, velocityValues,    c->velocityCtx);
412         c->velocityInterp(c->velocityOld, interpIndices, c->numVelocityComp, c->velocityComp, velocityValuesOld, c->velocityCtx);
413       }
414       Qi.x = 0.5*(velocityValues[0] + velocityValuesOld[0]);
415       Qi.y = 0.5*(velocityValues[1] + velocityValuesOld[1]);
416     }
417     c->queue[n] = Qi;
418   }
419   ierr = PetscLogEventEnd(CHARACTERISTIC_HalfTimeLocal,0,0,0,0);CHKERRQ(ierr);
420 
421   ierr = PetscLogEventBegin(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr);
422   ierr = CharacteristicSendCoordinatesEnd(c);CHKERRQ(ierr);
423   ierr = PetscLogEventEnd(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr);
424 
425 
426   /* Calculate velocity at t_n+1/2 (fill remote requests) */
427   ierr = PetscLogEventBegin(CHARACTERISTIC_HalfTimeRemote,0,0,0,0);CHKERRQ(ierr);
428   ierr = PetscInfo1(PETSC_NULL, "Calculating %d remote velocities at t_{n - 1/2}\n", c->queueRemoteSize);CHKERRQ(ierr);
429   for (n = 0; n < c->queueRemoteSize; n++) {
430     Qi = c->queueRemote[n];
431     interpIndices[0] = Qi.x;
432     interpIndices[1] = Qi.y;
433     if (c->velocityInterpLocal) {
434       c->velocityInterpLocal(velocityArray,    interpIndices, c->numVelocityComp, c->velocityComp, velocityValues,    c->velocityCtx);
435       c->velocityInterpLocal(velocityArrayOld, interpIndices, c->numVelocityComp, c->velocityComp, velocityValuesOld, c->velocityCtx);
436     } else {
437       c->velocityInterp(c->velocity,    interpIndices, c->numVelocityComp, c->velocityComp, velocityValues,    c->velocityCtx);
438       c->velocityInterp(c->velocityOld, interpIndices, c->numVelocityComp, c->velocityComp, velocityValuesOld, c->velocityCtx);
439     }
440     Qi.x = 0.5*(velocityValues[0] + velocityValuesOld[0]);
441     Qi.y = 0.5*(velocityValues[1] + velocityValuesOld[1]);
442     c->queueRemote[n] = Qi;
443   }
444   ierr = PetscLogEventEnd(CHARACTERISTIC_HalfTimeRemote,0,0,0,0);CHKERRQ(ierr);
445   ierr = PetscLogEventBegin(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr);
446   ierr = CharacteristicGetValuesBegin(c);CHKERRQ(ierr);
447   ierr = CharacteristicGetValuesEnd(c);CHKERRQ(ierr);
448   if (c->velocityInterpLocal) {
449     ierr = DMDAVecRestoreArray(c->velocityDA, velocityLocal,    &velocityArray);CHKERRQ(ierr);
450     ierr = DMDAVecRestoreArray(c->velocityDA, velocityLocalOld, &velocityArrayOld);CHKERRQ(ierr);
451     ierr = DMRestoreLocalVector(c->velocityDA, &velocityLocal);CHKERRQ(ierr);
452     ierr = DMRestoreLocalVector(c->velocityDA, &velocityLocalOld);CHKERRQ(ierr);
453   }
454   ierr = PetscLogEventEnd(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr);
455 
456   /* -----------------------------------------------------------------------
457      PART 2, AT t-dt
458      -----------------------------------------------------------------------*/
459 
460   /* GET POSITION AT t_n (local values) */
461   ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeLocal,0,0,0,0);CHKERRQ(ierr);
462   ierr = PetscInfo(PETSC_NULL, "Calculating position at t_{n}\n");CHKERRQ(ierr);
463   for (n = 0; n < c->queueSize; n++) {
464     Qi = c->queue[n];
465     Qi.x = Qi.i - Qi.x*dt;
466     Qi.y = Qi.j - Qi.y*dt;
467 
468     /* Determine whether the position at t-dt is local */
469     Qi.proc = DMDAGetNeighborRelative(da, Qi.x, Qi.y);
470 
471     /* Check for Periodic boundaries and move all periodic points back onto the domain */
472     ierr = DMDAMapCoordsToPeriodicDomain(da,&(Qi.x),&(Qi.y));CHKERRQ(ierr);
473 
474     c->queue[n] = Qi;
475   }
476   ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeLocal,0,0,0,0);CHKERRQ(ierr);
477 
478   ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr);
479   ierr = CharacteristicSendCoordinatesBegin(c);CHKERRQ(ierr);
480   ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr);
481 
482   /* GET VALUE AT FULL TIME IN THE PAST (LOCAL REQUESTS) */
483   ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeLocal,0,0,0,0);CHKERRQ(ierr);
484   if (c->fieldInterpLocal) {
485     ierr = DMGetLocalVector(c->fieldDA, &fieldLocal);CHKERRQ(ierr);
486     ierr = DMGlobalToLocalBegin(c->fieldDA, c->field, INSERT_VALUES, fieldLocal);CHKERRQ(ierr);
487     ierr = DMGlobalToLocalEnd(c->fieldDA, c->field, INSERT_VALUES, fieldLocal);CHKERRQ(ierr);
488     ierr = DMDAVecGetArray(c->fieldDA, fieldLocal, &fieldArray);CHKERRQ(ierr);
489   }
490   ierr = PetscInfo(PETSC_NULL, "Calculating local field at t_{n}\n");CHKERRQ(ierr);
491   for (n = 0; n < c->queueSize; n++) {
492     if (c->neighbors[c->queue[n].proc] == rank) {
493       interpIndices[0] = c->queue[n].x;
494       interpIndices[1] = c->queue[n].y;
495       if (c->fieldInterpLocal) {
496         c->fieldInterpLocal(fieldArray, interpIndices, c->numFieldComp, c->fieldComp, fieldValues, c->fieldCtx);
497       } else {
498         c->fieldInterp(c->field, interpIndices, c->numFieldComp, c->fieldComp, fieldValues, c->fieldCtx);
499       }
500       for (comp = 0; comp < c->numFieldComp; comp++) {
501         c->queue[n].field[comp] = fieldValues[comp];
502       }
503     }
504   }
505   ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeLocal,0,0,0,0);CHKERRQ(ierr);
506 
507   ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr);
508   ierr = CharacteristicSendCoordinatesEnd(c);CHKERRQ(ierr);
509   ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr);
510 
511   /* GET VALUE AT FULL TIME IN THE PAST (REMOTE REQUESTS) */
512   ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeRemote,0,0,0,0);CHKERRQ(ierr);
513   ierr = PetscInfo1(PETSC_NULL, "Calculating %d remote field points at t_{n}\n", c->queueRemoteSize);CHKERRQ(ierr);
514   for (n = 0; n < c->queueRemoteSize; n++) {
515     interpIndices[0] = c->queueRemote[n].x;
516     interpIndices[1] = c->queueRemote[n].y;
517 
518     /* for debugging purposes */
519     if (1) { /* hacked bounds test...let's do better */
520       PetscScalar im = interpIndices[0]; PetscScalar jm = interpIndices[1];
521 
522       if (( im < (PetscScalar) is - 1.) || (im > (PetscScalar) ie) || (jm < (PetscScalar)  js - 1.) || (jm > (PetscScalar) je)) {
523         SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB, "Nonlocal point: (%g,%g)", im, jm);
524       }
525     }
526 
527     if (c->fieldInterpLocal) {
528       c->fieldInterpLocal(fieldArray, interpIndices, c->numFieldComp, c->fieldComp, fieldValues, c->fieldCtx);
529     } else {
530       c->fieldInterp(c->field, interpIndices, c->numFieldComp, c->fieldComp, fieldValues, c->fieldCtx);
531     }
532     for (comp = 0; comp < c->numFieldComp; comp++) {
533       c->queueRemote[n].field[comp] = fieldValues[comp];
534     }
535   }
536   ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeRemote,0,0,0,0);CHKERRQ(ierr);
537 
538   ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr);
539   ierr = CharacteristicGetValuesBegin(c);CHKERRQ(ierr);
540   ierr = CharacteristicGetValuesEnd(c);CHKERRQ(ierr);
541   if (c->fieldInterpLocal) {
542     ierr = DMDAVecRestoreArray(c->fieldDA, fieldLocal, &fieldArray);CHKERRQ(ierr);
543     ierr = DMRestoreLocalVector(c->fieldDA, &fieldLocal);CHKERRQ(ierr);
544   }
545   ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr);
546 
547   /* Return field of characteristics at t_n-1 */
548   ierr = PetscLogEventBegin(CHARACTERISTIC_DAUpdate,0,0,0,0);CHKERRQ(ierr);
549   ierr = DMDAGetInfo(c->fieldDA,0,0,0,0,0,0,0,&dof,0,0,0,0,0);CHKERRQ(ierr);
550   ierr = DMDAVecGetArray(c->fieldDA, solution, &solArray);CHKERRQ(ierr);
551   for (n = 0; n < c->queueSize; n++) {
552     Qi = c->queue[n];
553     for (comp = 0; comp < c->numFieldComp; comp++) {
554       solArray[Qi.j][Qi.i*dof+c->fieldComp[comp]] = Qi.field[comp];
555     }
556   }
557   ierr = DMDAVecRestoreArray(c->fieldDA, solution, &solArray);CHKERRQ(ierr);
558   ierr = PetscLogEventEnd(CHARACTERISTIC_DAUpdate,0,0,0,0);CHKERRQ(ierr);
559   ierr = PetscLogEventEnd(CHARACTERISTIC_Solve,0,0,0,0);CHKERRQ(ierr);
560 
561   /* Cleanup */
562   ierr = PetscFree(interpIndices);CHKERRQ(ierr);
563   ierr = PetscFree(velocityValues);CHKERRQ(ierr);
564   ierr = PetscFree(velocityValuesOld);CHKERRQ(ierr);
565   ierr = PetscFree(fieldValues);CHKERRQ(ierr);
566   PetscFunctionReturn(0);
567 }
568 
569 #undef __FUNCT__
570 #define __FUNCT__ "CharacteristicSetNeighbors"
571 PetscErrorCode CharacteristicSetNeighbors(Characteristic c, PetscInt numNeighbors, PetscMPIInt neighbors[])
572 {
573   PetscErrorCode ierr;
574 
575   PetscFunctionBegin;
576   c->numNeighbors = numNeighbors;
577   ierr = PetscFree(c->neighbors);CHKERRQ(ierr);
578   ierr = PetscMalloc(numNeighbors * sizeof(PetscMPIInt), &c->neighbors);CHKERRQ(ierr);
579   ierr = PetscMemcpy(c->neighbors, neighbors, numNeighbors * sizeof(PetscMPIInt));CHKERRQ(ierr);
580   PetscFunctionReturn(0);
581 }
582 
583 #undef __FUNCT__
584 #define __FUNCT__ "CharacteristicAddPoint"
585 PetscErrorCode CharacteristicAddPoint(Characteristic c, CharacteristicPointDA2D *point)
586 {
587   PetscFunctionBegin;
588   if (c->queueSize >= c->queueMax) {
589     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE, "Exceeeded maximum queue size %d", c->queueMax);
590   }
591   c->queue[c->queueSize++] = *point;
592   PetscFunctionReturn(0);
593 }
594 
595 #undef __FUNCT__
596 #define __FUNCT__ "CharacteristicSendCoordinatesBegin"
597 int CharacteristicSendCoordinatesBegin(Characteristic c)
598 {
599   PetscMPIInt    rank, tag = 121;
600   PetscInt       i, n;
601   PetscErrorCode ierr;
602 
603   PetscFunctionBegin;
604   ierr = MPI_Comm_rank(((PetscObject)c)->comm, &rank);CHKERRQ(ierr);
605   ierr = CharacteristicHeapSort(c, c->queue, c->queueSize);CHKERRQ(ierr);
606   ierr = PetscMemzero(c->needCount, c->numNeighbors * sizeof(PetscInt));CHKERRQ(ierr);
607   for (i = 0;  i < c->queueSize; i++) {
608     c->needCount[c->queue[i].proc]++;
609   }
610   c->fillCount[0] = 0;
611   for (n = 1; n < c->numNeighbors; n++) {
612     ierr = MPI_Irecv(&(c->fillCount[n]), 1, MPIU_INT, c->neighbors[n], tag, ((PetscObject)c)->comm, &(c->request[n-1]));CHKERRQ(ierr);
613   }
614   for (n = 1; n < c->numNeighbors; n++) {
615     ierr = MPI_Send(&(c->needCount[n]), 1, MPIU_INT, c->neighbors[n], tag, ((PetscObject)c)->comm);CHKERRQ(ierr);
616   }
617   ierr = MPI_Waitall(c->numNeighbors-1, c->request, c->status);CHKERRQ(ierr);
618   /* Initialize the remote queue */
619   c->queueLocalMax  = c->localOffsets[0]  = 0;
620   c->queueRemoteMax = c->remoteOffsets[0] = 0;
621   for (n = 1; n < c->numNeighbors; n++) {
622     c->remoteOffsets[n] = c->queueRemoteMax;
623     c->queueRemoteMax  += c->fillCount[n];
624     c->localOffsets[n]  = c->queueLocalMax;
625     c->queueLocalMax   += c->needCount[n];
626   }
627   /* HACK BEGIN */
628   for (n = 1; n < c->numNeighbors; n++) {
629     c->localOffsets[n] += c->needCount[0];
630   }
631   c->needCount[0] = 0;
632   /* HACK END */
633   if (c->queueRemoteMax) {
634     ierr = PetscMalloc(sizeof(CharacteristicPointDA2D) * c->queueRemoteMax, &c->queueRemote);CHKERRQ(ierr);
635   } else {
636     c->queueRemote = PETSC_NULL;
637   }
638   c->queueRemoteSize = c->queueRemoteMax;
639 
640   /* Send and Receive requests for values at t_n+1/2, giving the coordinates for interpolation */
641   for (n = 1; n < c->numNeighbors; n++) {
642     ierr = PetscInfo2(PETSC_NULL, "Receiving %d requests for values from proc %d\n", c->fillCount[n], c->neighbors[n]);CHKERRQ(ierr);
643     ierr = MPI_Irecv(&(c->queueRemote[c->remoteOffsets[n]]), c->fillCount[n], c->itemType, c->neighbors[n], tag, ((PetscObject)c)->comm, &(c->request[n-1]));CHKERRQ(ierr);
644   }
645   for (n = 1; n < c->numNeighbors; n++) {
646     ierr = PetscInfo2(PETSC_NULL, "Sending %d requests for values from proc %d\n", c->needCount[n], c->neighbors[n]);CHKERRQ(ierr);
647     ierr = MPI_Send(&(c->queue[c->localOffsets[n]]), c->needCount[n], c->itemType, c->neighbors[n], tag, ((PetscObject)c)->comm);CHKERRQ(ierr);
648   }
649   PetscFunctionReturn(0);
650 }
651 
652 #undef __FUNCT__
653 #define __FUNCT__ "CharacteristicSendCoordinatesEnd"
654 PetscErrorCode CharacteristicSendCoordinatesEnd(Characteristic c)
655 {
656 #if 0
657   PetscMPIInt rank;
658   PetscInt n;
659 #endif
660   PetscErrorCode ierr;
661 
662   PetscFunctionBegin;
663   ierr = MPI_Waitall(c->numNeighbors-1, c->request, c->status);CHKERRQ(ierr);
664 #if 0
665   ierr = MPI_Comm_rank(((PetscObject)c)->comm, &rank);CHKERRQ(ierr);
666   for (n = 0; n < c->queueRemoteSize; n++) {
667     if (c->neighbors[c->queueRemote[n].proc] == rank) {
668       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB, "This is fucked up, n = %d proc = %d", n, c->queueRemote[n].proc);
669     }
670   }
671 #endif
672   PetscFunctionReturn(0);
673 }
674 
675 #undef __FUNCT__
676 #define __FUNCT__ "CharacteristicGetValuesBegin"
677 PetscErrorCode CharacteristicGetValuesBegin(Characteristic c)
678 {
679   PetscMPIInt    tag = 121;
680   PetscInt       n;
681   PetscErrorCode ierr;
682 
683   PetscFunctionBegin;
684   /* SEND AND RECIEVE FILLED REQUESTS for velocities at t_n+1/2 */
685   for (n = 1; n < c->numNeighbors; n++) {
686     ierr = MPI_Irecv(&(c->queue[c->localOffsets[n]]), c->needCount[n], c->itemType, c->neighbors[n], tag, ((PetscObject)c)->comm, &(c->request[n-1]));CHKERRQ(ierr);
687   }
688   for (n = 1; n < c->numNeighbors; n++) {
689     ierr = MPI_Send(&(c->queueRemote[c->remoteOffsets[n]]), c->fillCount[n], c->itemType, c->neighbors[n], tag, ((PetscObject)c)->comm);CHKERRQ(ierr);
690   }
691   PetscFunctionReturn(0);
692 }
693 
694 #undef __FUNCT__
695 #define __FUNCT__ "CharacteristicGetValuesEnd"
696 PetscErrorCode CharacteristicGetValuesEnd(Characteristic c)
697 {
698   PetscErrorCode ierr;
699 
700   PetscFunctionBegin;
701   ierr = MPI_Waitall(c->numNeighbors-1, c->request, c->status);CHKERRQ(ierr);
702   /* Free queue of requests from other procs */
703   ierr = PetscFree(c->queueRemote);CHKERRQ(ierr);
704   PetscFunctionReturn(0);
705 }
706 
707 /*---------------------------------------------------------------------*/
708 #undef __FUNCT__
709 #define __FUNCT__ "CharacteristicHeapSort"
710 /*
711   Based on code from http://linux.wku.edu/~lamonml/algor/sort/heap.html
712 */
713 PetscErrorCode CharacteristicHeapSort(Characteristic c, Queue queue, PetscInt size)
714 /*---------------------------------------------------------------------*/
715 {
716   PetscErrorCode          ierr;
717   CharacteristicPointDA2D temp;
718   PetscInt                n;
719 
720   PetscFunctionBegin;
721   if (0) { /* Check the order of the queue before sorting */
722     PetscInfo(PETSC_NULL, "Before Heap sort\n");
723     for (n=0;  n<size; n++) {
724       ierr = PetscInfo2(PETSC_NULL,"%d %d\n",n,queue[n].proc);CHKERRQ(ierr);
725     }
726   }
727 
728   /* SORTING PHASE */
729   for (n = (size / 2)-1; n >= 0; n--) {
730     ierr = CharacteristicSiftDown(c, queue, n, size-1);CHKERRQ(ierr); /* Rich had size-1 here, Matt had size*/
731   }
732   for (n = size-1; n >= 1; n--) {
733     temp = queue[0];
734     queue[0] = queue[n];
735     queue[n] = temp;
736     ierr = CharacteristicSiftDown(c, queue, 0, n-1);CHKERRQ(ierr);
737   }
738   if (0) { /* Check the order of the queue after sorting */
739     ierr = PetscInfo(PETSC_NULL, "Avter  Heap sort\n");CHKERRQ(ierr);
740     for (n=0;  n<size; n++) {
741       ierr = PetscInfo2(PETSC_NULL,"%d %d\n",n,queue[n].proc);CHKERRQ(ierr);
742     }
743   }
744   PetscFunctionReturn(0);
745 }
746 
747 /*---------------------------------------------------------------------*/
748 #undef __FUNCT__
749 #define __FUNCT__ "CharacteristicSiftDown"
750 /*
751   Based on code from http://linux.wku.edu/~lamonml/algor/sort/heap.html
752 */
753 PetscErrorCode CharacteristicSiftDown(Characteristic c, Queue queue, PetscInt root, PetscInt bottom)
754 /*---------------------------------------------------------------------*/
755 {
756   PetscBool                done = PETSC_FALSE;
757   PetscInt                 maxChild;
758   CharacteristicPointDA2D  temp;
759 
760   PetscFunctionBegin;
761   while ((root*2 <= bottom) && (!done)) {
762     if (root*2 == bottom)  maxChild = root * 2;
763     else if (queue[root*2].proc > queue[root*2+1].proc)  maxChild = root * 2;
764     else  maxChild = root * 2 + 1;
765 
766     if (queue[root].proc < queue[maxChild].proc) {
767       temp = queue[root];
768       queue[root] = queue[maxChild];
769       queue[maxChild] = temp;
770       root = maxChild;
771     } else
772       done = PETSC_TRUE;
773   }
774   PetscFunctionReturn(0);
775 }
776 
777 #undef __FUNCT__
778 #define __FUNCT__ "DMDAGetNeighborsRank"
779 /* [center, left, top-left, top, top-right, right, bottom-right, bottom, bottom-left] */
780 PetscErrorCode DMDAGetNeighborsRank(DM da, PetscMPIInt neighbors[])
781 {
782   DMDABoundaryType bx, by;
783   PetscBool        IPeriodic = PETSC_FALSE, JPeriodic = PETSC_FALSE;
784   MPI_Comm         comm;
785   PetscMPIInt      rank;
786   PetscInt         **procs,pi,pj,pim,pip,pjm,pjp,PI,PJ;
787   PetscErrorCode   ierr;
788 
789   PetscFunctionBegin;
790   ierr = PetscObjectGetComm((PetscObject) da, &comm);CHKERRQ(ierr);
791   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
792   ierr = DMDAGetInfo(da, 0, 0, 0, 0, &PI,&PJ, 0, 0, 0, &bx, &by,0, 0);
793 
794   if (bx == DMDA_BOUNDARY_PERIODIC) {
795     IPeriodic = PETSC_TRUE;
796   }
797   if (by == DMDA_BOUNDARY_PERIODIC) {
798     JPeriodic = PETSC_TRUE;
799   }
800 
801   neighbors[0] = rank;
802   rank = 0;
803   ierr = PetscMalloc(sizeof(PetscInt*)*PJ,&procs);CHKERRQ(ierr);
804   for (pj=0;pj<PJ;pj++) {
805     ierr = PetscMalloc(sizeof(PetscInt)*PI,&(procs[pj]));CHKERRQ(ierr);
806     for (pi=0;pi<PI;pi++) {
807       procs[pj][pi] = rank;
808       rank++;
809     }
810   }
811 
812   pi = neighbors[0] % PI;
813   pj = neighbors[0] / PI;
814   pim = pi-1;  if (pim<0) pim=PI-1;
815   pip = (pi+1)%PI;
816   pjm = pj-1;  if (pjm<0) pjm=PJ-1;
817   pjp = (pj+1)%PJ;
818 
819   neighbors[1] = procs[pj] [pim];
820   neighbors[2] = procs[pjp][pim];
821   neighbors[3] = procs[pjp][pi];
822   neighbors[4] = procs[pjp][pip];
823   neighbors[5] = procs[pj] [pip];
824   neighbors[6] = procs[pjm][pip];
825   neighbors[7] = procs[pjm][pi];
826   neighbors[8] = procs[pjm][pim];
827 
828   if (!IPeriodic) {
829     if (pi==0)    neighbors[1]=neighbors[2]=neighbors[8]=neighbors[0];
830     if (pi==PI-1) neighbors[4]=neighbors[5]=neighbors[6]=neighbors[0];
831   }
832 
833   if (!JPeriodic) {
834     if (pj==0)    neighbors[6]=neighbors[7]=neighbors[8]=neighbors[0];
835     if (pj==PJ-1) neighbors[2]=neighbors[3]=neighbors[4]=neighbors[0];
836   }
837 
838   for (pj = 0; pj < PJ; pj++) {
839     ierr = PetscFree(procs[pj]);CHKERRQ(ierr);
840   }
841   ierr = PetscFree(procs);CHKERRQ(ierr);
842   PetscFunctionReturn(0);
843 }
844 
845 #undef __FUNCT__
846 #define __FUNCT__ "DMDAGetNeighborRelative"
847 /*
848   SUBDOMAIN NEIGHBORHOOD PROCESS MAP:
849     2 | 3 | 4
850     __|___|__
851     1 | 0 | 5
852     __|___|__
853     8 | 7 | 6
854       |   |
855 */
856 PetscInt DMDAGetNeighborRelative(DM da, PassiveReal ir, PassiveReal jr)
857 {
858   DMDALocalInfo  info;
859   PassiveReal    is,ie,js,je;
860   PetscErrorCode ierr;
861 
862   ierr = DMDAGetLocalInfo(da, &info);CHKERRQ(ierr);
863   is = (PassiveReal) info.xs - 0.5; ie = (PassiveReal) info.xs + info.xm - 0.5;
864   js = (PassiveReal) info.ys - 0.5; je = (PassiveReal) info.ys + info.ym - 0.5;
865 
866   if (ir >= is && ir <= ie) { /* center column */
867     if (jr >= js && jr <= je) {
868       return 0;
869     } else if (jr < js) {
870       return 7;
871     } else {
872       return 3;
873     }
874   } else if (ir < is) {     /* left column */
875     if (jr >= js && jr <= je) {
876       return 1;
877     } else if (jr < js) {
878       return 8;
879     } else {
880       return 2;
881     }
882   } else {                  /* right column */
883     if (jr >= js && jr <= je) {
884       return 5;
885     } else if (jr < js) {
886       return 6;
887     } else {
888       return 4;
889     }
890   }
891 }
892