/* Helper proxy function to thunk the attr copy function call into F90 calling convention */
static
int
MPIR_Win_copy_attr_f90_proxy(
MPI_Win_copy_attr_function* user_function,
MPI_Win win,
int keyval,
void* extra_state,
MPIR_AttrType value_type,
void* value,
void** new_value,
int* flag
)
{
MPI_Fint ierr = 0;
MPI_Fint fhandle = (MPI_Fint)win;
MPI_Fint fkeyval = (MPI_Fint)keyval;
MPI_Aint fvalue = MPI_VOID_PTR_CAST_TO_MPI_AINT (value);
MPI_Aint* fextra = (MPI_Aint*)extra_state;
MPI_Aint fnew = 0;
MPI_Fint fflag = 0;
((F90_CopyFunction*)user_function)( &fhandle, &fkeyval, fextra, &fvalue, &fnew, &fflag, &ierr );
*flag = MPIR_FROM_FLOG(fflag);
*new_value = MPI_AINT_CAST_TO_VOID_PTR (fnew);
return (int)ierr;
}
FORT_DLL_SPEC void FORT_CALL mpi_dist_graph_create_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint v3[], MPI_Fint v4[], MPI_Fint v5[], MPI_Fint v6[], MPI_Fint *v7, MPI_Fint *v8, MPI_Fint *v9, MPI_Fint *ierr ){
int l8;
#ifndef HAVE_MPI_F_INIT_WORKS_WITH_C
if (MPIR_F_NeedInit){ mpirinitf_(); MPIR_F_NeedInit = 0; }
#endif
if (v6 == MPIR_F_MPI_UNWEIGHTED) v6 = MPI_UNWEIGHTED;
else if (v6 == MPIR_F_MPI_WEIGHTS_EMPTY) v6 = MPI_WEIGHTS_EMPTY;
l8 = MPIR_FROM_FLOG(*v8);
*ierr = MPI_Dist_graph_create( (MPI_Comm)(*v1), (int)*v2, v3, v4, v5, v6, (MPI_Info)(*v7), l8, (MPI_Comm *)(v9) );
}
FORTRAN_API void FORT_CALL mpi_cart_map_ ( MPI_Fint *comm_old, MPI_Fint *ndims, MPI_Fint *dims, MPI_Fint *periods, MPI_Fint *newrank, MPI_Fint *__ierr )
{
int lperiods[20], i;
int ldims[20];
int lnewrank;
static char myname[] = "MPI_CART_MAP";
if ((int)*ndims > 20) {
struct MPIR_COMMUNICATOR *comm_old_ptr;
comm_old_ptr = MPIR_GET_COMM_PTR(MPI_Comm_f2c(*comm_old));
*__ierr = MPIR_Err_setmsg( MPI_ERR_DIMS, MPIR_ERR_DIMS_TOOLARGE,
myname, (char *)0, (char *)0,
(int)*ndims, 20 );
*__ierr = MPIR_ERROR( comm_old_ptr, *__ierr, myname );
return;
}
for (i=0; i<(int)*ndims; i++) {
lperiods[i] = MPIR_FROM_FLOG(periods[i]);
ldims[i] = (int)dims[i];
}
*__ierr = MPI_Cart_map( MPI_Comm_f2c(*comm_old), (int)*ndims, ldims,
lperiods, &lnewrank);
*newrank = (MPI_Fint)lnewrank;
}
void MPICH_DEFAULT_LXOR(void *invec,
void *inoutvec, int *Len, MPI_Datatype *type)
{
int i, len = *Len;
switch (*type) {
case MPIR_INT:{
int *a = (int *) inoutvec;
int *b = (int *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
case MPIR_UINT:{
unsigned *a = (unsigned *) inoutvec;
unsigned *b = (unsigned *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
case MPIR_LONG:{
long *a = (long *) inoutvec;
long *b = (long *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
#if defined(HAVE_LONG_LONG_INT)
case MPIR_LONGLONGINT:{
long long *a = (long long *) inoutvec;
long long *b = (long long *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
#endif
case MPIR_ULONG:{
unsigned long *a = (unsigned long *) inoutvec;
unsigned long *b = (unsigned long *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
case MPIR_SHORT:{
short *a = (short *) inoutvec;
short *b = (short *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
case MPIR_USHORT:{
unsigned short *a = (unsigned short *) inoutvec;
unsigned short *b = (unsigned short *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
case MPIR_CHAR:{
char *a = (char *) inoutvec;
char *b = (char *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
case MPIR_UCHAR:
case MPI_BYTE:{
unsigned char *a = (unsigned char *) inoutvec;
unsigned char *b = (unsigned char *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
case MPIR_FLOAT:{
float *a = (float *) inoutvec;
float *b = (float *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
case MPIR_DOUBLE:{
double *a = (double *) inoutvec;
double *b = (double *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
#if defined(HAVE_LONG_DOUBLE)
case MPIR_LONGDOUBLE:{
long double *a = (long double *) inoutvec;
long double *b = (long double *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_LLXOR(a[i], b[i]);
break;
}
#endif
case MPIR_LOGICAL:{
MPI_Fint *a = (MPI_Fint *) inoutvec;
MPI_Fint *b = (MPI_Fint *) invec;
for (i = 0; i < len; i++)
a[i] = MPIR_TO_FLOG(MPIR_LLXOR(MPIR_FROM_FLOG(a[i]), MPIR_FROM_FLOG(b[i])));
break;
}
default:
MPIR_Op_errno = MPIR_ERR_OP_NOT_DEFINED;
MPIR_ERROR(MPIR_COMM_WORLD, MPIR_ERR_OP_NOT_DEFINED,
"MPI_LXOR");
break;
}
}
FORT_DLL_SPEC void FORT_CALL mpi_graph_create_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint v3[], MPI_Fint v4[], MPI_Fint *v5, MPI_Fint *v6, MPI_Fint *ierr ){
int l5;
l5 = MPIR_FROM_FLOG(*v5);
*ierr = MPI_Graph_create( (MPI_Comm)(*v1), (int)*v2, v3, v4, l5, (MPI_Comm *)(v6) );
}
FORT_DLL_SPEC void FORT_CALL mpi_op_create_ ( MPI_User_function*v1, MPI_Fint *v2, MPI_Fint *v3, MPI_Fint *ierr ){
int l2;
l2 = MPIR_FROM_FLOG(*v2);
*ierr = MPI_Op_create( v1, l2, v3 );
}
