Charm++: Charm Source Code Documentation

00001 /*
00002 Multiblock CFD Framework for Charm++
00003 Parallel Programming Lab, Univ. of Illinois 2000
00004 
00005 This file implements a C, C++, or Fortran-callable
00006 library for parallel multiblock CFD computations.
00007 
00008 We partition the user's grid using the makemblock programs.
00009 We run the user's (timeloop) driver routine in a 
00010 thread (in the style of AMPI), so communication looks
00011 blocking to the user.  Internally, we suspend the
00012 user's driver thread when communication is needed,
00013 then resume the thread when the results arrive.
00014  */
00015 #include "mblock_impl.h"
00016 #include <limits.h>
00017 #include <float.h> /*for FLT_MIN on non-Suns*/
00018 
00019 /* TCHARM Semaphore ID */
00020 #define MBLOCK_TCHARM_SEMAID 0x003B70C6 /* __MBLOCK */
00021 
00022 #if 0
00023 /*Many debugging statements:*/
00024 #define DBG(x) ckout<<"["<<thisIndex<<"] MBLK> "<<x<<endl;
00025 
00026 #else
00027 /*No debugging statements*/
00028 #define DBG(x) /*empty*/
00029 #endif
00030 
00031 //_mblkptr gives the current chunk, and is only
00032 // valid in routines called from driver().
00033 CtvStaticDeclare(MBlockChunk *, _mblkptr);
00034 
00035 CLINKAGE void driver(void);
00036 FLINKAGE void FTN_NAME(DRIVER,driver)(void);
00037 
00038 static void callDrivers(void) {
00039     driver();
00040     FTN_NAME(DRIVER,driver)();
00041 }
00042 
00043 static int callDrivers_idx = -1;
00044 
00045 void MBlockNodeInit(void) 
00046 {
00047   CmiAssert(callDrivers_idx == -1);
00048   callDrivers_idx = TCHARM_Register_thread_function((TCHARM_Thread_data_start_fn)callDrivers);
00049 }
00050 
00051 //Startup routine to use if the user doesn't register one
00052 static void MBlockFallbackSetup(void)
00053 {
00054     TCHARM_Create(TCHARM_Get_num_chunks(),callDrivers_idx);
00055 }
00056 
00057 void MBlockProcInit(void) 
00058 {
00059   CtvInitialize(MBlockChunk *, _mblkptr);
00060   TCHARM_Set_fallback_setup(MBlockFallbackSetup);
00061 }
00062 
00063 CLINKAGE void MBLK_Init(int comm) {
00064   if (TCHARM_Element()==0) {
00065      CkArrayID threads; int nThreads;
00066      CkArrayOptions opt=TCHARM_Attach_start(&threads,&nThreads);
00067      CkArrayID aid=CProxy_MBlockChunk::ckNew(threads,opt);
00068   }
00069   MBlockChunk *c=(MBlockChunk *)TCharm::get()->semaGet(MBLOCK_TCHARM_SEMAID);
00070 }
00071 FORTRAN_AS_C(MBLK_INIT,MBLK_Init,mblk_init, (int *comm), (*comm))
00072 
00073 /******************** Reduction Support **********************/
00074 
00075 template<class d>
00076 void sum(const int len, d* lhs, const d* rhs)
00077 {
00078   int i;
00079   for(i=0;i<len;i++) {
00080     *lhs++ += *rhs++;
00081   }
00082 }
00083 
00084 template<class d>
00085 void max(const int len, d* lhs, const d* rhs)
00086 {
00087   int i;
00088   for(i=0;i<len;i++) {
00089     *lhs = (*lhs > *rhs) ? *lhs : *rhs;
00090     lhs++; rhs++;
00091   }
00092 }
00093 
00094 template<class d>
00095 void min(const int len, d* lhs, const d* rhs)
00096 {
00097   int i;
00098   for(i=0;i<len;i++) {
00099     *lhs = (*lhs < *rhs) ? *lhs : *rhs;
00100     lhs++; rhs++;
00101   }
00102 }
00103 
00104 template<class d>
00105 void assign(const int len, d* lhs, d val)
00106 {
00107   int i;
00108   for(i=0;i<len;i++) {
00109     *lhs = val;
00110   }
00111 }
00112 
00113 static inline void
00114 initialize(const DType& dt, void *lhs, int op)
00115 {
00116   switch(op) {
00117     case MBLK_SUM:
00118       switch(dt.base_type) {
00119         case MBLK_BYTE : 
00120           assign(dt.vec_len,(unsigned char*)lhs, (unsigned char)0); 
00121           break;
00122         case MBLK_INT : assign(dt.vec_len,(int*)lhs, 0); break;
00123         case MBLK_REAL : assign(dt.vec_len,(float*)lhs, (float)0.0); break;
00124         case MBLK_DOUBLE : assign(dt.vec_len,(double*)lhs, 0.0); break;
00125       }
00126       break;
00127     case MBLK_MAX:
00128       switch(dt.base_type) {
00129         case MBLK_BYTE : 
00130           assign(dt.vec_len,(unsigned char*)lhs, (unsigned char)CHAR_MIN); 
00131           break;
00132         case MBLK_INT : assign(dt.vec_len,(int*)lhs, INT_MIN); break;
00133         case MBLK_REAL : assign(dt.vec_len,(float*)lhs, (float)FLT_MIN); break;
00134         case MBLK_DOUBLE : assign(dt.vec_len,(double*)lhs, DBL_MIN); break;
00135       }
00136       break;
00137     case MBLK_MIN:
00138       switch(dt.base_type) {
00139         case MBLK_BYTE : 
00140           assign(dt.vec_len,(unsigned char*)lhs, (unsigned char)CHAR_MAX); 
00141           break;
00142         case MBLK_INT : assign(dt.vec_len,(int*)lhs, INT_MAX); break;
00143         case MBLK_REAL : assign(dt.vec_len,(float*)lhs, FLT_MAX); break;
00144         case MBLK_DOUBLE : assign(dt.vec_len,(double*)lhs, DBL_MAX); break;
00145       }
00146       break;
00147   }
00148 }
00149 
00150 typedef void (*combineFn)(const int len,void *lhs,const void *rhs);
00151 
00152 typedef void (*combineFn_BYTE)(const int len,unsigned char *lhs,const unsigned char *rhs);
00153 typedef void (*combineFn_INT)(const int len,int *lhs,const int *rhs);
00154 typedef void (*combineFn_REAL)(const int len,float *lhs,const float *rhs);
00155 typedef void (*combineFn_DOUBLE)(const int len,double *lhs,const double *rhs);
00156 
00157 
00158 static combineFn
00159 combine(const DType& dt, int op)
00160 {
00161   switch(op) {
00162 //This odd-looking define selects the appropriate templated type
00163     // of "fn", casts it to a void* type, and returns it.
00164 #define combine_switch(fn) \
00165       switch(dt.base_type) {\
00166         case MBLK_BYTE : return (combineFn)(combineFn_BYTE)fn;\
00167         case MBLK_INT : return (combineFn)(combineFn_INT)fn;\
00168         case MBLK_REAL : return (combineFn)(combineFn_REAL)fn;\
00169         case MBLK_DOUBLE : return (combineFn)(combineFn_DOUBLE)fn;\
00170       }\
00171       break;
00172     case MBLK_SUM: combine_switch(sum);
00173     case MBLK_MIN: combine_switch(min);
00174     case MBLK_MAX: combine_switch(max);
00175   }
00176   return NULL;
00177 }
00178 
00179 /******************************* MBLOCKCHUNK *********************************/
00180 
00181 void MBlockChunk::commonInit(void)
00182 {
00183   nfields = 0;
00184   seqnum = 0;
00185   b=NULL;
00186 
00187   for (int bc=0;bc<MBLK_MAXBC;bc++)
00188     bcs[bc].fn=NULL;
00189 }
00190 
00191 MBlockChunk::MBlockChunk(const CkArrayID &threads_)
00192 {
00193   commonInit();
00194 
00195   threads=threads_;
00196   migInit();
00197   
00198   update.nRecd = 0;
00199   update.wait_seqnum = -1;
00200   messages = CmmNew();
00201   
00202   thread->semaPut(MBLOCK_TCHARM_SEMAID,this);
00203 }
00204 
00205 MBlockChunk::MBlockChunk(CkMigrateMessage *msg)
00206     :CBase_MBlockChunk(msg)
00207 {
00208   commonInit();
00209   
00210   messages=NULL;
00211 }
00212 
00213 //Update fields after migration
00214 void MBlockChunk::migInit(void)
00215 {
00216   thread=threads[thisIndex].ckLocal();
00217   if (thread==NULL) CkAbort("MBlock can't locate its thread!\n");
00218   CtvAccessOther(thread->getThread(),_mblkptr)=this;
00219 }
00220 
00221 void MBlockChunk::ckJustMigrated(void)
00222 {
00223   ArrayElement1D::ckJustMigrated();
00224   migInit();
00225 }
00226 
00227 MBlockChunk::~MBlockChunk() //Destructor-- deallocate memory
00228 {
00229         CmmFree(messages);
00230     delete b;
00231 }
00232 
00233 void 
00234 MBlockChunk::read(const char *prefix,int nDim) 
00235 {
00236   if (nDim!=3) CkAbort("MBlock> Currently only 3D calculations are supported.\n");
00237   delete b;
00238   b = new block(prefix, thisIndex);
00239   int n = b->getPatches();
00240   nRecvPatches = 0;
00241   for(int i=0;i<n;i++) {
00242     patch *p = b->getPatch(i);
00243     if(p->type == patch::internal)
00244       nRecvPatches++;
00245   }
00246 }
00247 
00248 void
00249 MBlockChunk::recv(MBlockDataMsg *dm)
00250 {
00251   if(dm->seqnum == update.wait_seqnum) {
00252     DBG( "recv: handling ("<<dm->seqnum<<")" )
00253     update_field(dm); // update the appropriate field value
00254     if(update.nRecd==nRecvPatches) {
00255       update.wait_seqnum = -1; //This update is complete
00256       thread->resume();
00257     }
00258   } else if (dm->seqnum>seqnum) {
00259     DBG( "recv: stashing early ("<<dm->seqnum<<")" )
00260     CmmPut(messages, 1, &(dm->seqnum), dm);
00261   } else
00262     CkAbort("MBLOCK MBlockChunk received message from the past!\n");
00263 }
00264 
00265 //Send the values for my source patches out
00266 void
00267 MBlockChunk::send(int fid,const extrudeMethod &meth,const void *grid)
00268 {
00269   const DType &dt=fields[fid]->dt;
00270   int len = dt.length();
00271   const char *fStart=(const char *)grid;
00272   fStart+=dt.init_offset;
00273   blockDim d = fields[fid]->dim;
00274   int n = b->getPatches();
00275   for(int m=0;m<n;m++) {
00276     patch *p = b->getPatch(m);
00277     if (p->type != patch::internal)
00278       continue;
00279     internalBCpatch *ip = (internalBCpatch*) p;
00280     blockSpan src=ip->getExtents(meth,fields[fid]->forVoxel,-1);
00281     int dest = ip->dest;
00282     int num = src.getDim().getSize();
00283     int msgLen=len*num;
00284     MBlockDataMsg *msg = new (&msgLen, 0) MBlockDataMsg(seqnum, thisIndex, fid, 
00285         ip->destPatch); 
00286     CHK(msg);
00287     blockLoc dsize; //Size in destination space
00288     blockLoc so; //Source origin-- corresponds to dest. start
00289     for (int axis=0;axis<3;axis++) {
00290       dsize[ip->orient[axis]]=src.getDim()[axis];
00291       if (ip->orient.dIsFlipped(axis)) 
00292     so[axis]=src.end[axis]-1;
00293       else
00294     so[axis]=src.start[axis]; 
00295     }
00296     blockLoc iDir=ip->orient.destAxis(0);
00297     blockLoc jDir=ip->orient.destAxis(1);
00298     blockLoc kDir=ip->orient.destAxis(2);
00299     
00300     //Loop over the destination space
00301     void *data = msg->data;
00302     for(int k=0;k<dsize[2];k++) 
00303       for(int j=0;j<dsize[1];j++)
00304         for(int i=0;i<dsize[0];i++) 
00305     {
00306       blockLoc from=so+i*iDir+j*jDir+k*kDir;
00307 #if CMK_ERROR_CHECKING  /*Perform bounds check*/
00308       if (!src.contains(from))
00309         CkAbort("Read location out of bounds in mblock::MBlockChunk::send!\n");
00310 #endif
00311           const void *src = (const void *)(fStart+d[from]*dt.distance);
00312           memcpy(data, src, len);
00313           data = (void*) ((char*)data + len);
00314         }
00315     thisProxy[dest].recv(msg);
00316     DBG("  sending "<<num<<" data items ("<<seqnum<<") to processor "<<dest)
00317   }
00318 }
00319 
00320 
00321 //Update my ghost cells based on these values
00322 void
00323 MBlockChunk::update_field(MBlockDataMsg *msg)
00324 {
00325   DBG("    update_field ("<<msg->seqnum<<")")
00326   const DType &dt=fields[msg->fid]->dt;
00327   int length=dt.length();
00328   char *aStart=(char *)update.ogrid;
00329   char *aEnd=aStart+fields[msg->fid]->arrayBytes;
00330   char *fStart=aStart+dt.init_offset;
00331   char *data = (char *) msg->data;
00332   internalBCpatch *p = (internalBCpatch*) (b->getPatch(msg->patchno));
00333   blockSpan dest=p->getExtents(update.m,fields[msg->fid]->forVoxel);
00334 
00335   blockDim dim = fields[msg->fid]->dim;
00336   //Loop over the destination-space patch
00337   for(int k=dest.start[2]; k<dest.end[2]; k++)
00338     for(int j=dest.start[1]; j<dest.end[1]; j++)
00339       for(int i=dest.start[0]; i<dest.end[0]; i++) 
00340       {
00341         char *dest = fStart+dim.c_index(i,j,k)*dt.distance;
00342 #if CMK_ERROR_CHECKING /*Perform bounds check*/
00343     if (dest<aStart || dest>=aEnd)
00344       CkAbort("MBlockChunk::update_field would write out of bounds!\n");
00345 #endif
00346         memcpy(dest, data, length);
00347         data = data + length;
00348       }
00349   delete msg;
00350   update.nRecd++;
00351 }
00352 
00353 void
00354 MBlockChunk::start_update(int fid,const extrudeMethod &m,void *ingrid, void *outgrid)
00355 {
00356   //Update sequence number
00357   seqnum++;
00358   update.nRecd=0;
00359   update.wait_seqnum=seqnum;
00360   update.m=m;
00361   update.ogrid=outgrid;
00362 
00363   DBG("update("<<seqnum<<") {")
00364   // first send my field values to all the processors that need it
00365   send(fid, m,ingrid);
00366 
00367   // now, if any of the field values have been received already,
00368   // process them
00369   MBlockDataMsg *dm;
00370   while ((dm = (MBlockDataMsg*)CmmGet(messages, 1, &seqnum, 0))!=NULL) {
00371     DBG("   handling stashed message")
00372     update_field(dm);
00373   }
00374   if (update.nRecd == nRecvPatches)
00375     update.wait_seqnum = -1; // we now have everything
00376 
00377   DBG("} update("<<seqnum<<")")
00378 }
00379 
00380 int
00381 MBlockChunk::test_update(void)
00382 {
00383   return (update.wait_seqnum==(-1))?MBLK_DONE : MBLK_NOTDONE;
00384 }
00385 
00386 int
00387 MBlockChunk::wait_update(void)
00388 {
00389   if(update.wait_seqnum != (-1)) {
00390     DBG("sleeping for "<<nRecvPatches-nRecd<<" update messages")
00391     thread->suspend();
00392     DBG("got all update messages for "<<seqnum)  
00393   }
00394   return MBLK_SUCCESS;
00395 }
00396 
00397 void
00398 MBlockChunk::reduce_field(int fid, const void *grid, void *outbuf, int op)
00399 {
00400   // first reduce over local gridpoints
00401   const DType &dt = fields[fid]->dt;
00402   const void *src = (const void *) ((const char *) grid + dt.init_offset);
00403   ::initialize(dt,outbuf,op);
00404   combineFn fn=combine(dt,op);
00405   int dim[3];
00406   MBLK_Get_blocksize(dim);
00407   blockDim d = fields[fid]->dim;
00408   for(int k=0; k<dim[2]; k++)
00409     for(int j=0; j<dim[1]; j++)
00410       for(int i=0; i<dim[0]; i++)
00411         fn(dt.vec_len, outbuf, 
00412             ((const char *)src + d.c_index(i,j,k)*dt.distance));
00413   // and now reduce over partitions
00414   reduce(fid, outbuf, outbuf, op);
00415 }
00416 
00417 void
00418 MBlockChunk::reduce(int fid, const void *inbuf, void *outbuf, int op)
00419 {
00420   const DType &dt = fields[fid]->dt;
00421   int len = dt.length();
00422   if(ckGetArraySize()==1) {
00423     memcpy(outbuf,inbuf,len);
00424     return;
00425   }
00426   CkReduction::reducerType rtype;
00427   switch(op) {
00428     case MBLK_SUM:
00429       switch(dt.base_type) {
00430         case MBLK_INT: rtype = CkReduction::sum_int; break;
00431         case MBLK_REAL: rtype = CkReduction::sum_float; break;
00432         case MBLK_DOUBLE: rtype = CkReduction::sum_double; break;
00433       }
00434       break;
00435     case MBLK_MAX:
00436       switch(dt.base_type) {
00437         case MBLK_INT: rtype = CkReduction::max_int; break;
00438         case MBLK_REAL: rtype = CkReduction::max_float; break;
00439         case MBLK_DOUBLE: rtype = CkReduction::max_double; break;
00440       }
00441       break;
00442     case MBLK_MIN:
00443       switch(dt.base_type) {
00444         case MBLK_INT: rtype = CkReduction::min_int; break;
00445         case MBLK_REAL: rtype = CkReduction::min_float; break;
00446         case MBLK_DOUBLE: rtype = CkReduction::min_double; break;
00447       }
00448       break;
00449   }
00450   reduce_output = outbuf;
00451   contribute(len, (void *)inbuf, rtype, 
00452     CkCallback(index_t::reductionResult(0),thisProxy) );
00453   thread->suspend();
00454 }
00455 
00456 void
00457 MBlockChunk::reductionResult(CkReductionMsg *m)
00458 {
00459   memcpy(reduce_output,m->getData(),m->getSize());
00460   delete m;
00461   reduce_output=NULL;
00462   thread->resume();
00463 }
00464 
00465 /********** Thread/migration support ************/
00466 static MBlockChunk *getCurMBlockChunk(void) 
00467 {
00468   MBlockChunk *cptr=CtvAccess(_mblkptr);
00469   if (cptr==NULL) 
00470     CkAbort("MBlock does not appear to be initialized!");
00471   return cptr;
00472 }
00473 
00474 
00475 /******************************* C Bindings **********************************/
00476 
00477 CLINKAGE int
00478 MBLK_Read(const char *prefix,int nDim) {
00479   getCurMBlockChunk() -> read(prefix,nDim);
00480   return MBLK_SUCCESS;
00481 }
00482 
00483 CLINKAGE int
00484 MBLK_Get_nblocks(int *n)
00485 {
00486   *n = TCHARM_Num_elements();
00487   return MBLK_SUCCESS;
00488 }
00489 
00490 CLINKAGE int
00491 MBLK_Get_myblock(int *m)
00492 {
00493   *m = TCHARM_Element();
00494   return MBLK_SUCCESS;
00495 }
00496 
00497 CLINKAGE int
00498 MBLK_Get_blocksize(int *dim)
00499 {
00500   MBLOCKAPI("MBLK_Get_blocksize");
00501   MBlockChunk *cptr = getCurMBlockChunk();
00502   blockDim d = cptr->b->getDim();
00503   /*Subtract one to get to voxel coordinates*/
00504   dim[0] = d[0]-1; dim[1] = d[1]-1; dim[2] = d[2]-1;
00505   return MBLK_SUCCESS;
00506 }
00507 
00508 CLINKAGE int
00509 MBLK_Get_nodelocs(const int *nodedim,double *nodeloc) {
00510   MBLOCKAPI("MBLK_Get_nodelocs");
00511   block *b=getCurMBlockChunk()->b;
00512   blockDim d = b->getDim();
00513   for (int i=0;i<3;i++)
00514     if (nodedim[i]!=d[i]) {
00515       CkError("MBLK_Get_nodelocs: your nodedim is %d; mine is %d!\n",
00516         nodedim[i],d[i]);
00517       return MBLK_FAILURE;
00518     }
00519   
00520   blockLoc j;
00521   BLOCKSPAN_FOR(j,blockSpan(blockLoc(0,0,0),d)) {
00522      int idx=d[j];
00523      vector3d v=b->getLoc(j);
00524      nodeloc[3*idx+0]=v.x;
00525      nodeloc[3*idx+1]=v.y;
00526      nodeloc[3*idx+2]=v.z;
00527   }
00528   
00529   return MBLK_SUCCESS;
00530 }
00531 
00532 CLINKAGE double
00533 MBLK_Timer(void)
00534 {
00535   return TCHARM_Wall_timer();
00536 }
00537 
00538 CLINKAGE void
00539 MBLK_Print(const char *str)
00540 {
00541   MBLOCKAPI("MBLK_Print");
00542   CkPrintf("[%d] %s\n", TCHARM_Element(), str);
00543 }
00544 
00545 CLINKAGE int
00546 MBLK_Register(void *_ud,MBLK_PupFn _pup_ud, int *rid)
00547 {
00548   *rid=TCHARM_Register(_ud,_pup_ud);
00549   return MBLK_SUCCESS;
00550 }
00551 
00552 CLINKAGE int
00553 MBLK_Get_registered(int n, void **b)
00554 {
00555   *b=TCHARM_Get_userdata(n);
00556   return MBLK_SUCCESS;
00557 }
00558 
00559 CLINKAGE int
00560 MBLK_Migrate(void)
00561 {
00562   MBLOCKAPI("MBLK_Migrate");
00563   TCharm::get()->migrate();
00564   return MBLK_SUCCESS;
00565 }
00566 
00567 CLINKAGE int
00568 MBLK_Create_field(int *dims,int isVoxel,
00569           int base_type, int vec_len, 
00570           int init_offset, int distance,
00571           int *fid)
00572 {
00573   MBLOCKAPI("MBLK_Create_field");
00574   field_t *f=new field_t(DType(base_type,vec_len,init_offset,distance),
00575              blockDim(dims[0],dims[1],dims[2]),isVoxel==1);
00576   *fid = getCurMBlockChunk()->add_field(f);
00577   return ((*fid==(-1)) ? MBLK_FAILURE : MBLK_SUCCESS);
00578 }
00579 
00580 CLINKAGE int
00581 MBLK_Update_field(int fid, int ghostWidth, void *grid)
00582 {
00583   MBLOCKAPI("MBLK_Update_field");
00584   MBLK_Iupdate_field(fid, ghostWidth, grid, grid);
00585   return MBLK_Wait_update();
00586 }
00587 
00588 CLINKAGE int
00589 MBLK_Iupdate_field(int fid, int ghostWidth, void *ingrid, void *outgrid)
00590 {
00591   MBLOCKAPI("MBLK_Iupdate_field");
00592   getCurMBlockChunk()->start_update(fid,extrudeMethod(ghostWidth),ingrid,outgrid);
00593   return MBLK_SUCCESS;
00594 }
00595 
00596 CLINKAGE int
00597 MBLK_Test_update(int *status)
00598 {
00599   MBLOCKAPI("MBLK_Test_update");
00600   *status=getCurMBlockChunk()->test_update();
00601   return MBLK_SUCCESS; 
00602 }
00603 
00604 CLINKAGE int
00605 MBLK_Wait_update(void)
00606 {
00607   MBLOCKAPI("MBLK_Wait_update");
00608   return getCurMBlockChunk()->wait_update();
00609 }
00610 
00611 CLINKAGE int
00612 MBLK_Reduce_field(int fid, void *ingrid, void *outbuf, int op)
00613 {
00614   MBLOCKAPI("MBLK_Reduce_field");
00615   getCurMBlockChunk()->reduce_field(fid, ingrid, outbuf, op);
00616   return MBLK_SUCCESS;
00617 }
00618 
00619 CLINKAGE int
00620 MBLK_Reduce(int fid, void *inbuf, void *outbuf, int op)
00621 {
00622   MBLOCKAPI("MBLK_Reduce");
00623   getCurMBlockChunk()->reduce(fid, inbuf, outbuf, op);
00624   return MBLK_SUCCESS;
00625 }
00626 
00627 CLINKAGE int
00628 MBLK_Register_bc(const int bcnum, int ghostWidth,const MBLK_BcFn bcfn)
00629 {
00630   MBLOCKAPI("MBLK_Register_bc");
00631   return getCurMBlockChunk()->register_bc(bcnum, bcfn, extrudeMethod(ghostWidth), false);
00632 }
00633 
00634 CLINKAGE int
00635 MBLK_Apply_bc(const int bcnum, void *p1,void *p2)
00636 {
00637   MBLOCKAPI("MBLK_Apply_bc");
00638   int retval =  getCurMBlockChunk()->apply_bc(bcnum, p1,p2);
00639   return retval;
00640 }
00641 
00642 CLINKAGE int
00643 MBLK_Apply_bc_all(void *p1,void *p2)
00644 {
00645   MBLOCKAPI("MBLK_Apply_bc_all");
00646   int retval =  getCurMBlockChunk()->apply_bc_all(p1,p2);
00647   return retval;
00648 }
00649 
00650 CLINKAGE void
00651 MBLK_Print_block(void)
00652 {
00653   MBLOCKAPI("MBLK_Print_block");
00654   MBlockChunk *cptr = getCurMBlockChunk();
00655   cptr->print();
00656 }
00657 
00658 /************************ Fortran Bindings *********************************/
00659 
00660 // Utility functions for Fortran
00661 FLINKAGE int FTN_NAME(FOFFSETOF,foffsetof)
00662   (void *first, void *second)
00663 {
00664   return (int)((char *)second - (char*)first);
00665 }
00666 
00667 FLINKAGE void FTN_NAME(MBLK_READ, mblk_read)
00668   (const char *str, int *nDim,int *ret, int len)
00669 {
00670   /* skip over silly Fortran space-padded string */
00671   while (str[len-1]==' ') len--;
00672   char *tmpstr = new char[len+1]; CHK(tmpstr);
00673   memcpy(tmpstr,str,len);
00674   tmpstr[len] = '\0';
00675   *ret = MBLK_Read(tmpstr,*nDim);
00676   delete[] tmpstr;
00677 }
00678 
00679 FLINKAGE void FTN_NAME(MBLK_GET_NBLOCKS, mblk_get_nblocks)
00680   (int *n, int *ret)
00681 {
00682   *ret = MBLK_Get_nblocks(n);
00683 }
00684 
00685 FLINKAGE void FTN_NAME(MBLK_GET_MYBLOCK, mblk_get_myblock)
00686   (int *m, int *ret)
00687 {
00688   *ret = MBLK_Get_myblock(m);
00689 }
00690 static void c2f_index3d(int *idx) {
00691   idx[0]++; idx[1]++; idx[2]++;
00692 }
00693 FLINKAGE void FTN_NAME(MBLK_GET_BLOCKSIZE, mblk_get_blocksize)
00694   (int *dims, int *ret)
00695 {
00696   *ret = MBLK_Get_blocksize(dims);
00697 }
00698 
00699 FLINKAGE void FTN_NAME(MBLK_GET_NODELOCS,mblk_get_nodelocs)
00700   (const int *nodedim,double *nodeloc,int *ret) 
00701 {
00702   *ret = MBLK_Get_nodelocs(nodedim,nodeloc);
00703 }
00704 
00705 FLINKAGE double FTN_NAME(MBLK_TIMER, mblk_timer)
00706   (void)
00707 {
00708   return MBLK_Timer();
00709 }
00710 
00711 FLINKAGE void FTN_NAME(MBLK_PRINT,mblk_print)
00712   (char *str, int len)
00713 {
00714   char *tmpstr = new char[len+1]; CHK(tmpstr);
00715   memcpy(tmpstr,str,len);
00716   tmpstr[len] = '\0';
00717   MBLK_Print(tmpstr);
00718   delete[] tmpstr;
00719 }
00720 
00721 FLINKAGE void FTN_NAME(MBLK_PRINT_BLOCK,mblk_print_block)
00722   (void)
00723 {
00724   MBLK_Print_block();
00725 }
00726 
00727 FLINKAGE void FTN_NAME(MBLK_CREATE_FIELD, mblk_create_field)
00728   (int *dims,int *forVox,int *b, int *l, int *o, int *d, int *f, int *ret)
00729 {
00730   *ret = MBLK_Create_field(dims,*forVox,*b, *l, *o, *d, f);
00731 }
00732 
00733 FLINKAGE void FTN_NAME(MBLK_UPDATE_FIELD, mblk_update_field)
00734   (int *fid, int *ghostWidth,void *grid, int *ret)
00735 {
00736   *ret = MBLK_Update_field(*fid,*ghostWidth, grid);
00737 }
00738 
00739 FLINKAGE void FTN_NAME(MBLK_IUPDATE_FIELD, mblk_iupdate_field)
00740   (int *fid, int *ghostWidth, void *igrid, void *ogrid, int *ret)
00741 {
00742   *ret = MBLK_Iupdate_field(*fid,*ghostWidth, igrid, ogrid);
00743 }
00744 
00745 FLINKAGE void FTN_NAME(MBLK_TEST_UPDATE, mblk_test_update)
00746   (int *status, int *ret)
00747 {
00748   *ret = MBLK_Test_update(status);
00749 }
00750 
00751 FLINKAGE void FTN_NAME(MBLK_WAIT_UPDATE, mblk_wait_update)
00752   (int *ret)
00753 {
00754   *ret = MBLK_Wait_update();
00755 }
00756 
00757 FLINKAGE void FTN_NAME(MBLK_REDUCE_FIELD, mblk_reduce_field)
00758   (int *fid, void *grid, void *out, int *op, int *ret)
00759 {
00760   *ret = MBLK_Reduce_field(*fid, grid, out, *op);
00761 }
00762 
00763 FLINKAGE void FTN_NAME(MBLK_REDUCE, mblk_reduce)
00764   (int *fid, void *in, void *out, int *op, int *ret)
00765 {
00766   *ret = MBLK_Reduce_field(*fid, in, out, *op);
00767 }
00768 
00769 FLINKAGE void FTN_NAME(MBLK_REGISTER_BC, mblk_register_bc)
00770   (int *bcnum, int *ghostWidth,MBLK_BcFn bcfn, int *ret)
00771 {
00772   MBLOCKAPI("MBLK_register_bc");
00773   *ret=getCurMBlockChunk()->register_bc(*bcnum, bcfn, extrudeMethod(*ghostWidth), true);    
00774 }
00775 
00776 FLINKAGE void FTN_NAME(MBLK_APPLY_BC, mblk_apply_bc)
00777   (int *bcnum, void *p1,void *p2, int *ret)
00778 {
00779   *ret = MBLK_Apply_bc(*bcnum, p1,p2);
00780 }
00781 
00782 FLINKAGE void FTN_NAME(MBLK_APPLY_BC_ALL, mblk_apply_bc_all)
00783   (void *p1,void *p2, int *ret)
00784 {
00785   *ret = MBLK_Apply_bc_all(p1,p2);
00786 }
00787 
00788 FLINKAGE void FTN_NAME(MBLK_REGISTER, mblk_register)
00789   (void *block, MBLK_PupFn pupfn, int *rid, int *ret)
00790 {
00791   *ret = MBLK_Register(block, pupfn, rid);
00792 }
00793 
00794 FLINKAGE void FTN_NAME(MBLK_MIGRATE, mblk_migrate)
00795   (int *ret)
00796 {
00797   *ret = MBLK_Migrate();
00798 }
00799 
00800 
00801 void
00802 MBlockChunk::print(void)
00803 {
00804   CkPrintf("-------------------- Block %d --------------------\n",thisIndex);
00805   b->print();
00806   CkPrintf("--------------------------------------------------\n",thisIndex);
00807 }  
00808   
00809 static void cmm_pup_mblock_message(pup_er p,void **msg) {
00810     CkPupMessage(*(PUP::er *)p,msg,1);
00811     if (pup_isDeleting(p)) delete (MBlockDataMsg *)*msg;
00812 }
00813 
00814 void
00815 MBlockChunk::pup(PUP::er &p)
00816 {
00817   threads.pup(p);
00818   messages=CmmPup(&p,messages,cmm_pup_mblock_message);
00819 
00820   if(p.isUnpacking())
00821     b = new block();
00822   b->pup(p);
00823 //Pup all other fields
00824   p(nfields);
00825   for (int i=0;i<nfields;i++) {
00826     if (p.isUnpacking()) fields[i]=new field_t;
00827     fields[i]->pup(p);
00828   }
00829   p((char*)bcs, MBLK_MAXBC*sizeof(bcs[0]));
00830   p(seqnum);
00831   p(update.wait_seqnum);
00832   p(update.nRecd);
00833   p(nRecvPatches);
00834 }
00835 
00836 #include "mblock.def.h"
libs/ck-libs/mblock/mblock.C
