ports/openmpi
ports/openmpi
1
1
Форкнуть 0
Код Релизы Активность

- Implement correct Fortran Logical-handling in f77/f90 interface in

Просмотр исходного кода 
case of:
    sizeof(MPI_Flogical) != sizeof (int)
  and
    Fortran value of .TRUE. != 1
  as is often the case.
- Check in configure the value of .TRUE., the C-type coresponding to
  logical and check, that fortran compiler does not do something strange
  with arrays of logicals
- Convert all occurrences of logicals in the fortran wrappers, only
  in case it is needed.
  *Please note* Implementation of MPI_Cart_sub needed special treatment.
- Output these value in ompi_info -a
- Clean up the prototypes_mpi.h to just have a single definition and
  thereby deleting the necessity for prototypes_pmpi.h

- configured, compiled and tested with F90-program, which uses
  MPI_Cart_create and MPI_Cart_get:
  linux ia32, gcc (no testing, as no f90)
  linux ia32, gcc --disable-mpi-f77 --disable-mpi-f90 (had a bug there)
  linux ia32, icc-8.1
  linux opteron, gcc-3.3.5, pgcc, pathccx/pathf90 (tested just
pgi-compiler)
  linux em64t, gcc, icc-8.1 (tested just icc)

This commit was SVN r8254.
Этот коммит содержится в:
Rainer Keller 2005-11-24 16:52:35 +00:00
родитель 00c10a6372
Коммит bf0892bb32
40 изменённых файлов: 891 добавлений и 3241 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

2
acinclude.m4
Просмотреть файл

@ -36,6 +36,8 @@ m4_include(config/f77_find_ext_symbol_convention.m4)
m4_include(config/f77_get_alignment.m4)
m4_include(config/f77_get_fortran_handle_max.m4)
m4_include(config/f77_get_sizeof.m4)
m4_include(config/f77_get_value_true.m4)
m4_include(config/f77_check_logical_array.m4)
m4_include(config/f77_purge_unsupported_kind.m4)
m4_include(config/f90_check_type.m4)

137
config/f77_check_logical_array.m4 Обычный файл
Просмотреть файл

@ -0,0 +1,137 @@
dnl -*- shell-script -*-
dnl
dnl Copyright (c) 2004-2005 The Trustees of Indiana University.
dnl All rights reserved.
dnl Copyright (c) 2004-2005 The Trustees of the University of Tennessee.
dnl All rights reserved.
dnl Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
dnl University of Stuttgart. All rights reserved.
dnl Copyright (c) 2004-2005 The Regents of the University of California.
dnl All rights reserved.
dnl $COPYRIGHT$
dnl
dnl Additional copyrights may follow
dnl
dnl $HEADER$
dnl
AC_DEFUN([OMPI_F77_CHECK_LOGICAL_ARRAY],[
AC_MSG_CHECKING([for correct handling of FORTRAN logical arrays])
if test "$1" = "none" -o "$OMPI_WANT_F77_BINDINGS" = "0"; then
AC_MSG_RESULT([no Fortran 77 bindings -- skipped])
else
if test "x$ompi_ac_doubleunder" = xy || test "x$ompi_ac_singleunder" = xy; then
ompi_ac_check_logical_fn=check_
else
if test "x$ompi_ac_nounder" = xy; then
ompi_ac_check_logical_fn=check
else
if test "x$ompi_ac_caps" = xy; then
ompi_ac_check_logical_fn=CHECK
else
AC_MSG_WARN([*** FORTRAN external naming convention undefined])
AC_MSG_ERROR([*** Cannot continue.])
fi
fi
fi
#
# Cannot use standard AC_TRY macros because we need two different .o
# files here, and link them together
#
#
# Fortran module
#
cat > conftestf.f <<EOF
program check_logical_array
external CHECK
logical l(2)
l(1)=.FALSE.
l(2)=.TRUE.
CALL CHECK(l)
end
EOF
#
# C module
# We really need the confdefs.h Header file for
# the ompi_fortran_logical_t definition
#
if test \! -f confdefs.h ; then
AC_MSG_WARN([*** Problem running configure test!])
AC_MSG_WARN([*** Cannot find confdefs.h file for config test])
AC_MSG_WARN([*** See config.log for details.])
AC_MSG_ERROR([*** Cannot continue.])
fi
cat > conftest.c <<EOF
#include <stdio.h>
#include <stdlib.h>
#include "confdefs.h"
#ifdef __cplusplus
extern "C" {
#endif
void $ompi_ac_check_logical_fn(ompi_fortran_logical_t * logical);
void $ompi_ac_check_logical_fn(ompi_fortran_logical_t * logical)
{
int result = 0;
FILE *f=fopen("conftestval", "w");
if (!f) exit(1);
if (logical[[0]] == 0 &&
logical[[1]] == $ompi_ac_value_true)
result = 1;
fprintf(f, "%d\n", result);
}
#ifdef __cplusplus
}
#endif
EOF
#
# Try the compilation and run. Can't use AC_TRY_RUN because it's two
# module files.
#
OMPI_LOG_COMMAND([$CC $CFLAGS -I. -c conftest.c],
OMPI_LOG_COMMAND([$F77 $FFLAGS conftestf.f conftest.o -o conftest $LDFLAGS $LIBS],
OMPI_LOG_COMMAND([./conftest],[HAPPY=1],[HAPPY=0]),
[HAPPY=0]),
[HAPPY=0])
if test "$HAPPY" = "1" -a -f conftestval; then
ompi_result=`cat conftestval`
if test "$ompi_result" = "1"; then
AC_MSG_RESULT([yes])
else
AC_MSG_RESULT([no])
AC_MSG_WARN([*** Problem running configure test!])
AC_MSG_WARN([*** See config.log for details.])
AC_MSG_ERROR([*** Cannot continue.])
fi
else
AC_MSG_RESULT([unknown])
OMPI_LOG_MSG([here is the C program:], 1)
OMPI_LOG_FILE([conftest.c])
if test -f conftest.h; then
OMPI_LOG_MSG([here is contest.h:], 1)
OMPI_LOG_FILE([conftest.h])
fi
OMPI_LOG_MSG([here is the fortran program:], 1)
OMPI_LOG_FILE([conftestf.f])
AC_MSG_WARN([*** Problem running configure test!])
AC_MSG_WARN([*** See config.log for details.])
AC_MSG_ERROR([*** Cannot continue.])
fi
unset HAPPY ompi_result
/bin/rm -f conftest*
fi
])dnl

68
config/f77_get_value_true.m4 Обычный файл
Просмотреть файл

@ -0,0 +1,68 @@
dnl -*- shell-script -*-
dnl
dnl Copyright (c) 2004-2005 The Trustees of Indiana University.
dnl All rights reserved.
dnl Copyright (c) 2004-2005 The Trustees of the University of Tennessee.
dnl All rights reserved.
dnl Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
dnl University of Stuttgart. All rights reserved.
dnl Copyright (c) 2004-2005 The Regents of the University of California.
dnl All rights reserved.
dnl $COPYRIGHT$
dnl
dnl Additional copyrights may follow
dnl
dnl $HEADER$
dnl
AC_DEFUN([OMPI_F77_GET_VALUE_TRUE],[
# Determine the value of .TRUE. of this FORTRAN compiler.
AC_MSG_CHECKING([FORTRAN value for .TRUE. logical type])
if test "$1" = "none" -o "$OMPI_WANT_F77_BINDINGS" = "0"; then
OMPI_FORTRAN_VALUE_TRUE=0
AC_MSG_RESULT([no Fortran 77 bindings -- skipped])
else
cat > conftestf.f <<EOF
program main
logical value
open(8, file="conftestval")
value=.TRUE.
write(8, fmt="(I5)") value
close(8)
end
EOF
#
# Try the compilation and run.
#
OMPI_LOG_COMMAND([$F77 $FFLAGS -o conftest conftestf.f],
OMPI_LOG_COMMAND([./conftest], [HAPPY=1], [HAPPY=0]),
[HAPPY=0])
if test "$HAPPY" = "1" -a -f conftestval; then
# get rid of leading spaces for eval assignment
ompi_ac_value_true=`sed 's/ *//' conftestval`
OMPI_FORTRAN_VALUE_TRUE=$ompi_ac_value_true
AC_MSG_RESULT([$ompi_ac_value_true])
else
AC_MSG_RESULT([unknown])
OMPI_LOG_MSG([here is the fortran program:], 1)
OMPI_LOG_FILE([conftestf.f90])
AC_MSG_WARN([*** Problem running configure test!])
AC_MSG_WARN([*** See config.log for details.])
AC_MSG_ERROR([*** Cannot continue.])
fi
unset HAPPY
/bin/rm -f conftest*
fi
AC_DEFINE_UNQUOTED(OMPI_FORTRAN_VALUE_TRUE,
$OMPI_FORTRAN_VALUE_TRUE,
[Fortran value for LOGICAL .TRUE. value])
])dnl

8
configure.ac
Просмотреть файл

@ -515,6 +515,14 @@ OMPI_F77_CHECK(COMPLEX*32, COMPLEX32, [], no, [], 32)
OMPI_F77_GET_FORTRAN_HANDLE_MAX
#
# Check for Fortran compilers value of TRUE and for the correct assumption
# on LOGICAL for conversion into what C considers to be a true value
#
OMPI_F77_GET_VALUE_TRUE
OMPI_F77_CHECK_LOGICAL_ARRAY
#
# There are 2 layers to the MPI f77 layer. The only extra thing that
# determine f77 bindings is that fortran can be disabled by user. In

