MPI_Fint MPIO_File_c2f(MPI_File fh)
{
#ifndef INT_LT_POINTER
return (MPI_Fint) fh;
#else
int i;
if ((fh <= (MPI_File) 0) || (fh->cookie != ADIOI_FILE_COOKIE))
return (MPI_Fint) 0;
if (fh->fortran_handle != -1)
return fh->fortran_handle;
if (!ADIOI_Ftable) {
ADIOI_Ftable_max = 1024;
ADIOI_Ftable = (MPI_File *)
ADIOI_Malloc(ADIOI_Ftable_max*sizeof(MPI_File));
ADIOI_Ftable_ptr = 0; /* 0 can't be used though, because
MPI_FILE_NULL=0 */
for (i=0; i<ADIOI_Ftable_max; i++) ADIOI_Ftable[i] = MPI_FILE_NULL;
}
if (ADIOI_Ftable_ptr == ADIOI_Ftable_max-1) {
ADIOI_Ftable = (MPI_File *) ADIOI_Realloc(ADIOI_Ftable,
(ADIOI_Ftable_max+1024)*sizeof(MPI_File));
for (i=ADIOI_Ftable_max; i<ADIOI_Ftable_max+1024; i++)
ADIOI_Ftable[i] = MPI_FILE_NULL;
ADIOI_Ftable_max += 1024;
}
ADIOI_Ftable_ptr++;
ADIOI_Ftable[ADIOI_Ftable_ptr] = fh;
fh->fortran_handle = ADIOI_Ftable_ptr;
return (MPI_Fint) ADIOI_Ftable_ptr;
#endif
}
/*@
MPI_Info_c2f - Translates a C info handle to a Fortran info handle
Input Parameters:
. info - C info handle (integer)
Return Value:
Fortran info handle (handle)
@*/
MPI_Fint MPI_Info_c2f(MPI_Info info)
{
#ifndef INT_LT_POINTER
return (MPI_Fint) info;
#else
int i;
if ((info <= (MPI_Info) 0) || (info->cookie != MPIR_INFO_COOKIE))
return (MPI_Fint) 0;
if (!MPIR_Infotable) {
MPIR_Infotable_max = 1024;
MPIR_Infotable = (MPI_Info *)
ADIOI_Malloc(MPIR_Infotable_max*sizeof(MPI_Info));
MPIR_Infotable_ptr = 0; /* 0 can't be used though, because
MPI_INFO_NULL=0 */
for (i=0; i<MPIR_Infotable_max; i++) MPIR_Infotable[i] = MPI_INFO_NULL;
}
if (MPIR_Infotable_ptr == MPIR_Infotable_max-1) {
MPIR_Infotable = (MPI_Info *) ADIOI_Realloc(MPIR_Infotable,
(MPIR_Infotable_max+1024)*sizeof(MPI_Info));
for (i=MPIR_Infotable_max; i<MPIR_Infotable_max+1024; i++)
MPIR_Infotable[i] = MPI_INFO_NULL;
MPIR_Infotable_max += 1024;
}
MPIR_Infotable_ptr++;
MPIR_Infotable[MPIR_Infotable_ptr] = info;
return (MPI_Fint) MPIR_Infotable_ptr;
#endif
}
MPI_Fint MPIO_Request_c2f(MPIO_Request request)
{
#ifndef INT_LT_POINTER
return (MPI_Fint) request;
#else
int i;
MPID_CS_ENTER();
if ((request <= (MPIO_Request) 0) || (request->cookie != ADIOI_REQ_COOKIE))
{
MPID_CS_EXIT();
return (MPI_Fint) 0;
}
if (!ADIOI_Reqtable) {
ADIOI_Reqtable_max = 1024;
ADIOI_Reqtable = (MPIO_Request *)
ADIOI_Malloc(ADIOI_Reqtable_max*sizeof(MPIO_Request));
ADIOI_Reqtable_ptr = 0; /* 0 can't be used though, because
MPIO_REQUEST_NULL=0 */
for (i=0; i<ADIOI_Reqtable_max; i++) ADIOI_Reqtable[i] = MPIO_REQUEST_NULL;
}
if (ADIOI_Reqtable_ptr == ADIOI_Reqtable_max-1) {
ADIOI_Reqtable = (MPIO_Request *) ADIOI_Realloc(ADIOI_Reqtable,
(ADIOI_Reqtable_max+1024)*sizeof(MPIO_Request));
for (i=ADIOI_Reqtable_max; i<ADIOI_Reqtable_max+1024; i++)
ADIOI_Reqtable[i] = MPIO_REQUEST_NULL;
ADIOI_Reqtable_max += 1024;
}
ADIOI_Reqtable_ptr++;
ADIOI_Reqtable[ADIOI_Reqtable_ptr] = request;
MPID_CS_EXIT();
return (MPI_Fint) ADIOI_Reqtable_ptr;
#endif
}
/* Sets error_code to MPI_SUCCESS if successful, or creates an error code
* in the case of error.
*/
static void ADIOI_LUSTRE_W_Exchange_data(ADIO_File fd, const void *buf,
char *write_buf,
ADIOI_Flatlist_node *flat_buf,
ADIO_Offset *offset_list,
ADIO_Offset *len_list, int *send_size,
int *recv_size, ADIO_Offset off,
int size, int *count,
int *start_pos,
int *sent_to_proc, int nprocs,
int myrank, int buftype_is_contig,
int contig_access_count,
int *striping_info,
ADIOI_Access *others_req,
int *send_buf_idx,
int *curr_to_proc, int *done_to_proc,
int *hole, int iter,
MPI_Aint buftype_extent,
int *buf_idx,
ADIO_Offset **srt_off, int **srt_len, int *srt_num,
int *error_code)
{
int i, j, nprocs_recv, nprocs_send, err;
char **send_buf = NULL;
MPI_Request *requests, *send_req;
MPI_Datatype *recv_types;
MPI_Status *statuses, status;
int sum_recv;
int data_sieving = *hole;
static char myname[] = "ADIOI_W_EXCHANGE_DATA";
/* create derived datatypes for recv */
nprocs_recv = 0;
for (i = 0; i < nprocs; i++)
if (recv_size[i])
nprocs_recv++;
recv_types = (MPI_Datatype *) ADIOI_Malloc((nprocs_recv + 1) *
sizeof(MPI_Datatype));
/* +1 to avoid a 0-size malloc */
j = 0;
for (i = 0; i < nprocs; i++) {
if (recv_size[i]) {
ADIOI_Type_create_hindexed_x(count[i],
&(others_req[i].lens[start_pos[i]]),
&(others_req[i].mem_ptrs[start_pos[i]]),
MPI_BYTE, recv_types + j);
/* absolute displacements; use MPI_BOTTOM in recv */
MPI_Type_commit(recv_types + j);
j++;
}
}
/* To avoid a read-modify-write,
* check if there are holes in the data to be written.
* For this, merge the (sorted) offset lists others_req using a heap-merge.
*/
*srt_num = 0;
for (i = 0; i < nprocs; i++)
*srt_num += count[i];
if (*srt_off)
*srt_off = (ADIO_Offset *) ADIOI_Realloc(*srt_off, (*srt_num + 1) * sizeof(ADIO_Offset));
else
*srt_off = (ADIO_Offset *) ADIOI_Malloc((*srt_num + 1) * sizeof(ADIO_Offset));
if (*srt_len)
*srt_len = (int *) ADIOI_Realloc(*srt_len, (*srt_num + 1) * sizeof(int));
else
*srt_len = (int *) ADIOI_Malloc((*srt_num + 1) * sizeof(int));
/* +1 to avoid a 0-size malloc */
ADIOI_Heap_merge(others_req, count, *srt_off, *srt_len, start_pos,
nprocs, nprocs_recv, *srt_num);
/* check if there are any holes */
*hole = 0;
for (i = 0; i < *srt_num - 1; i++) {
if ((*srt_off)[i] + (*srt_len)[i] < (*srt_off)[i + 1]) {
*hole = 1;
break;
}
}
/* In some cases (see John Bent ROMIO REQ # 835), an odd interaction
* between aggregation, nominally contiguous regions, and cb_buffer_size
* should be handled with a read-modify-write (otherwise we will write out
* more data than we receive from everyone else (inclusive), so override
* hole detection
*/
if (*hole == 0) {
sum_recv = 0;
for (i = 0; i < nprocs; i++)
sum_recv += recv_size[i];
if (size > sum_recv)
*hole = 1;
}
/* check the hint for data sieving */
if (data_sieving == ADIOI_HINT_ENABLE && nprocs_recv && *hole) {
ADIO_ReadContig(fd, write_buf, size, MPI_BYTE,
ADIO_EXPLICIT_OFFSET, off, &status, &err);
// --BEGIN ERROR HANDLING--
if (err != MPI_SUCCESS) {
*error_code = MPIO_Err_create_code(err,
MPIR_ERR_RECOVERABLE,
myname, __LINE__,
MPI_ERR_IO,
"**ioRMWrdwr", 0);
ADIOI_Free(recv_types);
return;
}
// --END ERROR HANDLING--
}
nprocs_send = 0;
for (i = 0; i < nprocs; i++)
if (send_size[i])
nprocs_send++;
if (fd->atomicity) {
/* bug fix from Wei-keng Liao and Kenin Coloma */
requests = (MPI_Request *) ADIOI_Malloc((nprocs_send + 1) *
sizeof(MPI_Request));
send_req = requests;
} else {
requests = (MPI_Request *) ADIOI_Malloc((nprocs_send + nprocs_recv + 1)*
sizeof(MPI_Request));
/* +1 to avoid a 0-size malloc */
/* post receives */
j = 0;
for (i = 0; i < nprocs; i++) {
if (recv_size[i]) {
MPI_Irecv(MPI_BOTTOM, 1, recv_types[j], i,
myrank + i + 100 * iter, fd->comm, requests + j);
j++;
}
}
send_req = requests + nprocs_recv;
}
/* post sends.
* if buftype_is_contig, data can be directly sent from
* user buf at location given by buf_idx. else use send_buf.
*/
if (buftype_is_contig) {
j = 0;
for (i = 0; i < nprocs; i++)
if (send_size[i]) {
ADIOI_Assert(buf_idx[i] != -1);
MPI_Isend(((char *) buf) + buf_idx[i], send_size[i],
MPI_BYTE, i, myrank + i + 100 * iter, fd->comm,
send_req + j);
j++;
}
} else
if (nprocs_send) {
/* buftype is not contig */
send_buf = (char **) ADIOI_Malloc(nprocs * sizeof(char *));
for (i = 0; i < nprocs; i++)
if (send_size[i])
send_buf[i] = (char *) ADIOI_Malloc(send_size[i]);
ADIOI_LUSTRE_Fill_send_buffer(fd, buf, flat_buf, send_buf, offset_list,
len_list, send_size, send_req,
sent_to_proc, nprocs, myrank,
contig_access_count, striping_info,
send_buf_idx, curr_to_proc, done_to_proc,
iter, buftype_extent);
/* the send is done in ADIOI_Fill_send_buffer */
}
/* bug fix from Wei-keng Liao and Kenin Coloma */
if (fd->atomicity) {
j = 0;
for (i = 0; i < nprocs; i++) {
MPI_Status wkl_status;
if (recv_size[i]) {
MPI_Recv(MPI_BOTTOM, 1, recv_types[j], i,
myrank + i + 100 * iter, fd->comm, &wkl_status);
j++;
}
}
}
for (i = 0; i < nprocs_recv; i++)
MPI_Type_free(recv_types + i);
ADIOI_Free(recv_types);
/* bug fix from Wei-keng Liao and Kenin Coloma */
/* +1 to avoid a 0-size malloc */
if (fd->atomicity) {
statuses = (MPI_Status *) ADIOI_Malloc((nprocs_send + 1) *
sizeof(MPI_Status));
} else {
statuses = (MPI_Status *) ADIOI_Malloc((nprocs_send + nprocs_recv + 1) *
sizeof(MPI_Status));
}
#ifdef NEEDS_MPI_TEST
i = 0;
if (fd->atomicity) {
/* bug fix from Wei-keng Liao and Kenin Coloma */
while (!i)
MPI_Testall(nprocs_send, send_req, &i, statuses);
} else {
while (!i)
MPI_Testall(nprocs_send + nprocs_recv, requests, &i, statuses);
}
#else
/* bug fix from Wei-keng Liao and Kenin Coloma */
if (fd->atomicity)
MPI_Waitall(nprocs_send, send_req, statuses);
else
MPI_Waitall(nprocs_send + nprocs_recv, requests, statuses);
#endif
ADIOI_Free(statuses);
ADIOI_Free(requests);
if (!buftype_is_contig && nprocs_send) {
for (i = 0; i < nprocs; i++)
if (send_size[i])
ADIOI_Free(send_buf[i]);
ADIOI_Free(send_buf);
}
}
