mpi_f08: correctly implements MPI_{COMM,TYPE,WIN}_{DUP,NULL_{COPY,DELETE}}_FN
Fixes open-mpi/ompi#1323
Этот коммит содержится в:
родитель
728a97c558
Коммит
cda094afc7
@ -43,8 +43,6 @@ noinst_LTLIBRARIES = $(module_sentinel_file)
|
||||
mpi-f08.lo: $(module_sentinel_file)
|
||||
mpi-f08.lo: mpi-f08.F90
|
||||
mpi-f08.lo: mpi-f-interfaces-bind.h pmpi-f-interfaces-bind.h
|
||||
mpi-f08.lo: attr-fn-f08-callback-interfaces.h
|
||||
mpi-f08.lo: conversion-fn-null-f08-interface.h
|
||||
mpi-f08.lo: sizeof_f08.h
|
||||
|
||||
#
|
||||
@ -800,8 +798,6 @@ libmpi_usempif08_la_SOURCES = \
|
||||
$(pmpi_api_files) \
|
||||
mpi-f-interfaces-bind.h \
|
||||
pmpi-f-interfaces-bind.h \
|
||||
attr-fn-f08-callback-interfaces.h \
|
||||
conversion-fn-null-f08-interface.h \
|
||||
mpi-f08.F90 \
|
||||
buffer_detach.c \
|
||||
constants.h \
|
||||
@ -843,8 +839,6 @@ $(pmpi_api_lo_files): mpi-f08.lo
|
||||
|
||||
mpi-f08.lo: $(module_sentinel_file) $(SIZEOF_H)
|
||||
mpi-f08.lo: mpi-f-interfaces-bind.h pmpi-f-interfaces-bind.h
|
||||
mpi-f08.lo: attr-fn-f08-callback-interfaces.h
|
||||
mpi-f08.lo: conversion-fn-null-f08-interface.h
|
||||
|
||||
###########################################################################
|
||||
|
||||
@ -854,6 +848,7 @@ libforce_usempif08_internal_modules_to_be_built_la_SOURCES = \
|
||||
mpi-f08-types.F90 \
|
||||
mpi-f08-interfaces.F90 \
|
||||
mpi-f08-interfaces-callbacks.F90 \
|
||||
mpi-f08-callbacks.F90 \
|
||||
pmpi-f08-interfaces.F90
|
||||
|
||||
config_h = \
|
||||
@ -873,6 +868,9 @@ mpi-f08-interfaces.lo: mpi-f08-interfaces-callbacks.lo
|
||||
mpi-f08-interfaces-callbacks.lo: $(config_h)
|
||||
mpi-f08-interfaces-callbacks.lo: mpi-f08-interfaces-callbacks.F90
|
||||
mpi-f08-interfaces-callbacks.lo: mpi-f08-types.lo
|
||||
mpi-f08-callbacks.lo: $(config_h)
|
||||
mpi-f08-callbacks.lo: mpi-f08-callbacks.F90
|
||||
mpi-f08-callbacks.lo: mpi-f08-types.lo
|
||||
pmpi-f08-interfaces.lo: $(config_h)
|
||||
pmpi-f08-interfaces.lo: pmpi-f08-interfaces.F90
|
||||
pmpi-f08-interfaces.lo: mpi-f08-interfaces-callbacks.lo
|
||||
|
@ -1,152 +0,0 @@
|
||||
! -*- f90 -*-
|
||||
! Copyright (c) 2004-2005 The Regents of the University of California.
|
||||
! All rights reserved.
|
||||
! Copyright (c) 2006-2014 Cisco Systems, Inc. All rights reserved.
|
||||
! Copyright (c) 2013 Los Alamos National Security, LLC. All rights
|
||||
! reserved.
|
||||
! Copyright (c) 2015-2016 Research Organization for Information Science
|
||||
! and Technology (RIST). All rights reserved.
|
||||
! $COPYRIGHT$
|
||||
!
|
||||
! Additional copyrights may follow
|
||||
!
|
||||
! $HEADER$
|
||||
!
|
||||
|
||||
!
|
||||
! F08 handle (e.g., Type(MPI_Comm)) pre-defined attribute callback
|
||||
! function interfaces
|
||||
!
|
||||
|
||||
interface
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
subroutine MPI_NULL_COPY_FN( comm, comm_keyval, extra_state, &
|
||||
attribute_val_in, attribute_val_out, &
|
||||
flag, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Comm) :: comm
|
||||
integer :: comm_keyval, extra_state
|
||||
integer :: attribute_val_in, attribute_val_out, ierr
|
||||
logical :: flag
|
||||
end subroutine MPI_NULL_COPY_FN
|
||||
|
||||
subroutine MPI_NULL_DELETE_FN( comm, comm_keyval, attribute_val_out, &
|
||||
extra_state, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Comm) :: comm
|
||||
integer :: comm_keyval, attribute_val_out, extra_state, ierr
|
||||
end subroutine MPI_NULL_DELETE_FN
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
subroutine MPI_COMM_NULL_COPY_FN( comm, comm_keyval, extra_state, &
|
||||
attribute_val_in, attribute_val_out, &
|
||||
flag, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Comm) :: comm
|
||||
integer :: comm_keyval
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
integer :: ierr
|
||||
logical :: flag
|
||||
end subroutine MPI_COMM_NULL_COPY_FN
|
||||
|
||||
subroutine MPI_COMM_DUP_FN( comm, comm_keyval, extra_state, &
|
||||
attribute_val_in, attribute_val_out, &
|
||||
flag, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Comm) :: comm
|
||||
integer :: comm_keyval
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
integer :: ierr
|
||||
logical :: flag
|
||||
end subroutine MPI_COMM_DUP_FN
|
||||
|
||||
subroutine MPI_COMM_NULL_DELETE_FN(comm, comm_keyval, attribute_val_out, &
|
||||
extra_state, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Comm) :: comm
|
||||
integer :: comm_keyval
|
||||
integer(kind=MPI_ADDRESS_KIND) :: attribute_val_out, extra_state
|
||||
integer :: ierr
|
||||
end subroutine MPI_COMM_NULL_DELETE_FN
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
subroutine MPI_TYPE_NULL_COPY_FN( type, type_keyval, extra_state, &
|
||||
attribute_val_in, attribute_val_out, &
|
||||
flag, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Datatype) :: type
|
||||
integer :: type_keyval
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
integer :: ierr
|
||||
logical :: flag
|
||||
end subroutine MPI_TYPE_NULL_COPY_FN
|
||||
|
||||
subroutine MPI_TYPE_DUP_FN( type, type_keyval, extra_state, &
|
||||
attribute_val_in, attribute_val_out, &
|
||||
flag, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Datatype) :: type
|
||||
integer :: type_keyval
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
integer :: ierr
|
||||
logical :: flag
|
||||
end subroutine MPI_TYPE_DUP_FN
|
||||
|
||||
subroutine MPI_TYPE_NULL_DELETE_FN( type, type_keyval, attribute_val_out, &
|
||||
extra_state, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Datatype) :: type
|
||||
integer :: type_keyval
|
||||
integer(kind=MPI_ADDRESS_KIND) :: attribute_val_out, extra_state
|
||||
integer :: ierr
|
||||
end subroutine MPI_TYPE_NULL_DELETE_FN
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
subroutine MPI_WIN_NULL_COPY_FN( window, win_keyval, extra_state, &
|
||||
attribute_val_in, attribute_val_out, &
|
||||
flag, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Win) :: window
|
||||
integer :: win_keyval
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
integer :: ierr
|
||||
logical :: flag
|
||||
end subroutine MPI_WIN_NULL_COPY_FN
|
||||
|
||||
subroutine MPI_WIN_DUP_FN( window, win_keyval, extra_state, &
|
||||
attribute_val_in, attribute_val_out, &
|
||||
flag, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Win) :: window
|
||||
integer :: win_keyval
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
integer :: ierr
|
||||
logical :: flag
|
||||
end subroutine MPI_WIN_DUP_FN
|
||||
|
||||
subroutine MPI_WIN_NULL_DELETE_FN( window, win_keyval, attribute_val_out, &
|
||||
extra_state, ierr )
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Win) :: window
|
||||
integer :: win_keyval
|
||||
integer(kind=MPI_ADDRESS_KIND) :: attribute_val_out, extra_state
|
||||
integer :: ierr
|
||||
end subroutine MPI_WIN_NULL_DELETE_FN
|
||||
|
||||
end interface
|
@ -1,35 +0,0 @@
|
||||
! -*- f90 -*-
|
||||
! Copyright (c) 2006-2014 Cisco Systems, Inc. All rights reserved.
|
||||
! $COPYRIGHT$
|
||||
!
|
||||
! Additional copyrights may follow
|
||||
!
|
||||
! $HEADER$
|
||||
!
|
||||
|
||||
! Note about these declarations: these are "external" functions in
|
||||
! mpif-common.h. However, if we don't declare them here, compilers will add
|
||||
! them to the "mpi" module namespace, and result in linker errors if MPI
|
||||
! F90 applications try to use them. because the implementations of
|
||||
! these functions are not in the MPI module namespace -- they're the F77
|
||||
! functions.
|
||||
|
||||
!
|
||||
! F08 handle pre-defined conversion callback function interface
|
||||
!
|
||||
|
||||
interface
|
||||
|
||||
subroutine MPI_CONVERSION_FN_NULL(userbuf, datatype, count, filebuf, &
|
||||
position, extra_state, ierror)
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
character(len=*), intent(in) :: filebuf
|
||||
character(len=*), intent(out) :: userbuf
|
||||
type(MPI_Datatype) :: datatype
|
||||
integer, intent(in) :: count, ierror
|
||||
integer(kind=MPI_OFFSET_KIND), intent(in) :: position
|
||||
integer(kind=MPI_ADDRESS_KIND), intent(in) :: extra_state
|
||||
end subroutine MPI_CONVERSION_FN_NULL
|
||||
|
||||
end interface
|
142
ompi/mpi/fortran/use-mpi-f08/mpi-f08-callbacks.F90
Обычный файл
142
ompi/mpi/fortran/use-mpi-f08/mpi-f08-callbacks.F90
Обычный файл
@ -0,0 +1,142 @@
|
||||
! -*- f90 -*-
|
||||
! Copyright (c) 2016 Research Organization for Information Science
|
||||
! and Technology (RIST). All rights reserved.
|
||||
! $COPYRIGHT$
|
||||
|
||||
#include "ompi/mpi/fortran/configure-fortran-output.h"
|
||||
|
||||
module mpi_f08_callbacks
|
||||
|
||||
! MPI3.1, p270, 5-19
|
||||
|
||||
contains
|
||||
|
||||
subroutine MPI_COMM_DUP_FN(oldcomm,comm_keyval,extra_state, &
|
||||
attribute_val_in,attribute_val_out,flag,ierror)
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Comm) :: oldcomm
|
||||
integer :: comm_keyval, ierror
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
logical :: flag
|
||||
|
||||
flag = .true.
|
||||
attribute_val_out = attribute_val_in
|
||||
ierror = MPI_SUCCESS
|
||||
end subroutine
|
||||
|
||||
subroutine MPI_COMM_NULL_COPY_FN(oldcomm,comm_keyval,extra_state, &
|
||||
attribute_val_in,attribute_val_out,flag,ierror)
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Comm) :: oldcomm
|
||||
integer :: comm_keyval, ierror
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
logical :: flag
|
||||
|
||||
flag = .false.
|
||||
ierror = MPI_SUCCESS
|
||||
end subroutine
|
||||
|
||||
subroutine MPI_COMM_NULL_DELETE_FN(comm,comm_keyval, &
|
||||
attribute_val, extra_state, ierror)
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Comm) :: comm
|
||||
integer :: comm_keyval, ierror
|
||||
integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state
|
||||
|
||||
ierror = MPI_SUCCESS
|
||||
end subroutine
|
||||
|
||||
subroutine MPI_TYPE_DUP_FN(oldtype,type_keyval,extra_state, &
|
||||
attribute_val_in,attribute_val_out,flag,ierror)
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Datatype) :: oldtype
|
||||
integer :: type_keyval, ierror
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
logical :: flag
|
||||
|
||||
flag = .true.
|
||||
attribute_val_out = attribute_val_in
|
||||
ierror = MPI_SUCCESS
|
||||
end subroutine
|
||||
|
||||
subroutine MPI_TYPE_NULL_COPY_FN(oldtype,type_keyval,extra_state, &
|
||||
attribute_val_in,attribute_val_out,flag,ierror)
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Datatype) :: oldtype
|
||||
integer :: type_keyval, ierror
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
logical :: flag
|
||||
|
||||
flag = .false.
|
||||
ierror = MPI_SUCCESS
|
||||
end subroutine
|
||||
|
||||
subroutine MPI_TYPE_NULL_DELETE_FN(datatype,type_keyval, &
|
||||
attribute_val, extra_state, ierror)
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Datatype) :: datatype
|
||||
integer :: type_keyval, ierror
|
||||
integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state
|
||||
|
||||
ierror = MPI_SUCCESS
|
||||
end subroutine
|
||||
|
||||
subroutine MPI_WIN_DUP_FN(oldwin,win_keyval,extra_state, &
|
||||
attribute_val_in,attribute_val_out,flag,ierror)
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Win) :: oldwin
|
||||
integer :: win_keyval, ierror
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
logical :: flag
|
||||
|
||||
flag = .true.
|
||||
attribute_val_out = attribute_val_in
|
||||
ierror = MPI_SUCCESS
|
||||
end subroutine
|
||||
|
||||
subroutine MPI_WIN_NULL_COPY_FN(oldwin,win_keyval,extra_state, &
|
||||
attribute_val_in,attribute_val_out,flag,ierror)
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Win) :: oldwin
|
||||
integer :: win_keyval, ierror
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
|
||||
logical :: flag
|
||||
|
||||
flag = .false.
|
||||
ierror = MPI_SUCCESS
|
||||
end subroutine
|
||||
|
||||
subroutine MPI_WIN_NULL_DELETE_FN(win,win_keyval, &
|
||||
attribute_val, extra_state, ierror)
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(MPI_Win) :: win
|
||||
integer :: win_keyval, ierror
|
||||
integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state
|
||||
|
||||
ierror = MPI_SUCCESS
|
||||
end subroutine
|
||||
|
||||
subroutine MPI_CONVERSION_FN_NULL(userbuf, datatype, count, &
|
||||
filebuf, position, extra_state, ierror)
|
||||
use, intrinsic :: iso_c_binding, only : c_ptr
|
||||
use mpi_f08_types
|
||||
implicit none
|
||||
type(c_ptr), value :: userbuf, filebuf
|
||||
type(MPI_Datatype) :: datatype
|
||||
integer :: count, ierror
|
||||
integer(kind=MPI_OFFSET_KIND) :: position
|
||||
integer(kind=MPI_ADDRESS_KIND) :: extra_state
|
||||
|
||||
! Do nothing
|
||||
end subroutine
|
||||
|
||||
end module mpi_f08_callbacks
|
@ -13,6 +13,8 @@
|
||||
! Copyright (c) 2006-2014 Cisco Systems, Inc. All rights reserved.
|
||||
! Copyright (c) 2009-2012 Los Alamos National Security, LLC.
|
||||
! All rights reserved.
|
||||
! Copyright (c) 2016 Research Organization for Information Science
|
||||
! and Technology (RIST). All rights reserved.
|
||||
! $COPYRIGHT$
|
||||
!
|
||||
! Additional copyrights may follow
|
||||
@ -27,6 +29,7 @@ module mpi_f08
|
||||
use mpi_f08_types
|
||||
use mpi_f08_interfaces ! this module contains the mpi_f08 interface declarations
|
||||
use pmpi_f08_interfaces ! this module contains the pmpi_f08 interface declarations
|
||||
use mpi_f08_callbacks ! this module contains the mpi_f08 attribute callback subroutines
|
||||
|
||||
!
|
||||
! Declaration of the interfaces to the ompi impl files
|
||||
@ -35,14 +38,6 @@ module mpi_f08
|
||||
#include "mpi-f-interfaces-bind.h"
|
||||
#include "pmpi-f-interfaces-bind.h"
|
||||
|
||||
! The MPI attribute callback functions
|
||||
|
||||
include "attr-fn-f08-callback-interfaces.h"
|
||||
|
||||
! The MPI_CONVERSION_FN_NULL function
|
||||
|
||||
include "conversion-fn-null-f08-interface.h"
|
||||
|
||||
! The sizeof interfaces
|
||||
|
||||
include "sizeof_f08.h"
|
||||
|
Загрузка…
x
Ссылка в новой задаче
Block a user