3
include/ompi_config_bottom.h
Просмотреть файл

@ -80,6 +80,9 @@
/* MPI_Fint is the same as ompi_fortran_INTEGER_t */
#define MPI_Fint ompi_fortran_integer_t
/* MPI_Flogical is the same as the ompi_fortran_logical_t */
#define MPI_Flogical ompi_fortran_logical_t
/* Do we have thread support? */
#define OMPI_HAVE_THREAD_SUPPORT (OMPI_ENABLE_MPI_THREADS || OMPI_ENABLE_PROGRESS_THREADS)

6
ompi/mpi/f77/address_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_ADDRESS,
pmpi_address_,
pmpi_address__,
pmpi_address_f,
(char *location, MPI_Fint *address, MPI_Fint *ierr),
(char *location, MPI_Aint *address, MPI_Fint *ierr),
(location, address, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_ADDRESS,
mpi_address_,
mpi_address__,
mpi_address_f,
(char *location, MPI_Fint *address, MPI_Fint *ierr),
(char *location, MPI_Aint *address, MPI_Fint *ierr),
(location, address, ierr) )
#endif
@ -57,7 +57,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_ADDRESS,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_address_f(char *location, MPI_Fint *address, MPI_Fint *ierr)
void mpi_address_f(char *location, MPI_Aint *address, MPI_Fint *ierr)
{
MPI_Aint addr;

21
ompi/mpi/f77/attr_get_f.c
Просмотреть файл

@ -33,7 +33,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_ATTR_GET,
pmpi_attr_get_,
pmpi_attr_get__,
pmpi_attr_get_f,
(MPI_Fint *comm, MPI_Fint *keyval, MPI_Fint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Fint *keyval, MPI_Fint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr),
(comm, keyval, attribute_val, flag, ierr) )
#endif
@ -50,7 +50,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_ATTR_GET,
mpi_attr_get_,
mpi_attr_get__,
mpi_attr_get_f,
(MPI_Fint *comm, MPI_Fint *keyval, MPI_Fint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Fint *keyval, MPI_Fint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr),
(comm, keyval, attribute_val, flag, ierr) )
#endif
@ -60,18 +60,17 @@ OMPI_GENERATE_F77_BINDINGS (MPI_ATTR_GET,
#endif
void mpi_attr_get_f(MPI_Fint *comm, MPI_Fint *keyval,
MPI_Fint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr)
MPI_Fint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr)
{
int c_err, c_flag;
MPI_Comm c_comm = MPI_Comm_f2c(*comm);
OMPI_LOGICAL_NAME_DECL(flag);
/* This stuff is very confusing. Be sure to see the comment at
the top of src/attributes/attributes.c. */
c_err = ompi_attr_get_fortran_mpi1(c_comm->c_keyhash,
OMPI_FINT_2_INT(*keyval),
attribute_val,
&c_flag);
*ierr = OMPI_INT_2_FINT(c_err);
*flag = OMPI_INT_2_FINT(c_flag);
*ierr = OMPI_INT_2_FINT(ompi_attr_get_fortran_mpi1(c_comm->c_keyhash,
OMPI_FINT_2_INT(*keyval),
attribute_val,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
OMPI_SINGLE_INT_2_LOGICAL(flag);
}

3
ompi/mpi/f77/bindings.h
Просмотреть файл

@ -51,10 +51,11 @@
* top-level always builds MPI_* bindings and bottom level will always build
* PMPI_* bindings. This means that top-level includes "src/mpi/interface/f77"
* .h files and lower-level includes "src/mpi/interface/f77/profile" .h files
*
* Both prototypes for all MPI- PMPI functions is moved into prototypes_mpi.h
*/
#include "mpi/f77/prototypes_mpi.h"
#include "mpi/f77/profile/prototypes_pmpi.h"
#include "mpi/f77/fint_2_int.h"

26
ompi/mpi/f77/cart_create_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_CART_CREATE,
pmpi_cart_create_,
pmpi_cart_create__,
pmpi_cart_create_f,
(MPI_Fint *old_comm, MPI_Fint *ndims, MPI_Fint *dims, MPI_Fint *periods, MPI_Fint *reorder, MPI_Fint *comm_cart, MPI_Fint *ierr),
(MPI_Fint *old_comm, MPI_Fint *ndims, MPI_Fint *dims, MPI_Flogical *periods, MPI_Flogical *reorder, MPI_Fint *comm_cart, MPI_Fint *ierr),
(old_comm, ndims, dims, periods, reorder, comm_cart, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_CART_CREATE,
mpi_cart_create_,
mpi_cart_create__,
mpi_cart_create_f,
(MPI_Fint *old_comm, MPI_Fint *ndims, MPI_Fint *dims, MPI_Fint *periods, MPI_Fint *reorder, MPI_Fint *comm_cart, MPI_Fint *ierr),
(MPI_Fint *old_comm, MPI_Fint *ndims, MPI_Fint *dims, MPI_Flogical *periods, MPI_Flogical *reorder, MPI_Fint *comm_cart, MPI_Fint *ierr),
(old_comm, ndims, dims, periods, reorder, comm_cart, ierr) )
#endif
@ -58,30 +58,34 @@ OMPI_GENERATE_F77_BINDINGS (MPI_CART_CREATE,
#endif
void mpi_cart_create_f(MPI_Fint *old_comm, MPI_Fint *ndims, MPI_Fint *dims,
MPI_Fint *periods, MPI_Fint *reorder,
MPI_Fint *comm_cart, MPI_Fint *ierr)
MPI_Flogical *periods, MPI_Flogical *reorder,
MPI_Fint *comm_cart, MPI_Fint *ierr)
{
MPI_Comm c_comm1, c_comm2;
int size;
OMPI_ARRAY_NAME_DECL(dims);
OMPI_ARRAY_NAME_DECL(periods);
OMPI_LOGICAL_ARRAY_NAME_DECL(periods);
c_comm1 = MPI_Comm_f2c(*old_comm);
c_comm2 = MPI_Comm_f2c(*comm_cart);
size = OMPI_FINT_2_INT(*ndims);
OMPI_ARRAY_FINT_2_INT(dims, size);
OMPI_ARRAY_FINT_2_INT(periods, size);
OMPI_ARRAY_LOGICAL_2_INT(periods, size);
*ierr = OMPI_INT_2_FINT(MPI_Cart_create(c_comm1, OMPI_FINT_2_INT(*ndims),
OMPI_ARRAY_NAME_CONVERT(dims),
OMPI_ARRAY_NAME_CONVERT(periods),
OMPI_FINT_2_INT(*reorder),
&c_comm2));
OMPI_ARRAY_NAME_CONVERT(dims),
OMPI_LOGICAL_ARRAY_NAME_CONVERT(periods),
OMPI_LOGICAL_2_INT(*reorder),
&c_comm2));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
*comm_cart = MPI_Comm_c2f(c_comm2);
}
/*
* Need to convert back into Fortran, to not surprise the user
*/
OMPI_ARRAY_FINT_2_INT_CLEANUP(dims);
OMPI_ARRAY_FINT_2_INT_CLEANUP(periods);
OMPI_ARRAY_INT_2_LOGICAL(periods, size);
OMPI_ARRAY_LOGICAL_2_INT_CLEANUP(periods);
}

25
ompi/mpi/f77/cart_get_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_CART_GET,
pmpi_cart_get_,
pmpi_cart_get__,
pmpi_cart_get_f,
(MPI_Fint *comm, MPI_Fint *maxdims, MPI_Fint *dims, MPI_Fint *periods, MPI_Fint *coords, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Fint *maxdims, MPI_Fint *dims, MPI_Flogical *periods, MPI_Fint *coords, MPI_Fint *ierr),
(comm, maxdims, dims, periods, coords, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_CART_GET,
mpi_cart_get_,
mpi_cart_get__,
mpi_cart_get_f,
(MPI_Fint *comm, MPI_Fint *maxdims, MPI_Fint *dims, MPI_Fint *periods, MPI_Fint *coords, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Fint *maxdims, MPI_Fint *dims, MPI_Flogical *periods, MPI_Fint *coords, MPI_Fint *ierr),
(comm, maxdims, dims, periods, coords, ierr) )
#endif
@ -58,28 +58,29 @@ OMPI_GENERATE_F77_BINDINGS (MPI_CART_GET,
#endif
void mpi_cart_get_f(MPI_Fint *comm, MPI_Fint *maxdims, MPI_Fint *dims,
MPI_Fint *periods, MPI_Fint *coords, MPI_Fint *ierr)
MPI_Flogical *periods, MPI_Fint *coords, MPI_Fint *ierr)
{
MPI_Comm c_comm;
int size;
OMPI_ARRAY_NAME_DECL(dims);
OMPI_ARRAY_NAME_DECL(periods);
OMPI_ARRAY_NAME_DECL(coords);
OMPI_LOGICAL_ARRAY_NAME_DECL(periods);
c_comm = MPI_Comm_f2c(*comm);
size = OMPI_FINT_2_INT(*maxdims);
OMPI_ARRAY_FINT_2_INT_ALLOC(dims, size);
OMPI_ARRAY_FINT_2_INT_ALLOC(periods, size);
OMPI_ARRAY_FINT_2_INT_ALLOC(coords, size);
OMPI_ARRAY_LOGICAL_2_INT_ALLOC(periods, size);
*ierr = OMPI_INT_2_FINT(MPI_Cart_get(c_comm,
OMPI_FINT_2_INT(*maxdims),
OMPI_ARRAY_NAME_CONVERT(dims),
OMPI_ARRAY_NAME_CONVERT(periods),
OMPI_ARRAY_NAME_CONVERT(coords)));
OMPI_FINT_2_INT(*maxdims),
OMPI_ARRAY_NAME_CONVERT(dims),
OMPI_LOGICAL_ARRAY_NAME_CONVERT(periods),
OMPI_ARRAY_NAME_CONVERT(coords)));
OMPI_ARRAY_INT_2_FINT(dims, size);
OMPI_ARRAY_INT_2_FINT(periods, size);
OMPI_ARRAY_INT_2_LOGICAL(periods, size);
OMPI_ARRAY_INT_2_FINT(coords, size);
OMPI_ARRAY_LOGICAL_2_INT_CLEANUP(periods);
}

