1
1

Merge pull request #241 from cniethammer/master

Add missing Fortran binding for Win_allocate.
Этот коммит содержится в:
Jeff Squyres 2014-10-24 08:54:28 -04:00
родитель 5207429734 9020a1c1f6
Коммит 37c2b9cf30
13 изменённых файлов: 298 добавлений и 1 удалений

Просмотреть файл

@ -386,6 +386,7 @@ libmpi_mpifh_la_SOURCES += \
rput_f.c \
compare_and_swap_f.c \
fetch_and_op_f.c \
win_allocate_f.c \
win_allocate_shared_f.c \
win_call_errhandler_f.c \
win_complete_f.c \

Просмотреть файл

@ -314,6 +314,7 @@ linked_files = \
prput_f.c \
pcompare_and_swap_f.c \
pfetch_and_op_f.c \
pwin_allocate_f.c \
pwin_allocate_shared_f.c \
pwin_call_errhandler_f.c \
pwin_complete_f.c \

Просмотреть файл

@ -344,6 +344,8 @@
#define ompi_waitany_f pompi_waitany_f
#define ompi_wait_f pompi_wait_f
#define ompi_waitsome_f pompi_waitsome_f
#define ompi_win_allocate_f pompi_win_allocate_f
#define ompi_win_allocate_cptr_f pompi_win_allocate_cptr_f
#define ompi_win_allocate_shared_f pompi_win_allocate_shared_f
#define ompi_win_allocate_shared_cptr_f pompi_win_allocate_shared_cptr_f
#define ompi_win_call_errhandler_f pompi_win_call_errhandler_f

Просмотреть файл

