From c12d31d66a38d77fde70a88e2050bd607e181410 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 1 Jul 2026 12:35:59 +0200 Subject: [PATCH] Fortran: support for the mpi_f08 module current MPI implementations provide the mpi_f08 module which uses newer Fortran features. The current fftw3-mpi interfaces are incompatible because the communicator has changed from an integer to type(MPI_comm). According to Jeff Hammond, only a syntax change is needed because "MPI object handles are properly typed and thus compilers will not accept erroneous usage. At the same time, MPI object handle types are interoperable with the old method, because the type contains the integer handle as its only member." https://users.ugent.be/~kehoste/eum25/014_eum25_keynote_JeffHammond_MPI.pdf With this change, a second set of MPI interfaces for Fortran with an f08 extension are generated. They can be used together with mpi_f08. --- api/Makefile.am | 2 +- api/genf08.pl | 210 ++++++++++++++++++++++++++++++++++++++++++++++++ mpi/Makefile.am | 20 ++++- mpi/f08api.sh | 45 +++++++++++ 4 files changed, 272 insertions(+), 5 deletions(-) create mode 100644 api/genf08.pl create mode 100644 mpi/f08api.sh diff --git a/api/Makefile.am b/api/Makefile.am index 5cb108203..7dc9c32ba 100644 --- a/api/Makefile.am +++ b/api/Makefile.am @@ -1,7 +1,7 @@ AM_CPPFLAGS = -I $(top_srcdir) AM_CFLAGS = $(STACK_ALIGN_CFLAGS) -EXTRA_DIST = f03api.sh genf03.pl fftw3.f03.in +EXTRA_DIST = f03api.sh genf03.pl genf08.pl fftw3.f03.in include_HEADERS = fftw3.h fftw3.f fftw3l.f03 fftw3q.f03 nodist_include_HEADERS = fftw3.f03 diff --git a/api/genf08.pl b/api/genf08.pl new file mode 100644 index 000000000..10ae9d84e --- /dev/null +++ b/api/genf08.pl @@ -0,0 +1,210 @@ +#!/usr/bin/perl -w +# Generate Fortran 2008 module interfaces (with mpi_f08 type-safe wrappers) +# from a sequence of C function declarations of the form (one per line): +# extern (...args...) +# extern (...args...) +# ... +# with no line breaks within a given function. (It's too much work to +# write a general parser, since we just have to handle FFTW's header files.) + +sub canonicalize_type { + my($type); + ($type) = @_; + $type =~ s/ +/ /g; + $type =~ s/^ //; + $type =~ s/ $//; + $type =~ s/([^\* ])\*/$1 \*/g; + return $type; +} + +# C->Fortran map of supported return types +%return_types = ( + "int" => "integer(C_INT)", + "ptrdiff_t" => "integer(C_INTPTR_T)", + "size_t" => "integer(C_SIZE_T)", + "double" => "real(C_DOUBLE)", + "float" => "real(C_FLOAT)", + "long double" => "real(C_LONG_DOUBLE)", + "__float128" => "real(16)", + "fftw_plan" => "type(C_PTR)", + "fftwf_plan" => "type(C_PTR)", + "fftwl_plan" => "type(C_PTR)", + "fftwq_plan" => "type(C_PTR)", + "void *" => "type(C_PTR)", + "char *" => "type(C_PTR)", + "double *" => "type(C_PTR)", + "float *" => "type(C_PTR)", + "long double *" => "type(C_PTR)", + "__float128 *" => "type(C_PTR)", + "fftw_complex *" => "type(C_PTR)", + "fftwf_complex *" => "type(C_PTR)", + "fftwl_complex *" => "type(C_PTR)", + "fftwq_complex *" => "type(C_PTR)", + ); + +# C->Fortran map of supported argument types +%arg_types = ( + "int" => "integer(C_INT), value", + "unsigned" => "integer(C_INT), value", + "size_t" => "integer(C_SIZE_T), value", + "ptrdiff_t" => "integer(C_INTPTR_T), value", + + "fftw_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", + "fftwf_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", + "fftwl_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", + "fftwq_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", + + "double" => "real(C_DOUBLE), value", + "float" => "real(C_FLOAT), value", + "long double" => "real(C_LONG_DOUBLE), value", + "__float128" => "real(16), value", + + "fftw_complex" => "complex(C_DOUBLE_COMPLEX), value", + "fftwf_complex" => "complex(C_DOUBLE_COMPLEX), value", + "fftwl_complex" => "complex(C_LONG_DOUBLE), value", + "fftwq_complex" => "complex(16), value", + + "fftw_plan" => "type(C_PTR), value", + "fftwf_plan" => "type(C_PTR), value", + "fftwl_plan" => "type(C_PTR), value", + "fftwq_plan" => "type(C_PTR), value", + "const fftw_plan" => "type(C_PTR), value", + "const fftwf_plan" => "type(C_PTR), value", + "const fftwl_plan" => "type(C_PTR), value", + "const fftwq_plan" => "type(C_PTR), value", + + "const int *" => "integer(C_INT), dimension(*), intent(in)", + "ptrdiff_t *" => "integer(C_INTPTR_T), intent(out)", + "const ptrdiff_t *" => "integer(C_INTPTR_T), dimension(*), intent(in)", + + "const fftw_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", + "const fftwf_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", + "const fftwl_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", + "const fftwq_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", + + "double *" => "real(C_DOUBLE), dimension(*), intent(out)", + "float *" => "real(C_FLOAT), dimension(*), intent(out)", + "long double *" => "real(C_LONG_DOUBLE), dimension(*), intent(out)", + "__float128 *" => "real(16), dimension(*), intent(out)", + + "fftw_complex *" => "complex(C_DOUBLE_COMPLEX), dimension(*), intent(out)", + "fftwf_complex *" => "complex(C_FLOAT_COMPLEX), dimension(*), intent(out)", + "fftwl_complex *" => "complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out)", + "fftwq_complex *" => "complex(16), dimension(*), intent(out)", + + "const fftw_iodim *" => "type(fftw_iodim), dimension(*), intent(in)", + "const fftwf_iodim *" => "type(fftwf_iodim), dimension(*), intent(in)", + "const fftwl_iodim *" => "type(fftwl_iodim), dimension(*), intent(in)", + "const fftwq_iodim *" => "type(fftwq_iodim), dimension(*), intent(in)", + + "const fftw_iodim64 *" => "type(fftw_iodim64), dimension(*), intent(in)", + "const fftwf_iodim64 *" => "type(fftwf_iodim64), dimension(*), intent(in)", + "const fftwl_iodim64 *" => "type(fftwl_iodim64), dimension(*), intent(in)", + "const fftwq_iodim64 *" => "type(fftwq_iodim64), dimension(*), intent(in)", + + "void *" => "type(C_PTR), value", + "FILE *" => "type(C_PTR), value", + + "const char *" => "character(C_CHAR), dimension(*), intent(in)", + + "fftw_write_char_func" => "type(C_FUNPTR), value", + "fftwf_write_char_func" => "type(C_FUNPTR), value", + "fftwl_write_char_func" => "type(C_FUNPTR), value", + "fftwq_write_char_func" => "type(C_FUNPTR), value", + "fftw_read_char_func" => "type(C_FUNPTR), value", + "fftwf_read_char_func" => "type(C_FUNPTR), value", + "fftwl_read_char_func" => "type(C_FUNPTR), value", + "fftwq_read_char_func" => "type(C_FUNPTR), value", + + # MPI_Comm is interoperable with plain integer via the mpi_f08 + # module, so we use TYPE(MPI_Comm) here for type safety. + "MPI_Comm" => "type(MPI_Comm), value" + ); + +while (<>) { + next if /^ *$/; + if (/^ *extern +([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *\((.*)\) *$/) { + $ret = &canonicalize_type($1); + $name = $2; + + $args = $3; + $args =~ s/^ *void *$//; + + $bad = ($ret ne "void") && !exists($return_types{$ret}); + foreach $arg (split(/ *, */, $args)) { + $arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/; + $argtype = &canonicalize_type($1); + $bad = 1 if !exists($arg_types{$argtype}); + } + if ($bad) { + print "! Unable to generate Fortran interface for $name\n"; + next; + } + + # any function taking an MPI_Comm arg needs a C wrapper (grr). + if ($args =~ /MPI_Comm/) { + $cname = $name . "_f03"; + } + else { + $cname = $name; + } + + # Fortran has a 132-character line-length limit by default (grr) + $len = 0; + + print " "; $len = $len + length(" "); + if ($ret eq "void") { + $kind = "subroutine" + } + else { + print "$return_types{$ret} "; + $len = $len + length("$return_types{$ret} "); + $kind = "function" + } + print "$kind $name("; $len = $len + length("$kind $name("); + $len0 = $len; + + $argnames = $args; + $argnames =~ s/([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) */$2/g; + $comma = ""; + foreach $argname (split(/ *, */, $argnames)) { + if ($len + length("$comma$argname") + 3 > 132) { + printf ", &\n%*s", $len0, ""; + $len = $len0; + $comma = ""; + } + print "$comma$argname"; + $len = $len + length("$comma$argname"); + $comma = ","; + } + print ") "; $len = $len + 2; + + if ($len + length("bind(C, name='$cname')") > 132) { + printf "&\n%*s", $len0 - length("$name("), ""; + } + print "bind(C, name='$cname')\n"; + + print " import\n"; + foreach $arg (split(/ *, */, $args)) { + $arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/; + $argtype = &canonicalize_type($1); + $argname = $2; + $ftype = $arg_types{$argtype}; + + # Various special cases for argument types: + if ($name =~ /_flops$/ && $argtype eq "double *") { + $ftype = "real(C_DOUBLE), intent(out)" + } + if ($name =~ /_execute/ && ($argname eq "ri" || + $argname eq "ii" || + $argname eq "in")) { + $ftype =~ s/intent\(out\)/intent(inout)/; + } + + print " $ftype :: $argname\n" + } + + print " end $kind $name\n"; + print " \n"; + } +} diff --git a/mpi/Makefile.am b/mpi/Makefile.am index 8e43fac5b..9025e30ba 100644 --- a/mpi/Makefile.am +++ b/mpi/Makefile.am @@ -6,15 +6,15 @@ AM_CPPFLAGS = -I $(top_srcdir) -I $(top_srcdir)/api if MPI lib_LTLIBRARIES = libfftw3@PREC_SUFFIX@_mpi.la include_HEADERS = fftw3-mpi.h -nodist_include_HEADERS = fftw3-mpi.f03 fftw3l-mpi.f03 +nodist_include_HEADERS = fftw3-mpi.f03 fftw3l-mpi.f03 fftw3-mpi.f08 fftw3l-mpi.f08 noinst_PROGRAMS = mpi-bench endif CC=@MPICC@ -EXTRA_DIST = testsched.c f03api.sh f03-wrap.sh genf03-wrap.pl fftw3-mpi.f03.in fftw3l-mpi.f03.in -BUILT_SOURCES = fftw3-mpi.f03.in fftw3-mpi.f03 fftw3l-mpi.f03.in fftw3l-mpi.f03 f03-wrap.c -CLEANFILES = fftw3-mpi.f03 fftw3l-mpi.f03 +EXTRA_DIST = testsched.c f03api.sh f03-wrap.sh genf03-wrap.pl fftw3-mpi.f03.in fftw3l-mpi.f03.in f08api.sh fftw3-mpi.f08.in fftw3l-mpi.f08.in +BUILT_SOURCES = fftw3-mpi.f03.in fftw3-mpi.f03 fftw3l-mpi.f03.in fftw3l-mpi.f03 fftw3-mpi.f08.in fftw3-mpi.f08 fftw3l-mpi.f08.in fftw3l-mpi.f08 f03-wrap.c +CLEANFILES = fftw3-mpi.f03 fftw3l-mpi.f03 fftw3-mpi.f08 fftw3l-mpi.f08 TRANSPOSE_SRC = transpose-alltoall.c transpose-pairwise.c transpose-recurse.c transpose-problem.c transpose-solve.c mpi-transpose.h DFT_SRC = dft-serial.c dft-rank-geq2.c dft-rank-geq2-transposed.c dft-rank1.c dft-rank1-bigvec.c dft-problem.c dft-solve.c mpi-dft.h @@ -87,6 +87,12 @@ fftw3-mpi.f03: fftw3-mpi.f03.in Makefile fftw3l-mpi.f03: fftw3l-mpi.f03.in Makefile sed 's/C_MPI_FINT/@C_MPI_FINT@/' $(srcdir)/fftw3l-mpi.f03.in > $@ +fftw3-mpi.f08: fftw3-mpi.f08.in Makefile + sed 's/C_MPI_FINT/@C_MPI_FINT@/' $(srcdir)/fftw3-mpi.f08.in > $@ + +fftw3l-mpi.f08: fftw3l-mpi.f08.in Makefile + sed 's/C_MPI_FINT/@C_MPI_FINT@/' $(srcdir)/fftw3l-mpi.f08.in > $@ + if MAINTAINER_MODE fftw3-mpi.f03.in: fftw3-mpi.h f03api.sh $(top_srcdir)/api/genf03.pl @@ -95,6 +101,12 @@ fftw3-mpi.f03.in: fftw3-mpi.h f03api.sh $(top_srcdir)/api/genf03.pl fftw3l-mpi.f03.in: fftw3-mpi.h f03api.sh $(top_srcdir)/api/genf03.pl sh $(srcdir)/f03api.sh l | grep -v parameter | sed 's/fftw3.f03/fftw3l.f03/' > $@ +fftw3-mpi.f08.in: fftw3-mpi.h f08api.sh $(top_srcdir)/api/genf08.pl + sh $(srcdir)/f08api.sh d f > $@ + +fftw3l-mpi.f08.in: fftw3-mpi.h f08api.sh $(top_srcdir)/api/genf08.pl + sh $(srcdir)/f08api.sh l | grep -v parameter | sed 's/include .fftw3.f03./include '"'"'fftw3l.f03'"'"'/; s/module fftw3_mpi/module fftw3l_mpi/' > $@ + f03-wrap.c: fftw3-mpi.h f03-wrap.sh genf03-wrap.pl sh $(srcdir)/f03-wrap.sh > $@ diff --git a/mpi/f08api.sh b/mpi/f08api.sh new file mode 100644 index 000000000..cece8a5fe --- /dev/null +++ b/mpi/f08api.sh @@ -0,0 +1,45 @@ +#! /bin/sh + +# Script to generate the fftw3_mpi Fortran 2008 module from the +# fftw3-mpi.h header file, using mpi_f08 type-safe MPI bindings. + +# This is designed so that the Fortran caller can do: +# use fftw3_mpi +# and then call the C FFTW MPI functions directly, with TYPE(MPI_Comm) +# instead of an integer communicator handle. + +echo "! Generated automatically. DO NOT EDIT!" +echo + +echo "module fftw3_mpi" +echo " use, intrinsic :: iso_c_binding" +echo " use mpi_f08, only: MPI_Comm" +echo " implicit none" +echo + +echo " include 'fftw3.f03'" +echo + +# Extract constants +perl -pe 's/#define +([A-Z0-9_]+) +\(([+-]?[0-9]+)U?\)/\n integer\(C_INTPTR_T\), parameter :: \1 = \2\n/g' < fftw3-mpi.h | grep 'integer(C_INTPTR_T)' +perl -pe 'if (/#define +([A-Z0-9_]+) +\(([0-9]+)U? *<< *([0-9]+)\)/) { print "\n integer\(C_INT\), parameter :: $1 = ",$2 << $3,"\n"; }' < fftw3-mpi.h | grep 'integer(C_INT)' + +# Extract function declarations +for p in $*; do + if test "$p" = "d"; then p=""; fi + + echo + cat <