23
ompi/mpi/f77/cart_map_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_CART_MAP,
pmpi_cart_map_,
pmpi_cart_map__,
pmpi_cart_map_f,
(MPI_Fint *comm, MPI_Fint *ndims, MPI_Fint *dims, MPI_Fint *periods, MPI_Fint *newrank, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Fint *ndims, MPI_Fint *dims, MPI_Flogical *periods, MPI_Fint *newrank, MPI_Fint *ierr),
(comm, ndims, dims, periods, newrank, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_CART_MAP,
mpi_cart_map_,
mpi_cart_map__,
mpi_cart_map_f,
(MPI_Fint *comm, MPI_Fint *ndims, MPI_Fint *dims, MPI_Fint *periods, MPI_Fint *newrank, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Fint *ndims, MPI_Fint *dims, MPI_Flogical *periods, MPI_Fint *newrank, MPI_Fint *ierr),
(comm, ndims, dims, periods, newrank, ierr) )
#endif
@ -58,27 +58,28 @@ OMPI_GENERATE_F77_BINDINGS (MPI_CART_MAP,
#endif
void mpi_cart_map_f(MPI_Fint *comm, MPI_Fint *ndims, MPI_Fint *dims,
MPI_Fint *periods, MPI_Fint *newrank, MPI_Fint *ierr)
MPI_Flogical *periods, MPI_Fint *newrank, MPI_Fint *ierr)
{
MPI_Comm c_comm;
int size;
OMPI_ARRAY_NAME_DECL(dims);
OMPI_ARRAY_NAME_DECL(periods);
OMPI_LOGICAL_ARRAY_NAME_DECL(periods);
OMPI_SINGLE_NAME_DECL(newrank);
c_comm = MPI_Comm_f2c(*comm);
size = OMPI_FINT_2_INT(*ndims);
OMPI_ARRAY_FINT_2_INT(dims, size);
OMPI_ARRAY_FINT_2_INT(periods, size);
OMPI_ARRAY_LOGICAL_2_INT(periods, size);
*ierr = OMPI_INT_2_FINT(MPI_Cart_map(c_comm,
OMPI_FINT_2_INT(*ndims),
OMPI_ARRAY_NAME_CONVERT(dims),
OMPI_ARRAY_NAME_CONVERT(periods),
OMPI_SINGLE_NAME_CONVERT(newrank)));
OMPI_FINT_2_INT(*ndims),
OMPI_ARRAY_NAME_CONVERT(dims),
OMPI_LOGICAL_ARRAY_NAME_CONVERT(periods),
OMPI_SINGLE_NAME_CONVERT(newrank)));
OMPI_ARRAY_FINT_2_INT_CLEANUP(dims);
OMPI_ARRAY_FINT_2_INT_CLEANUP(periods);
OMPI_ARRAY_INT_2_LOGICAL(periods, size);
OMPI_ARRAY_LOGICAL_2_INT_CLEANUP(periods);
OMPI_SINGLE_INT_2_FINT(newrank);
}

32
ompi/mpi/f77/cart_sub_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_CART_SUB,
pmpi_cart_sub_,
pmpi_cart_sub__,
pmpi_cart_sub_f,
(MPI_Fint *comm, MPI_Fint *remain_dims, MPI_Fint *new_comm, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Flogical *remain_dims, MPI_Fint *new_comm, MPI_Fint *ierr),
(comm, remain_dims, new_comm, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_CART_SUB,
mpi_cart_sub_,
mpi_cart_sub__,
mpi_cart_sub_f,
(MPI_Fint *comm, MPI_Fint *remain_dims, MPI_Fint *new_comm, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Flogical *remain_dims, MPI_Fint *new_comm, MPI_Fint *ierr),
(comm, remain_dims, new_comm, ierr) )
#endif
@ -57,16 +57,38 @@ OMPI_GENERATE_F77_BINDINGS (MPI_CART_SUB,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_cart_sub_f(MPI_Fint *comm, MPI_Fint *remain_dims,
MPI_Fint *new_comm, MPI_Fint *ierr)
void mpi_cart_sub_f(MPI_Fint *comm, MPI_Flogical *remain_dims,
MPI_Fint *new_comm, MPI_Fint *ierr)
{
MPI_Comm c_comm, c_new_comm;
/*
* Just in the case, when sizeof(logical)!=sizeof(int) and
* Fortran TRUE-value != 1, we have to convert -- then we need
* to know the number of dimensions, for the size of remain_dims
*/
#if OMPI_FORTRAN_MUST_CONVERT_LOGICAL_2_INT == 1
int ndims;
#endif
OMPI_LOGICAL_ARRAY_NAME_DECL(remain_dims);
c_comm = MPI_Comm_f2c(*comm);
c_new_comm = MPI_Comm_f2c(*new_comm);
*ierr = OMPI_INT_2_FINT(MPI_Cart_sub(c_comm, remain_dims, &c_new_comm));
#if OMPI_FORTRAN_MUST_CONVERT_LOGICAL_2_INT == 1
*ierr = OMPI_INT_2_FINT(MPI_Cartdim_get(c_comm, &ndims));
if (MPI_SUCCESS != OMPI_FINT_2_INT(*ierr)) {
return;
}
#endif
OMPI_ARRAY_LOGICAL_2_INT(remain_dims, ndims);
*ierr = OMPI_INT_2_FINT(MPI_Cart_sub(c_comm,
OMPI_LOGICAL_ARRAY_NAME_CONVERT(remain_dims),
&c_new_comm));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
*new_comm = MPI_Comm_c2f(c_new_comm);
}
OMPI_ARRAY_INT_2_LOGICAL(remain_dims, ndims);
OMPI_ARRAY_LOGICAL_2_INT_CLEANUP(remain_dims);
}

13
ompi/mpi/f77/comm_get_attr_f.c
Просмотреть файл

@ -33,7 +33,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_COMM_GET_ATTR,
pmpi_comm_get_attr_,
pmpi_comm_get_attr__,
pmpi_comm_get_attr_f,
(MPI_Fint *comm, MPI_Fint *comm_keyval, MPI_Aint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Fint *comm_keyval, MPI_Aint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr),
(comm, comm_keyval, attribute_val, flag, ierr) )
#endif
@ -50,7 +50,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_GET_ATTR,
mpi_comm_get_attr_,
mpi_comm_get_attr__,
mpi_comm_get_attr_f,
(MPI_Fint *comm, MPI_Fint *comm_keyval, MPI_Aint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Fint *comm_keyval, MPI_Aint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr),
(comm, comm_keyval, attribute_val, flag, ierr) )
#endif
@ -60,11 +60,12 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_GET_ATTR,
#endif
void mpi_comm_get_attr_f(MPI_Fint *comm, MPI_Fint *comm_keyval,
MPI_Aint *attribute_val, MPI_Fint *flag,
MPI_Aint *attribute_val, MPI_Flogical *flag,
MPI_Fint *ierr)
{
int c_err, c_flag;
int c_err;
MPI_Comm c_comm = MPI_Comm_f2c(*comm);
OMPI_LOGICAL_NAME_DECL(flag);
/* This stuff is very confusing. Be sure to see the comment at
the top of src/attributes/attributes.c. */
@ -72,7 +73,7 @@ void mpi_comm_get_attr_f(MPI_Fint *comm, MPI_Fint *comm_keyval,
c_err = ompi_attr_get_fortran_mpi2(c_comm->c_keyhash,
OMPI_FINT_2_INT(*comm_keyval),
attribute_val,
&c_flag);
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag));
*ierr = OMPI_INT_2_FINT(c_err);
*flag = OMPI_INT_2_FINT(c_flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}

