Blockstructured Adaptive Mesh Refinement in object-oriented C++

---

       

---

CommServer.C

Go to the documentation of this file.

#if  __GNUC__ >= 3
#else
extern "C" {
void exit(int);
}
#endif

#include "CommServer.h"

// ---------------------------------------------------------------------

int dim_cube( const int N )
  { int i; for ( i = 0 ; ( 1 << i ) < N ; i++ ); return i ; }

// ---------------------------------------------------------------------

ostream & operator << ( ostream & OS , const MPI_Status & MS )
{
  return
    OS << "{" << dec << MS.MPI_SOURCE << " , " << MS.MPI_TAG << dec << "}";
    //OS << "{ " << hex << MS.MPI_SOURCE << " , " << MS.MPI_TAG << dec << "}";
}

// ---------------------------------------------------------------------

// ---------------------------------------------------------------------

void comm_service::error_msg( const char who[] , const char what[] , int R )
{

#ifdef DAGH_NO_MPI
#else

  char message[ MPI_MAX_ERROR_STRING ];
  int me ;
  int len = MPI_MAX_ERROR_STRING ;

  MPI_Comm_rank( CommWorld , &me );

  MPI_Error_string( R , message , &len );

  for (int i=0; i<1000; i++)
    cerr << "P" << me << " : " << who << " " << what << " => " << R << endl ;

#endif
}
void comm_service::error_die( const char who[] , const char what[] , int R )
{
  error_msg( who , what , R );
  exit(-1);
}

// ---------------------------------------------------------------------

class comm_barrier : public comm_service {
public:
  const int cycle ;
  const int who ;
  int flag ;
  MPI_Comm comm;

  comm_barrier( const int Cycle , const int Who, MPI_Comm C, unsigned const T );
  inline ~comm_barrier() {}

  void callrecv(  const MPI_Status & );

  const char * name(void) const ;
};

// ---------------------------------------------------------------------

#ifndef CommIncrement
#define CommIncrement (128)
#endif

// ---------------------------------------------------------------------

ofstream        comm_service::oflog ; 
ostream*       comm_service::olog = (ostream *) 0; 
int             comm_service::init_flag = 0 ;
int             comm_service::dce_flag = 0 ;

int             comm_service::PMe   = -1 ;

int             comm_service::NList =  0 ;
comm_service ** comm_service::SList =  0 ;
comm_barrier ** comm_service::Barrier = 0 ;
comm_barrier ** comm_service::BarrierWorld = 0 ;
MPI_Request   * comm_service::RList =  0 ;

int             comm_service::PNum  = -1 ;
MPI_Comm        comm_service::Comm  =  0 ;
MPI_Group       comm_service::Grp = 0 ;

int             comm_service::io_flag = 0;
int             comm_service::PIO = -1;
MPI_Comm        comm_service::CommIO = 0;

int             comm_service::PWorld = 0;
MPI_Comm        comm_service::CommWorld = 0;
MPI_Group       comm_service::GrpWorld = 0 ;

int             comm_service::NumCommArray = 0;
MPI_Comm      * comm_service::CommArray = 0;

double          comm_service::Idle_Time = 0.0 ;
double          comm_service::Srvc_Time = 0.0 ;

// ---------------------------------------------------------------------

int comm_service::findTag( const int Id , const int Tag,  const int Src )
{
  const int NL = NList ;
  comm_service ** const SL = SList ;
  for ( register int i = 1 ; i < NL ; i++ )
     if ( SL[i] && SL[i]->Id == Id && 
          SL[i]->Tag == Tag && SL[i]->Src == Src ) return i ;
  return -1 ;
}

int comm_service::findService( comm_service * const CS )
{
  const int NL = NList ;
  comm_service ** const SL = SList ;
  for ( register int i = 1 ; i < NL ; i++ ) if ( SL[i] == CS ) return i ;
  return -1 ;
}

int comm_service::findRequest( const MPI_Request req_in )
{
  const int NL = NList ;
  const MPI_Request * const RL = RList ;
  for ( register int i = 1 ; i < NL ; i++ ) if ( RL[i] == req_in ) return i ;
  return -1 ;
}

void comm_service::setreq( int const I , int const T , int const S)
{
  int J;
  if ( (J = findTag(I,T,S)) >= 0)
    Req = RList + J;
  else 
    Req = 0;
}

