1 2 #include <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 HeapSort(Characteristic, Queue, PetscInt); 19 PetscErrorCode SiftDown(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 = PetscTypeCompare((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, const 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 = PetscTypeCompare((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->data = 0; 183 } 184 185 ierr = PetscFListFind(CharacteristicList, ((PetscObject)c)->comm,type,PETSC_TRUE, (void (**)(void)) &r);CHKERRQ(ierr); 186 if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown Characteristic type given: %s", type); 187 c->setupcalled = 0; 188 ierr = (*r)(c);CHKERRQ(ierr); 189 ierr = PetscObjectChangeTypeName((PetscObject) c, type);CHKERRQ(ierr); 190 PetscFunctionReturn(0); 191 } 192 193 #undef __FUNCT__ 194 #define __FUNCT__ "CharacteristicSetUp" 195 /*@ 196 CharacteristicSetUp - Sets up the internal data structures for the 197 later use of an iterative solver. 198 199 Collective on Characteristic 200 201 Input Parameter: 202 . ksp - iterative context obtained from CharacteristicCreate() 203 204 Level: developer 205 206 .keywords: Characteristic, setup 207 208 .seealso: CharacteristicCreate(), CharacteristicSolve(), CharacteristicDestroy() 209 @*/ 210 PetscErrorCode CharacteristicSetUp(Characteristic c) 211 { 212 PetscErrorCode ierr; 213 214 PetscFunctionBegin; 215 PetscValidHeaderSpecific(c, CHARACTERISTIC_CLASSID, 1); 216 217 if (!((PetscObject)c)->type_name){ 218 ierr = CharacteristicSetType(c, CHARACTERISTICDA);CHKERRQ(ierr); 219 } 220 221 if (c->setupcalled == 2) PetscFunctionReturn(0); 222 223 ierr = PetscLogEventBegin(CHARACTERISTIC_SetUp,c,0,0,0);CHKERRQ(ierr); 224 if (!c->setupcalled) { 225 ierr = (*c->ops->setup)(c);CHKERRQ(ierr); 226 } 227 ierr = PetscLogEventEnd(CHARACTERISTIC_SetUp,c,0,0,0);CHKERRQ(ierr); 228 c->setupcalled = 2; 229 PetscFunctionReturn(0); 230 } 231 232 #undef __FUNCT__ 233 #define __FUNCT__ "CharacteristicRegister" 234 /*@C 235 CharacteristicRegister - See CharacteristicRegisterDynamic() 236 237 Level: advanced 238 @*/ 239 PetscErrorCode CharacteristicRegister(const char sname[],const char path[],const char name[],PetscErrorCode (*function)(Characteristic)) 240 { 241 PetscErrorCode ierr; 242 char fullname[PETSC_MAX_PATH_LEN]; 243 244 PetscFunctionBegin; 245 ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr); 246 ierr = PetscFListAdd(&CharacteristicList,sname,fullname,(void (*)(void))function);CHKERRQ(ierr); 247 PetscFunctionReturn(0); 248 } 249 250 #undef __FUNCT__ 251 #define __FUNCT__ "CharacteristicSetVelocityInterpolation" 252 PetscErrorCode CharacteristicSetVelocityInterpolation(Characteristic c, DM da, Vec v, Vec vOld, PetscInt numComponents, PetscInt components[], PetscErrorCode (*interp)(Vec, PetscReal [], PetscInt, PetscInt [], PetscScalar [], void *), void *ctx) 253 { 254 PetscFunctionBegin; 255 c->velocityDA = da; 256 c->velocity = v; 257 c->velocityOld = vOld; 258 c->numVelocityComp = numComponents; 259 c->velocityComp = components; 260 c->velocityInterp = interp; 261 c->velocityCtx = ctx; 262 PetscFunctionReturn(0); 263 } 264 265 #undef __FUNCT__ 266 #define __FUNCT__ "CharacteristicSetVelocityInterpolationLocal" 267 PetscErrorCode CharacteristicSetVelocityInterpolationLocal(Characteristic c, DM da, Vec v, Vec vOld, PetscInt numComponents, PetscInt components[], PetscErrorCode (*interp)(void *, PetscReal [], PetscInt, PetscInt [], PetscScalar [], void *), void *ctx) 268 { 269 PetscFunctionBegin; 270 c->velocityDA = da; 271 c->velocity = v; 272 c->velocityOld = vOld; 273 c->numVelocityComp = numComponents; 274 c->velocityComp = components; 275 c->velocityInterpLocal = interp; 276 c->velocityCtx = ctx; 277 PetscFunctionReturn(0); 278 } 279 280 #undef __FUNCT__ 281 #define __FUNCT__ "CharacteristicSetFieldInterpolation" 282 PetscErrorCode CharacteristicSetFieldInterpolation(Characteristic c, DM da, Vec v, PetscInt numComponents, PetscInt components[], PetscErrorCode (*interp)(Vec, PetscReal [], PetscInt, PetscInt [], PetscScalar [], void *), void *ctx) 283 { 284 PetscFunctionBegin; 285 #if 0 286 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."); 287 #endif 288 c->fieldDA = da; 289 c->field = v; 290 c->numFieldComp = numComponents; 291 c->fieldComp = components; 292 c->fieldInterp = interp; 293 c->fieldCtx = ctx; 294 PetscFunctionReturn(0); 295 } 296 297 #undef __FUNCT__ 298 #define __FUNCT__ "CharacteristicSetFieldInterpolationLocal" 299 PetscErrorCode CharacteristicSetFieldInterpolationLocal(Characteristic c, DM da, Vec v, PetscInt numComponents, PetscInt components[], PetscErrorCode (*interp)(void *, PetscReal [], PetscInt, PetscInt [], PetscScalar [], void *), void *ctx) 300 { 301 PetscFunctionBegin; 302 #if 0 303 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."); 304 #endif 305 c->fieldDA = da; 306 c->field = v; 307 c->numFieldComp = numComponents; 308 c->fieldComp = components; 309 c->fieldInterpLocal = interp; 310 c->fieldCtx = ctx; 311 PetscFunctionReturn(0); 312 } 313 314 #undef __FUNCT__ 315 #define __FUNCT__ "CharacteristicSolve" 316 PetscErrorCode CharacteristicSolve(Characteristic c, PetscReal dt, Vec solution) 317 { 318 CharacteristicPointDA2D Qi; 319 DM da = c->velocityDA; 320 Vec velocityLocal, velocityLocalOld; 321 Vec fieldLocal; 322 DMDALocalInfo info; 323 PetscScalar **solArray; 324 void *velocityArray; 325 void *velocityArrayOld; 326 void *fieldArray; 327 PassiveScalar *interpIndices; 328 PassiveScalar *velocityValues, *velocityValuesOld; 329 PassiveScalar *fieldValues; 330 PetscMPIInt rank; 331 PetscInt dim; 332 PetscMPIInt neighbors[9]; 333 PetscInt dof; 334 PetscInt gx, gy; 335 PetscInt n, is, ie, js, je, comp; 336 PetscErrorCode ierr; 337 338 PetscFunctionBegin; 339 c->queueSize = 0; 340 ierr = MPI_Comm_rank(((PetscObject)c)->comm, &rank);CHKERRQ(ierr); 341 ierr = DMDAGetNeighborsRank(da, neighbors);CHKERRQ(ierr); 342 ierr = CharacteristicSetNeighbors(c, 9, neighbors);CHKERRQ(ierr); 343 ierr = CharacteristicSetUp(c);CHKERRQ(ierr); 344 /* global and local grid info */ 345 ierr = DMDAGetInfo(da, &dim, &gx, &gy, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);CHKERRQ(ierr); 346 ierr = DMDAGetLocalInfo(da, &info);CHKERRQ(ierr); 347 is = info.xs; ie = info.xs+info.xm; 348 js = info.ys; je = info.ys+info.ym; 349 /* Allocation */ 350 ierr = PetscMalloc(dim*sizeof(PetscScalar), &interpIndices);CHKERRQ(ierr); 351 ierr = PetscMalloc(c->numVelocityComp*sizeof(PetscScalar), &velocityValues);CHKERRQ(ierr); 352 ierr = PetscMalloc(c->numVelocityComp*sizeof(PetscScalar), &velocityValuesOld);CHKERRQ(ierr); 353 ierr = PetscMalloc(c->numFieldComp*sizeof(PetscScalar), &fieldValues);CHKERRQ(ierr); 354 ierr = PetscLogEventBegin(CHARACTERISTIC_Solve,0,0,0,0);CHKERRQ(ierr); 355 356 /* ----------------------------------------------------------------------- 357 PART 1, AT t-dt/2 358 -----------------------------------------------------------------------*/ 359 ierr = PetscLogEventBegin(CHARACTERISTIC_QueueSetup,0,0,0,0);CHKERRQ(ierr); 360 /* GET POSITION AT HALF TIME IN THE PAST */ 361 if (c->velocityInterpLocal) { 362 ierr = DMGetLocalVector(c->velocityDA, &velocityLocal);CHKERRQ(ierr); 363 ierr = DMGetLocalVector(c->velocityDA, &velocityLocalOld);CHKERRQ(ierr); 364 ierr = DMGlobalToLocalBegin(c->velocityDA, c->velocity, INSERT_VALUES, velocityLocal);CHKERRQ(ierr); 365 ierr = DMGlobalToLocalEnd(c->velocityDA, c->velocity, INSERT_VALUES, velocityLocal);CHKERRQ(ierr); 366 ierr = DMGlobalToLocalBegin(c->velocityDA, c->velocityOld, INSERT_VALUES, velocityLocalOld);CHKERRQ(ierr); 367 ierr = DMGlobalToLocalEnd(c->velocityDA, c->velocityOld, INSERT_VALUES, velocityLocalOld);CHKERRQ(ierr); 368 ierr = DMDAVecGetArray(c->velocityDA, velocityLocal, &velocityArray); CHKERRQ(ierr); 369 ierr = DMDAVecGetArray(c->velocityDA, velocityLocalOld, &velocityArrayOld);CHKERRQ(ierr); 370 } 371 ierr = PetscInfo(PETSC_NULL, "Calculating position at t_{n - 1/2}\n");CHKERRQ(ierr); 372 for(Qi.j = js; Qi.j < je; Qi.j++) { 373 for(Qi.i = is; Qi.i < ie; Qi.i++) { 374 interpIndices[0] = Qi.i; 375 interpIndices[1] = Qi.j; 376 if (c->velocityInterpLocal) { 377 c->velocityInterpLocal(velocityArray, interpIndices, c->numVelocityComp, c->velocityComp, velocityValues, c->velocityCtx); 378 } else { 379 c->velocityInterp(c->velocity, interpIndices, c->numVelocityComp, c->velocityComp, velocityValues, c->velocityCtx); 380 } 381 Qi.x = Qi.i - velocityValues[0]*dt/2.0; 382 Qi.y = Qi.j - velocityValues[1]*dt/2.0; 383 384 /* Determine whether the position at t - dt/2 is local */ 385 Qi.proc = DMDAGetNeighborRelative(da, Qi.x, Qi.y); 386 387 /* Check for Periodic boundaries and move all periodic points back onto the domain */ 388 ierr = DMDAMapCoordsToPeriodicDomain(da,&(Qi.x),&(Qi.y));CHKERRQ(ierr); 389 ierr = CharacteristicAddPoint(c, &Qi);CHKERRQ(ierr); 390 } 391 } 392 ierr = PetscLogEventEnd(CHARACTERISTIC_QueueSetup,0,0,0,0);CHKERRQ(ierr); 393 394 ierr = PetscLogEventBegin(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr); 395 ierr = CharacteristicSendCoordinatesBegin(c);CHKERRQ(ierr); 396 ierr = PetscLogEventEnd(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr); 397 398 ierr = PetscLogEventBegin(CHARACTERISTIC_HalfTimeLocal,0,0,0,0);CHKERRQ(ierr); 399 /* Calculate velocity at t_n+1/2 (local values) */ 400 ierr = PetscInfo(PETSC_NULL, "Calculating local velocities at t_{n - 1/2}\n");CHKERRQ(ierr); 401 for(n = 0; n < c->queueSize; n++) { 402 Qi = c->queue[n]; 403 if (c->neighbors[Qi.proc] == rank) { 404 interpIndices[0] = Qi.x; 405 interpIndices[1] = Qi.y; 406 if (c->velocityInterpLocal) { 407 c->velocityInterpLocal(velocityArray, interpIndices, c->numVelocityComp, c->velocityComp, velocityValues, c->velocityCtx); 408 c->velocityInterpLocal(velocityArrayOld, interpIndices, c->numVelocityComp, c->velocityComp, velocityValuesOld, c->velocityCtx); 409 } else { 410 c->velocityInterp(c->velocity, interpIndices, c->numVelocityComp, c->velocityComp, velocityValues, c->velocityCtx); 411 c->velocityInterp(c->velocityOld, interpIndices, c->numVelocityComp, c->velocityComp, velocityValuesOld, c->velocityCtx); 412 } 413 Qi.x = 0.5*(velocityValues[0] + velocityValuesOld[0]); 414 Qi.y = 0.5*(velocityValues[1] + velocityValuesOld[1]); 415 } 416 c->queue[n] = Qi; 417 } 418 ierr = PetscLogEventEnd(CHARACTERISTIC_HalfTimeLocal,0,0,0,0);CHKERRQ(ierr); 419 420 ierr = PetscLogEventBegin(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr); 421 ierr = CharacteristicSendCoordinatesEnd(c);CHKERRQ(ierr); 422 ierr = PetscLogEventEnd(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr); 423 424 425 /* Calculate velocity at t_n+1/2 (fill remote requests) */ 426 ierr = PetscLogEventBegin(CHARACTERISTIC_HalfTimeRemote,0,0,0,0);CHKERRQ(ierr); 427 ierr = PetscInfo1(PETSC_NULL, "Calculating %d remote velocities at t_{n - 1/2}\n", c->queueRemoteSize);CHKERRQ(ierr); 428 for(n = 0; n < c->queueRemoteSize; n++) { 429 Qi = c->queueRemote[n]; 430 interpIndices[0] = Qi.x; 431 interpIndices[1] = Qi.y; 432 if (c->velocityInterpLocal) { 433 c->velocityInterpLocal(velocityArray, interpIndices, c->numVelocityComp, c->velocityComp, velocityValues, c->velocityCtx); 434 c->velocityInterpLocal(velocityArrayOld, interpIndices, c->numVelocityComp, c->velocityComp, velocityValuesOld, c->velocityCtx); 435 } else { 436 c->velocityInterp(c->velocity, interpIndices, c->numVelocityComp, c->velocityComp, velocityValues, c->velocityCtx); 437 c->velocityInterp(c->velocityOld, interpIndices, c->numVelocityComp, c->velocityComp, velocityValuesOld, c->velocityCtx); 438 } 439 Qi.x = 0.5*(velocityValues[0] + velocityValuesOld[0]); 440 Qi.y = 0.5*(velocityValues[1] + velocityValuesOld[1]); 441 c->queueRemote[n] = Qi; 442 } 443 ierr = PetscLogEventEnd(CHARACTERISTIC_HalfTimeRemote,0,0,0,0);CHKERRQ(ierr); 444 ierr = PetscLogEventBegin(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr); 445 ierr = CharacteristicGetValuesBegin(c);CHKERRQ(ierr); 446 ierr = CharacteristicGetValuesEnd(c);CHKERRQ(ierr); 447 if (c->velocityInterpLocal) { 448 ierr = DMDAVecRestoreArray(c->velocityDA, velocityLocal, &velocityArray); CHKERRQ(ierr); 449 ierr = DMDAVecRestoreArray(c->velocityDA, velocityLocalOld, &velocityArrayOld);CHKERRQ(ierr); 450 ierr = DMRestoreLocalVector(c->velocityDA, &velocityLocal);CHKERRQ(ierr); 451 ierr = DMRestoreLocalVector(c->velocityDA, &velocityLocalOld);CHKERRQ(ierr); 452 } 453 ierr = PetscLogEventEnd(CHARACTERISTIC_HalfTimeExchange,0,0,0,0);CHKERRQ(ierr); 454 455 /* ----------------------------------------------------------------------- 456 PART 2, AT t-dt 457 -----------------------------------------------------------------------*/ 458 459 /* GET POSITION AT t_n (local values) */ 460 ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeLocal,0,0,0,0);CHKERRQ(ierr); 461 ierr = PetscInfo(PETSC_NULL, "Calculating position at t_{n}\n");CHKERRQ(ierr); 462 for(n = 0; n < c->queueSize; n++) { 463 Qi = c->queue[n]; 464 Qi.x = Qi.i - Qi.x*dt; 465 Qi.y = Qi.j - Qi.y*dt; 466 467 /* Determine whether the position at t-dt is local */ 468 Qi.proc = DMDAGetNeighborRelative(da, Qi.x, Qi.y); 469 470 /* Check for Periodic boundaries and move all periodic points back onto the domain */ 471 ierr = DMDAMapCoordsToPeriodicDomain(da,&(Qi.x),&(Qi.y));CHKERRQ(ierr); 472 473 c->queue[n] = Qi; 474 } 475 ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeLocal,0,0,0,0);CHKERRQ(ierr); 476 477 ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr); 478 ierr = CharacteristicSendCoordinatesBegin(c);CHKERRQ(ierr); 479 ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr); 480 481 /* GET VALUE AT FULL TIME IN THE PAST (LOCAL REQUESTS) */ 482 ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeLocal,0,0,0,0);CHKERRQ(ierr); 483 if (c->fieldInterpLocal) { 484 ierr = DMGetLocalVector(c->fieldDA, &fieldLocal);CHKERRQ(ierr); 485 ierr = DMGlobalToLocalBegin(c->fieldDA, c->field, INSERT_VALUES, fieldLocal);CHKERRQ(ierr); 486 ierr = DMGlobalToLocalEnd(c->fieldDA, c->field, INSERT_VALUES, fieldLocal);CHKERRQ(ierr); 487 ierr = DMDAVecGetArray(c->fieldDA, fieldLocal, &fieldArray);CHKERRQ(ierr); 488 } 489 ierr = PetscInfo(PETSC_NULL, "Calculating local field at t_{n}\n");CHKERRQ(ierr); 490 for(n = 0; n < c->queueSize; n++) { 491 if (c->neighbors[c->queue[n].proc] == rank) { 492 interpIndices[0] = c->queue[n].x; 493 interpIndices[1] = c->queue[n].y; 494 if (c->fieldInterpLocal) { 495 c->fieldInterpLocal(fieldArray, interpIndices, c->numFieldComp, c->fieldComp, fieldValues, c->fieldCtx); 496 } else { 497 c->fieldInterp(c->field, interpIndices, c->numFieldComp, c->fieldComp, fieldValues, c->fieldCtx); 498 } 499 for(comp = 0; comp < c->numFieldComp; comp++) { 500 c->queue[n].field[comp] = fieldValues[comp]; 501 } 502 } 503 } 504 ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeLocal,0,0,0,0);CHKERRQ(ierr); 505 506 ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr); 507 ierr = CharacteristicSendCoordinatesEnd(c);CHKERRQ(ierr); 508 ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr); 509 510 /* GET VALUE AT FULL TIME IN THE PAST (REMOTE REQUESTS) */ 511 ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeRemote,0,0,0,0);CHKERRQ(ierr); 512 ierr = PetscInfo1(PETSC_NULL, "Calculating %d remote field points at t_{n}\n", c->queueRemoteSize);CHKERRQ(ierr); 513 for(n = 0; n < c->queueRemoteSize; n++) { 514 interpIndices[0] = c->queueRemote[n].x; 515 interpIndices[1] = c->queueRemote[n].y; 516 517 /* for debugging purposes */ 518 if (1) { /* hacked bounds test...let's do better */ 519 PetscScalar im = interpIndices[0]; PetscScalar jm = interpIndices[1]; 520 521 if (( im < (PetscScalar) is - 1.) || (im > (PetscScalar) ie) || (jm < (PetscScalar) js - 1.) || (jm > (PetscScalar) je)) { 522 SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB, "Nonlocal point: (%g,%g)", im, jm); 523 } 524 } 525 526 if (c->fieldInterpLocal) { 527 c->fieldInterpLocal(fieldArray, interpIndices, c->numFieldComp, c->fieldComp, fieldValues, c->fieldCtx); 528 } else { 529 c->fieldInterp(c->field, interpIndices, c->numFieldComp, c->fieldComp, fieldValues, c->fieldCtx); 530 } 531 for(comp = 0; comp < c->numFieldComp; comp++) { 532 c->queueRemote[n].field[comp] = fieldValues[comp]; 533 } 534 } 535 ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeRemote,0,0,0,0);CHKERRQ(ierr); 536 537 ierr = PetscLogEventBegin(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr); 538 ierr = CharacteristicGetValuesBegin(c);CHKERRQ(ierr); 539 ierr = CharacteristicGetValuesEnd(c);CHKERRQ(ierr); 540 if (c->fieldInterpLocal) { 541 ierr = DMDAVecRestoreArray(c->fieldDA, fieldLocal, &fieldArray);CHKERRQ(ierr); 542 ierr = DMRestoreLocalVector(c->fieldDA, &fieldLocal);CHKERRQ(ierr); 543 } 544 ierr = PetscLogEventEnd(CHARACTERISTIC_FullTimeExchange,0,0,0,0);CHKERRQ(ierr); 545 546 /* Return field of characteristics at t_n-1 */ 547 ierr = PetscLogEventBegin(CHARACTERISTIC_DAUpdate,0,0,0,0);CHKERRQ(ierr); 548 ierr = DMDAGetInfo(c->fieldDA,0,0,0,0,0,0,0,&dof,0,0,0,0,0);CHKERRQ(ierr); 549 ierr = DMDAVecGetArray(c->fieldDA, solution, &solArray);CHKERRQ(ierr); 550 for(n = 0; n < c->queueSize; n++) { 551 Qi = c->queue[n]; 552 for(comp = 0; comp < c->numFieldComp; comp++) { 553 solArray[Qi.j][Qi.i*dof+c->fieldComp[comp]] = Qi.field[comp]; 554 } 555 } 556 ierr = DMDAVecRestoreArray(c->fieldDA, solution, &solArray);CHKERRQ(ierr); 557 ierr = PetscLogEventEnd(CHARACTERISTIC_DAUpdate,0,0,0,0);CHKERRQ(ierr); 558 ierr = PetscLogEventEnd(CHARACTERISTIC_Solve,0,0,0,0);CHKERRQ(ierr); 559 560 /* Cleanup */ 561 ierr = PetscFree(interpIndices);CHKERRQ(ierr); 562 ierr = PetscFree(velocityValues);CHKERRQ(ierr); 563 ierr = PetscFree(velocityValuesOld);CHKERRQ(ierr); 564 ierr = PetscFree(fieldValues);CHKERRQ(ierr); 565 PetscFunctionReturn(0); 566 } 567 568 #undef __FUNCT__ 569 #define __FUNCT__ "CharacteristicSetNeighbors" 570 PetscErrorCode CharacteristicSetNeighbors(Characteristic c, PetscInt numNeighbors, PetscMPIInt neighbors[]) 571 { 572 PetscErrorCode ierr; 573 574 PetscFunctionBegin; 575 c->numNeighbors = numNeighbors; 576 ierr = PetscFree(c->neighbors);CHKERRQ(ierr); 577 ierr = PetscMalloc(numNeighbors * sizeof(PetscMPIInt), &c->neighbors);CHKERRQ(ierr); 578 ierr = PetscMemcpy(c->neighbors, neighbors, numNeighbors * sizeof(PetscMPIInt));CHKERRQ(ierr); 579 PetscFunctionReturn(0); 580 } 581 582 #undef __FUNCT__ 583 #define __FUNCT__ "CharacteristicAddPoint" 584 PetscErrorCode CharacteristicAddPoint(Characteristic c, CharacteristicPointDA2D *point) 585 { 586 PetscFunctionBegin; 587 if (c->queueSize >= c->queueMax) { 588 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE, "Exceeeded maximum queue size %d", c->queueMax); 589 } 590 c->queue[c->queueSize++] = *point; 591 PetscFunctionReturn(0); 592 } 593 594 #undef __FUNCT__ 595 #define __FUNCT__ "CharacteristicSendCoordinatesBegin" 596 int CharacteristicSendCoordinatesBegin(Characteristic c) 597 { 598 PetscMPIInt rank, tag = 121; 599 PetscInt i, n; 600 PetscErrorCode ierr; 601 602 PetscFunctionBegin; 603 ierr = MPI_Comm_rank(((PetscObject)c)->comm, &rank);CHKERRQ(ierr); 604 ierr = HeapSort(c, c->queue, c->queueSize);CHKERRQ(ierr); 605 ierr = PetscMemzero(c->needCount, c->numNeighbors * sizeof(PetscInt));CHKERRQ(ierr); 606 for(i = 0; i < c->queueSize; i++) { 607 c->needCount[c->queue[i].proc]++; 608 } 609 c->fillCount[0] = 0; 610 for(n = 1; n < c->numNeighbors; n++) { 611 ierr = MPI_Irecv(&(c->fillCount[n]), 1, MPIU_INT, c->neighbors[n], tag, ((PetscObject)c)->comm, &(c->request[n-1]));CHKERRQ(ierr); 612 } 613 for(n = 1; n < c->numNeighbors; n++) { 614 ierr = MPI_Send(&(c->needCount[n]), 1, MPIU_INT, c->neighbors[n], tag, ((PetscObject)c)->comm);CHKERRQ(ierr); 615 } 616 ierr = MPI_Waitall(c->numNeighbors-1, c->request, c->status);CHKERRQ(ierr); 617 /* Initialize the remote queue */ 618 c->queueLocalMax = c->localOffsets[0] = 0; 619 c->queueRemoteMax = c->remoteOffsets[0] = 0; 620 for(n = 1; n < c->numNeighbors; n++) { 621 c->remoteOffsets[n] = c->queueRemoteMax; 622 c->queueRemoteMax += c->fillCount[n]; 623 c->localOffsets[n] = c->queueLocalMax; 624 c->queueLocalMax += c->needCount[n]; 625 } 626 /* HACK BEGIN */ 627 for(n = 1; n < c->numNeighbors; n++) { 628 c->localOffsets[n] += c->needCount[0]; 629 } 630 c->needCount[0] = 0; 631 /* HACK END */ 632 if (c->queueRemoteMax) { 633 ierr = PetscMalloc(sizeof(CharacteristicPointDA2D) * c->queueRemoteMax, &c->queueRemote);CHKERRQ(ierr); 634 } else { 635 c->queueRemote = PETSC_NULL; 636 } 637 c->queueRemoteSize = c->queueRemoteMax; 638 639 /* Send and Receive requests for values at t_n+1/2, giving the coordinates for interpolation */ 640 for(n = 1; n < c->numNeighbors; n++) { 641 ierr = PetscInfo2(PETSC_NULL, "Receiving %d requests for values from proc %d\n", c->fillCount[n], c->neighbors[n]);CHKERRQ(ierr); 642 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); 643 } 644 for(n = 1; n < c->numNeighbors; n++) { 645 ierr = PetscInfo2(PETSC_NULL, "Sending %d requests for values from proc %d\n", c->needCount[n], c->neighbors[n]);CHKERRQ(ierr); 646 ierr = MPI_Send(&(c->queue[c->localOffsets[n]]), c->needCount[n], c->itemType, c->neighbors[n], tag, ((PetscObject)c)->comm);CHKERRQ(ierr); 647 } 648 PetscFunctionReturn(0); 649 } 650 651 #undef __FUNCT__ 652 #define __FUNCT__ "CharacteristicSendCoordinatesEnd" 653 PetscErrorCode CharacteristicSendCoordinatesEnd(Characteristic c) 654 { 655 #if 0 656 PetscMPIInt rank; 657 PetscInt n; 658 #endif 659 PetscErrorCode ierr; 660 661 PetscFunctionBegin; 662 ierr = MPI_Waitall(c->numNeighbors-1, c->request, c->status);CHKERRQ(ierr); 663 #if 0 664 ierr = MPI_Comm_rank(((PetscObject)c)->comm, &rank);CHKERRQ(ierr); 665 for(n = 0; n < c->queueRemoteSize; n++) { 666 if (c->neighbors[c->queueRemote[n].proc] == rank) { 667 SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB, "This is fucked up, n = %d proc = %d", n, c->queueRemote[n].proc); 668 } 669 } 670 #endif 671 PetscFunctionReturn(0); 672 } 673 674 #undef __FUNCT__ 675 #define __FUNCT__ "CharacteristicGetValuesBegin" 676 PetscErrorCode CharacteristicGetValuesBegin(Characteristic c) 677 { 678 PetscMPIInt tag = 121; 679 PetscInt n; 680 PetscErrorCode ierr; 681 682 PetscFunctionBegin; 683 /* SEND AND RECIEVE FILLED REQUESTS for velocities at t_n+1/2 */ 684 for(n = 1; n < c->numNeighbors; n++) { 685 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); 686 } 687 for(n = 1; n < c->numNeighbors; n++) { 688 ierr = MPI_Send(&(c->queueRemote[c->remoteOffsets[n]]), c->fillCount[n], c->itemType, c->neighbors[n], tag, ((PetscObject)c)->comm);CHKERRQ(ierr); 689 } 690 PetscFunctionReturn(0); 691 } 692 693 #undef __FUNCT__ 694 #define __FUNCT__ "CharacteristicGetValuesEnd" 695 PetscErrorCode CharacteristicGetValuesEnd(Characteristic c) 696 { 697 PetscErrorCode ierr; 698 699 PetscFunctionBegin; 700 ierr = MPI_Waitall(c->numNeighbors-1, c->request, c->status);CHKERRQ(ierr); 701 /* Free queue of requests from other procs */ 702 ierr = PetscFree(c->queueRemote);CHKERRQ(ierr); 703 PetscFunctionReturn(0); 704 } 705 706 /*---------------------------------------------------------------------*/ 707 #undef __FUNCT__ 708 #define __FUNCT__ "HeapSort" 709 /* 710 Based on code from http://linux.wku.edu/~lamonml/algor/sort/heap.html 711 */ 712 int HeapSort(Characteristic c, Queue queue, PetscInt size) 713 /*---------------------------------------------------------------------*/ 714 { 715 CharacteristicPointDA2D temp; 716 int n; 717 718 if (0) { /* Check the order of the queue before sorting */ 719 PetscInfo(PETSC_NULL, "Before Heap sort\n"); 720 for (n=0; n<size; n++) { 721 PetscInfo2(PETSC_NULL,"%d %d\n",n,queue[n].proc); 722 } 723 } 724 725 /* SORTING PHASE */ 726 for (n = (size / 2)-1; n >= 0; n--) 727 SiftDown(c, queue, n, size-1); /* Rich had size-1 here, Matt had size*/ 728 for (n = size-1; n >= 1; n--) { 729 temp = queue[0]; 730 queue[0] = queue[n]; 731 queue[n] = temp; 732 SiftDown(c, queue, 0, n-1); 733 } 734 if (0) { /* Check the order of the queue after sorting */ 735 PetscInfo(PETSC_NULL, "Avter Heap sort\n"); 736 for (n=0; n<size; n++) { 737 PetscInfo2(PETSC_NULL,"%d %d\n",n,queue[n].proc); 738 } 739 } 740 return 0; 741 } 742 743 /*---------------------------------------------------------------------*/ 744 #undef __FUNCT__ 745 #define __FUNCT__ "SiftDown" 746 /* 747 Based on code from http://linux.wku.edu/~lamonml/algor/sort/heap.html 748 */ 749 PetscErrorCode SiftDown(Characteristic c, Queue queue, PetscInt root, PetscInt bottom) 750 /*---------------------------------------------------------------------*/ 751 { 752 PetscBool done = PETSC_FALSE; 753 PetscInt maxChild; 754 CharacteristicPointDA2D temp; 755 756 PetscFunctionBegin; 757 while ((root*2 <= bottom) && (!done)) { 758 if (root*2 == bottom) maxChild = root * 2; 759 else if (queue[root*2].proc > queue[root*2+1].proc) maxChild = root * 2; 760 else maxChild = root * 2 + 1; 761 762 if (queue[root].proc < queue[maxChild].proc) { 763 temp = queue[root]; 764 queue[root] = queue[maxChild]; 765 queue[maxChild] = temp; 766 root = maxChild; 767 } else 768 done = PETSC_TRUE; 769 } 770 PetscFunctionReturn(0); 771 } 772 773 #undef __FUNCT__ 774 #define __FUNCT__ "DMDAGetNeighborsRank" 775 /* [center, left, top-left, top, top-right, right, bottom-right, bottom, bottom-left] */ 776 PetscErrorCode DMDAGetNeighborsRank(DM da, PetscMPIInt neighbors[]) 777 { 778 DMDABoundaryType bx, by; 779 PetscBool IPeriodic = PETSC_FALSE, JPeriodic = PETSC_FALSE; 780 MPI_Comm comm; 781 PetscMPIInt rank; 782 PetscInt **procs,pi,pj,pim,pip,pjm,pjp,PI,PJ; 783 PetscErrorCode ierr; 784 785 PetscFunctionBegin; 786 ierr = PetscObjectGetComm((PetscObject) da, &comm);CHKERRQ(ierr); 787 ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr); 788 ierr = DMDAGetInfo(da, 0, 0, 0, 0, &PI,&PJ, 0, 0, 0, &bx, &by,0, 0); 789 790 if (bx == DMDA_BOUNDARY_PERIODIC) { 791 IPeriodic = PETSC_TRUE; 792 } 793 if (by == DMDA_BOUNDARY_PERIODIC) { 794 JPeriodic = PETSC_TRUE; 795 } 796 797 neighbors[0] = rank; 798 rank = 0; 799 ierr = PetscMalloc(sizeof(PetscInt*)*PJ,&procs);CHKERRQ(ierr); 800 for (pj=0;pj<PJ;pj++) { 801 ierr = PetscMalloc(sizeof(PetscInt)*PI,&(procs[pj]));CHKERRQ(ierr); 802 for (pi=0;pi<PI;pi++) { 803 procs[pj][pi] = rank; 804 rank++; 805 } 806 } 807 808 pi = neighbors[0] % PI; 809 pj = neighbors[0] / PI; 810 pim = pi-1; if (pim<0) pim=PI-1; 811 pip = (pi+1)%PI; 812 pjm = pj-1; if (pjm<0) pjm=PJ-1; 813 pjp = (pj+1)%PJ; 814 815 neighbors[1] = procs[pj] [pim]; 816 neighbors[2] = procs[pjp][pim]; 817 neighbors[3] = procs[pjp][pi]; 818 neighbors[4] = procs[pjp][pip]; 819 neighbors[5] = procs[pj] [pip]; 820 neighbors[6] = procs[pjm][pip]; 821 neighbors[7] = procs[pjm][pi]; 822 neighbors[8] = procs[pjm][pim]; 823 824 if (!IPeriodic) { 825 if (pi==0) neighbors[1]=neighbors[2]=neighbors[8]=neighbors[0]; 826 if (pi==PI-1) neighbors[4]=neighbors[5]=neighbors[6]=neighbors[0]; 827 } 828 829 if (!JPeriodic) { 830 if (pj==0) neighbors[6]=neighbors[7]=neighbors[8]=neighbors[0]; 831 if (pj==PJ-1) neighbors[2]=neighbors[3]=neighbors[4]=neighbors[0]; 832 } 833 834 for(pj = 0; pj < PJ; pj++) { 835 ierr = PetscFree(procs[pj]);CHKERRQ(ierr); 836 } 837 ierr = PetscFree(procs);CHKERRQ(ierr); 838 PetscFunctionReturn(0); 839 } 840 841 #undef __FUNCT__ 842 #define __FUNCT__ "DMDAGetNeighborRelative" 843 /* 844 SUBDOMAIN NEIGHBORHOOD PROCESS MAP: 845 2 | 3 | 4 846 __|___|__ 847 1 | 0 | 5 848 __|___|__ 849 8 | 7 | 6 850 | | 851 */ 852 PetscInt DMDAGetNeighborRelative(DM da, PassiveReal ir, PassiveReal jr) 853 { 854 DMDALocalInfo info; 855 PassiveReal is,ie,js,je; 856 PetscErrorCode ierr; 857 858 ierr = DMDAGetLocalInfo(da, &info);CHKERRQ(ierr); 859 is = (PassiveReal) info.xs - 0.5; ie = (PassiveReal) info.xs + info.xm - 0.5; 860 js = (PassiveReal) info.ys - 0.5; je = (PassiveReal) info.ys + info.ym - 0.5; 861 862 if (ir >= is && ir <= ie) { /* center column */ 863 if (jr >= js && jr <= je) { 864 return 0; 865 } else if (jr < js) { 866 return 7; 867 } else { 868 return 3; 869 } 870 } else if (ir < is) { /* left column */ 871 if (jr >= js && jr <= je) { 872 return 1; 873 } else if (jr < js) { 874 return 8; 875 } else { 876 return 2; 877 } 878 } else { /* right column */ 879 if (jr >= js && jr <= je) { 880 return 5; 881 } else if (jr < js) { 882 return 6; 883 } else { 884 return 4; 885 } 886 } 887 } 888