13
ompi/mpi/f77/comm_test_inter_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_COMM_TEST_INTER,
pmpi_comm_test_inter_,
pmpi_comm_test_inter__,
pmpi_comm_test_inter_f,
(MPI_Fint *comm, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Flogical *flag, MPI_Fint *ierr),
(comm, flag, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_TEST_INTER,
mpi_comm_test_inter_,
mpi_comm_test_inter__,
mpi_comm_test_inter_f,
(MPI_Fint *comm, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *comm, MPI_Flogical *flag, MPI_Fint *ierr),
(comm, flag, ierr) )
#endif
@ -57,14 +57,13 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_TEST_INTER,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_comm_test_inter_f(MPI_Fint *comm, MPI_Fint *flag, MPI_Fint *ierr)
void mpi_comm_test_inter_f(MPI_Fint *comm, MPI_Flogical *flag, MPI_Fint *ierr)
{
MPI_Comm c_comm = MPI_Comm_f2c (*comm);
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
*ierr = OMPI_INT_2_FINT(MPI_Comm_test_inter(c_comm,
OMPI_SINGLE_NAME_CONVERT(flag)));
*ierr = OMPI_INT_2_FINT(MPI_Comm_test_inter(c_comm, OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}

14
ompi/mpi/f77/file_get_atomicity_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_FILE_GET_ATOMICITY,
pmpi_file_get_atomicity_,
pmpi_file_get_atomicity__,
pmpi_file_get_atomicity_f,
(MPI_Fint *fh, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *fh, MPI_Flogical *flag, MPI_Fint *ierr),
(fh, flag, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_FILE_GET_ATOMICITY,
mpi_file_get_atomicity_,
mpi_file_get_atomicity__,
mpi_file_get_atomicity_f,
(MPI_Fint *fh, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *fh, MPI_Flogical *flag, MPI_Fint *ierr),
(fh, flag, ierr) )
#endif
@ -57,15 +57,15 @@ OMPI_GENERATE_F77_BINDINGS (MPI_FILE_GET_ATOMICITY,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_file_get_atomicity_f(MPI_Fint *fh, MPI_Fint *flag, MPI_Fint *ierr)
void mpi_file_get_atomicity_f(MPI_Fint *fh, MPI_Flogical *flag, MPI_Fint *ierr)
{
MPI_File c_fh;
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
c_fh = MPI_File_f2c(*fh);
*ierr = OMPI_INT_2_FINT(MPI_File_get_atomicity(c_fh,
OMPI_SINGLE_NAME_CONVERT(flag)));
*ierr = OMPI_INT_2_FINT(MPI_File_get_atomicity(c_fh,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}

10
ompi/mpi/f77/file_set_atomicity_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_FILE_SET_ATOMICITY,
pmpi_file_set_atomicity_,
pmpi_file_set_atomicity__,
pmpi_file_set_atomicity_f,
(MPI_Fint *fh, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *fh, MPI_Flogical *flag, MPI_Fint *ierr),
(fh, flag, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_FILE_SET_ATOMICITY,
mpi_file_set_atomicity_,
mpi_file_set_atomicity__,
mpi_file_set_atomicity_f,
(MPI_Fint *fh, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *fh, MPI_Flogical *flag, MPI_Fint *ierr),
(fh, flag, ierr) )
#endif
@ -57,10 +57,10 @@ OMPI_GENERATE_F77_BINDINGS (MPI_FILE_SET_ATOMICITY,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_file_set_atomicity_f(MPI_Fint *fh, MPI_Fint *flag, MPI_Fint *ierr)
void mpi_file_set_atomicity_f(MPI_Fint *fh, MPI_Flogical *flag, MPI_Fint *ierr)
{
MPI_File c_fh = MPI_File_f2c(*fh);
*ierr = OMPI_INT_2_FINT(MPI_File_set_atomicity(c_fh,
OMPI_FINT_2_INT(*flag)));
*ierr = OMPI_INT_2_FINT(MPI_File_set_atomicity(c_fh,
OMPI_LOGICAL_2_INT(*flag)));
}

13
ompi/mpi/f77/finalized_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_FINALIZED,
pmpi_finalized_,
pmpi_finalized__,
pmpi_finalized_f,
(MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Flogical *flag, MPI_Fint *ierr),
(flag, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_FINALIZED,
mpi_finalized_,
mpi_finalized__,
mpi_finalized_f,
(MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Flogical *flag, MPI_Fint *ierr),
(flag, ierr) )
#endif
@ -57,11 +57,12 @@ OMPI_GENERATE_F77_BINDINGS (MPI_FINALIZED,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_finalized_f(MPI_Fint *flag, MPI_Fint *ierr)
void mpi_finalized_f(MPI_Flogical *flag, MPI_Fint *ierr)
{
OMPI_SINGLE_NAME_DECL(flag);
*ierr = OMPI_INT_2_FINT(MPI_Finalized(OMPI_SINGLE_NAME_CONVERT(flag)));
OMPI_LOGICAL_NAME_DECL(flag);
*ierr = OMPI_INT_2_FINT(MPI_Finalized(OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}

87
ompi/mpi/f77/fint_2_int.h
Просмотреть файл

@ -139,7 +139,92 @@
} \
free(OMPI_ARRAY_NAME_CONVERT(in))
#endif
/*
* Define MACROS to take account of different size of logical from int
*/
#if OMPI_SIZEOF_FORTRAN_LOGICAL == SIZEOF_INT
# define OMPI_LOGICAL_NAME_DECL(in) /* Not needed for int==logical */
# define OMPI_LOGICAL_NAME_CONVERT(in) in /* Not needed for int==logical */
# define OMPI_LOGICAL_SINGLE_NAME_CONVERT(in) in /* Not needed for int==logical */
# define OMPI_LOGICAL_ARRAY_NAME_DECL(in) /* Not needed for int==logical */
# define OMPI_LOGICAL_ARRAY_NAME_CONVERT(in) in /* Not needed for int==logical */
# define OMPI_ARRAY_LOGICAL_2_INT_ALLOC(in,n) /* Not needed for int==logical */
# define OMPI_ARRAY_LOGICAL_2_INT_CLEANUP(in) /* Not needed for int==logical */
# if OMPI_FORTRAN_VALUE_TRUE == 1
# define OMPI_FORTRAN_MUST_CONVERT_LOGICAL_2_INT 0
# define OMPI_LOGICAL_2_INT(a) a
# define OMPI_INT_2_LOGICAL(a) a
# define OMPI_ARRAY_LOGICAL_2_INT(in, n)
# define OMPI_ARRAY_INT_2_LOGICAL(in, n)
# define OMPI_SINGLE_INT_2_LOGICAL(a) /* Single-OUT variable -- Not needed for int==logical, true=1 */
# else
# define OMPI_FORTRAN_MUST_CONVERT_LOGICAL_2_INT 1
# define OMPI_LOGICAL_2_INT(a) ((a)==0? 0 : 1)
# define OMPI_INT_2_LOGICAL(a) ((a)==0? 0 : OMPI_FORTRAN_VALUE_TRUE)
# define OMPI_SINGLE_INT_2_LOGICAL(a) *a=OMPI_INT_2_LOGICAL(OMPI_LOGICAL_NAME_CONVERT(*a))
# define OMPI_ARRAY_LOGICAL_2_INT(in, n) do { \
int __n = (n); \
OMPI_ARRAY_LOGICAL_2_INT_ALLOC(in, __n); \
while (__n > 0) { \
OMPI_LOGICAL_ARRAY_NAME_CONVERT(in)[__n]=OMPI_LOGICAL_2_INT(in[__n]); \
__n--; \
} \
} while (0)
# define OMPI_ARRAY_INT_2_LOGICAL(in, n) do { \
int __n = (n); \
while (__n > 0) { \
in[__n]=OMPI_INT_2_LOGICAL(OMPI_LOGICAL_ARRAY_NAME_CONVERT(in)[__n]); \
__n--; \
} \
} while (0) \
/* free(OMPI_LOGICAL_ARRAY_NAME_CONVERT(in)) * No Need to free, here */
# endif
#else
/*
* For anything other than Fortran-logical == C-int, we have to convert
*/
# define OMPI_FORTRAN_MUST_CONVERT_LOGICAL_2_INT 1
# define OMPI_LOGICAL_NAME_DECL(in) int c_##in
# define OMPI_LOGICAL_NAME_CONVERT(in) c_##in
# define OMPI_LOGICAL_SINGLE_NAME_CONVERT(in) &c_##in
# define OMPI_LOGICAL_ARRAY_NAME_DECL(in) int * c_##in
# define OMPI_LOGICAL_ARRAY_NAME_CONVERT(in) c_##in
# define OMPI_ARRAY_LOGICAL_2_INT_ALLOC(in,n) \
OMPI_LOGICAL_ARRAY_NAME_CONVERT(in) = malloc(n * sizeof(int))
# define OMPI_ARRAY_LOGICAL_2_INT_CLEANUP(in) \
free(OMPI_LOGICAL_ARRAY_NAME_CONVERT(in))
# if OMPI_FORTRAN_VALUE_TRUE == 1
# define OMPI_LOGICAL_2_INT(a) (int)a
# define OMPI_INT_2_LOGICAL(a) (MPI_Flogical)a
# define OMPI_SINGLE_INT_2_LOGICAL(a) *a=(OMPI_INT_2_LOGICAL(OMPI_LOGICAL_NAME_CONVERT(a)))
# else
# define OMPI_LOGICAL_2_INT(a) ((a)==0? 0 : 1)
# define OMPI_INT_2_LOGICAL(a) ((a)==0? 0 : OMPI_FORTRAN_VALUE_TRUE)
# define OMPI_SINGLE_INT_2_LOGICAL(a) *a=(OMPI_INT_2_LOGICAL(OMPI_LOGICAL_NAME_CONVERT(a)))
# endif
# define OMPI_ARRAY_LOGICAL_2_INT(in, n) do { \
int __n = (n); \
OMPI_ARRAY_LOGICAL_2_INT_ALLOC(in, __n); \
while (__n > 0) { \
OMPI_LOGICAL_ARRAY_NAME_CONVERT(in)[__n]=OMPI_LOGICAL_2_INT(in[__n]); \
__n--; \
} \
} while (0)
# define OMPI_ARRAY_INT_2_LOGICAL(in, n) do { \
int __n = (n); \
while (__n > 0) { \
in[__n]=OMPI_INT_2_LOGICAL(OMPI_LOGICAL_ARRAY_NAME_CONVERT(in)[__n]); \
__n--; \
} \
} while (0) \
/* free(OMPI_LOGICAL_ARRAY_NAME_CONVERT(in)) * No Need to free, here */
#endif /* OMPI_SIZEOF_FORTRAN_LOGICAL */
#endif /* OMPI_FINT_2_INT_H */

26
ompi/mpi/f77/graph_create_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_GRAPH_CREATE,
pmpi_graph_create_,
pmpi_graph_create__,
pmpi_graph_create_f,
(MPI_Fint *comm_old, MPI_Fint *nnodes, MPI_Fint *index, MPI_Fint *edges, MPI_Fint *reorder, MPI_Fint *comm_graph, MPI_Fint *ierr),
(MPI_Fint *comm_old, MPI_Fint *nnodes, MPI_Fint *index, MPI_Fint *edges, MPI_Flogical *reorder, MPI_Fint *comm_graph, MPI_Fint *ierr),
(comm_old, nnodes, index, edges, reorder, comm_graph, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_GRAPH_CREATE,
mpi_graph_create_,
mpi_graph_create__,
mpi_graph_create_f,
(MPI_Fint *comm_old, MPI_Fint *nnodes, MPI_Fint *index, MPI_Fint *edges, MPI_Fint *reorder, MPI_Fint *comm_graph, MPI_Fint *ierr),
(MPI_Fint *comm_old, MPI_Fint *nnodes, MPI_Fint *index, MPI_Fint *edges, MPI_Flogical *reorder, MPI_Fint *comm_graph, MPI_Fint *ierr),
(comm_old, nnodes, index, edges, reorder, comm_graph, ierr) )
#endif
@ -58,27 +58,27 @@ OMPI_GENERATE_F77_BINDINGS (MPI_GRAPH_CREATE,
#endif
void mpi_graph_create_f(MPI_Fint *comm_old, MPI_Fint *nnodes,
MPI_Fint *index, MPI_Fint *edges,
MPI_Fint *reorder, MPI_Fint *comm_graph,
MPI_Fint *ierr)
MPI_Fint *index, MPI_Fint *edges,
MPI_Flogical *reorder, MPI_Fint *comm_graph,
MPI_Fint *ierr)
{
MPI_Comm c_comm_old, c_comm_graph;
OMPI_ARRAY_NAME_DECL(index);
OMPI_ARRAY_NAME_DECL(edges);
c_comm_old = MPI_Comm_f2c(*comm_old);
OMPI_ARRAY_FINT_2_INT(index, *nnodes);
/* Number of edges is equal to the last entry in the index array */
OMPI_ARRAY_FINT_2_INT(edges, index[*nnodes - 1]);
*ierr = OMPI_INT_2_FINT(MPI_Graph_create(c_comm_old,
OMPI_FINT_2_INT(*nnodes),
OMPI_ARRAY_NAME_CONVERT(index),
OMPI_ARRAY_NAME_CONVERT(edges),
OMPI_FINT_2_INT(*reorder),
&c_comm_graph));
OMPI_FINT_2_INT(*nnodes),
OMPI_ARRAY_NAME_CONVERT(index),
OMPI_ARRAY_NAME_CONVERT(edges),
OMPI_LOGICAL_2_INT(*reorder),
&c_comm_graph));
if (OMPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
*comm_graph = MPI_Comm_c2f(c_comm_graph);
}

18
ompi/mpi/f77/info_get_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET,
pmpi_info_get_,
pmpi_info_get__,
pmpi_info_get_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr),
(info, key, valuelen, value, flag, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET,
mpi_info_get_,
mpi_info_get__,
mpi_info_get_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, MPI_Flogical *flag, MPI_Fint *ierr),
(info, key, valuelen, value, flag, ierr) )
#endif
@ -58,18 +58,18 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET,
#endif
void mpi_info_get_f(MPI_Fint *info, char *key, MPI_Fint *valuelen,
char *value, MPI_Fint *flag, MPI_Fint *ierr)
char *value, MPI_Flogical *flag, MPI_Fint *ierr)
{
MPI_Info c_info;
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
c_info = MPI_Info_f2c(*info);
*ierr = OMPI_INT_2_FINT(MPI_Info_get(c_info, key,
OMPI_FINT_2_INT(*valuelen),
value,
OMPI_SINGLE_NAME_CONVERT(flag)));
*ierr = OMPI_INT_2_FINT(MPI_Info_get(c_info, key,
OMPI_FINT_2_INT(*valuelen),
value,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}

17
ompi/mpi/f77/info_get_valuelen_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET_VALUELEN,
pmpi_info_get_valuelen_,
pmpi_info_get_valuelen__,
pmpi_info_get_valuelen_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr),
(info, key, valuelen, flag, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_VALUELEN,
mpi_info_get_valuelen_,
mpi_info_get_valuelen__,
mpi_info_get_valuelen_f,
(MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *info, char *key, MPI_Fint *valuelen, MPI_Flogical *flag, MPI_Fint *ierr),
(info, key, valuelen, flag, ierr) )
#endif
@ -58,20 +58,19 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_VALUELEN,
#endif
void mpi_info_get_valuelen_f(MPI_Fint *info, char *key,
MPI_Fint *valuelen, MPI_Fint *flag,
MPI_Fint *ierr)
MPI_Fint *valuelen, MPI_Flogical *flag,
MPI_Fint *ierr)
{
MPI_Info c_info;
OMPI_SINGLE_NAME_DECL(valuelen);
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
c_info = MPI_Info_f2c(*info);
*ierr = OMPI_INT_2_FINT(MPI_Info_get_valuelen(c_info, key,
OMPI_SINGLE_NAME_CONVERT(valuelen),
OMPI_SINGLE_NAME_CONVERT(flag)
));
OMPI_SINGLE_NAME_CONVERT(valuelen),
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(valuelen);
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}

