From a7bfd6e76692f00c1fcab0bebf40179acefc93e1 Mon Sep 17 00:00:00 2001 From: Gilles Gouaillardet Date: Thu, 17 Jul 2014 07:38:13 +0000 Subject: [PATCH] fortran: fix compile issue with ABSoft compilers one more fix ... cmr=v1.8.2:ticket=trac:4792 This commit was SVN r32255. The following Trac tickets were found above: Ticket 4792 --> https://svn.open-mpi.org/trac/ompi/ticket/4792 --- .../use-mpi-f08/mpi-f-interfaces-bind.h | 11 +++++++++++ ompi/mpi/fortran/use-mpi-f08/mpi-f08.F90 | 18 ++++++++---------- .../use-mpi-f08/pmpi-f-interfaces-bind.h | 16 ++++++++++++++-- 3 files changed, 33 insertions(+), 12 deletions(-) diff --git a/ompi/mpi/fortran/use-mpi-f08/mpi-f-interfaces-bind.h b/ompi/mpi/fortran/use-mpi-f08/mpi-f-interfaces-bind.h index 0a461558bc..e85adc4bc9 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mpi-f-interfaces-bind.h +++ b/ompi/mpi/fortran/use-mpi-f08/mpi-f-interfaces-bind.h @@ -2441,6 +2441,17 @@ subroutine ompi_win_shared_query_f(win, rank, size, disp_unit, baseptr,& INTEGER, OPTIONAL, INTENT(OUT) :: ierror end subroutine ompi_win_shared_query_f #else +subroutine ompi_win_shared_query_f_error(win, rank, size, disp_unit, baseptr,& + ierror) BIND(C, name="ompi_win_shared_query_f") + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR + use :: mpi_f08_types, only : MPI_ADDRESS_KIND + INTEGER, INTENT(IN) :: win + INTEGER, INTENT(IN) :: rank + INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(OUT) :: size + INTEGER, INTENT(OUT) :: disp_unit + TYPE(C_PTR), INTENT(OUT) :: baseptr + INTEGER, INTENT(OUT) :: ierror +end subroutine ompi_win_shared_query_f_error subroutine ompi_win_shared_query_f(win, rank, size, disp_unit, baseptr,& ierror) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR diff --git a/ompi/mpi/fortran/use-mpi-f08/mpi-f08.F90 b/ompi/mpi/fortran/use-mpi-f08/mpi-f08.F90 index dd98bfa69f..fdc76858a6 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mpi-f08.F90 +++ b/ompi/mpi/fortran/use-mpi-f08/mpi-f08.F90 @@ -53,6 +53,7 @@ subroutine ompi_win_shared_query_f(win, rank, size, disp_unit, baseptr,& ierror) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR use :: mpi_f08_types, only : MPI_ADDRESS_KIND + use :: mpi_f08, only : ompi_win_shared_query_f_error implicit none INTEGER, INTENT(IN) :: win INTEGER, INTENT(IN) :: rank @@ -60,17 +61,16 @@ subroutine ompi_win_shared_query_f(win, rank, size, disp_unit, baseptr,& INTEGER, INTENT(OUT) :: disp_unit TYPE(C_PTR), INTENT(OUT) :: baseptr INTEGER, OPTIONAL, INTENT(OUT) :: ierror - if (present(ierror) then - call MPI_Win_shared_query_f08(win, rank, size, disp_unit, baseptr, ierror) - else - call MPI_Win_shared_query_f08(win, rank, size, disp_unit, baseptr) - endif + INTEGER :: cerror + call ompi_win_shared_query_f_error(win, rank, size, disp_unit, baseptr, cerror) + if (present(ierror)) ierror = cerror end subroutine ompi_win_shared_query_f subroutine pompi_win_shared_query_f(win, rank, size, disp_unit, baseptr,& ierror) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR use :: mpi_f08_types, only : MPI_ADDRESS_KIND + use :: mpi_f08, only : pompi_win_shared_query_f_error implicit none INTEGER, INTENT(IN) :: win INTEGER, INTENT(IN) :: rank @@ -78,10 +78,8 @@ subroutine pompi_win_shared_query_f(win, rank, size, disp_unit, baseptr,& INTEGER, INTENT(OUT) :: disp_unit TYPE(C_PTR), INTENT(OUT) :: baseptr INTEGER, OPTIONAL, INTENT(OUT) :: ierror - if (present(ierror) then - call PMPI_Win_shared_query_f08(win, rank, size, disp_unit, baseptr, ierror) - else - call PMPI_Win_shared_query_f08(win, rank, size, disp_unit, baseptr) - endif + INTEGER :: cerror + call pompi_win_shared_query_f_error(win, rank, size, disp_unit, baseptr, cerror) + if (present(ierror)) ierror = cerror end subroutine pompi_win_shared_query_f #endif diff --git a/ompi/mpi/fortran/use-mpi-f08/pmpi-f-interfaces-bind.h b/ompi/mpi/fortran/use-mpi-f08/pmpi-f-interfaces-bind.h index c4d7d21c5c..0288c2c692 100644 --- a/ompi/mpi/fortran/use-mpi-f08/pmpi-f-interfaces-bind.h +++ b/ompi/mpi/fortran/use-mpi-f08/pmpi-f-interfaces-bind.h @@ -2278,7 +2278,19 @@ subroutine pompi_win_shared_query_f(win, rank, size, disp_unit, baseptr,& INTEGER, OPTIONAL, INTENT(OUT) :: ierror end subroutine pompi_win_shared_query_f #else -subroutine pompi_win_shared_query_f(win, rank, size, disp_unit, baseptr,& +subroutine pompi_win_shared_query_f_error(win, rank, size, disp_unit, baseptr,& + ierror) BIND(C, name="ompi_win_shared_query_f") + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR + use :: mpi_f08_types, only : MPI_ADDRESS_KIND + INTEGER, INTENT(IN) :: win + INTEGER, INTENT(IN) :: rank + INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(OUT) :: size + INTEGER, INTENT(OUT) :: disp_unit + TYPE(C_PTR), INTENT(OUT) :: baseptr + INTEGER, INTENT(OUT) :: ierror +end subroutine pompi_win_shared_query_f_error + +subroutine pmpi_win_shared_query_f(win, rank, size, disp_unit, baseptr,& ierror) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR use :: mpi_f08_types, only : MPI_ADDRESS_KIND @@ -2288,7 +2300,7 @@ subroutine pompi_win_shared_query_f(win, rank, size, disp_unit, baseptr,& INTEGER, INTENT(OUT) :: disp_unit TYPE(C_PTR), INTENT(OUT) :: baseptr INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine pompi_win_shared_query_f +end subroutine pmpi_win_shared_query_f #endif subroutine pompi_win_start_f(group,assert,win,ierror) &