FORT_DLL_SPEC void FORT_CALL mpi_file_get_atomicity_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint *ierr ){
#ifdef MPI_MODE_RDONLY
int l2;
*ierr = MPI_File_get_atomicity( MPI_File_f2c(*v1), &l2 );
*v2 = MPIR_TO_FLOG(l2);
#else
*ierr = MPI_ERR_INTERN;
#endif
}
FORT_DLL_SPEC void FORT_CALL mpi_cart_get_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint *v3, MPI_Fint *v4, MPI_Fint *v5, MPI_Fint *ierr ){
*ierr = MPI_Cart_get( (MPI_Comm)(*v1), *v2, v3, v4, v5 );
{int li;
for (li=0; li<*v2; li++) {
v4[li] = MPIR_TO_FLOG(v4[li]);
}
}
}
FORTRAN_API void FORT_CALL mpi_null_copy_fn_ ( MPI_Fint comm, MPI_Fint *keyval,
void *extra_state, void *attr_in,
void *attr_out, MPI_Fint *flag,
MPI_Fint *err )
{
/* Note the we actually need to fix the comm argument, except that the
null function doesn't use it */
*flag = MPIR_TO_FLOG(0);
*err = MPI_SUCCESS;
}
FORT_DLL_SPEC void FORT_CALL mpi_testall_ ( MPI_Fint *v1, MPI_Fint v2[], MPI_Fint *v3, MPI_Fint v4[], MPI_Fint *ierr ){
int l3;
#ifndef HAVE_MPI_F_INIT_WORKS_WITH_C
if (MPIR_F_NeedInit){ mpirinitf_(); MPIR_F_NeedInit = 0; }
#endif
if (v4 == MPI_F_STATUSES_IGNORE) { v4 = (MPI_Fint *)MPI_STATUSES_IGNORE; }
*ierr = MPI_Testall( (int)*v1, (MPI_Request *)(v2), &l3, (MPI_Status *)v4 );
if (*ierr == MPI_SUCCESS) *v3 = MPIR_TO_FLOG(l3);
}
FORT_DLL_SPEC void FORT_CALL mpi_iprobe_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint *v3, MPI_Fint *v4, MPI_Fint *v5, MPI_Fint *ierr ){
int l4;
#ifndef HAVE_MPI_F_INIT_WORKS_WITH_C
if (MPIR_F_NeedInit){ mpirinitf_(); MPIR_F_NeedInit = 0; }
#endif
if (v5 == MPI_F_STATUS_IGNORE) { v5 = (MPI_Fint*)MPI_STATUS_IGNORE; }
*ierr = MPI_Iprobe( (int)*v1, (int)*v2, (MPI_Comm)(*v3), &l4, (MPI_Status *)v5 );
if (*ierr == MPI_SUCCESS) *v4 = MPIR_TO_FLOG(l4);
}
FORT_DLL_SPEC void FORT_CALL mpi_attr_get_ ( MPI_Fint *v1, MPI_Fint *v2, void*v3, MPI_Fint *v4, MPI_Fint *ierr ){
void *attrv3;
int l4;
*ierr = MPIR_CommGetAttr_fort( (MPI_Comm)(*v1), (int)*v2, &attrv3, &l4, MPIR_ATTR_INT );
if ((int)*ierr || !l4) {
*(MPI_Fint*)v3 = 0;
}
else {
*(MPI_Fint*)v3 = (MPI_Fint)(MPIR_Pint)attrv3;
}
if (*ierr == MPI_SUCCESS) *v4 = MPIR_TO_FLOG(l4);
}
FORT_DLL_SPEC void FORT_CALL mpi_win_get_attr_ ( MPI_Fint *v1, MPI_Fint *v2, void*v3, MPI_Fint *v4, MPI_Fint *ierr ){
void *attrv3;
int l4;
*ierr = MPIR_WinGetAttr( (MPI_Win)*v1, (int)*v2, &attrv3, &l4, MPIR_ATTR_AINT );
if ((int)*ierr || !l4) {
*(MPI_Aint*)v3 = 0;
}
else {
*(MPI_Aint*)v3 = (MPI_Aint)attrv3;
}
if (*ierr == MPI_SUCCESS) *v4 = MPIR_TO_FLOG(l4);
}
FORT_DLL_SPEC void FORT_CALL mpi_testany_ ( MPI_Fint *v1, MPI_Fint v2[], MPI_Fint *v3, MPI_Fint *v4, MPI_Fint *v5, MPI_Fint *ierr ){
int l3;
int l4;
#ifndef HAVE_MPI_F_INIT_WORKS_WITH_C
if (MPIR_F_NeedInit){ mpirinitf_(); MPIR_F_NeedInit = 0; }
#endif
if (v5 == MPI_F_STATUS_IGNORE) { v5 = (MPI_Fint*)MPI_STATUS_IGNORE; }
*ierr = MPI_Testany( (int)*v1, (MPI_Request *)(v2), &l3, &l4, (MPI_Status *)v5 );
*v3 = (MPI_Fint)l3;
if (l3 >= 0) *v3 = *v3 + 1;
if (*ierr == MPI_SUCCESS) *v4 = MPIR_TO_FLOG(l4);
}
EXPORT_MPI_API void FORTRAN_API mpi_attr_get_ ( MPI_Fint *comm, MPI_Fint *keyval, MPI_Fint *attr_value, MPI_Fint *found, MPI_Fint *__ierr )
{
void *vval;
int l_found;
*__ierr = MPI_Attr_get( MPI_Comm_f2c(*comm), (int)*keyval, &vval,
&l_found);
/* Convert attribute value to integer. This code handles the case
where sizeof(int) < sizeof(void *), and the value was stored as a
void *
*/
if ((int)*__ierr || l_found == 0)
*attr_value = 0;
else {
MPI_Aint lvval = (MPI_Aint)vval;
*attr_value = (int)lvval;
}
*found = MPIR_TO_FLOG(l_found);
return;
}
EXPORT_MPI_API void FORTRAN_API mpi_comm_test_inter_ ( MPI_Fint *comm, MPI_Fint *flag, MPI_Fint *__ierr )
{
int l_flag;
*__ierr = MPI_Comm_test_inter( MPI_Comm_f2c(*comm), &l_flag);
*flag = MPIR_TO_FLOG(l_flag);
}
FORT_DLL_SPEC void FORT_CALL mpi_comm_null_copy_fn_ ( MPI_Fint*v1, MPI_Fint*v2, MPI_Aint *v3, MPI_Aint *v4, MPI_Aint *v5, MPI_Fint *v6, MPI_Fint *ierr ){
*ierr = MPI_SUCCESS;
*v6 = MPIR_TO_FLOG(0);
}
FORT_DLL_SPEC void FORT_CALL mpi_comm_test_inter_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint *ierr ){
int l2;
*ierr = MPI_Comm_test_inter( (MPI_Comm)(*v1), &l2 );
if (*ierr == MPI_SUCCESS) *v2 = MPIR_TO_FLOG(l2);
}
FORT_DLL_SPEC void FORT_CALL mpi_win_test_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint *ierr ){
int l2;
*ierr = MPI_Win_test( (MPI_Win)*v1, &l2 );
if (*ierr == MPI_SUCCESS) *v2 = MPIR_TO_FLOG(l2);
}
FORT_DLL_SPEC void FORT_CALL mpi_win_dup_fn_ ( MPI_Fint v1, MPI_Fint*v2, void*v3, MPI_Aint *v4, MPI_Aint *v5, MPI_Fint*v6, MPI_Fint *ierr ){
*v5 = *v4;
*v6 = MPIR_TO_FLOG(1);
*ierr = MPI_SUCCESS;
}
FORT_DLL_SPEC void FORT_CALL mpi_finalized_ ( MPI_Fint *v1, MPI_Fint *ierr ) {
int l1;
*ierr = MPI_Finalized( &l1 );
if (*ierr == MPI_SUCCESS) *v1 = MPIR_TO_FLOG(l1);
}
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_test_cancelled_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint *ierr ){
int l2;
*ierr = MPI_Test_cancelled( (MPI_Status *)(v1), &l2 );
*v2 = MPIR_TO_FLOG(l2);
}
FORT_DLL_SPEC void FORT_CALL mpi_is_thread_main_ ( MPI_Fint *v1, MPI_Fint *ierr ){
int l1;
*ierr = MPI_Is_thread_main( &l1 );
if (*ierr == MPI_SUCCESS) *v1 = MPIR_TO_FLOG(l1);
}
