visual_mess.c

fortran并行计算包

  
  
  returnVal = PMPI_Irecv( buf, count, datatype, source, tag, comm, request );

  if (source != MPI_PROC_NULL && returnVal == MPI_SUCCESS) {
      rq_alloc( requests_avail_1, newrq1 );
    if (newrq1) {
      newrq1->request = *request;
      newrq1->status = RQ_RECV;
      newrq1->next = 0;
      rq_add( requests_head_1, requests_tail_1, newrq1 );
    }
  }

  return returnVal;
}

int  MPI_Irsend( buf, count, datatype, dest, tag, comm, request )
void * buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
MPI_Request * request;
{
  int  returnVal;
  request_list *newrq;
  int typesize3;

  
  
/* fprintf( stderr, "MPI_Irsend call on %d\n", procid_1 ); */
  
  returnVal = PMPI_Irsend( buf, count, datatype, dest, tag, comm, request );

  if (dest != MPI_PROC_NULL) {
      rq_alloc( requests_avail_1, newrq );
    if (newrq) {
      PMPI_Type_size( datatype, &typesize3 );
      newrq->request = *request;
      newrq->status = RQ_SEND;
      newrq->size = count * typesize3;
      newrq->tag = tag;
      newrq->otherParty = dest;
      newrq->next = 0;
      rq_add( requests_head_1, requests_tail_1, newrq );
    }
  }

  return returnVal;
}

int  MPI_Isend( buf, count, datatype, dest, tag, comm, request )
void * buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
MPI_Request * request;
{
  int  returnVal;
  request_list *newrq;
  int typesize3;

  
  
/* fprintf( stderr, "MPI_Isend call on %d\n", procid_1 ); */
  
  returnVal = PMPI_Isend( buf, count, datatype, dest, tag, comm, request );

  if (dest != MPI_PROC_NULL) {
      rq_alloc( requests_avail_1, newrq );
    if (newrq) {
      PMPI_Type_size( datatype, &typesize3 );
      newrq->request = *request;
      newrq->status = RQ_SEND;
      newrq->size = count * typesize3;
      newrq->tag = tag;
      newrq->otherParty = dest;
      newrq->next = 0;
      rq_add( requests_head_1, requests_tail_1, newrq );
    }
  }

  return returnVal;
}

int  MPI_Issend( buf, count, datatype, dest, tag, comm, request )
void * buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
MPI_Request * request;
{
  int  returnVal;
  request_list *newrq;
  int typesize3;

  
  
/* fprintf( stderr, "MPI_Issend call on %d\n", procid_1 ); */
  
  returnVal = PMPI_Issend( buf, count, datatype, dest, tag, comm, request );

  if (dest != MPI_PROC_NULL) {
      rq_alloc( requests_avail_1, newrq );
    if (newrq) {
      PMPI_Type_size( datatype, &typesize3 );
      newrq->request = *request;
      newrq->status = RQ_SEND;
      newrq->size = count * typesize3;
      newrq->tag = tag;
      newrq->otherParty = dest;
      newrq->next = 0;
      rq_add( requests_head_1, requests_tail_1, newrq );
    }
  }

  return returnVal;
}

int  MPI_Recv( buf, count, datatype, source, tag, comm, status )
void * buf;
int count;
MPI_Datatype datatype;
int source;
int tag;
MPI_Comm comm;
MPI_Status * status;
{
  int  returnVal;
  int size;

  
  
  returnVal = PMPI_Recv( buf, count, datatype, source, tag, comm, status );

  if (source != MPI_PROC_NULL && returnVal == MPI_SUCCESS) {
    MPI_Get_count( status, MPI_BYTE, &size );
    prof_recv( procid_1, status->MPI_SOURCE,
	       status->MPI_TAG, size, "MPI_Recv" );
  }

  return returnVal;
}

int  MPI_Rsend( buf, count, datatype, dest, tag, comm )
void * buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
{
  int  returnVal;
  int typesize;

  
  
  returnVal = PMPI_Rsend( buf, count, datatype, dest, tag, comm );

  if (dest != MPI_PROC_NULL) {
    MPI_Type_size( datatype, &typesize );
    prof_send( procid_1, dest, tag, typesize*count,
	       "MPI_Rsend" );
  }

  return returnVal;
}