@ -401,6 +401,8 @@ PN2(void, MPI_Waitall, mpi_waitall, MPI_WAITALL, (MPI_Fint *count, MPI_Fint *arr
PN2(void, MPI_Waitany, mpi_waitany, MPI_WAITANY, (MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index, MPI_Fint *status, MPI_Fint *ierr));
PN2(void, MPI_Wait, mpi_wait, MPI_WAIT, (MPI_Fint *request, MPI_Fint *status, MPI_Fint *ierr));
PN2(void, MPI_Waitsome, mpi_waitsome, MPI_WAITSOME, (MPI_Fint *incount, MPI_Fint *array_of_requests, MPI_Fint *outcount, MPI_Fint *array_of_indices, MPI_Fint *array_of_statuses, MPI_Fint *ierr));
PN2(void, MPI_Win_allocate, mpi_win_allocate, MPI_WIN_ALLOCATE, (MPI_Aint *size, MPI_Fint *disp_unit, MPI_Fint *info, MPI_Fint *comm, char *baseptr, MPI_Fint *win, MPI_Fint *ierr));
PN2(void, MPI_Win_allocate_cptr, mpi_win_allocate_cptr, MPI_WIN_ALLOCATE_CPTR, (MPI_Aint *size, MPI_Fint *disp_unit, MPI_Fint *info, MPI_Fint *comm, char *baseptr, MPI_Fint *win, MPI_Fint *ierr));
PN2(void, MPI_Win_allocate_shared, mpi_win_allocate_shared, MPI_WIN_ALLOCATE_SHARED, (MPI_Aint *size, MPI_Fint *disp_unit, MPI_Fint *info, MPI_Fint *comm, char *baseptr, MPI_Fint *win, MPI_Fint *ierr));
PN2(void, MPI_Win_allocate_shared_cptr, mpi_win_allocate_shared_cptr, MPI_WIN_ALLOCATE_SHARED_CPTR, (MPI_Aint *size, MPI_Fint *disp_unit, MPI_Fint *info, MPI_Fint *comm, char *baseptr, MPI_Fint *win, MPI_Fint *ierr));
PN2(void, MPI_Win_call_errhandler, mpi_win_call_errhandler, MPI_WIN_CALL_ERRHANDLER, (MPI_Fint *win, MPI_Fint *errorcode, MPI_Fint *ierr));

137
ompi/mpi/fortran/mpif-h/win_allocate_f.c Обычный файл
Просмотреть файл

@ -0,0 +1,137 @@
/*
* Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
* University Research and Technology
* Corporation. All rights reserved.
* Copyright (c) 2004-2005 The University of Tennessee and The University
* of Tennessee Research Foundation. All rights
* reserved.
* Copyright (c) 2004-2014 High Performance Computing Center Stuttgart,
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2011-2014 Cisco Systems, Inc. All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
*
* $HEADER$
*/
#include "ompi_config.h"
#include "ompi/mpi/fortran/mpif-h/bindings.h"
#if OPAL_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
#pragma weak PMPI_WIN_ALLOCATE = ompi_win_allocate_f
#pragma weak pmpi_win_allocate = ompi_win_allocate_f
#pragma weak pmpi_win_allocate_ = ompi_win_allocate_f
#pragma weak pmpi_win_allocate__ = ompi_win_allocate_f
#pragma weak PMPI_Win_allocate_f = ompi_win_allocate_f
#pragma weak PMPI_Win_allocate_f08 = ompi_win_allocate_f
#pragma weak PMPI_WIN_ALLOCATE_CPTR = ompi_win_allocate_f
#pragma weak pmpi_win_allocate_cptr = ompi_win_allocate_f
#pragma weak pmpi_win_allocate_cptr_ = ompi_win_allocate_f
#pragma weak pmpi_win_allocate_cptr__ = ompi_win_allocate_f
#pragma weak PMPI_Win_allocate_cptr_f = ompi_win_allocate_f
#pragma weak PMPI_Win_allocate_cptr_f08 = ompi_win_allocate_f
#elif OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (PMPI_WIN_ALLOCATE,
pmpi_win_allocate,
pmpi_win_allocate_,
pmpi_win_allocate__,
pompi_win_allocate_f,
(MPI_Aint *size, MPI_Fint *disp_unit,
MPI_Fint *info, MPI_Fint *comm, char *baseptr,
MPI_Fint *win, MPI_Fint *ierr),
(size, disp_unit, info, comm, baseptr, win, ierr) )
OMPI_GENERATE_F77_BINDINGS (PMPI_WIN_ALLOCATE_CPTR,
pmpi_win_allocate_cptr,
pmpi_win_allocate_cptr_,
pmpi_win_allocate_cptr__,
pompi_win_allocate_cptr_f,
(MPI_Aint *size, MPI_Fint *disp_unit,
MPI_Fint *info, MPI_Fint *comm, char *baseptr,
MPI_Fint *win, MPI_Fint *ierr),
(size, disp_unit, info, comm, baseptr, win, ierr) )
#endif
#if OPAL_HAVE_WEAK_SYMBOLS
#pragma weak MPI_WIN_ALLOCATE = ompi_win_allocate_f
#pragma weak mpi_win_allocate = ompi_win_allocate_f
#pragma weak mpi_win_allocate_ = ompi_win_allocate_f
#pragma weak mpi_win_allocate__ = ompi_win_allocate_f
#pragma weak MPI_Win_allocate_f = ompi_win_allocate_f
#pragma weak MPI_Win_allocate_f08 = ompi_win_allocate_f
#pragma weak MPI_WIN_ALLOCATE_CPTR = ompi_win_allocate_f
#pragma weak mpi_win_allocate_cptr = ompi_win_allocate_f
#pragma weak mpi_win_allocate_cptr_ = ompi_win_allocate_f
#pragma weak mpi_win_allocate_cptr__ = ompi_win_allocate_f
#pragma weak MPI_Win_allocate_cptr_f = ompi_win_allocate_f
#pragma weak MPI_Win_allocate_cptr_f08 = ompi_win_allocate_f
#endif
#if ! OPAL_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER
OMPI_GENERATE_F77_BINDINGS (MPI_WIN_ALLOCATE,
mpi_win_allocate,
mpi_win_allocate_,
mpi_win_allocate__,
ompi_win_allocate_f,
(MPI_Aint *size, MPI_Fint *disp_unit,
MPI_Fint *info, MPI_Fint *comm, char *baseptr,
MPI_Fint *win, MPI_Fint *ierr),
(size, disp_unit, info, comm, baseptr, win, ierr) )
OMPI_GENERATE_F77_BINDINGS (MPI_WIN_ALLOCATE_CPTR,
mpi_win_allocate_cptr,
mpi_win_allocate_cptr_,
mpi_win_allocate_cptr__,
ompi_win_allocate_cptr_f,
(MPI_Aint *size, MPI_Fint *disp_unit,
MPI_Fint *info, MPI_Fint *comm, char *baseptr,
MPI_Fint *win, MPI_Fint *ierr),
(size, disp_unit, info, comm, baseptr, win, ierr) )
#endif
#if OMPI_PROFILE_LAYER && ! OPAL_HAVE_WEAK_SYMBOLS
#include "ompi/mpi/fortran/mpif-h/profile/defines.h"
#endif
void ompi_win_allocate_f(MPI_Aint *size, MPI_Fint *disp_unit,
MPI_Fint *info, MPI_Fint *comm, char *baseptr,
MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Info c_info;
MPI_Comm c_comm;
MPI_Win c_win;
c_info = MPI_Info_f2c(*info);
c_comm = MPI_Comm_f2c(*comm);
c_ierr = MPI_Win_allocate(*size, OMPI_FINT_2_INT(*disp_unit),
c_info, c_comm,
baseptr, &c_win);
*win = MPI_Win_c2f(c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
/*
* Note that MPI-3 mandates a second form of the
* MPI_Win_allocate interface -- one that has a "_cptr" suffix.
*/
void ompi_win_allocate_cptr_f(MPI_Aint *size, MPI_Fint *disp_unit,
MPI_Fint *info, MPI_Fint *comm,
char *baseptr,
MPI_Fint *win, MPI_Fint *ierr)
{
ompi_win_allocate_f(size, disp_unit, info, comm, baseptr,
win, ierr);
}

Просмотреть файл

@ -327,6 +327,7 @@ mpi_api_files = \
waitany_f08.F90 \
wait_f08.F90 \
waitsome_f08.F90 \
win_allocate_f08.F90 \
win_allocate_shared_f08.F90 \
win_call_errhandler_f08.F90 \
win_complete_f08.F90 \
@ -673,6 +674,7 @@ pmpi_api_files = \
profile/pwaitany_f08.F90 \
profile/pwait_f08.F90 \
profile/pwaitsome_f08.F90 \
profile/pwin_allocate_f08.F90 \
profile/pwin_allocate_shared_f08.F90 \
profile/pwin_call_errhandler_f08.F90 \
profile/pwin_complete_f08.F90 \

Просмотреть файл

@ -1573,6 +1573,19 @@ subroutine ompi_type_set_name_f(type,type_name,ierror,type_name_len) &
INTEGER, VALUE, INTENT(IN) :: type_name_len
end subroutine ompi_type_set_name_f
subroutine ompi_win_allocate_f(size, disp_unit, info, comm, &
baseptr, win, ierror) BIND(C, name="ompi_win_allocate_f")
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR
use :: mpi_f08_types, only : MPI_ADDRESS_KIND
INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: size
INTEGER, INTENT(IN) :: disp_unit
INTEGER, INTENT(IN) :: info
INTEGER, INTENT(IN) :: comm
TYPE(C_PTR), INTENT(OUT) :: baseptr
INTEGER, INTENT(OUT) :: win
INTEGER, INTENT(OUT) :: ierror
end subroutine ompi_win_allocate_f
subroutine ompi_win_allocate_shared_f(size, disp_unit, info, comm, &
baseptr, win, ierror) BIND(C, name="ompi_win_allocate_shared_f")
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR

Просмотреть файл

@ -2103,6 +2103,21 @@ subroutine MPI_Type_set_name_f08(datatype,type_name,ierror)
end subroutine MPI_Type_set_name_f08
end interface MPI_Type_set_name
interface MPI_Win_allocate
subroutine MPI_Win_allocate_f08(size, disp_unit, info, comm, &
baseptr, win, ierror)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR
use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win, MPI_ADDRESS_KIND
INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: size
INTEGER, INTENT(IN) :: disp_unit
TYPE(MPI_Info), INTENT(IN) :: info
TYPE(MPI_Comm), INTENT(IN) :: comm
TYPE(C_PTR), INTENT(OUT) :: baseptr
TYPE(MPI_Win), INTENT(OUT) :: win
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
end subroutine MPI_Win_allocate_f08
end interface MPI_Win_allocate
interface MPI_Win_allocate_shared
subroutine MPI_Win_allocate_shared_f08(size, disp_unit, info, comm, &
baseptr, win, ierror)
@ -2116,7 +2131,7 @@ subroutine MPI_Win_allocate_shared_f08(size, disp_unit, info, comm, &
TYPE(MPI_Win), INTENT(OUT) :: win
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
end subroutine MPI_Win_allocate_shared_f08
end interface
end interface MPI_Win_allocate_shared
interface MPI_Win_create_keyval
subroutine MPI_Win_create_keyval_f08(win_copy_attr_fn,win_delete_attr_fn,win_keyval, &

Просмотреть файл

@ -1407,6 +1407,19 @@ subroutine pompi_type_set_name_f(type,type_name,ierror,type_name_len) &
INTEGER, VALUE, INTENT(IN) :: type_name_len
end subroutine pompi_type_set_name_f
subroutine pompi_win_allocate_f(size, disp_unit, info, comm, &
baseptr, win, ierror) BIND(C, name="ompi_win_allocate_f")
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR
use :: mpi_f08_types, only : MPI_ADDRESS_KIND
INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: size
INTEGER, INTENT(IN) :: disp_unit
INTEGER, INTENT(IN) :: info
INTEGER, INTENT(IN) :: comm
TYPE(C_PTR), INTENT(OUT) :: baseptr
INTEGER, INTENT(OUT) :: win
INTEGER, INTENT(OUT) :: ierror
end subroutine pompi_win_allocate_f
subroutine pompi_win_allocate_shared_f(size, disp_unit, info, comm, &
baseptr, win, ierror) BIND(C, name="ompi_win_allocate_shared_f")
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR

Просмотреть файл

@ -0,0 +1,28 @@
! -*- f90 -*-
!
! Copyright (c) 2010-2012 Cisco Systems, Inc. All rights reserved.
! Copyright (c) 2009-2012 Los Alamos National Security, LLC.
! All Rights reserved.
! Copyright (c) 2004-2014 High Performance Computing Center Stuttgart,
! University of Stuttgart. All rights reserved.
! $COPYRIGHT$
subroutine PMPI_Win_allocate_f08(size, disp_unit, info, comm, &
baseptr, win, ierror)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR
use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win, MPI_ADDRESS_KIND
use :: mpi_f08, only : ompi_win_allocate_f
implicit none
INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: size
INTEGER, INTENT(IN) :: disp_unit
TYPE(MPI_Info), INTENT(IN) :: info
TYPE(MPI_Comm), INTENT(IN) :: comm
TYPE(C_PTR), INTENT(OUT) :: baseptr
TYPE(MPI_Win), INTENT(OUT) :: win
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
integer :: c_ierror
call ompi_win_allocate_f(size, disp_unit, info%MPI_VAL, comm%MPI_VAL, baseptr, win%MPI_VAL, c_ierror)
if (present(ierror)) ierror = c_ierror
end subroutine PMPI_Win_allocate_f08

Просмотреть файл

@ -0,0 +1,28 @@
! -*- f90 -*-
!
! Copyright (c) 2010-2012 Cisco Systems, Inc. All rights reserved.
! Copyright (c) 2009-2012 Los Alamos National Security, LLC.
! All Rights reserved.
! Copyright (c) 2004-2014 High Performance Computing Center Stuttgart,
! University of Stuttgart. All rights reserved.
! $COPYRIGHT$
subroutine MPI_Win_allocate_f08(size, disp_unit, info, comm, &
baseptr, win, ierror)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR
use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win, MPI_ADDRESS_KIND
use :: mpi_f08, only : ompi_win_allocate_f
implicit none
INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: size
INTEGER, INTENT(IN) :: disp_unit
TYPE(MPI_Info), INTENT(IN) :: info
TYPE(MPI_Comm), INTENT(IN) :: comm
TYPE(C_PTR), INTENT(OUT) :: baseptr
TYPE(MPI_Win), INTENT(OUT) :: win
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
integer :: c_ierror
call ompi_win_allocate_f(size, disp_unit, info%MPI_VAL, comm%MPI_VAL, baseptr, win%MPI_VAL, c_ierror)
if (present(ierror)) ierror = c_ierror
end subroutine MPI_Win_allocate_f08

Просмотреть файл

@ -7272,6 +7272,32 @@ end subroutine MPI_Win_call_errhandler
end interface
interface MPI_Win_allocate
subroutine MPI_Win_allocate(size, disp_unit, info, comm, &
baseptr, win, ierror)
include 'mpif-config.h'
integer(KIND=MPI_ADDRESS_KIND), intent(in) :: size
integer, intent(in) :: disp_unit
integer, intent(in) :: info
integer, intent(in) :: comm
integer(KIND=MPI_ADDRESS_KIND), intent(out) :: baseptr
integer, intent(out) :: win
integer, intent(out) :: ierror
end subroutine MPI_Win_allocate
subroutine MPI_Win_allocate_cptr(size, disp_unit, info, comm, &
baseptr, win, ierror)
use, intrinsic :: iso_c_binding, only : c_ptr
include 'mpif-config.h'
integer :: disp_unit, info, comm, win, ierror
integer(KIND=MPI_ADDRESS_KIND) :: size
type(C_PTR) :: baseptr
end subroutine MPI_Win_allocate_cptr
end interface
interface MPI_Win_allocate_shared
subroutine MPI_Win_allocate_shared(size, disp_unit, info, comm, &

Просмотреть файл

@ -17,6 +17,35 @@
! below.
!
interface MPI_Win_allocate
subroutine MPI_Win_allocate(size, disp_unit, info, comm, &
baseptr, win, ierror)
include 'mpif-config.h'
integer(KIND=MPI_ADDRESS_KIND), intent(in) :: size
integer, intent(in) :: disp_unit
integer, intent(in) :: info
integer, intent(in) :: comm
integer(KIND=MPI_ADDRESS_KIND), intent(out) :: baseptr
integer, intent(out) :: win
integer, intent(out) :: ierror
end subroutine MPI_Win_allocate
! Only include the 2nd interface if we have ISO_C_BINDING / TYPE(C_PTR)
#if OMPI_FORTRAN_HAVE_ISO_C_BINDING
subroutine MPI_Win_allocate_cptr(size, disp_unit, info, comm, &
baseptr, win, ierror)
use, intrinsic :: iso_c_binding, only : c_ptr
include 'mpif-config.h'
integer :: disp_unit, info, comm, win, ierror
integer(KIND=MPI_ADDRESS_KIND) :: size
type(C_PTR) :: baseptr
end subroutine MPI_Win_allocate_cptr
#endif
end interface
interface MPI_Win_allocate_shared
subroutine MPI_Win_allocate_shared(size, disp_unit, info, comm, &