12
ompi/mpi/f77/initialized_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INITIALIZED,
pmpi_initialized_,
pmpi_initialized__,
pmpi_initialized_f,
(MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Flogical *flag, MPI_Fint *ierr),
(flag, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INITIALIZED,
mpi_initialized_,
mpi_initialized__,
mpi_initialized_f,
(MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Flogical *flag, MPI_Fint *ierr),
(flag, ierr) )
#endif
@ -57,11 +57,11 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INITIALIZED,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_initialized_f(MPI_Fint *flag, MPI_Fint *ierr)
void mpi_initialized_f(MPI_Flogical *flag, MPI_Fint *ierr)
{
OMPI_SINGLE_NAME_DECL(flag);
*ierr = OMPI_INT_2_FINT(MPI_Initialized(OMPI_SINGLE_NAME_CONVERT(flag)));
OMPI_LOGICAL_NAME_DECL(flag);
*ierr = OMPI_INT_2_FINT(MPI_Initialized(OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}

12
ompi/mpi/f77/intercomm_merge_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_INTERCOMM_MERGE,
pmpi_intercomm_merge_,
pmpi_intercomm_merge__,
pmpi_intercomm_merge_f,
(MPI_Fint *intercomm, MPI_Fint *high, MPI_Fint *newintercomm, MPI_Fint *ierr),
(MPI_Fint *intercomm, MPI_Flogical *high, MPI_Fint *newintercomm, MPI_Fint *ierr),
(intercomm, high, newintercomm, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INTERCOMM_MERGE,
mpi_intercomm_merge_,
mpi_intercomm_merge__,
mpi_intercomm_merge_f,
(MPI_Fint *intercomm, MPI_Fint *high, MPI_Fint *newintercomm, MPI_Fint *ierr),
(MPI_Fint *intercomm, MPI_Flogical *high, MPI_Fint *newintercomm, MPI_Fint *ierr),
(intercomm, high, newintercomm, ierr) )
#endif
@ -57,15 +57,15 @@ OMPI_GENERATE_F77_BINDINGS (MPI_INTERCOMM_MERGE,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_intercomm_merge_f(MPI_Fint *intercomm, MPI_Fint *high,
MPI_Fint *newintracomm,
void mpi_intercomm_merge_f(MPI_Fint *intercomm, MPI_Flogical *high,
MPI_Fint *newintracomm,
MPI_Fint *ierr)
{
MPI_Comm c_newcomm;
MPI_Comm c_intercomm = MPI_Comm_f2c(*intercomm);
*ierr = MPI_Intercomm_merge (c_intercomm, OMPI_FINT_2_INT(*high),
&c_newcomm );
*ierr = MPI_Intercomm_merge (c_intercomm, OMPI_LOGICAL_2_INT(*high),
&c_newcomm);
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
*newintracomm = MPI_Comm_c2f (c_newcomm);
}

16
ompi/mpi/f77/iprobe_f.c
Просмотреть файл

@ -34,7 +34,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_IPROBE,
pmpi_iprobe_,
pmpi_iprobe__,
pmpi_iprobe_f,
(MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr),
(MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, MPI_Flogical *flag, MPI_Fint *status, MPI_Fint *ierr),
(source, tag, comm, flag, status, ierr) )
#endif
@ -51,7 +51,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_IPROBE,
mpi_iprobe_,
mpi_iprobe__,
mpi_iprobe_f,
(MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr),
(MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, MPI_Flogical *flag, MPI_Fint *status, MPI_Fint *ierr),
(source, tag, comm, flag, status, ierr) )
#endif
@ -61,14 +61,14 @@ OMPI_GENERATE_F77_BINDINGS (MPI_IPROBE,
#endif
void mpi_iprobe_f(MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm,
MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr)
MPI_Flogical *flag, MPI_Fint *status, MPI_Fint *ierr)
{
MPI_Status *c_status;
MPI_Comm c_comm;
#if OMPI_SIZEOF_FORTRAN_INTEGER != SIZEOF_INT
MPI_Status c_status2;
#endif
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
c_comm = MPI_Comm_f2c (*comm);
@ -89,11 +89,11 @@ void mpi_iprobe_f(MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm,
}
*ierr = OMPI_INT_2_FINT(MPI_Iprobe(OMPI_FINT_2_INT(*source),
OMPI_FINT_2_INT(*tag),
c_comm, OMPI_SINGLE_NAME_CONVERT(flag),
c_status));
OMPI_FINT_2_INT(*tag),
c_comm, OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag),
c_status));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
#if OMPI_SIZEOF_FORTRAN_INTEGER != SIZEOF_INT
if (MPI_STATUS_IGNORE != c_status) {
MPI_Status_c2f(c_status, status);

13
ompi/mpi/f77/is_thread_main_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_IS_THREAD_MAIN,
pmpi_is_thread_main_,
pmpi_is_thread_main__,
pmpi_is_thread_main_f,
(MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Flogical *flag, MPI_Fint *ierr),
(flag, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_IS_THREAD_MAIN,
mpi_is_thread_main_,
mpi_is_thread_main__,
mpi_is_thread_main_f,
(MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Flogical *flag, MPI_Fint *ierr),
(flag, ierr) )
#endif
@ -57,13 +57,12 @@ OMPI_GENERATE_F77_BINDINGS (MPI_IS_THREAD_MAIN,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_is_thread_main_f(MPI_Fint *flag, MPI_Fint *ierr)
void mpi_is_thread_main_f(MPI_Flogical *flag, MPI_Fint *ierr)
{
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
*ierr = OMPI_INT_2_FINT(MPI_Is_thread_main(OMPI_SINGLE_NAME_CONVERT(flag)
));
*ierr = OMPI_INT_2_FINT(MPI_Is_thread_main(OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}

10
ompi/mpi/f77/op_create_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_OP_CREATE,
pmpi_op_create_,
pmpi_op_create__,
pmpi_op_create_f,
(ompi_op_fortran_handler_fn_t* function, MPI_Fint *commute, MPI_Fint *op, MPI_Fint *ierr),
(ompi_op_fortran_handler_fn_t* function, MPI_Flogical *commute, MPI_Fint *op, MPI_Fint *ierr),
(function, commute, op, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_OP_CREATE,
mpi_op_create_,
mpi_op_create__,
mpi_op_create_f,
(ompi_op_fortran_handler_fn_t* function, MPI_Fint *commute, MPI_Fint *op, MPI_Fint *ierr),
(ompi_op_fortran_handler_fn_t* function, MPI_Flogical *commute, MPI_Fint *op, MPI_Fint *ierr),
(function, commute, op, ierr) )
#endif
@ -57,7 +57,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_OP_CREATE,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_op_create_f(ompi_op_fortran_handler_fn_t* function, MPI_Fint *commute,
void mpi_op_create_f(ompi_op_fortran_handler_fn_t* function, MPI_Flogical *commute,
MPI_Fint *op, MPI_Fint *ierr)
{
MPI_Op c_op;
@ -66,8 +66,8 @@ void mpi_op_create_f(ompi_op_fortran_handler_fn_t* function, MPI_Fint *commute,
(void*) for function pointers in this function */
*ierr = OMPI_INT_2_FINT(MPI_Op_create((MPI_User_function *) function,
OMPI_FINT_2_INT(*commute),
&c_op));
OMPI_LOGICAL_2_INT(*commute),
&c_op));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
c_op->o_flags |= OMPI_OP_FLAGS_FORTRAN_FUNC;
*op = MPI_Op_c2f(c_op);

3
ompi/mpi/f77/profile/Makefile.am
Просмотреть файл

@ -39,8 +39,7 @@ noinst_LTLIBRARIES +=
endif
headers = \
defines.h \
prototypes_pmpi.h
defines.h
nodist_libmpi_f77_pmpi_la_SOURCES = \
pabort_f.c \

1486
ompi/mpi/f77/profile/prototypes_pmpi.h
Просмотреть файл

Разница между файлами не показана из-за своего большого размера Загрузить разницу

1819
ompi/mpi/f77/prototypes_mpi.h
Просмотреть файл

Разница между файлами не показана из-за своего большого размера Загрузить разницу

17
ompi/mpi/f77/request_get_status_f.c
Просмотреть файл

@ -32,7 +32,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_REQUEST_GET_STATUS,
pmpi_request_get_status_,
pmpi_request_get_status__,
pmpi_request_get_status_f,
(MPI_Fint *request, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr),
(MPI_Fint *request, MPI_Flogical *flag, MPI_Fint *status, MPI_Fint *ierr),
(request, flag, status, ierr) )
#endif
@ -49,7 +49,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_REQUEST_GET_STATUS,
mpi_request_get_status_,
mpi_request_get_status__,
mpi_request_get_status_f,
(MPI_Fint *request, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr),
(MPI_Fint *request, MPI_Flogical *flag, MPI_Fint *status, MPI_Fint *ierr),
(request, flag, status, ierr) )
#endif
@ -58,24 +58,23 @@ OMPI_GENERATE_F77_BINDINGS (MPI_REQUEST_GET_STATUS,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_request_get_status_f(MPI_Fint *request, MPI_Fint *flag,
MPI_Fint *status, MPI_Fint *ierr)
void mpi_request_get_status_f(MPI_Fint *request, MPI_Flogical *flag,
MPI_Fint *status, MPI_Fint *ierr)
{
MPI_Status c_status;
MPI_Request c_req = MPI_Request_f2c( *request );
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
/* This seems silly, but someone will do it */
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
*flag = OMPI_INT_2_FINT(0);
*flag = OMPI_INT_2_LOGICAL(0);
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
} else {
*ierr = OMPI_INT_2_FINT(MPI_Request_get_status(c_req,
OMPI_SINGLE_NAME_CONVERT(flag),
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag),
&c_status));
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
MPI_Status_c2f( &c_status, status );
}
}

10
ompi/mpi/f77/status_set_cancelled_f.c
Просмотреть файл

@ -32,7 +32,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_STATUS_SET_CANCELLED,
pmpi_status_set_cancelled_,
pmpi_status_set_cancelled__,
pmpi_status_set_cancelled_f,
(MPI_Fint *status, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *status, MPI_Flogical *flag, MPI_Fint *ierr),
(status, flag, ierr) )
#endif
@ -49,7 +49,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_STATUS_SET_CANCELLED,
mpi_status_set_cancelled_,
mpi_status_set_cancelled__,
mpi_status_set_cancelled_f,
(MPI_Fint *status, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *status, MPI_Flogical *flag, MPI_Fint *ierr),
(status, flag, ierr) )
#endif
@ -58,7 +58,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_STATUS_SET_CANCELLED,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_status_set_cancelled_f(MPI_Fint *status, MPI_Fint *flag, MPI_Fint *ierr)
void mpi_status_set_cancelled_f(MPI_Fint *status, MPI_Flogical *flag, MPI_Fint *ierr)
{
MPI_Status c_status;
@ -69,8 +69,8 @@ void mpi_status_set_cancelled_f(MPI_Fint *status, MPI_Fint *flag, MPI_Fint *ierr
} else {
MPI_Status_f2c( status, &c_status );
*ierr = OMPI_INT_2_FINT(MPI_Status_set_cancelled(&c_status,
OMPI_FINT_2_INT(*flag)));
*ierr = OMPI_INT_2_FINT(MPI_Status_set_cancelled(&c_status,
OMPI_LOGICAL_2_INT(*flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
MPI_Status_c2f(&c_status, status);

18
ompi/mpi/f77/test_cancelled_f.c
Просмотреть файл

@ -32,7 +32,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_TEST_CANCELLED,
pmpi_test_cancelled_,
pmpi_test_cancelled__,
pmpi_test_cancelled_f,
(MPI_Fint *status, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *status, MPI_Flogical *flag, MPI_Fint *ierr),
(status, flag, ierr) )
#endif
@ -49,7 +49,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TEST_CANCELLED,
mpi_test_cancelled_,
mpi_test_cancelled__,
mpi_test_cancelled_f,
(MPI_Fint *status, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *status, MPI_Flogical *flag, MPI_Fint *ierr),
(status, flag, ierr) )
#endif
@ -58,24 +58,24 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TEST_CANCELLED,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_test_cancelled_f(MPI_Fint *status, MPI_Fint *flag, MPI_Fint *ierr)
void mpi_test_cancelled_f(MPI_Fint *status, MPI_Flogical *flag, MPI_Fint *ierr)
{
MPI_Status c_status;
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
/* This seems silly, but someone will do it */
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
*flag = OMPI_INT_2_FINT(0);
*flag = OMPI_INT_2_LOGICAL(0);
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
} else {
*ierr = MPI_Status_f2c( status, &c_status );
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
*ierr = OMPI_INT_2_FINT(MPI_Test_cancelled(&c_status,
OMPI_SINGLE_NAME_CONVERT(flag)));
OMPI_SINGLE_INT_2_FINT(flag);
*ierr = OMPI_INT_2_FINT(MPI_Test_cancelled(&c_status,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}
}

16
ompi/mpi/f77/test_f.c
Просмотреть файл

@ -33,7 +33,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_TEST,
pmpi_test_,
pmpi_test__,
pmpi_test_f,
(MPI_Fint *request, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr),
(MPI_Fint *request, MPI_Flogical *flag, MPI_Fint *status, MPI_Fint *ierr),
(request, flag, status, ierr) )
#endif
@ -50,7 +50,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TEST,
mpi_test_,
mpi_test__,
mpi_test_f,
(MPI_Fint *request, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr),
(MPI_Fint *request, MPI_Flogical *flag, MPI_Fint *status, MPI_Fint *ierr),
(request, flag, status, ierr) )
#endif
@ -59,18 +59,18 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TEST,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_test_f(MPI_Fint *request, MPI_Fint *flag,
MPI_Fint *status, MPI_Fint *ierr)
void mpi_test_f(MPI_Fint *request, MPI_Flogical *flag,
MPI_Fint *status, MPI_Fint *ierr)
{
MPI_Request c_req = MPI_Request_f2c(*request);
MPI_Status c_status;
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
*ierr = OMPI_INT_2_FINT(MPI_Test(&c_req,
OMPI_SINGLE_NAME_CONVERT(flag),
&c_status));
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag),
&c_status));
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
*request = OMPI_INT_2_FINT(c_req->req_f_to_c_index);

