00001
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "ParFUM.h"
00014 #include "ParFUM_internals.h"
00015
00016
00017
00018 int femVersion = 1;
00019 static FEM_Partition *mypartition=NULL;
00020
00021 enum PartitionMode {
00022 SerialPartitionMode = 1,
00023 ParallelPartitionMode = 2,
00024 ManualPartitionMode
00025 };
00026 PartitionMode FEM_Partition_Mode = SerialPartitionMode;
00027
00028 enum MetisGraphType {
00029 NodeNeighborMode,
00030 FaceNeighborMode
00031 };
00032 MetisGraphType FEM_Partition_Graph_Type = NodeNeighborMode;
00033
00034
00035 #define FEM_TCHARM_SEMAID 0x00FE300
00036
00037 void FEM_Abort(const char *msg) {
00038 CkAbort(msg);
00039 }
00040 void FEM_Abort(const char *caller,const char *sprintf_msg,
00041 int int0,int int1, int int2)
00042 {
00043 char userSprintf[1024];
00044 char msg[1024];
00045 sprintf(userSprintf,sprintf_msg,int0,int1,int2);
00046 sprintf(msg,"FEM Routine %s fatal error:\n %s",
00047 caller,userSprintf);
00048 FEM_Abort(msg);
00049 }
00050
00051
00052
00053
00054 enum {FEM_globalID=33};
00055
00056 CLINKAGE void pupFEM_Chunk(pup_er cp) {
00057 PUP::er &p=*(PUP::er *)cp;
00058 FEM_chunk *c=(FEM_chunk *)TCHARM_Get_global(FEM_globalID);
00059 if (c==NULL) {
00060 c=new FEM_chunk((CkMigrateMessage *)0);
00061 TCHARM_Set_global(FEM_globalID,c,pupFEM_Chunk);
00062 }
00063 c->pup(p);
00064 if (p.isDeleting())
00065 delete c;
00066 }
00067 FEM_chunk *FEM_chunk::get(const char *caller) {
00068 FEM_chunk *c=(FEM_chunk *)TCHARM_Get_global(FEM_globalID);
00069 if(!c) FEM_Abort(caller,"FEM is not initialized");
00070 return c;
00071 }
00072
00073 CLINKAGE void FEM_Init(FEM_Comm_t defaultComm)
00074 {
00075 IDXL_Init(defaultComm);
00076 if (!TCHARM_Get_global(FEM_globalID)) {
00077 FEM_chunk *c=new FEM_chunk(defaultComm);
00078 TCHARM_Set_global(FEM_globalID,c,pupFEM_Chunk);
00079 }
00080 char **argv = CkGetArgv();
00081 if(CmiGetArgFlagDesc(argv,"+Parfum_parallel_partition","ParFUM should use the parallel partitioner")){
00082 FEM_Partition_Mode = ParallelPartitionMode;
00083 }
00084 if (CmiGetArgFlagDesc(argv, "+Parfum_manual_partition", "Specify manual mesh partitioning")) {
00085 FEM_Partition_Mode = ManualPartitionMode;
00086 }
00087 if (CmiGetArgFlagDesc(argv,
00088 "+Parfum_face_neighbor_graph",
00089 "Specify partitioning based on face neighbors instead of node neighbors")) {
00090 FEM_Partition_Graph_Type = FaceNeighborMode;
00091 }
00092 }
00093 FORTRAN_AS_C(FEM_INIT,FEM_Init,fem_init, (int *comm), (*comm))
00094
00095
00096
00097
00098
00099 void FEM_Mesh_list::bad(int l,int bad_code,const char *caller) const {
00100 if (bad_code==0)
00101 FEM_Abort(caller,"Invalid FEM Mesh ID %d (should be like %d)",
00102 l,FEM_MESH_FIRST);
00103 else
00104 FEM_Abort(caller,"Re-used a deleted FEM Mesh ID %d",l);
00105 }
00106
00107 CLINKAGE int
00108 FEM_Mesh_allocate(void)
00109 {
00110 const char *caller="FEM_Mesh_allocate";FEMAPI(caller);
00111 FEM_chunk *c=FEM_chunk::get(caller);
00112 FEM_Mesh *m=new FEM_Mesh;
00113 m->becomeSetting();
00114 return c->meshes.put(m);
00115 }
00116 FORTRAN_AS_C_RETURN(int,
00117 FEM_MESH_ALLOCATE,FEM_Mesh_allocate,fem_mesh_allocate, (void),())
00118
00119
00120 template <class T>
00121 inline T *clonePointerViaPup(T *old) {
00122 size_t len=PUP::size(*old);
00123 char *buf=new char[len];
00124 PUP::toMemBuf(*old,buf,len);
00125 T *nu=new T;
00126 PUP::fromMemBuf(*nu,buf,len);
00127 return nu;
00128 }
00129
00130 CLINKAGE int
00131 FEM_Mesh_copy(int fem_mesh) {
00132 const char *caller="FEM_Mesh_copy";FEMAPI(caller);
00133 FEM_chunk *c=FEM_chunk::get(caller);
00134 return c->meshes.put(clonePointerViaPup(c->meshes.lookup(fem_mesh,caller)));
00135 }
00136 FORTRAN_AS_C_RETURN(int,
00137 FEM_MESH_COPY,FEM_Mesh_copy,fem_mesh_copy, (int *m),(*m))
00138
00139
00140 CLINKAGE void
00141 FEM_Mesh_deallocate(int fem_mesh)
00142 {
00143 if (fem_mesh!=-1) {
00144 const char *caller="FEM_Mesh_deallocate";FEMAPI(caller);
00145 FEM_chunk *c=FEM_chunk::get(caller);
00146 c->meshes.destroy(fem_mesh,caller);
00147 }
00148 }
00149 FORTRAN_AS_C(FEM_MESH_DEALLOCATE,FEM_Mesh_deallocate,fem_mesh_deallocate, (int *m),(*m))
00150
00151
00152 CLINKAGE int
00153 FEM_Mesh_read(const char *prefix,int partNo,int nParts)
00154 {
00155 const char *caller="FEM_Mesh_read";FEMAPI(caller);
00156 FEM_chunk *c=FEM_chunk::get(caller);
00157 return c->meshes.put(FEM_readMesh(prefix,partNo,nParts));
00158 }
00159 FLINKAGE int
00160 FTN_NAME(FEM_MESH_READ,fem_mesh_read)(const char *n,int *partNo,int *nParts,int len) {
00161 char *s=new char[len+1]; strncpy(s,n,len); s[len]=(char)0;
00162 int ret=FEM_Mesh_read(s,*partNo,*nParts);
00163 delete[] s;
00164 return ret;
00165 }
00166
00167 CLINKAGE void
00168 FEM_Mesh_write(int fem_mesh,const char *prefix,int partNo,int nParts)
00169 {
00170 const char *caller="FEM_Mesh_write";FEMAPI(caller);
00171 FEM_chunk *c=FEM_chunk::get(caller);
00172 FEM_writeMesh(c->meshes.lookup(fem_mesh,caller),prefix,partNo,nParts);
00173 }
00174 FLINKAGE void
00175 FTN_NAME(FEM_MESH_WRITE,fem_mesh_write)(int *m,const char *n,int *partNo,int *nParts,int len) {
00176 char *s=new char[len+1]; strncpy(s,n,len); s[len]=(char)0;
00177 FEM_Mesh_write(*m,s,*partNo,*nParts);
00178 delete[] s;
00179 }
00180
00181
00182 CLINKAGE int
00183 FEM_Mesh_assemble(int nParts,const int *srcMeshes) {
00184 const char *caller="FEM_Mesh_assemble";FEMAPI(caller);
00185 FEM_chunk *c=FEM_chunk::get(caller);
00186 FEM_Mesh **chunks=new FEM_Mesh*[nParts];
00187 for (int p=0;p<nParts;p++) chunks[p]=c->meshes.lookup(srcMeshes[p],caller);
00188 int ret=c->meshes.put(FEM_Mesh_assemble(nParts,chunks));
00189 delete[] chunks;
00190 return ret;
00191 }
00192 FORTRAN_AS_C_RETURN(int,FEM_MESH_ASSEMBLE,FEM_Mesh_assemble,fem_mesh_assemble,
00193 (int *nParts,const int *src),(*nParts,src))
00194
00195
00196
00197 FEM_Partition &FEM_curPartition(void) {
00198 if (mypartition==NULL) mypartition=new FEM_Partition();
00199 return *mypartition;
00200 }
00201 void clearPartition(void) {delete mypartition; mypartition=NULL;}
00202
00203 FEM_Partition::FEM_Partition()
00204 {
00205 elem2chunk=NULL;
00206 sym=NULL;
00207 lastLayer=0;
00208 }
00209 FEM_Partition::~FEM_Partition() {
00210 if (elem2chunk) {delete[] elem2chunk;elem2chunk=NULL;}
00211 for (int i=0;i<getRegions();i++) {
00212 delete regions[i].layer;
00213 delete regions[i].stencil;
00214 }
00215 }
00216
00217 void FEM_Partition::setPartition(const int *e, int nElem, int idxBase) {
00218 if (elem2chunk) {delete[] elem2chunk;elem2chunk=NULL;}
00219 elem2chunk=CkCopyArray(e,nElem,idxBase);
00220 }
00221 const int *FEM_Partition::getPartition(FEM_Mesh *src,int nChunks) const {
00222 if (!elem2chunk) {
00223 int *e=new int[src->nElems()];
00224 FEM_Mesh_partition(src,nChunks,e,FEM_Partition_Graph_Type == FaceNeighborMode);
00225 ((FEM_Partition *)this)->elem2chunk=e;
00226 }
00227 return elem2chunk;
00228 }
00229
00230 static void FEM_Mesh_partition(FEM_Mesh *src,int _nchunks,FEM_Mesh_Output *out) {
00231 src->setAscendingGlobalno();
00232 FEM_Mesh_split(src,_nchunks,FEM_curPartition(),out);
00233 clearPartition();
00234 }
00235
00236
00237 class FEM_Mesh_Partition_List : public FEM_Mesh_Output {
00238 FEM_chunk *c;
00239 int *dest;
00240 public:
00241 FEM_Mesh_Partition_List(FEM_chunk *c_, int *dest_)
00242 :c(c_), dest(dest_) {}
00243
00244 void accept(int chunkNo,FEM_Mesh *m) {
00245 dest[chunkNo]=c->meshes.put(m);
00246 }
00247 };
00248
00249 CLINKAGE void
00250 FEM_Mesh_partition(int fem_mesh,int nParts,int *destMeshes) {
00251 const char *caller="FEM_Mesh_partition"; FEMAPI(caller);
00252 FEM_chunk *c=FEM_chunk::get(caller);
00253 FEM_Mesh *m=c->lookup(fem_mesh,caller);
00254 FEM_Mesh_Partition_List l(c,destMeshes);
00255 if (m->node.size()>0) {
00256 FEM_Mesh_partition(m,nParts,&l);
00257 } else {
00258 for (int i=0;i<nParts;i++)
00259 destMeshes[i]=FEM_Mesh_copy(fem_mesh);
00260 }
00261 }
00262 FORTRAN_AS_C(FEM_MESH_PARTITION,FEM_Mesh_partition,fem_mesh_partition,
00263 (int *mesh,int *nParts,int *dest),(*mesh,*nParts,dest))
00264
00265
00266
00267 CLINKAGE int
00268 FEM_Mesh_recv(int fromRank,int tag,FEM_Comm_t comm_context)
00269 {
00270 const char *caller="FEM_Mesh_recv";FEMAPI(caller);
00271 FEM_chunk *c=FEM_chunk::get(caller);
00272 marshallNewHeapCopy<FEM_Mesh> m;
00273 MPI_Recv_pup(m,fromRank,tag,(MPI_Comm)comm_context);
00274 FEM_Mesh *msh=m;
00275 msh->becomeGetting();
00276 return c->meshes.put(msh);
00277 }
00278 FORTRAN_AS_C_RETURN(int,FEM_MESH_RECV,FEM_Mesh_recv,fem_mesh_recv,
00279 (int *from,int *tag,int *comm),(*from,*tag,*comm))
00280
00281 CLINKAGE void
00282 FEM_Mesh_send(int fem_mesh,int toRank,int tag,FEM_Comm_t comm_context)
00283 {
00284 const char *caller="FEM_Mesh_send";FEMAPI(caller);
00285 FEM_chunk *c=FEM_chunk::get(caller);
00286 marshallNewHeapCopy<FEM_Mesh> m(c->meshes.lookup(fem_mesh,caller));
00287 MPI_Send_pup(m,toRank,tag,(MPI_Comm)comm_context);
00288 }
00289 FORTRAN_AS_C(FEM_MESH_SEND,FEM_Mesh_send,fem_mesh_send,
00290 (int *mesh,int *to,int *tag,int *comm),(*mesh,*to,*tag,*comm))
00291
00292
00293 CLINKAGE int
00294 FEM_Mesh_reduce(int fem_mesh,int masterRank,FEM_Comm_t comm_context)
00295 {
00296 int tag=89374;
00297 int myRank; MPI_Comm_rank((MPI_Comm)comm_context,&myRank);
00298 if (myRank!=masterRank)
00299 {
00300 FEM_Mesh_send(fem_mesh,masterRank,tag,comm_context);
00301 return 0;
00302 }
00303 else
00304 {
00305 int p, nParts; MPI_Comm_size((MPI_Comm)comm_context,&nParts);
00306 int *parts=new int[nParts];
00307 for (p=0;p<nParts;p++)
00308 if (p!=masterRank)
00309 parts[p]=FEM_Mesh_recv(p,tag,comm_context);
00310 else
00311 parts[p]=fem_mesh;
00312 int new_mesh=FEM_Mesh_assemble(nParts,parts);
00313 for (p=0;p<nParts;p++)
00314 if (p!=masterRank)
00315 FEM_Mesh_deallocate(parts[p]);
00316 delete[] parts;
00317 return new_mesh;
00318 }
00319 }
00320 FORTRAN_AS_C_RETURN(int,FEM_MESH_REDUCE,FEM_Mesh_reduce,fem_mesh_reduce,
00321 (int *mesh,int *rank,int *comm),(*mesh,*rank,*comm))
00322
00323
00324 extern int FEM_Mesh_Parallel_broadcast(int fem_mesh,int masterRank,FEM_Comm_t comm_context);
00325
00326 CLINKAGE int
00327 FEM_Mesh_broadcast(int fem_mesh,int masterRank,FEM_Comm_t comm_context)
00328 {
00329 int myRank;
00330 MPI_Comm_rank((MPI_Comm)comm_context,&myRank);
00331 if (FEM_Partition_Mode == ManualPartitionMode && myRank == masterRank) {
00332 const char* caller = "FEM_Mesh_broadcast";
00333 FEMAPI(caller);
00334 FEM_chunk* c = FEM_chunk::get(caller);
00335 FEM_Mesh* mesh = c->lookup(fem_mesh,caller);
00336
00337
00338
00339 int nelems = mesh->nElems();
00340 int* elem2chunk = new int [nelems];
00341 int index=0;
00342 for (int elemType=0; elemType<mesh->elem.size(); ++elemType) {
00343 FEM_Elem& elems = mesh->elem[elemType];
00344 FEM_DataAttribute* partitionMap = (FEM_DataAttribute*) elems.lookup(FEM_PARTITION, caller);
00345 for (int elem=0; elem<elems.size(); ++elem) {
00346 elem2chunk[index++] = partitionMap->getInt().getData()[elem];
00347 }
00348 }
00349
00350 FEM_Set_partition(elem2chunk);
00351 }
00352 if (FEM_Partition_Mode == SerialPartitionMode || FEM_Partition_Mode == ManualPartitionMode) {
00353 int tag=89375;
00354 if (myRank==masterRank) {
00355 int p, nParts; MPI_Comm_size((MPI_Comm)comm_context,&nParts);
00356 int *parts=new int[nParts];
00357 FEM_Mesh_partition(fem_mesh,nParts,parts);
00358 int new_mesh=0;
00359 for (p=0;p<nParts;p++)
00360 if (p!=masterRank) {
00361 FEM_Mesh_send(parts[p],p,tag,comm_context);
00362 FEM_Mesh_deallocate(parts[p]);
00363 }
00364 else {
00365 new_mesh=parts[p];
00366 }
00367 return new_mesh;
00368 } else {
00369 return FEM_Mesh_recv(masterRank,tag,comm_context);
00370 }
00371 } else if (FEM_Partition_Mode == ParallelPartitionMode) {
00372
00373 MPI_Barrier((MPI_Comm)comm_context);
00374
00375 MPI_Barrier((MPI_Comm)comm_context);
00376 return FEM_Mesh_Parallel_broadcast(fem_mesh,masterRank,comm_context);
00377 } else {
00378 CkAbort("Unrecognized ParFUM partitioning mode");
00379 }
00380 return -1;
00381 }
00382 FORTRAN_AS_C_RETURN(int,FEM_MESH_BROADCAST,FEM_Mesh_broadcast,fem_mesh_broadcast,
00383 (int *mesh,int *rank,int *comm),(*mesh,*rank,*comm))
00384
00385
00386 CLINKAGE void
00387 FEM_Mesh_copy_globalno(int src_mesh,int dest_mesh)
00388 {
00389 const char *caller="FEM_Mesh_copy_globalno";FEMAPI(caller);
00390 FEM_chunk *c=FEM_chunk::get(caller);
00391 c->lookup(dest_mesh,caller)->
00392 copyOldGlobalno(*c->lookup(src_mesh,caller));
00393 }
00394
00395
00396 CLINKAGE int FEM_Mesh_default_read(void)
00397 {
00398 return FEM_chunk::get("FEM_Mesh_default_read")->default_read;
00399 }
00400 FORTRAN_AS_C_RETURN(int,
00401 FEM_MESH_DEFAULT_READ,FEM_Mesh_default_read,fem_mesh_default_read,
00402 (void),())
00403
00404 CLINKAGE int FEM_Mesh_default_write(void)
00405 {
00406 return FEM_chunk::get("FEM_Mesh_default_write")->default_write;
00407 }
00408 FORTRAN_AS_C_RETURN(int,
00409 FEM_MESH_DEFAULT_WRITE,FEM_Mesh_default_write,fem_mesh_default_write,
00410 (void),())
00411
00412 CLINKAGE void FEM_Mesh_set_default_read(int fem_mesh)
00413 {
00414 FEM_chunk::get("FEM_Mesh_set_default_read")->default_read=fem_mesh;
00415 }
00416 FORTRAN_AS_C(FEM_MESH_SET_DEFAULT_READ,FEM_Mesh_set_default_read,fem_mesh_set_default_read,
00417 (int *m),(*m))
00418 CLINKAGE void FEM_Mesh_set_default_write(int fem_mesh)
00419 {
00420 FEM_chunk::get("FEM_Mesh_set_default_write")->default_write=fem_mesh;
00421 }
00422 FORTRAN_AS_C(FEM_MESH_SET_DEFAULT_WRITE,FEM_Mesh_set_default_write,fem_mesh_set_default_write,
00423 (int *m),(*m))
00424
00425
00426
00427
00428
00429 int *CkCopyArray(const int *src,int len,int indexBase)
00430 {
00431 int *ret=new int[len];
00432 for (int i=0;i<len;i++) ret[i]=src[i]-indexBase;
00433 return ret;
00434 }
00435
00436
00437
00438
00439 #if CMK_ERROR_CHECKING
00440 void FEM_chunk::check(const char *where) {
00441
00442 }
00443 #endif
00444
00445 static FEM_Mesh *setMesh(void) {
00446 const char *caller="::setMesh";
00447 return FEM_chunk::get(caller)->setMesh(caller);
00448 }
00449
00450 static const FEM_Mesh *getMesh(void) {
00451 const char *caller="::getMesh";
00452 return FEM_chunk::get(caller)->getMesh(caller);
00453 }
00454
00455 FEM_Mesh *FEM_Mesh_lookup(int fem_mesh, const char *caller) {
00456 return FEM_chunk::get(caller)->lookup(fem_mesh,caller);
00457 }
00458
00459 CLINKAGE void FEM_Mesh_Become_Setting(int fem_mesh) {
00460 FEM_Mesh *meshP = FEM_Mesh_lookup(fem_mesh,"driver");
00461 meshP->becomeSetting();
00462 }
00463 FLINKAGE void FTN_NAME(FEM_MESH_BECOME_SETTING,fem_mesh_become_setting)
00464 (int *mesh)
00465 {
00466 FEM_Mesh_Become_Setting(*mesh);
00467 }
00468
00469 CLINKAGE void FEM_Mesh_Become_Getting(int fem_mesh) {
00470 FEM_Mesh *meshP = FEM_Mesh_lookup(fem_mesh,"driver");
00471 meshP->becomeGetting();
00472 }
00473 FLINKAGE void FTN_NAME(FEM_MESH_BECOME_GETTING,fem_mesh_become_getting)
00474 (int *mesh)
00475 {
00476 FEM_Mesh_Become_Getting(*mesh);
00477 }
00478
00479
00480
00481
00482 CLINKAGE void FEM_Set_partition(int *elem2chunk) {
00483 FEMAPI("FEM_Set_partition");
00484 FEM_curPartition().setPartition(elem2chunk,setMesh()->nElems(),0);
00485 }
00486
00487
00488 FLINKAGE void FTN_NAME(FEM_SET_PARTITION,fem_set_partition)
00489 (int *elem2chunk)
00490 {
00491 FEMAPI("FEM_Set_partition");
00492 FEM_curPartition().setPartition(elem2chunk,setMesh()->nElems(),1);
00493 }
00494
00495
00496
00497
00498 FEM_chunk::FEM_chunk(FEM_Comm_t defaultComm_)
00499 :defaultComm(defaultComm_)
00500 {
00501 default_read=-1;
00502 default_write=-1;
00503 checkMPI(MPI_Comm_rank((MPI_Comm)defaultComm,&thisIndex));
00504 initFields();
00505 }
00506 FEM_chunk::FEM_chunk(CkMigrateMessage *msg)
00507 {
00508 initFields();
00509 }
00510
00511 void FEM_chunk::pup(PUP::er &p)
00512 {
00513
00514
00515
00516 p|default_read;
00517 p|default_write;
00518 p|thisIndex;
00519 p|meshes;
00520
00521 p|defaultComm;
00522 }
00523
00524 PUPable_def(FEM_Sym_Linear)
00525
00526 void FEM_chunk::initFields(void)
00527 {
00528 if (CkMyRank() == 0)
00529 PUPable_reg(FEM_Sym_Linear);
00530 }
00531
00532 FEM_chunk::~FEM_chunk()
00533 {
00534 }
00535
00536
00537 void
00538 FEM_chunk::reduce_field(int fid, const void *nodes, void *outbuf, int op)
00539 {
00540 check("reduce_field precondition");
00541
00542 const IDXL_Layout &dt = IDXL_Layout_List::get().get(fid,"FEM_Reduce_field");
00543 const unsigned char *src = (const unsigned char *) nodes;
00544 reduction_initialize(dt,outbuf,op);
00545 reduction_combine_fn fn=reduction_combine(dt,op);
00546 int nNodes=getMesh("reduce_field")->node.size();
00547 for(int i=0; i<nNodes; i++) {
00548 if(getPrimary(i)) {
00549 fn((unsigned char *)outbuf, src, &dt);
00550 }
00551 src += dt.userBytes();
00552 }
00553
00554 reduce(fid, outbuf, outbuf, op);
00555 check("reduce_field postcondition");
00556 }
00557
00558 void
00559 FEM_chunk::reduce(int fid, const void *inbuf, void *outbuf, int op)
00560 {
00561 const char *caller="FEM_Reduce";
00562 check("reduce precondition");
00563 const IDXL_Layout &dt = IDXL_Layout_List::get().get(fid,caller);
00564 int len = dt.compressedBytes();
00565
00566 char *tmpbuf=new char[len];
00567 memcpy(tmpbuf,inbuf,len);
00568
00569 MPI_Datatype mpidt;
00570 switch (dt.type) {
00571 case IDXL_BYTE: mpidt=MPI_BYTE; break;
00572 case IDXL_INT: mpidt=MPI_INT; break;
00573 case IDXL_REAL: mpidt=MPI_FLOAT; break;
00574 case IDXL_DOUBLE: mpidt=MPI_DOUBLE; break;
00575 default: FEM_Abort(caller,"cannot map FEM datatype %d to MPI",dt.type); break;
00576 };
00577
00578 MPI_Op mpiop;
00579 switch (op) {
00580 case IDXL_SUM: mpiop=MPI_SUM; break;
00581 case IDXL_PROD: mpiop=MPI_PROD; break;
00582 case IDXL_MAX: mpiop=MPI_MAX; break;
00583 case IDXL_MIN: mpiop=MPI_MIN; break;
00584 default: FEM_Abort(caller,"cannot map FEM operation %d to MPI",op); break;
00585 };
00586 MPI_Comm comm=(MPI_Comm)defaultComm;
00587 MPI_Allreduce(tmpbuf,outbuf,dt.width,mpidt,mpiop,comm);
00588 delete[] tmpbuf;
00589 check("reduce postcondition");
00590 }
00591
00592 void
00593 FEM_chunk::readField(int fid, void *nodes, const char *fname)
00594 {
00595 const IDXL_Layout &dt = IDXL_Layout_List::get().get(fid,"FEM_Read_field");
00596 int type = dt.type;
00597 int width = dt.width;
00598 int offset = dt.offset;
00599 int distance = dt.distance;
00600 int skew = dt.skew;
00601 FILE *fp = fopen(fname, "r");
00602 if(fp==0) {
00603 CkError("Cannot open file %s for reading.\n", fname);
00604 CkAbort("Exiting");
00605 }
00606 char str[80];
00607 char* pos;
00608 const char* fmt;
00609 int i, j, curline;
00610 #if FEM_FORTRAN
00611 curline = 1;
00612 #else
00613 curline = 0;
00614 #endif
00615 switch(type) {
00616 case FEM_INT: fmt = "%d%n"; break;
00617 case FEM_REAL: fmt = "%f%n"; break;
00618 case FEM_DOUBLE: fmt = "%lf%n"; break;
00619 default: CkAbort("FEM_Read_field doesn't support that data type");
00620 }
00621 FEM_Mesh *cur_mesh=getMesh("FEM_Read_field");
00622 int nNodes=cur_mesh->node.size();
00623 for(i=0;i<nNodes;i++) {
00624
00625
00626 int target=cur_mesh->node.getGlobalno(i);
00627 for(j=curline;j<target;j++)
00628 fgets(str,80,fp);
00629 curline = target+1;
00630 fgets(str,80,fp);
00631 int curnode, numchars;
00632 sscanf(str,"%d%n",&curnode,&numchars);
00633 pos = str + numchars;
00634 if(curnode != target) {
00635 CkError("Expecting info for node %d, got %d\n", target, curnode);
00636 CkAbort("Exiting");
00637 }
00638 for(j=0;j<width;j++) {
00639 sscanf(pos, fmt, &IDXL_LAYOUT_DEREF(unsigned char,nodes,i,j), &numchars);
00640 pos += numchars;
00641 }
00642 }
00643 fclose(fp);
00644 }
00645
00646
00647
00648 CLINKAGE int FEM_Register(void *_ud,FEM_PupFn _pup_ud)
00649 {
00650 FEMAPI("FEM_Register");
00651 return TCHARM_Register(_ud,_pup_ud);
00652 }
00653
00654 CLINKAGE void *FEM_Get_userdata(int n)
00655 {
00656 FEMAPI("FEM_Get_userdata");
00657 return TCHARM_Get_userdata(n);
00658 }
00659
00660 CLINKAGE void FEM_Barrier(void) {TCHARM_Barrier();}
00661 FLINKAGE void FTN_NAME(FEM_BARRIER,fem_barrier)(void) {TCHARM_Barrier();}
00662
00663 CLINKAGE void
00664 FEM_Migrate(void)
00665 {
00666 TCHARM_Migrate();
00667 }
00668
00669 CLINKAGE void
00670 FEM_Async_Migrate(void)
00671 {
00672 TCHARM_Async_Migrate();
00673 }
00674
00675 CLINKAGE void
00676 FEM_Done(void)
00677 {
00678 TCHARM_Done(0);
00679 }
00680
00681 CLINKAGE int
00682 FEM_Create_simple_field(int base_type, int vec_len)
00683 {
00684 return IDXL_Layout_create(base_type,vec_len);
00685 }
00686
00687 CLINKAGE int
00688 FEM_Create_field(int base_type, int vec_len, int init_offset, int distance)
00689 {
00690 return IDXL_Layout_offset(base_type,vec_len,init_offset,distance,0);
00691 }
00692
00693 CLINKAGE void
00694 FEM_Update_field(int fid, void *nodes)
00695 {
00696 int mesh=FEM_Mesh_default_read();
00697 IDXL_t list=FEM_Comm_shared(mesh,FEM_NODE);
00698 IDXL_Comm_sendsum(0,list,fid,nodes);
00699 }
00700
00701 CLINKAGE void
00702 FEM_Reduce_field(int fid, const void *nodes, void *outbuf, int op)
00703 {
00704 const char *caller="FEM_Reduce_field"; FEMAPI(caller);
00705 FEM_chunk::get(caller)->reduce_field(fid, nodes, outbuf, op);
00706 }
00707
00708 CLINKAGE void
00709 FEM_Reduce(int fid, const void *inbuf, void *outbuf, int op)
00710 {
00711 const char *caller="FEM_Reduce";FEMAPI(caller);
00712 FEM_chunk::get(caller)->reduce(fid, inbuf, outbuf, op);
00713 }
00714
00715 CLINKAGE void
00716 FEM_Read_field(int fid, void *nodes, const char *fname)
00717 {
00718 const char *caller="FEM_Read_field";FEMAPI(caller);
00719 FEM_chunk::get(caller)->readField(fid, nodes, fname);
00720 }
00721
00722 CLINKAGE int
00723 FEM_My_partition(void)
00724 {
00725 return TCHARM_Element();
00726 }
00727
00728 CLINKAGE int
00729 FEM_Num_partitions(void)
00730 {
00731 return TCHARM_Num_elements();
00732 }
00733
00734 CLINKAGE double
00735 FEM_Timer(void)
00736 {
00737 return TCHARM_Wall_timer();
00738 }
00739
00740 CLINKAGE void
00741 FEM_Print(const char *str)
00742 {
00743 const char *caller="FEM_Print"; FEMAPI(caller);
00744 CkPrintf("[%d] %s\n", TCHARM_Element(), str);
00745 }
00746
00747 static void do_print_partition(int fem_mesh,int idxBase) {
00748
00749 const char *caller="FEM_Mesh_print"; FEMAPI(caller);
00750 FEM_chunk *cptr = FEM_chunk::get(caller);
00751 cptr->print(fem_mesh,idxBase);
00752 }
00753
00754 CLINKAGE void
00755 FEM_Mesh_print(int fem_mesh)
00756 {
00757 do_print_partition(fem_mesh,0);
00758 }
00759
00760 CLINKAGE void
00761 FEM_Print_partition(void) {
00762 do_print_partition(FEM_Mesh_default_read(),0);
00763 }
00764
00765 CLINKAGE int FEM_Get_comm_partners(void)
00766 {
00767 const char *caller="FEM_Get_Comm_Partners"; FEMAPI(caller);
00768 return FEM_chunk::get(caller)->getComm().size();
00769 }
00770 CLINKAGE int FEM_Get_comm_partner(int partnerNo)
00771 {
00772 const char *caller="FEM_Get_Comm_Partner"; FEMAPI(caller);
00773 return FEM_chunk::get(caller)->getComm().getLocalList(partnerNo).getDest();
00774 }
00775 CLINKAGE int FEM_Get_comm_count(int partnerNo)
00776 {
00777 const char *caller="FEM_Get_Comm_Count"; FEMAPI(caller);
00778 return FEM_chunk::get(caller)->getComm().getLocalList(partnerNo).size();
00779 }
00780 CLINKAGE void FEM_Get_comm_nodes(int partnerNo,int *nodeNos)
00781 {
00782 const char *caller="FEM_Get_comm_nodes"; FEMAPI(caller);
00783 const int *nNo=FEM_chunk::get(caller)->getComm().getLocalList(partnerNo).getVec();
00784 int len=FEM_Get_comm_count(partnerNo);
00785 for (int i=0;i<len;i++)
00786 nodeNos[i]=nNo[i];
00787 }
00788
00789
00790
00791 FLINKAGE int FTN_NAME(FEM_REGISTER,fem_register)
00792 (void *userData,FEM_PupFn _pup_ud)
00793 {
00794 return FEM_Register(userData,_pup_ud);
00795 }
00796
00797 FLINKAGE void FTN_NAME(FEM_MIGRATE,fem_migrate)
00798 (void)
00799 {
00800 FEM_Migrate();
00801 }
00802
00803 FLINKAGE void FTN_NAME(FEM_ASYNC_MIGRATE,fem_async_migrate)
00804 (void)
00805 {
00806 FEM_Async_Migrate();
00807 }
00808
00809 FLINKAGE int FTN_NAME(FEM_CREATE_SIMPLE_FIELD,fem_create_simple_field)
00810 (int *bt, int *vl)
00811 {
00812 return FEM_Create_simple_field(*bt, *vl);
00813 }
00814 FLINKAGE int FTN_NAME(FEM_CREATE_FIELD,fem_create_field)
00815 (int *bt, int *vl, int *io, int *d)
00816 {
00817 return FEM_Create_field(*bt, *vl, *io, *d);
00818 }
00819
00820 FLINKAGE void FTN_NAME(FEM_UPDATE_FIELD,fem_update_field)
00821 (int *fid, void *nodes)
00822 {
00823 FEM_Update_field(*fid, nodes);
00824 }
00825
00826 FLINKAGE void FTN_NAME(FEM_REDUCE_FIELD,fem_reduce_field)
00827 (int *fid, void *nodes, void *outbuf, int *op)
00828 {
00829 FEM_Reduce_field(*fid, nodes, outbuf, *op);
00830 }
00831
00832 FLINKAGE void FTN_NAME(FEM_REDUCE,fem_reduce)
00833 (int *fid, void *inbuf, void *outbuf, int *op)
00834 {
00835 FEM_Reduce(*fid, inbuf, outbuf, *op);
00836 }
00837
00838 FLINKAGE void FTN_NAME(FEM_READ_FIELD,fem_read_field)
00839 (int *fid, void *nodes, char *fname, int len)
00840 {
00841 char *tmp = new char[len+1]; CHK(tmp);
00842 memcpy(tmp, fname, len);
00843 tmp[len] = '\0';
00844 FEM_Read_field(*fid, nodes, tmp);
00845 delete[] tmp;
00846 }
00847
00848 FLINKAGE int FTN_NAME(FEM_MY_PARTITION,fem_my_partition)
00849 (void)
00850 {
00851 return FEM_My_partition()+1;
00852 }
00853
00854 FLINKAGE int FTN_NAME(FEM_NUM_PARTITIONS,fem_num_partitions)
00855 (void)
00856 {
00857 return FEM_Num_partitions();
00858 }
00859
00860 FLINKAGE double FTN_NAME(FEM_TIMER,fem_timer)
00861 (void)
00862 {
00863 return FEM_Timer();
00864 }
00865
00866
00867 FLINKAGE int FTN_NAME(FOFFSETOF,foffsetof)
00868 (void *first, void *second)
00869 {
00870 return (int)((char *)second - (char*)first);
00871 }
00872
00873 FLINKAGE void FTN_NAME(FEM_PRINT,fem_print)
00874 (char *str, int len)
00875 {
00876 char *tmpstr = new char[len+1]; CHK(tmpstr);
00877 memcpy(tmpstr,str,len);
00878 tmpstr[len] = '\0';
00879 FEM_Print(tmpstr);
00880 delete[] tmpstr;
00881 }
00882
00883 FLINKAGE void FTN_NAME(FEM_MESH_PRINT,fem_mesh_print)
00884 (int *m)
00885 {
00886 do_print_partition(*m,1);
00887 }
00888 FLINKAGE void FTN_NAME(FEM_PRINT_PARTITION,fem_print_partition)(void) {
00889 do_print_partition(FEM_Mesh_default_read(),0);
00890 }
00891
00892 FLINKAGE void FTN_NAME(FEM_DONE,fem_done)
00893 (void)
00894 {
00895 FEM_Done();
00896 }
00897
00898 FLINKAGE int FTN_NAME(FEM_GET_COMM_PARTNERS,fem_get_comm_partners)
00899 (void)
00900 {
00901 return FEM_Get_comm_partners();
00902 }
00903 FLINKAGE int FTN_NAME(FEM_GET_COMM_PARTNER,fem_get_comm_partner)
00904 (int *partnerNo)
00905 {
00906 return FEM_Get_comm_partner(*partnerNo-1)+1;
00907 }
00908 FLINKAGE int FTN_NAME(FEM_GET_COMM_COUNT,fem_get_comm_count)
00909 (int *partnerNo)
00910 {
00911 return FEM_Get_comm_count(*partnerNo-1);
00912 }
00913 FLINKAGE void FTN_NAME(FEM_GET_COMM_NODES,fem_get_comm_nodes)
00914 (int *pNo,int *nodeNos)
00915 {
00916 const char *caller="FEM_GET_COMM_NODES"; FEMAPI(caller);
00917 int partnerNo=*pNo-1;
00918 const int *nNo=FEM_chunk::get(caller)->getComm().getLocalList(partnerNo).getVec();
00919 int len=FEM_Get_comm_count(partnerNo);
00920 for (int i=0;i<len;i++)
00921 nodeNos[i]=nNo[i]+1;
00922 }
00923
00924
00925
00937 FEM_Ghost_Stencil::FEM_Ghost_Stencil(int elType_, int n_,bool addNodes_,
00938 const int *userEnds,
00939 const int *userAdj,
00940 int idxBase)
00941 :elType(elType_), n(n_), addNodes(addNodes_),
00942 ends(new int[n]), adj(new int[2*userEnds[n-1]])
00943 {
00944 int i;
00945 int lastEnd=0;
00946 for (i=0;i<n;i++) {
00947 ends[i]=userEnds[i];
00948 if (ends[i]<lastEnd) {
00949 CkError("FEM_Ghost_Stencil> ends array not monotonic!\n"
00950 " ends[%d]=%d < previous value %d\n",
00951 i,ends[i],lastEnd);
00952 CkAbort("FEM_Ghost_Stencil> ends array not monotonic");
00953 }
00954 lastEnd=ends[i];
00955 }
00956 int m=ends[n-1];
00957 for (i=0;i<m;i++) {
00958 adj[2*i+0]=userAdj[2*i+0];
00959 adj[2*i+1]=userAdj[2*i+1]-idxBase;
00960 }
00961 }
00962
00963 CLINKAGE void FEM_Add_ghost_stencil_type(int elType,int nElts,int addNodes,
00964 const int *ends,const int *adj2)
00965 {
00966 FEMAPI("FEM_Add_ghost_stencil_type");
00967 FEM_Ghost_Stencil *s=new FEM_Ghost_Stencil(
00968 elType, nElts, addNodes==1, ends, adj2, 0);
00969 FEM_curPartition().addGhostStencil(s);
00970 }
00971 FLINKAGE void FTN_NAME(FEM_ADD_GHOST_STENCIL_TYPE,fem_add_ghost_stencil_type)(
00972 int *elType,int *nElts,int *addNodes,
00973 const int *ends,const int *adj2)
00974 {
00975 FEMAPI("FEM_Add_ghost_stencil_type");
00976 FEM_Ghost_Stencil *s=new FEM_Ghost_Stencil(
00977 *elType, *nElts, *addNodes==1, ends, adj2, 1);
00978 FEM_curPartition().addGhostStencil(s);
00979 }
00980
00981
00982 inline int globalElem2elType(const FEM_Mesh *m,int globalElem) {
00983 int curStart=0;
00984 for (int t=0;t<m->elem.size();t++) if (m->elem.has(t)) {
00985 int n=m->elem[t].size();
00986 if (globalElem>=curStart && globalElem<curStart+n)
00987 return t;
00988 curStart+=n;
00989 }
00990 CkError("FEM> Invalid global element number %d!\n",globalElem);
00991 CkAbort("FEM> Invalid global element number!");
00992 return 0;
00993 }
00994
00995
00996
00997
00998
00999
01000 CLINKAGE void FEM_Add_ghost_stencil(int nElts,int addNodes,
01001 const int *ends,const int *adj)
01002 {
01003 FEMAPI("FEM_Add_ghost_stencil");
01004 const FEM_Mesh *m=setMesh();
01005 int adjSrc=0, endsSrc=0;
01006 for (int t=0;t<m->elem.size();t++) if (m->elem.has(t)) {
01007 const FEM_Elem &el=m->elem[t];
01008 int n=el.size();
01009 int nAdjLocal=ends[endsSrc+n-1]-adjSrc;
01010 int *adjLocal=new int[2*nAdjLocal];
01011 int *endsLocal=new int[n];
01012 int adjDest=0, endsDest=0;
01013 while (endsDest<n) {
01014 while (adjSrc<ends[endsSrc]) {
01015
01016 int et=globalElem2elType(m,adj[adjSrc]);
01017 adjLocal[2*adjDest+0]=et;
01018 adjLocal[2*adjDest+1]=adj[adjSrc]-m->nElems(et);
01019 adjDest++; adjSrc++;
01020 }
01021
01022 endsLocal[endsDest]=adjDest;
01023 endsDest++; endsSrc++;
01024 }
01025 if (adjDest!=nAdjLocal)
01026 CkAbort("FEM_Add_ghost_stencil adjacency count mismatch!");
01027 FEM_Add_ghost_stencil_type(t,n,addNodes,endsLocal,adjLocal);
01028 delete []endsLocal;
01029 delete []adjLocal;
01030 }
01031 if (endsSrc!=nElts) {
01032 CkError("FEM_Add_ghost_stencil: FEM thinks there are %d elements, but nElts is %d!\n",endsSrc,nElts);
01033 CkAbort("FEM_Add_ghost_stencil elements mismatch!");
01034 }
01035 FEM_curPartition().markGhostStencilLayer();
01036 }
01037 FLINKAGE void FTN_NAME(FEM_ADD_GHOST_STENCIL,fem_add_ghost_stencil)(
01038 int *nElts,int *addNodes,
01039 const int *ends,int *adj)
01040 {
01041 FEMAPI("FEM_Add_ghost_stencil");
01042 int i, n=ends[*nElts-1];
01043 for (i=0;i<n;i++) adj[i]--;
01044 FEM_Add_ghost_stencil(*nElts,*addNodes,ends,adj);
01045 for (i=0;i<n;i++) adj[i]++;
01046 }
01047
01048
01049 CLINKAGE void FEM_Add_ghost_layer(int nodesPerTuple,int doAddNodes)
01050 {
01051 FEMAPI("FEM_Add_ghost_layer");
01052 FEM_Ghost_Layer *cur=FEM_curPartition().addLayer();
01053 cur->nodesPerTuple=nodesPerTuple;
01054 cur->addNodes=(doAddNodes!=0);
01055 }
01056 FLINKAGE void FTN_NAME(FEM_ADD_GHOST_LAYER,fem_add_ghost_layer)
01057 (int *nodesPerTuple,int *doAddNodes)
01058 { FEM_Add_ghost_layer(*nodesPerTuple,*doAddNodes); }
01059
01060 static void add_ghost_elem(int elType,int tuplesPerElem,const int *elem2tuple,int idxBase) {
01061 FEMAPI("FEM_Add_ghost_elem");
01062 FEM_Ghost_Layer *cur=FEM_curPartition().curLayer();
01063 if (elType>=FEM_ELEM) elType-=FEM_ELEM;
01064 if (elType>=FEM_GHOST) elType-=FEM_GHOST;
01065 if (elType>=FEM_MAX_ELTYPE) CkAbort("Element exceeds (stupid) hardcoded maximum element types\n");
01066 cur->elem[elType].add=true;
01067 cur->elem[elType].tuplesPerElem=tuplesPerElem;
01068 cur->elem[elType].elem2tuple=CkCopyArray(elem2tuple,
01069 tuplesPerElem*cur->nodesPerTuple,idxBase);
01070 }
01071
01072 CLINKAGE void FEM_Add_ghost_elem(int elType,int tuplesPerElem,const int *elem2tuple)
01073 { add_ghost_elem(elType,tuplesPerElem,elem2tuple,0); }
01074 FLINKAGE void FTN_NAME(FEM_ADD_GHOST_ELEM,fem_add_ghost_elem)
01075 (int *FelType,int *FtuplesPerElem,const int *elem2tuple)
01076 { add_ghost_elem(*FelType,*FtuplesPerElem,elem2tuple,1); }
01077
01078 CLINKAGE void FEM_Update_ghost_field(int fid, int elType, void *v_data)
01079 {
01080 int mesh=FEM_Mesh_default_read();
01081 int entity;
01082 if (elType==-1) entity=FEM_NODE;
01083 else entity=FEM_ELEM+elType;
01084 IDXL_t src=FEM_Comm_ghost(mesh,entity);
01085 int nReal=FEM_Mesh_get_length(mesh,entity);
01086 int bytesPerRec=IDXL_Get_layout_distance(fid);
01087 char *data=(char *)v_data;
01088 IDXL_Comm_t comm=IDXL_Comm_begin(1,0);
01089 IDXL_Comm_send(comm,src,fid,data);
01090 IDXL_Comm_recv(comm,src,fid,&data[nReal*bytesPerRec]);
01091 IDXL_Comm_wait(comm);
01092 }
01093 FLINKAGE void FTN_NAME(FEM_UPDATE_GHOST_FIELD,fem_update_ghost_field)
01094 (int *fid, int *elemType, void *data)
01095 {
01096 int fElType=*elemType;
01097 if (fElType==0)
01098 FEM_Update_ghost_field(*fid,-1,data);
01099 else
01100 FEM_Update_ghost_field(*fid,fElType,data);
01101 }
01102
01103
01104
01105
01106
01107
01108
01109
01110
01111
01112
01113 void FEM_chunk::exchangeGhostLists(int elemType,
01114 int inLen,const int *inList,int idxbase)
01115 {
01116 check("exchangeGhostLists");
01117 FEM_Mesh *cur_mesh=getMesh("exchangeGhostLists");
01118 const FEM_Entity &e=cur_mesh->getCount(elemType);
01119 const FEM_Comm &cnt=e.getGhostSend();
01120 int tag=89376;
01121 MPI_Comm comm=(MPI_Comm)defaultComm;
01122
01123
01124 int i,chk,nChk=cnt.size();
01125 CkVec<int> *outIdx=new CkVec<int>[nChk];
01126
01127 for (i=0;i<inLen;i++) {
01128 int localNo=inList[i]-idxbase;
01129 const FEM_Comm_Rec *rec=cnt.getRec(localNo);
01130 if (NULL==rec) continue;
01131
01132 for (int s=0;s<rec->getShared();s++) {
01133 int localChk=cnt.findLocalList(rec->getChk(s));
01134 outIdx[localChk].push_back(rec->getIdx(s));
01135 }
01136 }
01137
01138
01139 MPI_Request *sends=new MPI_Request[nChk];
01140 for (chk=0;chk<nChk;chk++) {
01141 checkMPI(MPI_Isend(outIdx[chk].getVec(),outIdx[chk].size(),MPI_INT,
01142 cnt.getLocalList(chk).getDest(),tag,comm,&sends[chk]));
01143 }
01144
01145
01146 int listStart=0;
01147 for (chk=0;chk<e.getGhostRecv().size();chk++) {
01148 int src=e.getGhostRecv().getLocalList(chk).getDest();
01149 int nRecv=MPI_Incoming_pup(MPI_INT,src,tag,comm);
01150 listTmp.resize(listStart+nRecv);
01151 int *list=&listTmp[listStart];
01152 MPI_Status sts;
01153 checkMPI(MPI_Recv(list,nRecv,MPI_INT,src,tag,comm,&sts));
01154
01155
01156 int firstGhost=e.size();
01157 const FEM_Comm_List &l=e.getGhostRecv().getLocalList(chk);
01158 for (i=0;i<nRecv;i++)
01159 list[i]=firstGhost+l[list[i]];
01160 listStart+=nRecv;
01161 }
01162
01163
01164 MPI_Status *sts=new MPI_Status[nChk];
01165 checkMPI(MPI_Waitall(nChk,sends,sts));
01166 delete[] sts;
01167 delete[] sends;
01168 delete[] outIdx;
01169 }
01170
01171
01172 CLINKAGE void FEM_Exchange_ghost_lists(int elemType,int nIdx,const int *localIdx)
01173 {
01174 const char *caller="FEM_Exchange_Ghost_Lists"; FEMAPI(caller);
01175 FEM_chunk::get(caller)->exchangeGhostLists(elemType,nIdx,localIdx,0);
01176 }
01177 FLINKAGE void FTN_NAME(FEM_EXCHANGE_GHOST_LISTS,fem_exchange_ghost_lists)
01178 (int *elemType,int *nIdx,const int *localIdx)
01179 {
01180 const char *caller="FEM_exchange_ghost_lists"; FEMAPI(caller);
01181 FEM_chunk::get(caller)->exchangeGhostLists(*elemType,*nIdx,localIdx,1);
01182 }
01183 CLINKAGE int FEM_Get_ghost_list_length(void)
01184 {
01185 const char *caller="FEM_Get_Ghost_List_Length"; FEMAPI(caller);
01186 return FEM_chunk::get(caller)->getList().size();
01187 }
01188 FLINKAGE int FTN_NAME(FEM_GET_GHOST_LIST_LENGTH,fem_get_ghost_list_length)(void)
01189 { return FEM_Get_ghost_list_length();}
01190
01191 CLINKAGE void FEM_Get_ghost_list(int *dest)
01192 {
01193 const char *caller="FEM_Get_Ghost_List"; FEMAPI(caller);
01194 int i,len=FEM_Get_ghost_list_length();
01195 const int *src=FEM_chunk::get(caller)->getList().getVec();
01196 for (i=0;i<len;i++) dest[i]=src[i];
01197 FEM_chunk::get(caller)->emptyList();
01198 }
01199 FLINKAGE void FTN_NAME(FEM_GET_GHOST_LIST,fem_get_ghost_list)
01200 (int *dest)
01201 {
01202 const char *caller="FEM_get_ghost_list"; FEMAPI(caller);
01203 int i,len=FEM_Get_ghost_list_length();
01204 const int *src=FEM_chunk::get(caller)->getList().getVec();
01205 for (i=0;i<len;i++) dest[i]=src[i]+1;
01206 FEM_chunk::get(caller)->emptyList();
01207 }
01208
01209
01210
01211
01213 static void getRoccomPconn(IDXL_Side_t is,int bias,CkVec<int> &pconn,const int *paneFmChunk)
01214 {
01215 int p,np=IDXL_Get_partners(is);
01216 pconn.push_back(np);
01217 for (p=0;p<np;p++) {
01218 int chunk=IDXL_Get_partner(is,p);
01219 int pane=1+chunk;
01220 if(paneFmChunk) pane=paneFmChunk[chunk];
01221 pconn.push_back(pane);
01222 int n,nn=IDXL_Get_count(is,p);
01223 pconn.push_back(nn);
01224 for (n=0;n<nn;n++)
01225 pconn.push_back(IDXL_Get_index(is,p,n)+1+bias);
01226 }
01227 }
01228
01230 static CkVec<int> getRoccomPconn(int fem_mesh,int *ghost_len,const int *paneFmChunk)
01231 {
01232 CkVec<int> pconn;
01233
01234 getRoccomPconn(IDXL_Get_send(FEM_Comm_shared(fem_mesh,FEM_NODE)),0,pconn,paneFmChunk);
01235 int realLen=pconn.size();
01236
01237
01238 getRoccomPconn(IDXL_Get_send(FEM_Comm_ghost(fem_mesh,FEM_NODE)),0,pconn,paneFmChunk);
01239
01240 getRoccomPconn(IDXL_Get_recv(FEM_Comm_ghost(fem_mesh,FEM_NODE)),
01241 FEM_Mesh_get_length(fem_mesh,FEM_NODE),pconn,paneFmChunk);
01242
01243
01244
01245 int elems[1024];
01246 int e, ne=FEM_Mesh_get_entities(fem_mesh,elems);
01247 for (e=0;e<ne;e++)
01248 if (elems[e]<FEM_ELEM || elems[e]>=FEM_SPARSE)
01249 elems[e--]=elems[--ne];
01250
01251
01252 IDXL_t elghost=IDXL_Create();
01253 int out_r=0, out_g=0;
01254 for (e=0;e<ne;e++) {
01255 IDXL_Combine(elghost,FEM_Comm_ghost(fem_mesh,elems[e]), out_r,out_g);
01256 out_r+=FEM_Mesh_get_length(fem_mesh,elems[e]);
01257 out_g+=FEM_Mesh_get_length(fem_mesh,elems[e]+FEM_GHOST);
01258 }
01259
01260
01261 getRoccomPconn(IDXL_Get_send(elghost),0,pconn,paneFmChunk);
01262
01263 getRoccomPconn(IDXL_Get_recv(elghost),out_r,pconn,paneFmChunk);
01264 IDXL_Destroy(elghost);
01265
01266 if (ghost_len) *ghost_len=pconn.size()-realLen;
01267 return pconn;
01268 }
01269
01270 CLINKAGE void FEM_Get_roccom_pconn_size(int fem_mesh,int *total_len,int *ghost_len)
01271 {
01272 CkVec<int> pconn=getRoccomPconn(fem_mesh,ghost_len,NULL);
01273 *total_len=pconn.size();
01274 }
01275 FORTRAN_AS_C(FEM_GET_ROCCOM_PCONN_SIZE,FEM_Get_roccom_pconn_size,fem_get_roccom_pconn_size,
01276 (int *mesh,int *tl,int *gl), (*mesh,tl,gl)
01277 )
01278
01279 CLINKAGE void FEM_Get_roccom_pconn(int fem_mesh,const int *paneFmChunk,int *dest)
01280 {
01281 CkVec<int> pconn=getRoccomPconn(fem_mesh,NULL,paneFmChunk);
01282 for (unsigned int i=0;i<pconn.size();i++)
01283 dest[i]=pconn[i];
01284 }
01285 FORTRAN_AS_C(FEM_GET_ROCCOM_PCONN,FEM_Get_roccom_pconn,fem_get_roccom_pconn,
01286 (int *mesh,int *paneFmChunk,int *dest), (*mesh,paneFmChunk,dest)
01287 )
01288
01289 int findChunk(int paneID,const int *paneFmChunk)
01290 {
01291 for (int c=0;paneFmChunk[c]>0;c++)
01292 if (paneFmChunk[c]==paneID)
01293 return c;
01294 CkError("Can't find chunk for pconn paneID %d!\n",paneID);
01295 CmiAbort("Bad pconn array");
01296 return -1;
01297 }
01298
01299 const int* makeIDXLside(const int *src,const int *paneFmChunk,IDXL_Side &s) {
01300 int nPartner=*src++;
01301 for (int p=0;p<nPartner;p++) {
01302 int paneID=*src++;
01303 int chunk=findChunk(paneID,paneFmChunk);
01304 int nComm=*src++;
01305 for (int i=0;i<nComm;i++)
01306 s.addNode(*src++ - 1,chunk);
01307 }
01308 return src;
01309 }
01310
01311 CLINKAGE void FEM_Set_roccom_pconn(int fem_mesh,const int *paneFmChunk,const int *src,int total_len,int ghost_len)
01312 {
01313 const char *caller="FEM_Set_roccom_pconn"; FEMAPI(caller);
01314 FEM_Mesh *m=FEM_Mesh_lookup(fem_mesh,caller);
01316 makeIDXLside(src,paneFmChunk,m->node.shared);
01317 }
01318 FORTRAN_AS_C(FEM_SET_ROCCOM_PCONN,FEM_Set_roccom_pconn,fem_set_roccom_pconn,
01319 (int *mesh,const int *paneFmChunk,const int *src,int *tl,int *gl), (*mesh,paneFmChunk,src,*tl,*gl)
01320 )
01321
01322 enum {comm_unshared, comm_shared, comm_primary};
01323 int commState(int entityNo,const IDXL_Side &s)
01324 {
01325 const IDXL_Rec *r=s.getRec(entityNo);
01326 if (r==NULL || r->getShared()==0) return comm_unshared;
01327 int thisChunk=FEM_My_partition();
01328 for (int p=0;p<r->getShared();p++) {
01329 if (r->getChk(p)<thisChunk)
01330 return comm_shared;
01331
01332 }
01333
01334
01335 return comm_primary;
01336 }
01337
01342 CLINKAGE void FEM_Make_node_globalno(int fem_mesh,FEM_Comm_t comm_context)
01343 {
01344 const char *caller="FEM_Make_node_globalno"; FEMAPI(caller);
01345 FEM_Mesh *m=FEM_Mesh_lookup(fem_mesh,caller);
01346 int n, nNo=m->node.size();
01347 const IDXL_Side &shared=m->node.shared;
01348 CkVec<int> globalNo(nNo);
01349 CkVec<char> nodePrimary(nNo);
01350
01351
01352 int nLocal=0;
01353 for (n=0;n<nNo;n++) {
01354 switch (commState(n,shared)) {
01355 case comm_unshared:
01356 nodePrimary[n]=0;
01357 globalNo[n]=nLocal++;
01358 break;
01359 case comm_shared:
01360 nodePrimary[n]=0;
01361 globalNo[n]=-1;
01362 break;
01363 case comm_primary:
01364 nodePrimary[n]=1;
01365 globalNo[n]=nLocal++;
01366 break;
01367 };
01368 }
01369
01370
01371
01372 MPI_Comm comm=(MPI_Comm)comm_context;
01373 int firstGlobal=0;
01374 MPI_Scan(&nLocal,&firstGlobal, 1,MPI_INT, MPI_SUM,comm);
01375 firstGlobal-=nLocal;
01376 for (n=0;n<nNo;n++) {
01377 if (globalNo[n]==-1) globalNo[n]=0;
01378 else globalNo[n]+=firstGlobal;
01379 }
01380
01381
01382 IDXL_Layout_t l=IDXL_Layout_create(IDXL_INT,1);
01383 IDXL_Comm_t c=IDXL_Comm_begin(72173841,comm_context);
01384 IDXL_Comm_sendsum(c,FEM_Comm_shared(fem_mesh,FEM_NODE),l,&globalNo[0]);
01385 IDXL_Comm_wait(c);
01386 IDXL_Layout_destroy(l);
01387
01388
01389 FEM_Mesh_set_data(fem_mesh,FEM_NODE, FEM_GLOBALNO,
01390 &globalNo[0], 0,nNo, FEM_INDEX_0,1);
01391 FEM_Mesh_set_data(fem_mesh,FEM_NODE, FEM_NODE_PRIMARY,
01392 &nodePrimary[0], 0,nNo, FEM_BYTE,1);
01393 }
01394
01395 FORTRAN_AS_C(FEM_MAKE_NODE_GLOBALNO,FEM_Make_node_globalno,fem_make_node_globalno,
01396 (int *mesh,int *comm), (*mesh,*comm)
01397 )
01398
01399
01400
01401 class localToGlobal : public IDXL_Print_Map {
01402 FEM_Entity &e;
01403 public:
01404 int idxBase;
01405 localToGlobal(FEM_Entity &e_, int idxBase_)
01406 :e(e_), idxBase(idxBase_) {}
01407
01408 void map(int l) const {
01409 if (l<0) CkPrintf("(%d) ",l+idxBase);
01410 else {
01411 int g=e.getGlobalno(l);
01412 if (g==-1) CkPrintf("(%d) ",l+idxBase);
01413 else CkPrintf("%d ",g+idxBase);
01414 }
01415 }
01416 };
01417
01418 void FEM_Entity::print(const char *type,const IDXL_Print_Map &l2g)
01419 {
01420 CkPrintf("\nLength of %s = %d", type, size());
01421 if (ghost->size()>0) CkPrintf(" (and %d ghosts)\n",ghost->size());
01422 else CkPrintf("\n");
01423
01424
01425 }
01426
01427 void FEM_Node::print(const char *type,const IDXL_Print_Map &l2g)
01428 {
01429 super::print(type,l2g);
01430 CkPrintf("Node global numbers: * marks primary, () surrounds local-only:\n");
01431 for(int i=0;i<size();i++) {
01432 if (getPrimary(i)) CkPrintf("*");
01433 l2g.map(i);
01434 }
01435 CkPrintf("\n");
01436 }
01437
01438
01439
01440 void FEM_Elem::print(const char *type,const IDXL_Print_Map &l2g)
01441 {
01442 super::print(type,l2g);
01443
01444 localToGlobal *src_l2g=(localToGlobal *)&l2g;
01445 localToGlobal elt_l2g(*this,src_l2g->idxBase);
01446
01447 CkPrintf("%s Connectivity: \n",type);
01448 for (int r=0;r<size();r++) {
01449 CkPrintf(" Entry "); elt_l2g.map(r); CkPrintf("| ");
01450 for (int c=0;c<getNodesPer();c++)
01451 l2g.map(conn->get()(r,c));
01452 CkPrintf("\n");
01453 }
01454 }
01455
01456 void FEM_Mesh::print(int idxBase)
01457 {
01458 localToGlobal l2g(node,idxBase);
01459 node.print("FEM_NODE",l2g);
01460 int t;
01461 for (t=0;t<elem.size();t++)
01462 if (elem.has(t)) {
01463 char name[50]; sprintf(name,"FEM_ELEM+%d",t);
01464 elem[t].print(name,l2g);
01465 }
01466 for (t=0;t<sparse.size();t++)
01467 if (sparse.has(t)) {
01468 char name[50]; sprintf(name,"FEM_SPARSE+%d",t);
01469 sparse[t].print(name,l2g);
01470 }
01471 }
01472
01473 void
01474 FEM_chunk::print(int fem_mesh,int idxBase)
01475 {
01476 CkPrintf("-------------------- Chunk %d --------------------\n",thisIndex);
01477 lookup(fem_mesh,"FEM_Mesh_print")->print(idxBase);
01478 CkPrintf("\n\n");
01479 }
01480
01481
01493 CLINKAGE void FEM_Add_elem2face_tuples(int fem_mesh, int elem_type, int nodesPerTuple, int tuplesPerElem,const int *elem2tuple)
01494 {
01495 FEMAPI("FEM_Add_elem2face_tuples");
01496 FEM_Mesh *m = FEM_Mesh_lookup(fem_mesh,"FEM_Add_elem2face_tuples");
01497 FEM_ElemAdj_Layer *cur = m->getElemAdjLayer();
01498 cur->initialized = 1;
01499
01500 if(cur->elem[elem_type].tuplesPerElem != 0)
01501 CkPrintf("FEM> WARNING: Don't call FEM_Add_elem2face_tuples() repeatedly with the same element type\n");
01502
01503 int idxBase=0;
01504 cur->nodesPerTuple=nodesPerTuple;
01505 cur->elem[elem_type].tuplesPerElem=tuplesPerElem;
01506 cur->elem[elem_type].elem2tuple=CkCopyArray(elem2tuple, tuplesPerElem*cur->nodesPerTuple,idxBase);
01507
01508 }
01509 FORTRAN_AS_C(FEM_ADD_ELEM2FACE_TUPLES,FEM_Add_elem2face_tuples,fem_add_elem2face_tuples,
01510 (int *fem_mesh,int *elem_type,int *nodesPerTuple, int *tuplesPerElem, int *elem2tuple),
01511 (*fem_mesh, *elem_type, *nodesPerTuple, *tuplesPerElem, elem2tuple)
01512 )
01513
01514