// ---------------------------------------------------------------------
// Initialize
// ---------------------------------------------------------------------
int comm_service::init( MPI_Comm c )
{
  if (init_flag == 1) return MPI_SUCCESS;

  int flag;
#ifdef DAGH_NO_MPI
  flag = 0;
#else
  MPI_Initialized(&flag);
#endif

  if (flag == 0) {
    PMe = 0;
    PNum = 1;
    dce_flag = 0;
    CommWorld = Comm = c ;
    if (io_flag == 1) {
      CommIO = c;
      PIO = 0;
    }
    PWorld = 1;

#ifdef DEBUG_PRINT
    {
     char buf[64];
     ostrstream obuf(buf,sizeof(buf),ios::out);
     obuf << "P" << PMe << ".log" << ((char)0) ;
     oflog.open( buf , ios::out );     
     if (olog) delete olog;
     olog = new ostream(oflog.rdbuf());
    }
#endif

    init_flag = 1;
    return MPI_SUCCESS;
  }

#ifdef DAGH_NO_MPI
#else

  if ( SList ) return MPI_ERR_COMM ;

  // All MPI_Errhandler_set() added for correct error-handling --- RD
  MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);

  //if ( 0 == c ) c = MPI_COMM_WORLD ;
  if ( 0 == c ) MPI_Comm_dup(MPI_COMM_WORLD, &c) ;
  MPI_Errhandler_set(c, MPI_ERRORS_RETURN);

  dce_flag = 1 ;

  {
    int R , Me , Num ;
    if ( MPI_SUCCESS != ( R = MPI_Comm_rank( c , &Me  ) ) ) return R ;
    if ( MPI_SUCCESS != ( R = MPI_Comm_size( c , &Num ) ) ) return R ;

    if (io_flag == 1 && Num > 1) {
      PMe = Me ;
      PIO = Num-1;
      PNum = Num-1 ;
      PWorld = Num;
      CommWorld = CommIO = c;    

      // Define the compute node communicator 
      int ranks[1]; ranks[0] = Num-1;
      MPI_Comm_group(CommWorld, &GrpWorld);
      MPI_Group_excl(GrpWorld, 1, ranks, &Grp);
      MPI_Comm_create(CommWorld, Grp, &Comm);
      MPI_Errhandler_set(Comm, MPI_ERRORS_RETURN);
    }
    else if (io_flag == 1 && Num == 1) {
      PMe = Me ;
      PIO = Me;
      PNum = Num ;
      PWorld = Num;
      CommWorld = CommIO = Comm = c;    
      MPI_Comm_group(Comm, &Grp);
      GrpWorld = Grp;
    }
    else {
      PMe  = Me ;
      PWorld = PNum = Num ;
      CommWorld = Comm = c ;
      MPI_Comm_group(Comm, &Grp);
      GrpWorld = Grp;
    }
  }

#ifdef DEBUG_PRINT
    {
     char buf[64];
     ostrstream obuf(buf,sizeof(buf),ios::out);
     obuf << "P" << PMe << ".log" << ((char)0) ;
     oflog.open( buf , ios::out );
     if (olog) delete olog;
     olog = new ostream(oflog.rdbuf());
    }
#endif

  {
    comm_service ** const SL = SList = new comm_service*[ CommIncrement ];
    MPI_Request   * const RL = RList = new MPI_Request[ CommIncrement ];
    register int i ;
    for ( i = 0 ; i < CommIncrement ; i++ ) SL[i] = 0 ;
    for ( i = 0 ; i < CommIncrement ; i++ ) RL[i] = MPI_REQUEST_NULL ;
  }
  NList = 1 ;

  init_flag = 1;

  // Post compute barrier receives
  if (PMe < PNum) {
    const int me  = PMe ;
    const int num = PNum ;

    const int dcube = dim_cube( num );
    if (dcube > 0) {
      comm_barrier ** const B = Barrier = new comm_barrier * [ dcube ];

      for ( int cycle = 0 ; cycle < dcube ; cycle++ ) {
        B[cycle] = 0 ;
  
        const int upper = 1 << ( cycle + 1 );
        const int lower = 1 << cycle ;
        const int who   = me ^ lower ;
  
        if ( who < num )
          if (  ( lower <= who && who < upper )   // Fan-in  receive
             || ( lower <= me  &&  me < upper ) ) // Fan-out receive
            B[cycle] = new comm_barrier( cycle , who, Comm, 
                           (comm_service_tag|comm_service_comp_tag) );
      }
    }
  }

  // Post world barrier receives
  {
    const int me  = PMe ;
    const int num = PWorld ;

    const int dcube = dim_cube( num );
    if (dcube > 0) {
      comm_barrier ** const B = BarrierWorld = new comm_barrier * [ dcube ];

      for ( int cycle = 0 ; cycle < dcube ; cycle++ ) {
  
        B[cycle] = 0 ;

        const int upper = 1 << ( cycle + 1 );
        const int lower = 1 << cycle ;
        const int who   = me ^ lower ;
  
        if ( who < num )
          if (  ( lower <= who && who < upper )   // Fan-in  receive
             || ( lower <= me  &&  me < upper ) ) // Fan-out receive
            B[cycle] = new comm_barrier( cycle , who, CommWorld,
                           (comm_service_tag|comm_service_world_tag) );
      }
    }
  }