22
ompi/mpi/f77/testall_f.c
Просмотреть файл

@ -34,7 +34,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_TESTALL,
pmpi_testall_,
pmpi_testall__,
pmpi_testall_f,
(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr),
(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Flogical *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr),
(count, array_of_requests, flag, array_of_statuses, ierr) )
#endif
@ -51,7 +51,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TESTALL,
mpi_testall_,
mpi_testall__,
mpi_testall_f,
(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr),
(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Flogical *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr),
(count, array_of_requests, flag, array_of_statuses, ierr) )
#endif
@ -62,15 +62,14 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TESTALL,
static const char FUNC_NAME[] = "MPI_TESTALL";
void mpi_testall_f(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr)
void mpi_testall_f(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Flogical *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr)
{
MPI_Request *c_req;
MPI_Status *c_status;
int i;
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
c_req = malloc(OMPI_FINT_2_INT(*count) *
c_req = malloc(OMPI_FINT_2_INT(*count) *
(sizeof(MPI_Request) + sizeof(MPI_Status)));
if (NULL == c_req){
*ierr = OMPI_INT_2_FINT(OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD,
@ -83,12 +82,15 @@ void mpi_testall_f(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *flag,
c_req[i] = MPI_Request_f2c(array_of_requests[i]);
}
*ierr = OMPI_INT_2_FINT(MPI_Testall(OMPI_FINT_2_INT(*count), c_req,
OMPI_SINGLE_NAME_CONVERT(flag),
*ierr = OMPI_INT_2_FINT(MPI_Testall(OMPI_FINT_2_INT(*count), c_req,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag),
c_status));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr) &&
1 == *(OMPI_SINGLE_NAME_CONVERT(flag))) {
OMPI_SINGLE_INT_2_LOGICAL(flag);
/*
* All Fortran Compilers have FALSE == 0 -- we just need a TRUE value, i.e. *flag != 0
*/
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr) && *flag) {
for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) {
array_of_requests[i] = c_req[i]->req_f_to_c_index;
if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses) &&

13
ompi/mpi/f77/testany_f.c
Просмотреть файл

@ -34,7 +34,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_TESTANY,
pmpi_testany_,
pmpi_testany__,
pmpi_testany_f,
(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr),
(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index, MPI_Flogical *flag, MPI_Fint *status, MPI_Fint *ierr),
(count, array_of_requests, index, flag, status, ierr) )
#endif
@ -51,7 +51,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TESTANY,
mpi_testany_,
mpi_testany__,
mpi_testany_f,
(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr),
(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index, MPI_Flogical *flag, MPI_Fint *status, MPI_Fint *ierr),
(count, array_of_requests, index, flag, status, ierr) )
#endif
@ -63,12 +63,12 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TESTANY,
static const char FUNC_NAME[] = "MPI_TESTANY";
void mpi_testany_f(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr)
void mpi_testany_f(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index, MPI_Flogical *flag, MPI_Fint *status, MPI_Fint *ierr)
{
MPI_Request *c_req;
MPI_Status c_status;
int i;
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
OMPI_SINGLE_NAME_DECL(index);
c_req = malloc(OMPI_FINT_2_INT(*count) * sizeof(MPI_Request));
@ -85,15 +85,16 @@ void mpi_testany_f(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index
*ierr = OMPI_INT_2_FINT(MPI_Testany(OMPI_FINT_2_INT(*count), c_req,
OMPI_SINGLE_NAME_CONVERT(index),
OMPI_SINGLE_NAME_CONVERT(flag),
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag),
&c_status));
OMPI_SINGLE_INT_2_LOGICAL(flag);
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
/* Increment index by one for fortran conventions */
OMPI_SINGLE_INT_2_FINT(index);
if (1 == OMPI_INT_2_FINT(*flag) &&
if (*flag &&
MPI_UNDEFINED != *(OMPI_SINGLE_NAME_CONVERT(index))) {
array_of_requests[OMPI_INT_2_FINT(*index)] =
c_req[OMPI_INT_2_FINT(*index)]->req_f_to_c_index;

13
ompi/mpi/f77/type_get_attr_f.c
Просмотреть файл

@ -33,7 +33,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_TYPE_GET_ATTR,
pmpi_type_get_attr_,
pmpi_type_get_attr__,
pmpi_type_get_attr_f,
(MPI_Fint *type, MPI_Fint *type_keyval, MPI_Aint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *type, MPI_Fint *type_keyval, MPI_Aint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr),
(type, type_keyval, attribute_val, flag, ierr) )
#endif
@ -50,7 +50,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TYPE_GET_ATTR,
mpi_type_get_attr_,
mpi_type_get_attr__,
mpi_type_get_attr_f,
(MPI_Fint *type, MPI_Fint *type_keyval, MPI_Aint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *type, MPI_Fint *type_keyval, MPI_Aint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr),
(type, type_keyval, attribute_val, flag, ierr) )
#endif
@ -60,11 +60,12 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TYPE_GET_ATTR,
#endif
void mpi_type_get_attr_f(MPI_Fint *type, MPI_Fint *type_keyval,
MPI_Aint *attribute_val, MPI_Fint *flag,
MPI_Aint *attribute_val, MPI_Flogical *flag,
MPI_Fint *ierr)
{
int c_err, c_flag;
int c_err;
MPI_Datatype c_type = MPI_Type_f2c(*type);
OMPI_LOGICAL_NAME_DECL(flag);
/* This stuff is very confusing. Be sure to see the comment at
the top of src/attributes/attributes.c. */
@ -72,7 +73,7 @@ void mpi_type_get_attr_f(MPI_Fint *type, MPI_Fint *type_keyval,
c_err = ompi_attr_get_fortran_mpi2(c_type->d_keyhash,
OMPI_FINT_2_INT(*type_keyval),
attribute_val,
&c_flag);
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag));
*ierr = OMPI_INT_2_FINT(c_err);
*flag = OMPI_INT_2_FINT(c_flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}

13
ompi/mpi/f77/win_get_attr_f.c
Просмотреть файл

@ -33,7 +33,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_WIN_GET_ATTR,
pmpi_win_get_attr_,
pmpi_win_get_attr__,
pmpi_win_get_attr_f,
(MPI_Fint *win, MPI_Fint *win_keyval, MPI_Aint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *win, MPI_Fint *win_keyval, MPI_Aint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr),
(win, win_keyval, attribute_val, flag, ierr) )
#endif
@ -50,7 +50,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_WIN_GET_ATTR,
mpi_win_get_attr_,
mpi_win_get_attr__,
mpi_win_get_attr_f,
(MPI_Fint *win, MPI_Fint *win_keyval, MPI_Aint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *win, MPI_Fint *win_keyval, MPI_Aint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr),
(win, win_keyval, attribute_val, flag, ierr) )
#endif
@ -60,10 +60,11 @@ OMPI_GENERATE_F77_BINDINGS (MPI_WIN_GET_ATTR,
#endif
void mpi_win_get_attr_f(MPI_Fint *win, MPI_Fint *win_keyval,
MPI_Aint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr)
MPI_Aint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr)
{
int c_err, c_flag;
int c_err;
MPI_Win c_win = MPI_Win_f2c(*win);
OMPI_LOGICAL_NAME_DECL(flag);
/* This stuff is very confusing. Be sure to see the comment at
the top of src/attributes/attributes.c. */
@ -71,7 +72,7 @@ void mpi_win_get_attr_f(MPI_Fint *win, MPI_Fint *win_keyval,
c_err = ompi_attr_get_fortran_mpi2(c_win->w_keyhash,
OMPI_FINT_2_INT(*win_keyval),
attribute_val,
&c_flag);
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag));
*ierr = OMPI_INT_2_FINT(c_err);
*flag = OMPI_INT_2_FINT(c_flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}