int  MPI_Rsend_init( buf, count, datatype, dest, tag, comm, request )
void * buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
MPI_Request * request;
{
  int  returnVal;
  request_list *newrq;
  int typesize3;

  
  
/* fprintf( stderr, "MPI_Rsend_init call on %d\n", procid_1 ); */
  
  returnVal = PMPI_Rsend_init( buf, count, datatype, dest, tag, comm, request );

  if (dest != MPI_PROC_NULL) {
      rq_alloc( requests_avail_1, newrq );
    if (newrq) {
      PMPI_Type_size( datatype, &typesize3 );
      newrq->request = *request;
      newrq->status = RQ_SEND;
      newrq->size = count * typesize3;
      newrq->tag = tag;
      newrq->otherParty = dest;
      newrq->next = 0;
      rq_add( requests_head_1, requests_tail_1, newrq );
    }
  }

  return returnVal;
}

int  MPI_Send( buf, count, datatype, dest, tag, comm )
void * buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
{
  int  returnVal;
  int typesize;

  
  
  returnVal = PMPI_Send( buf, count, datatype, dest, tag, comm );

  if (dest != MPI_PROC_NULL) {
    MPI_Type_size( datatype, &typesize );
    prof_send( procid_1, dest, tag, typesize*count,
	       "MPI_Send" );
  }

  return returnVal;
}

int  MPI_Sendrecv( sendbuf, sendcount, sendtype, dest, sendtag, recvbuf, recvcount, recvtype, source, recvtag, comm, status )
void * sendbuf;
int sendcount;
MPI_Datatype sendtype;
int dest;
int sendtag;
void * recvbuf;
int recvcount;
MPI_Datatype recvtype;
int source;
int recvtag;
MPI_Comm comm;
MPI_Status * status;
{
  int  returnVal;
  int typesize1;
  int count;

  
  
  returnVal = PMPI_Sendrecv( sendbuf, sendcount, sendtype, dest, sendtag, recvbuf, recvcount, recvtype, source, recvtag, comm, status );

  if (dest != MPI_PROC_NULL && returnVal == MPI_SUCCESS) {
    MPI_Type_size( sendtype, &typesize1 );
    prof_send( procid_1, dest, sendtag,
	       typesize1*sendcount, "MPI_Sendrecv" );
    MPI_Get_count( status, MPI_BYTE, &count );
    prof_recv( dest, procid_1, recvtag, count,
	       "MPI_Sendrecv" );
  }

  return returnVal;
}

int  MPI_Sendrecv_replace( buf, count, datatype, dest, sendtag, source, recvtag, comm, status )
void * buf;
int count;
MPI_Datatype datatype;
int dest;
int sendtag;
int source;
int recvtag;
MPI_Comm comm;
MPI_Status * status;
{
  int  returnVal;
  int size1;
  int typesize2;

  
  
  returnVal = PMPI_Sendrecv_replace( buf, count, datatype, dest, sendtag, source, recvtag, comm, status );

  if (dest != MPI_PROC_NULL && returnVal == MPI_SUCCESS) {
    MPI_Type_size( datatype, &typesize2 );
    prof_send( procid_1, dest, sendtag,
	       typesize2*count, "MPI_Sendrecv_replace" );
    MPI_Get_count( status, MPI_BYTE, &size1 );
    prof_recv( dest, procid_1, recvtag, size1,
	       "MPI_Sendrecv_replace" );
  }

  return returnVal;
}

int  MPI_Ssend( buf, count, datatype, dest, tag, comm )
void * buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
{
  int  returnVal;
  int typesize;

  
  
  returnVal = PMPI_Ssend( buf, count, datatype, dest, tag, comm );

  if (dest != MPI_PROC_NULL) {
    MPI_Type_size( datatype, &typesize );
    prof_send( procid_1, dest, tag, typesize*count,
	       "MPI_Ssend" );
  }

  return returnVal;
}

int  MPI_Ssend_init( buf, count, datatype, dest, tag, comm, request )
void * buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
MPI_Request * request;
{
  int  returnVal;
  request_list *newrq;
  int typesize3;

  
  
/* fprintf( stderr, "MPI_Ssend_init call on %d\n", procid_1 ); */
  
  returnVal = PMPI_Ssend_init( buf, count, datatype, dest, tag, comm, request );

  if (dest != MPI_PROC_NULL) {
      rq_alloc( requests_avail_1, newrq );
    if (newrq) {
      PMPI_Type_size( datatype, &typesize3 );
      newrq->request = *request;
      newrq->status = RQ_SEND;
      newrq->size = count * typesize3;
      newrq->tag = tag;
      newrq->otherParty = dest;
      newrq->next = 0;
      rq_add( requests_head_1, requests_tail_1, newrq );
    }
  }

  return returnVal;
}