#endif

  return MPI_SUCCESS ;
}

// ---------------------------------------------------------------------
// Clean & Kill
// ---------------------------------------------------------------------
void comm_service::clean(void)

{
#ifdef DAGH_NO_MPI
#else

  if (!dce_flag) return;  

#ifdef DEBUG_PRINT_COMM
     ( oflog << "comm_service::clean Cleaning Up !" << endl ).flush();
#endif

  if ( Barrier ) {

#ifdef DEBUG_PRINT_COMM
     ( oflog << "comm_service::clean Deleting Barrier" << endl ).flush();
#endif 

    const int dcube = dim_cube( PNum );
    for ( int i = 0 ; i < dcube ; i++ )
      if ( Barrier[i] ) delete Barrier[i] ;
    delete[] Barrier ;
    Barrier = 0 ;
  }
  if ( BarrierWorld ) {
#ifdef DEBUG_PRINT_COMM
     ( oflog << "comm_service::clean Deleting BarrierWorld" << endl ).flush();
#endif

    const int dcube = dim_cube( PWorld );
    for ( int i = 0 ; i < dcube ; i++ )
      if ( BarrierWorld[i] ) delete BarrierWorld[i] ;
    delete[] BarrierWorld ;
    BarrierWorld = 0 ;
  }

  {
    comm_service ** const SL = SList ;
    MPI_Request   * const RL = RList ;
    const int N = NList ;

    for ( int i = 0 ; i < N ; i++ ) {
      if (RL[i] != MPI_REQUEST_NULL) {
        if (comm_service::proc_me() == comm_service::proc_io()) {
          while (RL[i] != MPI_REQUEST_NULL) serve(RL[i]);
        }
        else {
          serve();
// #ifndef MPICH
//        MPI_Status MS ;
//        MPI_Cancel( RL + i );
//        MPI_Wait( RL + i, &MS );
// #else
//        MPI_Request_free( RL + i );
// #endif
#ifndef MPI_SCORE2
          MPI_Status MS ;
          MPI_Cancel( RL + i );
          MPI_Wait( RL + i, &MS );
#else
          MPI_Request_free( RL + i );
#endif
        }
      }
      if ( SL[i] ) {
        SL[i]->Req = 0;
        SL[i] = 0;
      }
    }

    delete [] SL;
    delete [] RL;
  }

  int commcomp1 = MPI_IDENT;
  int commcomp2 = MPI_IDENT;

  if (Comm == (MPI_Comm)-1) Comm = 0; // Only on the IO proc.

  /* I addded the if's because on the SGI's MPICH
     gives and error if the args are not valid communicators */
  if (Comm != 0 && Comm != MPI_COMM_NULL)
    MPI_Comm_compare(Comm,CommWorld,&commcomp1);
  if (CommIO != 0 && CommIO != MPI_COMM_NULL)
    MPI_Comm_compare(CommWorld,CommIO,&commcomp2);

  if (commcomp1 == MPI_IDENT && commcomp2 == MPI_IDENT) {
    if (CommWorld != 0 && CommWorld != MPI_COMM_NULL && CommWorld != MPI_COMM_WORLD) 
      MPI_Comm_free(&CommWorld);
  }
  else if (commcomp1 == MPI_IDENT) {
    if (CommWorld != 0 && CommWorld != MPI_COMM_NULL && CommWorld != MPI_COMM_WORLD) 
      MPI_Comm_free(&CommWorld);
    if (CommIO != 0 && CommIO != MPI_COMM_NULL && CommIO != MPI_COMM_WORLD) 
      MPI_Comm_free(&CommIO);
  }
  else if (commcomp2 == MPI_IDENT) {
    if (CommWorld != 0 && CommWorld != MPI_COMM_NULL && CommWorld != MPI_COMM_WORLD) 
      MPI_Comm_free(&CommWorld);
    if (Comm != 0 && Comm != MPI_COMM_NULL && Comm != MPI_COMM_WORLD) 
      MPI_Comm_free(&Comm);
  }
  else {
    if (CommIO != 0 && CommIO != MPI_COMM_NULL && CommIO != MPI_COMM_WORLD) 
      MPI_Comm_free(&CommIO);
    if (CommWorld != 0 && CommWorld != MPI_COMM_NULL && CommWorld != MPI_COMM_WORLD) 
      MPI_Comm_free(&CommWorld);
    if (Comm != 0 && Comm != MPI_COMM_NULL && Comm != MPI_COMM_WORLD) 
      MPI_Comm_free(&Comm);
  } 
  
  if (CommArray) delete [] CommArray;

  dce_flag = 0;

#ifdef DEBUG_PRINT_COMM
     ( oflog << "comm_service::clean Done Cleaning Up !" << endl ).flush();
#endif

  return ;
#endif
}

