[MPI3 Fortran] Fwd: [Mpi-comments] MPI 3.0: Fortran 2008 interface - issue with the LOGICAL kind
Rolf Rabenseifner
rabenseifner at hlrs.de
Fri Mar 1 07:22:04 CST 2013
Dear all,
to remove BIND(C) is a hard step and even harder to do it as an erratum
to MPI-3.0. Therefore, I need help from our Fortran specialists.
I tried to produce a complete list of questions that allows
that I better understand the Fortran rules.
The following questions are based on MPI-3.0 and the wish to
understand, where this MPI-3.0 has an inconsistency with Fortran
and whether such inconsistency problems can be resolved by removing the BIND(C)
where it is currently required. (In most cases we have BIND(C) as optional).
Please, can some expert answer the questions based on the Fortran standard including TS 29113.
And please include considerations on whether usually interoperable types are there,
e.g., usually INTEGER interoperates with int (?),
or whether there is a hard warranty.
In parenthesis, I wrote my expected answers.
They may be wrong.
If they are correct, then please confirm with "CORRECT".
The list looks long, but it contains only eleven types of
dummy arguments.
I tried to get this checked before we finalized TS 29113 and MPI-3.0
but obviously LOGICAL was overseen.
At the end of this mail, I hope nothing will be overseen.
!--------------------------------------------------------
TYPE, BIND(C) :: MPI_Comm
INTEGER :: MPI_VAL
END TYPE MPI_Comm
ABSTRACT INTERFACE
SUBROUTINE MPI_Comm_copy_attr_function(oldcomm, comm_keyval, extra_state, attribute_val_in, attribute_val_out,flag,ierror) BIND(C)
TYPE(MPI_Comm) :: oldcomm
INTEGER :: comm_keyval, ierror
INTEGER(KIND=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
LOGICAL :: flag
END SUBROUTINE
END INTERFACE
! I have the following questions about this abstract interface:
! - Do we have any problem with TYPE(MPI_Comm)
! -- if we keep BIND(C)?
(No problem, as long as INTEGER interoperates
with some C type, e.g. int.)
! -- if we remove BIND(C) on the SUBROUTNE statement?
(No problem, as long as INTEGER interoperates
with some C type, e.g. int. This answer is
based on the kept BIND(C) in the TYPE definition.)
! - Do we have any problem with INTEGER
! -- if we keep BIND(C)?
(No problem, as long as INTEGER interoperates
with some C type, e.g. int.)
! -- if we remove BIND(C) on the SUBROUTNE statement?
(No problem)
! - Do we have any problem with INTEGER(KIND=MPI_ADDRESS_KIND)
! if it represents INTEGER*8
! -- if we keep BIND(C)?
(No problem, as long as INTEGER(KIND=MPI_ADDRESS_KIND)
interoperates with some C type, e.g. long long.)
! -- if we remove BIND(C) on the SUBROUTNE statement?
(No problem)
! - Do we have any problem with LOGICAL
! -- if we keep BIND(C)?
(Hard problem, because LOGICAL s normally no counterpart in C.)
(We forget to resolve LOGICAL in TS 29113, whereas we
resolved CHARACTER(LEN=*) in TS 29113.)
! -- if we remove BIND(C) on the SUBROUTNE statement?
(No problem)
!--------------------------------------------------------
TYPE, BIND(C) :: MPI_Status
INTEGER :: MPI_SOURCE
INTEGER :: MPI_TAG
INTEGER :: MPI_ERROR
! The following fields are only examples. They are not defined in the MPI standard.
INTEGER :: MPI_internal_bytecnt_high ! type, name, and semantics is implement implementation dependent
INTEGER :: MPI_internal_bytecnt_low ! type, name, and semantics is implement implementation dependent
INTEGER :: MPI_internal_cancal_flag ! type, name, and semantics is implement implementation dependent
END TYPE MPI_Status
ABSTRACT INTERFACE
SUBROUTINE MPI_Grequest_query_function(extra_state, status, ierror) BIND(C)
TYPE(MPI_Status) :: status
INTEGER :: ierror
INTEGER(KIND=MPI_ADDRESS_KIND) :: extra_state
END SUBROUTINE
END INTERFACE
! I have the following questions about this abstract interface:
! - Do we have any problem with TYPE(MPI_Status)
! -- if we keep BIND(C)?
(No problem, as long as INTEGER interoperates
with some C type, e.g. int.)
! -- if we remove BIND(C) on the SUBROUTNE statement?
(No problem, as long as INTEGER interoperates
with some C type, e.g. int. This answer is
based on the kept BIND(C) in the TYPE definition.)
!--------------------------------------------------------
ABSTRACT INTERFACE
SUBROUTINE MPI_Datarep_conversion_function(userbuf, datatype, count, filebuf, position, extra_state, ierror) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR
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
END SUBROUTINE
END INTERFACE
! I have the following questions about this abstract interface:
! - Do we have any problem with INTEGER(KIND=MPI_OFFSET_KIND)
! if it represents INTEGER*16
! -- if we keep BIND(C)?
(No problem, as long as INTEGER(KIND=MPI_OFFSET_KIND)
interoperates with some C type, e.g. ??????.)
! -- if we remove BIND(C) on the SUBROUTNE statement?
(No problem)
! - Do we have any problem with TYPE(C_PTR), VALUE
! -- if we keep BIND(C)?
(No problem)
! -- if we remove BIND(C) on the SUBROUTNE statement?
(No problem ????????????????)
!--------------------------------------------------------
INTERFACE
SUBROUTINE MPI_Irecv(buf, count, datatype, source, tag, comm, request, ierror &
&) BIND(C,NAME='MPI_Irecv_f08')
TYPE(*), DIMENSION(..), ASYNCHRONOUS :: buf
INTEGER, INTENT(IN) :: count, source, tag
TYPE(MPI_Datatype), INTENT(IN) :: datatype
TYPE(MPI_Comm), INTENT(IN) :: comm
TYPE(MPI_Request), INTENT(OUT) :: request
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
END SUBROUTINE
END INTERFACE
! I have the following questions about this subroutine interface:
! - Do we have any problem with TYPE(*), DIMENSION(..), ASYNCHRONOUS
! -- if we keep BIND(C)?
(No problem, this is resolved by TS 29113.)
! -- if we remove BIND(C) on the SUBROUTNE statement?
(No functional problem, because TYPE(*), DIMENSION(..)
and ASYNCHRONOUS is defined in TS 29113 also for
non-BIND(C) interfaces.
Latency performance problem, because we should write this
routine as a Fortran-written wrapper that internally calls
an internal BIND(C) routine that handles the buffer.)
! - Do we have any problem with INTEGER, OPTIONAL
! -- if we keep BIND(C)?
(No problem, this is resolved by TS 29113.)
! -- if we remove BIND(C) on the SUBROUTNE statement?
(No problem)
!--------------------------------------------------------
INTERFACE
SUBROUTINE MPI_Unpack_external(datarep, inbuf, insize, position, outbuf, outcount, datatype, ierror) BIND(C)
CHARACTER(LEN=*), INTENT(IN) :: datarep
TYPE(*), DIMENSION(..), INTENT(IN) :: inbuf
TYPE(*), DIMENSION(..) :: outbuf
INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: insize
INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(INOUT) :: position
INTEGER, INTENT(IN) :: outcount
TYPE(MPI_Datatype), INTENT(IN) :: datatype
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
END SUBROUTINE
END INTERFACE
! I have the following questions about this subroutine interface:
! - Do we have any problem with CHARACTER(LEN=*)
! -- if we keep BIND(C)?
(No problem, this is resolved by TS 29113.)
! -- if we remove BIND(C) on the SUBROUTNE statement?
(No problem)
!--------------------------------------------------------
INTERFACE
DOUBLE PRECISION FUNCTION MPI_Wtime() BIND(C)
END FUNCTION
END INTERFACE
! I have the following questions about this function interface:
! - Do we have any problem with DOUBLE PRECISION
! -- if we keep BIND(C)?
(No problem, as long as DOUBLE PRECISION
interoperates with some C type, e.g.double
! -- if we remove BIND(C) on the FUNCTION statement?
(No problem)
! in the following function interface:
!------------------------
The complete list of dummy argument types is:
TYPE(*), DIMENSION(..), ASYNCHRONOUS [checked above]
TYPE(*), DIMENSION(..)
INTEGER [checked above]
INTEGER, ASYNCHRONOUS
INTEGER, DIMENSION(1)
INTEGER(KIND=MPI_OFFSET_KIND) [checked above]
INTEGER(KIND=MPI_ADDRESS_KIND) [checked above]
INTEGER(KIND=MPI_ADDRESS_KIND), ASYNCHRONOUS
INTEGER(KIND=MPI_COUNT_KIND)
INTEGER, OPTIONAL [checked above]
LOGICAL [checked above]
CHARACTER(LEN=*) [checked above]
CHARACTER(LEN=MPI_MAX_ERROR_STRING)
CHARACTER(LEN=valuelen) ! with valuelen being another dummy argument
TYPE(C_PTR), VALUE [checked above]
TYPE(C_PTR)
TYPE(MPI_Comm) [checked above]
TYPE(MPI_Comm), ASYNCHRONOUS
TYPE(MPI_Status) [checked above]
Are there further problems that I did not catch with my questions?
Best regards
Rolf
----- Original Message -----
> From: "N.M. Maclaren" <nmm1 at cam.ac.uk>
> To: "MPI-3 Fortran working group" <mpi3-fortran at lists.mpi-forum.org>
> Sent: Friday, March 1, 2013 9:47:33 AM
> Subject: Re: [MPI3 Fortran] Fwd: [Mpi-comments] MPI 3.0: Fortran 2008 interface - issue with the LOGICAL kind
> On Feb 28 2013, Tobias Burnus wrote:
> >>
> >> Drop ALL of the BIND(C) from the functions, as they aren't
> >> currently
> >> conforming. Plain INTEGER is not guaranteed to be
> >> interoperable, and nor is DOUBLE PRECISION (Wtime, Wtick). I hope
> >> to
> >> make default types more interoperable in the next standard, but
> >> that hasn't even been discussed yet.
> >
> >That's probably the simplest. The actual implementation might even
> >use C
> >binding in this case, iff the Fortran interface is already
> >interopable
> >with C, e.g. integer matches "int" etc.
>
> Yes, precisely. Even if that were not possible, generating interface
> functions automatically from the specifications isn't hard.
>
>
> Regards,
> Nick Maclaren.
>
> _______________________________________________
> mpi3-fortran mailing list
> mpi3-fortran at lists.mpi-forum.org
> http://lists.mpi-forum.org/mailman/listinfo.cgi/mpi3-fortran
--
Dr. Rolf Rabenseifner . . . . . . . . . .. email rabenseifner at hlrs.de
High Performance Computing Center (HLRS) . phone ++49(0)711/685-65530
University of Stuttgart . . . . . . . . .. fax ++49(0)711 / 685-65832
Head of Dpmt Parallel Computing . . . www.hlrs.de/people/rabenseifner
Nobelstr. 19, D-70550 Stuttgart, Germany . . . . (Office: Room 1.307)
More information about the mpiwg-fortran
mailing list