12
ompi/mpi/f77/win_test_f.c
Просмотреть файл

@ -31,7 +31,7 @@ OMPI_GENERATE_F77_BINDINGS (PMPI_WIN_TEST,
pmpi_win_test_,
pmpi_win_test__,
pmpi_win_test_f,
(MPI_Fint *win, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *win, MPI_Flogical *flag, MPI_Fint *ierr),
(win, flag, ierr) )
#endif
@ -48,7 +48,7 @@ OMPI_GENERATE_F77_BINDINGS (MPI_WIN_TEST,
mpi_win_test_,
mpi_win_test__,
mpi_win_test_f,
(MPI_Fint *win, MPI_Fint *flag, MPI_Fint *ierr),
(MPI_Fint *win, MPI_Flogical *flag, MPI_Fint *ierr),
(win, flag, ierr) )
#endif
@ -57,14 +57,14 @@ OMPI_GENERATE_F77_BINDINGS (MPI_WIN_TEST,
#include "mpi/f77/profile/defines.h"
#endif
void mpi_win_test_f(MPI_Fint *win, MPI_Fint *flag, MPI_Fint *ierr)
void mpi_win_test_f(MPI_Fint *win, MPI_Flogical *flag, MPI_Fint *ierr)
{
MPI_Win c_win = MPI_Win_f2c(*win);
OMPI_SINGLE_NAME_DECL(flag);
OMPI_LOGICAL_NAME_DECL(flag);
*ierr = OMPI_INT_2_FINT(MPI_Win_test(c_win,
OMPI_SINGLE_NAME_CONVERT(flag)));
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(flag);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}

56
ompi/mpi/f90/scripts/mpi-f90-interfaces.h.sh
Просмотреть файл

@ -1508,7 +1508,7 @@ echo " use mpi_kinds"
echo " integer, intent(in) :: comm"
echo " integer, intent(in) :: keyval"
echo " integer, intent(out) :: attribute_val"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -2292,8 +2292,8 @@ echo " use mpi_kinds"
echo " integer, intent(in) :: old_comm"
echo " integer, intent(in) :: ndims"
echo " integer, dimension(*), intent(in) :: dims"
echo " integer, dimension(*), intent(in) :: periods"
echo " integer, intent(in) :: reorder"
echo " logical, dimension(*), intent(in) :: periods"
echo " logical, intent(in) :: reorder"
echo " integer, intent(out) :: comm_cart"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -2314,7 +2314,7 @@ echo " use mpi_kinds"
echo " integer, intent(in) :: comm"
echo " integer, intent(in) :: maxdims"
echo " integer, dimension(*), intent(out) :: dims"
echo " integer, dimension(*), intent(out) :: periods"
echo " logical, dimension(*), intent(out) :: periods"
echo " integer, dimension(*), intent(out) :: coords"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -2335,7 +2335,7 @@ echo " use mpi_kinds"
echo " integer, intent(in) :: comm"
echo " integer, intent(in) :: ndims"
echo " integer, dimension(*), intent(in) :: dims"
echo " integer, dimension(*), intent(in) :: periods"
echo " logical, dimension(*), intent(in) :: periods"
echo " integer, intent(out) :: newrank"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -2392,7 +2392,7 @@ proc="${procedure}"
echo "subroutine ${proc}(comm, remain_dims, new_comm, ierr)"
echo " use mpi_kinds"
echo " integer, intent(in) :: comm"
echo " integer, dimension(*), intent(in) :: remain_dims"
echo " logical, dimension(*), intent(in) :: remain_dims"
echo " integer, intent(out) :: new_comm"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -2584,7 +2584,7 @@ echo " use mpi_kinds"
echo " integer, intent(in) :: comm"
echo " integer, intent(in) :: comm_keyval"
echo " integer(kind=MPI_ADDRESS_KIND), intent(out) :: attribute_val"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -2792,7 +2792,7 @@ proc="${procedure}"
echo "subroutine ${proc}(comm, flag, ierr)"
echo " use mpi_kinds"
echo " integer, intent(inout) :: comm"
echo " integer, intent(in) :: flag"
echo " logical, intent(in) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -3172,7 +3172,7 @@ proc="${procedure}"
echo "subroutine ${proc}(fh, flag, ierr)"
echo " use mpi_kinds"
echo " integer, intent(in) :: fh"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -6007,7 +6007,7 @@ proc="${procedure}"
echo "subroutine ${proc}(fh, flag, ierr)"
echo " use mpi_kinds"
echo " integer, intent(inout) :: fh"
echo " integer, intent(in) :: flag"
echo " logical, intent(in) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -7825,7 +7825,7 @@ echo
proc="${procedure}"
echo "subroutine ${proc}(flag, ierr)"
echo " use mpi_kinds"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -8667,7 +8667,7 @@ echo " integer, intent(in) :: comm_old"
echo " integer, intent(in) :: nnodes"
echo " integer, dimension(*), intent(in) :: index"
echo " integer, dimension(*), intent(in) :: edges"
echo " integer, intent(in) :: reorder"
echo " logical, intent(in) :: reorder"
echo " integer, intent(out) :: comm_graph"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -9271,7 +9271,7 @@ echo " integer, intent(in) :: info"
echo " character(len=*), intent(in) :: key"
echo " integer, intent(in) :: valuelen"
echo " character(len=*), intent(out) :: value"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -9325,7 +9325,7 @@ echo " use mpi_kinds"
echo " integer, intent(in) :: info"
echo " character(len=*), intent(in) :: key"
echo " integer, intent(out) :: valuelen"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -9391,7 +9391,7 @@ echo
proc="${procedure}"
echo "subroutine ${proc}(flag, ierr)"
echo " use mpi_kinds"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -9430,7 +9430,7 @@ proc="${procedure}"
echo "subroutine ${proc}(intercomm, high, newintercomm, ierr)"
echo " use mpi_kinds"
echo " integer, intent(in) :: intercomm"
echo " integer, intent(in) :: high"
echo " logical, intent(in) :: high"
echo " integer, intent(out) :: newintercomm"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -9451,7 +9451,7 @@ echo " use mpi_kinds"
echo " integer, intent(in) :: source"
echo " integer, intent(in) :: tag"
echo " integer, intent(in) :: comm"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, dimension(MPI_STATUS_SIZE), intent(inout) :: status"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -9794,7 +9794,7 @@ echo
proc="${procedure}"
echo "subroutine ${proc}(flag, ierr)"
echo " use mpi_kinds"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -10172,7 +10172,7 @@ proc="${procedure}"
echo "subroutine ${proc}(function, commute, op, ierr)"
echo " use mpi_kinds"
echo " integer(MPI_ADDRESS_KIND), intent(in) :: function"
echo " integer, intent(in) :: commute"
echo " logical, intent(in) :: commute"
echo " integer, intent(out) :: op"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -11481,7 +11481,7 @@ proc="${procedure}"
echo "subroutine ${proc}(request, flag, status, ierr)"
echo " use mpi_kinds"
echo " integer, intent(in) :: request"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, dimension(MPI_STATUS_SIZE), intent(inout) :: status"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -13500,7 +13500,7 @@ proc="${procedure}"
echo "subroutine ${proc}(status, flag, ierr)"
echo " use mpi_kinds"
echo " integer, dimension(MPI_STATUS_SIZE), intent(inout) :: status"
echo " integer, intent(in) :: flag"
echo " logical, intent(in) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -13535,7 +13535,7 @@ proc="${procedure}"
echo "subroutine ${proc}(request, flag, status, ierr)"
echo " use mpi_kinds"
echo " integer, intent(inout) :: request"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, dimension(MPI_STATUS_SIZE), intent(inout) :: status"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -13553,7 +13553,7 @@ proc="${procedure}"
echo "subroutine ${proc}(status, flag, ierr)"
echo " use mpi_kinds"
echo " integer, dimension(MPI_STATUS_SIZE), intent(in) :: status"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -13571,7 +13571,7 @@ echo "subroutine ${proc}(count, array_of_requests, flag, array_of_statuses, ierr
echo " use mpi_kinds"
echo " integer, intent(in) :: count"
echo " integer, dimension(*), intent(inout) :: array_of_requests"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, dimension(MPI_STATUS_SIZE,*), intent(inout) :: array_of_statuses"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -13592,7 +13592,7 @@ echo " use mpi_kinds"
echo " integer, intent(in) :: count"
echo " integer, dimension(*), intent(inout) :: array_of_requests"
echo " integer, intent(out) :: index"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, dimension(MPI_STATUS_SIZE), intent(inout) :: status"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
@ -13991,7 +13991,7 @@ echo " use mpi_kinds"
echo " integer, intent(in) :: type"
echo " integer, intent(in) :: type_keyval"
echo " integer(kind=MPI_ADDRESS_KIND), intent(out) :: attribute_val"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -15008,7 +15008,7 @@ echo " use mpi_kinds"
echo " integer, intent(in) :: win"
echo " integer, intent(in) :: win_keyval"
echo " integer(kind=MPI_ADDRESS_KIND), intent(out) :: attribute_val"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo
@ -15184,7 +15184,7 @@ proc="${procedure}"
echo "subroutine ${proc}(win, flag, ierr)"
echo " use mpi_kinds"
echo " integer, intent(in) :: win"
echo " integer, intent(out) :: flag"
echo " logical, intent(out) :: flag"
echo " integer, intent(out) :: ierr"
echo "end subroutine ${proc}"
echo

6
ompi/tools/ompi_info/param.cc
Просмотреть файл

@ -408,6 +408,12 @@ void ompi_info::do_config(bool want_all)
out("Fort integer size", "compiler:fortran:sizeof:integer",
OMPI_SIZEOF_FORTRAN_INTEGER);
out("Fort logical size", "compiler:fortran:sizeof:logical",
OMPI_SIZEOF_FORTRAN_LOGICAL);
out("Fort logical value true", "compiler:fortran:value:true",
OMPI_FORTRAN_VALUE_TRUE);
// May or may not have the other Fortran sizes
if (OMPI_WANT_F77_BINDINGS || OMPI_WANT_F90_BINDINGS) {