void comm_service::kill(void)
{ 

 if ( dce_flag ) clean() ;

#ifdef DEBUG_PRINT_COMM
     ( oflog << "comm_service::kill Communications shut-down !" << endl ).flush();
#endif

#ifdef DEBUG_PRINT
  oflog.close();
  if (olog) delete olog;
#endif

  return ;
}

// ---------------------------------------------------------------------
// Add a service
// ---------------------------------------------------------------------
comm_service::comm_service( const int I , const int T , const int S ) 
    : Req(0), Id(I), Tag(T), Src(S)
{
  if ( !init_flag ) comm_service::init(); // Initialize static parameters

#ifdef DAGH_NO_MPI
#else

  if ( 0 <= findTag( I , T , S ) ) {
    Req = 0 ;
    oflog << "comm_service::comm_service" 
          << "(Id:" << I << ")" 
          << "(Tag:" << T << ")"
          << "(Src:" << S << ")"
          << "DUPLICATE TAG: Service not constructed."
          << endl ;
    oflog.flush();
    return ;
  }

  comm_service ** const SL = SList ;
  MPI_Request   * const RL = RList ;
  const int N = NList ;

  // Enlarge array as necessary

  if ( 0 == ( N % CommIncrement ) ) {
    MPI_Request   * const R = RList = new MPI_Request[ N + CommIncrement ];
    comm_service ** const S = SList = new comm_service *[ N + CommIncrement ];
    register int i ;
    if ( SL ) {
      for ( i = 0 ; i < N ; i++ ) { 
        if (RL[i]) {
          R[i] = RL[i] ;
          RL[i] = MPI_REQUEST_NULL;
        }
        else R[i] = MPI_REQUEST_NULL;

        if (SL[i]) {
          S[i] = SL[i];
          S[i]->Req = (R + i) ;
          SL[i] = 0;
        }
        else S[i] = 0 ;
      }
      delete[] SL ;
      delete[] RL ;
    }
    for ( i = N ; i < N + CommIncrement ; i++ ) {
       S[i] = 0 ;
       R[i] = MPI_REQUEST_NULL ;
    }
  }

  // Add to list
  SList[N] = this;
  SList[N]->Req = RList + N ;
  RList[N] = MPI_REQUEST_NULL ;

#ifdef DEBUG_PRINT_COMM
     ( oflog << "comm_service::comm_service"
             << "(Id:" << Id << ")" 
             << "(Tag:" << Tag << ")"
             << "(Src:" << Src << ")"
             << "(NList:" << NList << ")"
             << "(N:" << N << ")"
             << "(*Req:" << *Req << ")"
             << "(RList[N]:" << RList[N] << ")"
             << endl ).flush();
#endif

  NList++ ;

#endif
}

// ---------------------------------------------------------------------
// Delete a service
// ---------------------------------------------------------------------
comm_service::~comm_service()