int   MPI_Test( request, flag, status )
MPI_Request * request;
int * flag;
MPI_Status * status;
{
  int   returnVal;
  MPI_Request lreq = *request;

  
  returnVal = PMPI_Test( request, flag, status );

  if (*flag) 
    ProcessWaitTest_1( lreq, status, "MPI_Test" );

  return returnVal;
}

int  MPI_Testall( count, array_of_requests, flag, array_of_statuses )
int count;
MPI_Request * array_of_requests;
int * flag;
MPI_Status * array_of_statuses;
{
  int  returnVal;
  int i3;

  /* NEEDS WORK */
  
  returnVal = PMPI_Testall( count, array_of_requests, flag, array_of_statuses );

  if (*flag) {
    for (i3=0; i3 < count; i3++) {
      ProcessWaitTest_1( array_of_requests[i3], /* WRONG */
				  &array_of_statuses[i3],  
				  "MPI_Testall" );
    }
  }

  return returnVal;
}

int  MPI_Testany( count, array_of_requests, index, flag, status )
int count;
MPI_Request * array_of_requests;
int * index;
int * flag;
MPI_Status * status;
{
  int  returnVal;

  /* NEEDS WORK */
  
  returnVal = PMPI_Testany( count, array_of_requests, index, flag, status );

  if (*flag) 
    ProcessWaitTest_1( array_of_requests[*index], /* WRONG */
			        status, "MPI_Testany" );

  return returnVal;
}

int  MPI_Testsome( incount, array_of_requests, outcount, array_of_indices, array_of_statuses )
int incount;
MPI_Request * array_of_requests;
int * outcount;
int * array_of_indices;
MPI_Status * array_of_statuses;
{
  int  returnVal;
  int i2;

    /* NEEDS WORK */
  
  returnVal = PMPI_Testsome( incount, array_of_requests, outcount, array_of_indices, array_of_statuses );

  for (i2=0; i2 < *outcount; i2++) {
    ProcessWaitTest_1( array_of_requests
			          [array_of_indices[i2]], /* WRONG */
			        &array_of_statuses
			          [array_of_indices[i2]],
			        "MPI_Testsome" );
  }

  return returnVal;
}

int   MPI_Wait( request, status )
MPI_Request * request;
MPI_Status * status;
{
  int   returnVal;
  MPI_Request lreq = *request;
  
  returnVal = PMPI_Wait( request, status );

  ProcessWaitTest_1( lreq, status, "MPI_Wait" );

  return returnVal;
}

int  MPI_Waitall( count, array_of_requests, array_of_statuses )
int count;
MPI_Request * array_of_requests;
MPI_Status * array_of_statuses;
{
  int  returnVal;
  int i1;

  /* NEEDS WORK */
  
/* fprintf( stderr, "MPI_Waitall call on %d\n", procid_1 ); */
  
  returnVal = PMPI_Waitall( count, array_of_requests, array_of_statuses );

  for (i1=0; i1 < count; i1++) {
    ProcessWaitTest_1( array_of_requests[i1], /* WRONG */
			        &array_of_statuses[i1],
			        "MPI_Waitall" );
  }

  return returnVal;
}

int  MPI_Waitany( count, array_of_requests, index, status )
int count;
MPI_Request * array_of_requests;
int * index;
MPI_Status * status;
{
  int  returnVal;

  /* NEEDS WORK */
 
  returnVal = PMPI_Waitany( count, array_of_requests, index, status );

  ProcessWaitTest_1( array_of_requests[*index] /* WRONG */, status,
			      "MPI_Waitany" );

  return returnVal;
}

int  MPI_Waitsome( incount, array_of_requests, outcount, array_of_indices, array_of_statuses )
int incount;
MPI_Request * array_of_requests;
int * outcount;
int * array_of_indices;
MPI_Status * array_of_statuses;
{
  int  returnVal;
  int i;

  /* NEEDS WORK */
  
  returnVal = PMPI_Waitsome( incount, array_of_requests, outcount, array_of_indices, array_of_statuses );

  for (i=0; i < *outcount; i++) {
    ProcessWaitTest_1( array_of_requests
			          [array_of_indices[i]], /* WRONG */
			        &array_of_statuses
			          [array_of_indices[i]],
			        "MPI_Waitsome" );
  }

  return returnVal;
}