{

#ifdef DAGH_NO_MPI
#else

  if ( !Req ) return ; // Never registered

  const int I = findService( this );

  if ( I < 0 ) {
    oflog << "comm_service::~comm_service() UNREGISTERED OBJECT ?" << endl ;
    oflog.flush();
    return ;
  }

#ifdef DEBUG_PRINT_COMM
     ( oflog << "comm_service::~comm_service"
             << "(Id:" << Id << ")" 
             << "(Tag:" << Tag << ")"
             << "(Src:" << Src << ")"
             << "(NList:" << NList << ")"
             << "(I:" << I << ")"
             << "(*Req:" << *Req << ")"
             << "(RList[I]:" << RList[I] << ")"
             << endl ).flush();
#endif

  // Remove service from "registry"
  if ( MPI_REQUEST_NULL != *Req ) {
// #ifndef MPICH
//        MPI_Status MS ;
//        MPI_Cancel( Req );
//        MPI_Wait( Req , &MS );
// #else
//        MPI_Request_free( Req );
// #endif
#ifndef MPI_SCORE2
    MPI_Status MS ;
    MPI_Cancel( Req );
    MPI_Wait( Req , &MS );
#else
    MPI_Request_free( Req );
#endif
  }

  comm_service ** const SL = SList ;
  MPI_Request   * const RL = RList ;

  const int N = NList - 1 ;

  {
    for ( register int i = I ; i < N; i++ ) {
      RL[i] = RL[i+1];
      SL[i] = SL[i+1];
      SL[i]->Req = (RL + i);
    }
  }

  SL[N] = 0 ;
  RL[N] = MPI_REQUEST_NULL ;

  if ( 0 == ( N % CommIncrement ) ) {
    if ( N > 0 ) {
      MPI_Request   * const R = RList = new MPI_Request[ N ];
      comm_service ** const S = SList = new comm_service*[ N ];
      register int i ;
      for ( i = 0 ; i < N ; i++ ) {
        if (RL[i]) {
          R[i] = RL[i] ;
          RL[i] = MPI_REQUEST_NULL;
        }
        else R[i] = MPI_REQUEST_NULL;

        if (SL[i]) { 
          S[i] = SL[i];
          S[i]->Req = R + i ;
          SL[i] = 0;
        }
        else S[i] = 0 ;
      }
    }
    else {
      SList = 0 ;
      RList = 0 ;
    }
    delete[] SL ;
    delete[] RL ;
  }

  NList-- ;

#endif

  return ;
}

// ---------------------------------------------------------------------

void comm_service::callrecv( const MPI_Status & MS )
{
  oflog << "comm_service::callrecv("
        << MS << ") DEFAULT CALLBACK!" << endl ;
  oflog.flush();
}

const char * comm_service::name( void ) const
{
  static const char Name[] = "comm_service" ;
  return Name ;
}

// ---------------------------------------------------------------------
// ---------------------------------------------------------------------
// Perform services

int comm_service::serve( void )
{

#ifdef DAGH_NO_MPI
#else

  if ( NList <= 1 ) {
#ifdef DEBUG_PRINT_COMM
     ( oflog << "comm_service::serve" << NList << " <= 1" << endl ).flush();
#endif
    return MPI_SUCCESS ;
  }

  // Handle stockpiled requests

  int NumR ;
  int        * const IndR = new int[ NList ];
  MPI_Status * const MSR  = new MPI_Status[ NList ];

  MSR[0].MPI_SOURCE = MSR[0].MPI_TAG = 0 ;

  double next_time ;
  double start_time = MPI_Wtime();

  const int R = MPI_Testsome(NList,RList,&NumR,IndR,MSR);

  if ( MPI_SUCCESS == R ) {
    for ( int i = 0 ; i < NumR ; i++ ) {
      const int I = IndR[i];

      // MPI Spec says to use MSR[i], but 'chimp' uses MSR[I]

      //const MPI_Status &   MS = MSR[I] ;
      const MPI_Status &   MS = MSR[i] ;
      comm_service * const CS = SList[I];

#ifdef DEBUG_PRINT_COMM
      if ( CS )
        ( oflog << "MPI_Testsome #" << i << " (" << I << ")" << " => " << MS 
                << " => " << CS->name() << endl ).flush();
      else
        ( oflog << "MPI_Testsome #" << i << " => " << MS << endl ).flush();
#endif

      if ( CS ) {
        Idle_Time += ( next_time = MPI_Wtime() ) - start_time ;
        CS->callrecv( MS );
        Srvc_Time += ( start_time = MPI_Wtime() ) - next_time ;
      }
    }
  }

  delete [] IndR ;
  delete [] MSR ;

  Idle_Time += MPI_Wtime() - start_time ;

#endif

  return MPI_SUCCESS ;
}

// ---------------------------------------------------------------------

int comm_service::serve( MPI_Request req_in )
{

#ifdef DAGH_NO_MPI
#else

  double start_time = MPI_Wtime();
  double next_time ;

  // No services, just wait

  if ( 0 == NList ) {
    MPI_Status MS ;
    const int R = MPI_Wait( &req_in , &MS );
    Idle_Time += MPI_Wtime() - start_time ;
    return R ;
  }

  // Wait for the desired request

  int J = findRequest( req_in );
  if ( J < 0 ) RList[ J = 0 ] = req_in ;

  int NumR = 0;
  int        * const IndR = new int[ NList ];
  MPI_Status * const MSR  = new MPI_Status[ NList ];
  
  assert(IndR != 0);
  assert(MSR != 0);

  MSR[0].MPI_SOURCE = MSR[0].MPI_TAG = 0 ;

  do {

#ifdef DEBUG_PRINT_COMM
  ( oflog << "MPI_Waitsome " << J << "th" << endl ).flush();
#endif 

    const int R = MPI_Waitsome(NList,RList,&NumR,IndR,MSR);

    if ( MPI_SUCCESS != R ) {
      Idle_Time += MPI_Wtime() - start_time ;
      delete [] IndR ;
      delete [] MSR ;
      error_die( "comm_service::serve" , "MPI_Waitsome" , R );
      return R ;
    }

#ifdef DEBUG_PRINT_COMM
  ( oflog << "MPI_Waitsome " << NumR << " requests served" << endl ).flush();
#endif

    for ( int i = 0 ; i < NumR ; i++ ) {
      const int I = IndR[i];

      // MPI Spec says to use MSR[i], but 'chimp' uses MSR[I]
      //const MPI_Status & MS = MSR[I] ;
      const MPI_Status & MS = MSR[i] ;

      comm_service * const CS = SList[I];

#ifdef DEBUG_PRINT_COMM
  if ( CS )
    ( oflog << "MPI_Waitsome #" << i << "(" << I << ")" << " => " << MS
            << " => " << CS->name() << endl ).flush();
  else
    ( oflog << "MPI_Waitsome #" << i << "(" << I << ")" << " => " << MS << endl ).flush();
#endif

      if ( CS ) { // A service requests
        Idle_Time += ( next_time = MPI_Wtime() ) - start_time ;
        CS->callrecv( MS );
        Srvc_Time += ( start_time = MPI_Wtime() ) - next_time ;
      }

      if ( J == I ) J = -1 ;
    }

  } while ( 0 <= J );

  if (IndR) delete [] IndR ;
  if (MSR)  delete [] MSR ;

  RList[0] = MPI_REQUEST_NULL ;

  Idle_Time += MPI_Wtime() - start_time ;
  
#endif

  return MPI_SUCCESS ;
}

// ---------------------------------------------------------------------
// Add/Delete a communicator
// ---------------------------------------------------------------------

void comm_service::add_comm(int const id)
{
#ifdef DAGH_NO_MPI
#else
  MPI_Comm_dup(Comm, &CommArray[id]) ;
  MPI_Errhandler_set(CommArray[id], MPI_ERRORS_RETURN);
  NumCommArray++ ;
#endif
}

void comm_service::delete_comm(int const id)
{
#ifdef DAGH_NO_MPI
#else
  MPI_Comm_free(&CommArray[id]) ;
  NumCommArray-- ;
#endif
}

void comm_service::reset_comm(int const id)
{
#ifdef DAGH_NO_MPI
#else
  // Reseting the communication is necessary only in specific situations.
  // See the usage of this function in GridHierarchy!
  // The function must be used with care, because most MPI-implementations 
  // allow only 32767 communicator duplications during a single run.  If this 
  // number is reached, MPI usually blocks and waits an infinite time. 
  
  if (CommArray[id] != MPI_COMM_NULL) {
    MPI_Comm_free(&CommArray[id]) ;
    MPI_Comm_dup(Comm, &CommArray[id]) ;
    MPI_Errhandler_set(CommArray[id], MPI_ERRORS_RETURN);
  }
#endif
}

void comm_service::inc_commarray(int const inc)
{
#ifdef DAGH_NO_MPI
#else
  MPI_Comm   * const CA = CommArray ;
  const int N = NumCommArray ;

  MPI_Comm * const C = CommArray = new MPI_Comm[ N + inc ];
  register int i ;
  if ( CA ) {
    for ( i = 0 ; i < N ; i++ ) { 
      if (CA[i] != MPI_COMM_NULL) {
        C[i] = CA[i] ;
        CA[i] = MPI_COMM_NULL;
      }
      else C[i] = MPI_COMM_NULL;
    }
    delete[] CA ;
  }
  for ( i = N ; i < N + inc ; i++ ) {
    C[i] = MPI_COMM_NULL ;
  }
#endif
}
// ---------------------------------------------------------------------

// ---------------------------------------------------------------------
// Barrier sync....
// ---------------------------------------------------------------------
void comm_service::barrier(int const type)
{ 
#ifdef DAGH_NO_MPI
#else
  int R ;
  const int me    = PMe ;
  int num   = 0;
  unsigned tag_prefix = 0;
  comm_barrier **B = 0;
  MPI_Comm C = 0;

  if (type == comm_service_comp) {
     num   = PNum ;
     tag_prefix = (comm_service_tag | comm_service_comp_tag);
     B = Barrier;
     C = Comm;
  }
  /*******************/
  //else if (type == comm_sevice_io) {
  //   num   = (PWorld > 1) ? PNum+1 : PNum ;
  //   tag_prefix = (comm_service_tag | comm_service_io_tag);
  //   B = BarrierIO;
  //   C = CommIO;
  //}
  /*******************/
  else if (type == comm_service_world) {
     num = PWorld ;
     tag_prefix = (comm_service_tag | comm_service_world_tag);
     B = BarrierWorld;
     C = CommWorld;
  }
  else  {
     num   = PNum ;
     tag_prefix = (comm_service_tag | comm_service_comp_tag);
     B = Barrier;
     C = Comm;
  }
 
  const int dcube = dim_cube( num );

#ifdef DEBUG_PRINT_COMM
  oflog << "comm_service::barrier" << " DO " << dcube << endl ;
  oflog.flush();
#endif

  // Fan-in

  int cycle;
  for ( cycle = dcube - 1 ; 0 <= cycle ; cycle-- ) {
    const int upper = 1 << ( cycle + 1 );
    const int lower = 1 << cycle ;
    const int who   = me ^ lower ;
    const int tag   = tag_prefix | ( cycle + 1 ) ;

    if ( who < num ) {

      if ( lower <= who && who < upper ) {

#ifdef DEBUG_PRINT_COMM
  ( oflog << "comm_service::barrier" << " <= " << who << "..." << endl ).flush();
#endif

        if ( ! B[cycle]->flag ) {
          const int I = findTag( comm_service_null_id, tag, MPI_ANY_SOURCE );
          if ( I < 0 ) error_die( "comm_service::barrier" , "comm_service::find" , 0 );
          R = serve( RList[I] );
          if ( MPI_SUCCESS != R ) error_die( "comm_service::barrier" , "comm_service::serve" , R );
        }
        B[cycle]->flag = 0 ;

#ifdef DEBUG_PRINT_COMM
  ( oflog << "comm_service::barrier" << " <= " << who << " DONE" << endl ).flush();
#endif

      }
      else if ( lower <= me && me < upper ) {

#ifdef DEBUG_PRINT_COMM
  ( oflog <<  "comm_service::barrier" << " => " << who ).flush();
#endif

        MPI_Request req ;
        R = MPI_Isend((void*)0, 0, MPI_BYTE, who, tag, C , &req );
        if ( MPI_SUCCESS != R ) error_die( "comm_service::barrier" , "MPI_Isend" , R );

#ifdef DEBUG_PRINT_COMM
  ( oflog <<  " Isend" << endl ).flush();
#endif

        R = serve( req );
        if ( MPI_SUCCESS != R ) error_die( "comm_service::barrier" , "comm_service::serve" , R );

#ifdef DEBUG_PRINT_COMM
  ( oflog <<  "comm_service::barrier" << " => " << who << " Done" << endl ).flush();
#endif

      }
    }
  }

  // Fan-out

  for ( cycle = 0 ; cycle < dcube ; cycle++ ) {
    const int upper = 1 << ( cycle + 1 );
    const int lower = 1 << cycle ;
    const int who   = me ^ lower ;
    const int tag   = tag_prefix | ( cycle + 1 ) ;

    if ( who < num ) {

      if ( lower <= who && who < upper ) {

#ifdef DEBUG_PRINT_COMM
  ( oflog << "comm_service::barrier" << " => " << who ).flush();
#endif

        MPI_Request req ;
        R = MPI_Isend((void*)0, 0, MPI_BYTE, who, tag, C , &req );
        if ( MPI_SUCCESS != R ) error_die( "comm_service::barrier" , "MPI_Isend" , R );

#ifdef DEBUG_PRINT_COMM
  ( oflog <<  " Isend" << endl ).flush();
#endif

        R = serve( req );
        if ( MPI_SUCCESS != R ) error_die( "comm_service::barrier" , "comm_service::serve" , R );

#ifdef DEBUG_PRINT_COMM
  ( oflog << "comm_service::barrier" << " => " << who << " Done" << endl ).flush();
#endif

      }
      else if ( lower <= me && me < upper ) {

#ifdef DEBUG_PRINT_COMM
  ( oflog << "comm_service::barrier" << " <= " << who << "..." << endl ).flush();
#endif

        if ( ! B[cycle]->flag ) {
          const int I = findTag( comm_service_null_id , tag, MPI_ANY_SOURCE );
          if ( I < 0 ) error_die( "comm_service::barrier" , "comm_service::find" , 0 );
          R = serve( RList[I] );
          if ( MPI_SUCCESS != R ) error_die( "comm_service::barrier" , "comm_service::serve" , R );
        }

#ifdef DEBUG_PRINT_COMM
  ( oflog << "comm_service::barrier" << " <= " << who << endl ).flush();
#endif

        B[cycle]->flag = 0 ;
      }
    }
  }

#ifdef DEBUG_PRINT_COMM
  ( oflog << "comm_service::barrier" << " DONE" << endl ).flush();
#endif

#endif
  return ; // All sync'd
}
// ---------------------------------------------------------------------

// ---------------------------------------------------------------------
// Receive / log barrier messages
// ---------------------------------------------------------------------
comm_barrier::comm_barrier( const int Cycle , const int Who, MPI_Comm C, unsigned const T )
  : comm_service( comm_service_null_id, T | (Cycle+1) )
  , cycle( Cycle ) , who( Who ), comm(C)
{

  flag = 0 ;

#ifdef DAGH_NO_MPI
#else

#ifdef DEBUG_PRINT_COMM
     ( comm_service::log() << "comm_service::barrier " << Tag
             << " (" << *req() << ")"
             << " (" << cycle << "," << who << ")"
             << endl ).flush();
#endif

  int R = MPI_Irecv((void*)0,0,MPI_BYTE,who,Tag,comm,req());
  if ( MPI_SUCCESS != R ) error_die( "comm_service::barrier" , "MPI_Irecv" , R );

#endif
}

// ---------------------------------------------------------------------

void comm_barrier::callrecv( const MPI_Status & MS )
{

#ifdef DAGH_NO_MPI
#else

#ifdef DEBUG_PRINT_COMM
  (comm_service::log() << "comm_barrier::callrecv()" << MS << endl ).flush(); 
#endif

  if ( flag ) {
    comm_service::log() << "comm_barrier::callrecv()" << " ERROR: flag != 0" << endl ;
    comm_service::log().flush();
  }

  int R = MPI_Irecv((void*)0,0,MPI_BYTE,who,Tag,comm,req());

  if ( MPI_SUCCESS != R ) error_die( "comm_barrier::callrecv()" , "MPI_Irecv" , R );

  flag = 1 ;

#endif

  return ;
}

// ---------------------------------------------------------------------
const char * comm_barrier::name( void ) const
{
  static const char Name[] = "comm_barrier" ;
  return Name ;
}
// ---------------------------------------------------------------------

// ---------------------------------------------------------------------
// All to "proc" comm !
// ---------------------------------------------------------------------
// Will do later... :-)
// ---------------------------------------------------------------------

---

Quickstart     Users Guide     Programmers Reference     Installation      Examples     Download

---

AMROC Main      Home      Contact

last update: 06/01/04