#! /usr/bin/env perl
##
## Copyright (C) by Argonne National Laboratory
##     See COPYRIGHT in top-level directory
##

# FIXME:
# TODO:
# For MPI-3 (See 17.1.3 for details), need to add (for mpi module; mpi_f08
# module will require different system entirely):
# *ALL* functions declared
#    This will require the use of non-standard, compiler-specific options,
#    and may require overriding user choices about warning levels and options
#    in order to handle the choice arguments
# Provide DERIVED TYPES for MPI_STATUS and all handles (as in the mpi_f08
#     module).  For all handle types, provide overloads for .EQ., .NE., ==
#     and /= operators (Partially done)
# Check on MPI_F_SYNC_REG, mentioned on page 598.

use warnings;

# binding.sub provides the routines for reading the prototype file
# and extracting the function definitions.

# Allow this program to be invoked from a different directory
$mydir = ".";
if (!-s "binding.sub") {
    $mydir = $0;
    $mydir =~ s/\/buildiface//;
}

require "$mydir/binding.sub";

$gDebug = 0;

$prototype_file  = "../../../include/mpi_proto.h";
$is_MPI          = 1;
$buildMPIX       = 0;
$routine_prefix  = "MPI_";
$routine_pattern = "[A-Z][a-z0-9_]*";
$out_prefix      = "MPI_";
$outfile_prefix  = "mpi";
%CtoFName        = ();
%mpi_routines    = ();
%NeedConstants = ();    # constants needed for declaration, hashed by routine
my $line_limit = 80;    # Max line length

#
# ToDo: Fortran 90 allows some additional checks not possible in Fortran 77.
# For example, the size of an array may be queried.  This could be particularly
# useful for the ARGV argument in SPAWN, which in Fortran requires a blank
# line to terminate the ARGV.  Even without that, the Fortran 90 wrappers
# could check for the required blank entry, and report an error if it was
# missing.
#

#
# argtypec2f translates the C/C++ names to the Fortran 90 name.  %name% will
# be replaced with the argument name in declarations.
#
# Some picky compilers want an interface description where Fortran 77
# was happy with a simple EXTERNAL.  To handle this, the EXTERNAL
# has a more elaborate form:
#  INTERFACE %nl%SUBROUTINE %name%(<args>)%nl%<type decls>%nl%END SUBROUTINE%nl%END INTERFACE
# where %nl% is newline/indent.
#
%argtypec2f = (
    'int'      => 'INTEGER',
    'int[]'    => 'INTEGER %name%(*)',
    'int[][3]' => 'INTEGER %name%(3,*)',
    'int*'     => 'INTEGER',               # assume output scalar (see array
                                           # replacement below)
    'bool'     => 'LOGICAL',
    'bool[]'   => 'LOGICAL %name%(*)',
    'MPI_Handler_function*' =>
'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
    'MPI_Win_errhandler_function*' =>
'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
    'MPI_Session_errhandler_function*' =>
'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
    'MPI_Comm_errhandler_function*' =>
'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
    'MPI_File_errhandler_function*' =>
'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',

    # These other functions have <choice> (really void*) arguments
    # and so an interface spec is very hard to do in Fortran 90.
    'MPI_Comm_copy_attr_function*'     => 'EXTERNAL',
    'MPI_Comm_delete_attr_function*'   => 'EXTERNAL',
    'MPI_Type_copy_attr_function*'     => 'EXTERNAL',
    'MPI_Type_delete_attr_function*'   => 'EXTERNAL',
    'MPI_Win_copy_attr_function*'      => 'EXTERNAL',
    'MPI_Win_delete_attr_function*'    => 'EXTERNAL',
    'MPI_Copy_function*'               => 'EXTERNAL',
    'MPI_Delete_function*'             => 'EXTERNAL',
    'MPI_User_function*'               => 'EXTERNAL',
    'MPI_Grequest_query_function*'     => 'EXTERNAL',
    'MPI_Grequest_free_function*'      => 'EXTERNAL',
    'MPI_Grequest_cancel_function*'    => 'EXTERNAL',
    'MPI_Datarep_conversion_function*' => 'EXTERNAL',
    'MPI_Datarep_extent_function*'     => 'EXTERNAL',
    'MPI_Request'                      => 'INTEGER',
    'MPI_Request*'                     => 'INTEGER',
    'MPI_Request[]'                    => 'INTEGER %name%(*)',
    'MPIO_Request'                     => 'INTEGER',
    'MPIO_Request*'                    => 'INTEGER',
    'MPI_Datatype'                     => 'INTEGER',
    'MPI_Datatype*'                    => 'INTEGER',
    'MPI_Datatype[]'                   => 'INTEGER %name%(*)',
    'MPI_Comm'                         => 'INTEGER',
    'MPI_Comm*'       => 'INTEGER',    # Never an array of comm
    'MPI_Group'       => 'INTEGER',
    'MPI_Group*'      => 'INTEGER',    # Never an array of groups
    'MPI_Errhandler'  => 'INTEGER',
    'MPI_Errhandler*' => 'INTEGER',    # Never an array of errhandlers
    'MPI_Op'          => 'INTEGER',
    'MPI_Op*'         => 'INTEGER',    # Never an array of ops
    'MPI_Message'     => 'INTEGER',
    'MPI_Message*'    => 'INTEGER',    # Never an array of messages
    'MPI_Session'     => 'INTEGER',
    'MPI_Session*'    => 'INTEGER',    # Never an array of sessions
    'MPI_Status*'     => 'INTEGER %name%(MPI_STATUS_SIZE)',
    'MPI_Status[]'    => 'INTEGER %name%(MPI_STATUS_SIZE,*)',
    'MPI_F08_status*' => 'TYPE(MPI_Status)',
    'MPI_Fint*'       => 'INTEGER %name%(MPI_STATUS_SIZE)',
    'MPI_Aint'        => 'INTEGER(KIND=MPI_ADDRESS_KIND)',
    'MPI_Aint*'       => 'INTEGER(KIND=MPI_ADDRESS_KIND)',
    'MPI_Aint[]'      => 'INTEGER(KIND=MPI_ADDRESS_KIND) %name%(*)',
    'MPI_Count'       => 'INTEGER(KIND=MPI_COUNT_KIND)',
    'MPI_Count*'      => 'INTEGER(KIND=MPI_COUNT_KIND)',
    'MPI_Offset'      => 'INTEGER(KIND=MPI_OFFSET_KIND)',
    'MPI_Offset*'     => 'INTEGER(KIND=MPI_OFFSET_KIND)',
    'MPI_Info'        => 'INTEGER',
    'MPI_Info*'  => 'INTEGER',                       # Never an array of info
    'MPI_Info[]' => 'INTEGER %name%(*)',
    'char*'      => 'CHARACTER (LEN=*)',
    'char[]'     => 'CHARACTER (LEN=*)',
    'char*[]'    => 'CHARACTER (LEN=*) %name%(*)',
    'char**[]' => 'CHARACTER (LEN=*) %name%(count,*)',    #special case
         # from Comm_Spawn_multiple
    'MPI_Win'      => 'INTEGER',
    'MPI_Win*'     => 'INTEGER',    # Never an array of win
    'MPI_File'     => 'INTEGER',
    'MPI_File*'    => 'INTEGER',    # Never an array of files
    'MPI_Message'  => 'INTEGER',
    'MPI_Message*' => 'INTEGER',    # Never an array of messages
);

# special_args provides for handling of arguments that require special
# features.  The keys are of the form 'Routine-count', with count the
# position of the argument, starting from one.
%special_args = (
    'Testany-2'                    => 'MPI_Request[]',
    'Testany-4'                    => 'bool',
    'Startall-2'                   => 'MPI_Request[]',
    'Testall-2'                    => 'MPI_Request[]',
    'Testall-3'                    => 'bool',
    'Testall-4'                    => 'MPI_Status[]',
    'Testsome-2'                   => 'MPI_Request[]',
    'Testsome-4'                   => 'int[]',
    'Testsome-5'                   => 'MPI_Status[]',
    'Test-2'                       => 'bool',
    'Test_cancelled-2'             => 'bool',
    'Type_hindexed-2'              => 'int[]',
    'Type_hindexed-3'              => 'int[]',
    'Type_indexed-2'               => 'int[]',
    'Type_indexed-3'               => 'int[]',
    'Type_hvector-3'               => 'int',
    'Type_struct-2'                => 'int[]',
    'Type_struct-3'                => 'int[]',
    'Type_struct-4'                => 'MPI_Datatype[]',
    'Type_extent-2'                => 'int',
    'Type_lb-2'                    => 'int',
    'Type_ub-2'                    => 'int',
    'Waitall-2'                    => 'MPI_Request[]',
    'Waitall-3'                    => 'MPI_Status[]',
    'Waitany-2'                    => 'MPI_Request[]',
    'Waitsome-2'                   => 'MPI_Request[]',
    'Waitsome-4'                   => 'int[]',
    'Waitsome-5'                   => 'MPI_Status[]',
    'Group_excl-3'                 => 'int[]',
    'Group_incl-3'                 => 'int[]',
    'Group_translate_ranks-3'      => 'int[]',
    'Group_translate_ranks-5'      => 'int[]',
    'Cart_coords-4'                => 'int[]',
    'Cart_create-3'                => 'int[]',
    'Cart_create-4'                => 'bool[]',
    'Cart_get-3'                   => 'int[]',
    'Cart_get-5'                   => 'int[]',
    'Cart_get-4'                   => 'bool[]',
    'Cart_map-3'                   => 'int[]',
    'Cart_map-4'                   => 'bool[]',
    'Cart_rank-2'                  => 'int[]',
    'Cart_sub-2'                   => 'bool[]',
    'Dims_create-3'                => 'int[]',
    'Graph_create-3'               => 'int[]',
    'Graph_create-4'               => 'int[]',
    'Graph_create-5'               => 'bool',
    'Graph_get-4'                  => 'int[]',
    'Graph_get-5'                  => 'int[]',
    'Graph_map-3'                  => 'int[]',
    'Graph_map-4'                  => 'int[]',
    'Graph_neighbors-4'            => 'int[]',
    'Dist_graph_create-8'          => 'bool',
    'Dist_graph_create_adjacent-9' => 'bool',
    'Dist_graph_neighbors_count-4' => 'bool',
    'Allgatherv-5'                 => 'int[]',
    'Allgatherv-6'                 => 'int[]',
    'Alltoallv-2'                  => 'int[]',
    'Alltoallv-3'                  => 'int[]',
    'Alltoallv-6'                  => 'int[]',
    'Alltoallv-7'                  => 'int[]',
    'Alltoallw-2'                  => 'int[]',
    'Alltoallw-3'                  => 'int[]',
    'Alltoallw-6'                  => 'int[]',
    'Alltoallw-7'                  => 'int[]',
    'Gatherv-5'                    => 'int[]',
    'Gatherv-6'                    => 'int[]',
    'Iallgatherv-5'                => 'int[]',
    'Iallgatherv-6'                => 'int[]',
    'Ialltoallv-2'                 => 'int[]',
    'Ialltoallv-3'                 => 'int[]',
    'Ialltoallv-6'                 => 'int[]',
    'Ialltoallv-7'                 => 'int[]',
    'Ialltoallw-2'                 => 'int[]',
    'Ialltoallw-3'                 => 'int[]',
    'Ialltoallw-6'                 => 'int[]',
    'Ialltoallw-7'                 => 'int[]',
    'Igatherv-5'                   => 'int[]',
    'Igatherv-6'                   => 'int[]',
    'Ireduce_scatter-3'            => 'int[]',
    'Iscatterv-2'                  => 'int[]',
    'Iscatterv-3'                  => 'int[]',
    'Reduce_scatter-3'             => 'int[]',
    'Scatterv-2'                   => 'int[]',
    'Scatterv-3'                   => 'int[]',
    'Iprobe-4'                     => 'bool',
    'Improbe-4'                    => 'bool',
    'Op_create-2'                  => 'bool',
    'Attr_get-4'                   => 'bool',
    'Comm_get_attr-4'              => 'bool',
    'Type_get_attr-4'              => 'bool',
    'Win_get_attr-4'               => 'bool',
    'Comm_test_inter-2'            => 'bool',
    'Intercomm_merge-2'            => 'bool',
    'Cart_create-5'                => 'bool',
    'Initialized-1'                => 'bool',
    'Finalized-1'                  => 'bool',
    'Group_range_excl-3'           => 'int[][3]',
    'Group_range_incl-3'           => 'int[][3]',
    'Info_get_valuelen-4'          => 'bool',
    'Is_thread_main-1'             => 'bool',
    'Type_create_subarray-2'       => 'int[]',
    'Type_create_subarray-3'       => 'int[]',
    'Type_create_subarray-4'       => 'int[]',
    'Request_get_status-2'         => 'bool',
    'Status_set_cancelled-2'       => 'bool',
    'Info_get-5'                   => 'bool',
    'Info_get_string-5'            => 'bool',
    'Type_create_indexed_block-3'  => 'int[]',
    'Type_create_darray-4'         => 'int[]',
    'Type_create_darray-5'         => 'int[]',
    'Type_create_darray-6'         => 'int[]',
    'Type_create_darray-7'         => 'int[]',
    'Type_create_struct-2'         => 'int[]',
    'Type_create_struct-3'         => 'MPI_Aint[]',
    'Win_test-2'                   => 'bool',
    'Type_create_hindexed-2'       => 'int[]',
    'Type_create_hindexed-3'       => 'MPI_Aint[]',
    'Op_commutative-2'             => 'bool',
    'File_set_atomicity-2'         => 'bool',
    'File_get_atomicity-2'         => 'bool',
);

# Some routines must be skipped (custom code is provided for them)
%skip_routines = (
    'Init'            => 1,
    'Init_thread'     => 1,
    'Status_c2f'      => 1,
    'Status_f2c'      => 1,
    'Status_f2f08'    => 1,
    'Status_f082f'    => 1,
    'Status_c2f08'    => 1,
    'Status_f082c'    => 1,
    'Pcontrol'        => 1,
    'Info_create_env' => 1,
);

# Some routines *may* be skipped if we don't want to handle the possibility
# of a scalar or vector argument
# Still to do: Add the others (datatype creation, translate ranks, etc.)
# For each of these, we need to know which arguments are the "scalar/vector"
# The value of the hash gives us the answer, indexed from 1
# (these are not correct yet).
%scalarVectorRoutines = (
    'Startall'                   => '2-1',
    'Testall'                    => '2-1:4-1',
    'Testany'                    => '2-1',
    'Testsome'                   => '2-1:4-1:5-1',
    'Waitall'                    => '2-1:3-1',
    'Waitany'                    => '2-1',
    'Waitsome'                   => '2-1:4-1:5-1',
    'Dims_create'                => '3-2',
    'Cart_rank'                  => '2',
    'Cart_coords'                => '4-3',
    'Cart_get'                   => '3-2:4-2:5-2',
    'Graph_neighbors'            => '4-3',
    'Cart_sub'                   => '2',
    'Cart_map'                   => '3-2:4-2',
    'Cart_create'                => '3-2:4-2',
    'Graph_create'               => '3:4',
    'Dist_graph_create'          => '6',
    'Dist_graph_create_adjacent' => '4:7',
    'Dist_graph_neighbors'       => '4:7',
    'Group_translate_ranks'      => '3-2:5-2',

);

# And we skip them by default
$buildScalarVector = 0;
$build_io          = 1;

# Process any options
foreach $_ (@ARGV) {
    if (/--?prototype=(.*)/) {
        $prototype_file = $1;
    } elsif (/--?sv/) {

        # This obscure argument enables the creation of an interface that
        # includes the routines that can accept a scalar or a vector
        # (e.g., a single request or an array of requests) on a single
        # type (e.g., an integer).  By default, we leave these out.
        $buildScalarVector = 1;
    } elsif (/deffile=(.*)/) {
        $definition_file = $1;
        $is_MPI          = 0;
    } elsif (/--?noio/) {
        $build_io = 0;
    } elsif (/--?debug/) {
        $gDebug = 1;
    } else {
        print STDERR "Unrecognized argument $_\n";
        exit 2;
    }
}

#
# Load any definition file
if ($definition_file) {
    require $definition_file;
}
$ucoutfile_prefix = uc($outfile_prefix);

#
# Read the interface file (e.g., mpi_proto.h) and file in the various
# data structures (they're in global variables)
&ReadInterface($prototype_file, $routine_prefix, $routine_pattern,
    "mpi_routines");
if (-s "../../mpi/romio/include/mpio.h.in" && $build_io) {

    #    %skipBlocks = ( 'HAVE_MPI_DARRAY_SUBARRAY' => 1,
    #           'HAVE_MPI_INFO' => 1,
    #            'MPICH' => 1 );
    &ReadInterface("../../mpi/romio/include/mpio.h.in",
        $routine_prefix, $routine_pattern, "mpi_routines");

    #    %skipBlocks = ();
}
if ($buildMPIX) {
    &ReadInterface($prototype_file, "MPIX_", $routine_pattern, "mpi_routines");
}

#
# For some MPI routines, we need to distinguish between arguments that are
# input arrays versus ones that are output scalars.  For those functions,
# convert input (or output) arrays to [] format.

# ----------------------------------------------------------------------------
#
# Generate the module for the routines
# First pass.  Ignore the issue of choice routines
# Print header
open(MPIFD, ">${outfile_prefix}.f90.new")
  || die "Could not open ${outfile_prefix}.f90.new\n";

# Was
#       USE MPI_CONSTANTS,                                               &
#     &      BASE_MPI_WTIME => MPI_WTIME, BASE_MPI_WTICK => MPI_WTICK
# but this caused problems with the pg compiler.  Need to understand and fix
print MPIFD "! Copyright (C) by Argonne National Laboratory
!     See COPYRIGHT in top-level directory
       MODULE $ucoutfile_prefix
!      This module was created by the script buildiface
       USE ${ucoutfile_prefix}_CONSTANTS
       USE ${ucoutfile_prefix}_SIZEOFS
       USE ${ucoutfile_prefix}_BASE
       END MODULE $ucoutfile_prefix\n";

close(MPIFD);
&ReplaceIfDifferent("${outfile_prefix}.f90", "${outfile_prefix}.f90.new");

# ----------------------------------------------------------------------------
# This is the file for the routines that have no "choice" arguments.
# An example of a choice argument is a "void *buf" input argument to
# MPI_Send, which allows any buffer address, both numeric and character.
open(MPIBASEFD, ">${outfile_prefix}_base.f90.in.new")
  || die "Could not open ${outfile_prefix}_base.f90.in.new\n";
print MPIBASEFD "! Copyright (C) by Argonne National Laboratory
!     See COPYRIGHT in top-level directory
       MODULE ${ucoutfile_prefix}_BASE
       IMPLICIT NONE
!      This module was created by the script buildiface
       INTERFACE\n";

foreach $routine (keys(%mpi_routines)) {

    # Permit each package to define a new name for the Fortran version of the
    # routine
    if (defined($CtoFName{$routine})) {
        $routine = $CtoFName{$routine};
    }
    $ucname = uc($routine);
    my @argtypes = split(/,/, $mpi_routines{$routine}[0]);
    my @argnames = split(/,/, $mpi_routines{$routine}[1]);

    print "Trying to bind $routine\n" if $gDebug;

    # Check for a routine to skip
    if (defined($skip_routines{$routine})) {
        print "Skipping $routine as required\n" if $gDebug;
        next;
    }

    if (defined($scalarVectorRoutines{$routine})) {

        # These require special processing in any case
        next;
    }

    # Check for a void * argument (usually choice)
    # As noted above, we don't include the routines with choice arguments
    # in the base module.

    if ($mpi_routines{$routine}[0] =~ /void/) {
        $mpi_choice_routines{$routine} = $mpi_routines{$routine}[0];
        print "Skipping $routine because of void argument\n" if $gDebug;
        next;
    }

    print MPIBASEFD "      SUBROUTINE $out_prefix$ucname";
    &PrintArgBrace(MPIBASEFD,
        length("      SUBROUTINE $out_prefix$ucname"),
        length("      SUBROUTINE  "),
        $line_limit, @argnames
    );
    &PrintArgDecls($routine, 0, "");
    print MPIBASEFD "      END SUBROUTINE $out_prefix$ucname\n\n";
}

# Add special routines (e.g., the ones with unusual arguments)

#
# Some Fortran 90 compilers permit REAL*8; for some systems, this is
# preferable to DOUBLE PRECISION (in cases where the user is permitted
# to change the size of these basic types(!)).  This script must produce
# a standard-conforming file.  The top-level configure (in mpich/configure)
# will replace DOUBLE PRECISION with REAL*8 if the Fortran compiler
# supports REAL*8.
if ($is_MPI) {
    print MPIBASEFD "
        SUBROUTINE MPI_INIT(ierror)
        INTEGER ierror
        END SUBROUTINE MPI_INIT

        SUBROUTINE MPI_INIT_THREAD(v0,v1,ierror)
        INTEGER v0, v1, ierror
        END SUBROUTINE MPI_INIT_THREAD

        FUNCTION MPI_WTIME()
            \@WTIME_DOUBLE_TYPE\@ MPI_WTIME
        END FUNCTION MPI_WTIME
!
        FUNCTION MPI_WTICK()
            \@WTIME_DOUBLE_TYPE\@ MPI_WTICK
        END FUNCTION MPI_WTICK

        FUNCTION MPI_AINT_ADD(base, disp)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER(KIND=MPI_ADDRESS_KIND) MPI_AINT_ADD
            INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: base, disp
        END FUNCTION MPI_AINT_ADD

        FUNCTION MPI_AINT_DIFF(addr1, addr2)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER(KIND=MPI_ADDRESS_KIND) MPI_AINT_DIFF
            INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: addr1, addr2
        END FUNCTION MPI_AINT_DIFF

! style:PMPIuse:PMPI_WTIME:3 sig:0
        FUNCTION PMPI_WTIME()
            \@WTIME_DOUBLE_TYPE\@ PMPI_WTIME
        END FUNCTION PMPI_WTIME
!
! style:PMPIuse:PMPI_WTICK:3 sig:0
        FUNCTION PMPI_WTICK()
            \@WTIME_DOUBLE_TYPE\@ PMPI_WTICK
        END FUNCTION PMPI_WTICK

        SUBROUTINE MPI_NULL_DELETE_FN(COMM, KEYVAL, ATTRIBUTE_VAL,&
          EXTRA_STATE, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER COMM, KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) ATTRIBUTE_VAL, EXTRA_STATE
        END SUBROUTINE MPI_NULL_DELETE_FN

        SUBROUTINE MPI_DUP_FN(OLDCOMM, KEYVAL, EXTRA_STATE,&
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER OLDCOMM, KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
            LOGICAL FLAG
        END SUBROUTINE MPI_DUP_FN

        SUBROUTINE MPI_NULL_COPY_FN(OLDCOMM, KEYVAL, EXTRA_STATE,&
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER OLDCOMM, KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
            LOGICAL FLAG
        END SUBROUTINE MPI_NULL_COPY_FN

        SUBROUTINE MPI_COMM_NULL_DELETE_FN(COMM, COMM_KEYVAL, ATTRIBUTE_VAL,&
          EXTRA_STATE, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER COMM, COMM_KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) ATTRIBUTE_VAL, EXTRA_STATE
        END SUBROUTINE MPI_COMM_NULL_DELETE_FN

        SUBROUTINE MPI_COMM_DUP_FN(OLDCOMM, COMM_KEYVAL, EXTRA_STATE,&
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER OLDCOMM, COMM_KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
            LOGICAL FLAG
        END SUBROUTINE MPI_COMM_DUP_FN

        SUBROUTINE MPI_COMM_NULL_COPY_FN(OLDCOMM, COMM_KEYVAL, EXTRA_STATE,&
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER OLDCOMM, COMM_KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
            LOGICAL FLAG
        END SUBROUTINE MPI_COMM_NULL_COPY_FN

        SUBROUTINE MPI_TYPE_NULL_DELETE_FN(DATATYPE, TYPE_KEYVAL, ATTRIBUTE_VAL,&
          EXTRA_STATE, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER DATATYPE, TYPE_KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) ATTRIBUTE_VAL, EXTRA_STATE
        END SUBROUTINE MPI_TYPE_NULL_DELETE_FN

        SUBROUTINE MPI_TYPE_DUP_FN(OLDTYPE, TYPE_KEYVAL, EXTRA_STATE,&
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER OLDTYPE, TYPE_KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
            LOGICAL FLAG
        END SUBROUTINE MPI_TYPE_DUP_FN

        SUBROUTINE MPI_TYPE_NULL_COPY_FN(OLDTYPE, TYPE_KEYVAL, EXTRA_STATE,&
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER OLDTYPE, TYPE_KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
            LOGICAL FLAG
        END SUBROUTINE MPI_TYPE_NULL_COPY_FN

        SUBROUTINE MPI_WIN_NULL_DELETE_FN(WIN, WIN_KEYVAL, ATTRIBUTE_VAL,&
          EXTRA_STATE, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER WIN, WIN_KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) ATTRIBUTE_VAL, EXTRA_STATE
        END SUBROUTINE MPI_WIN_NULL_DELETE_FN

        SUBROUTINE MPI_WIN_DUP_FN(OLDWIN, WIN_KEYVAL, EXTRA_STATE,&
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER OLDWIN, WIN_KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
            LOGICAL FLAG
        END SUBROUTINE MPI_WIN_DUP_FN

        SUBROUTINE MPI_WIN_NULL_COPY_FN(OLDWIN, WIN_KEYVAL, EXTRA_STATE,&
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
            INTEGER OLDWIN, WIN_KEYVAL, IERROR
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
            LOGICAL FLAG
        END SUBROUTINE MPI_WIN_NULL_COPY_FN

        SUBROUTINE MPI_INFO_CREATE_ENV(info,ierror)
            INTEGER info
            INTEGER ierror
        END SUBROUTINE MPI_INFO_CREATE_ENV
";
}

# Here's where we need to place the interface definitions for the functions
# that take vector or scalar arguments (startall, testall/any/some,
# waitall/any/some, group_translate_ranks, etc.)
# For each such routine, we need to generate two entries.  Here's the
# example for STARTALL:
#     subroutine MPI_STARTALL_S(c,r,ierr)
#     integer c,r,ierr
#     external MPI_STARTALL
#         call MPI_STARTALL(c,r,ierr)
#     end subroutine MPI_STARTALL_S
#     subroutine MPI_STARTALL_V(c,r,ierr)
#     integer c,r(*),ierr
#     external MPI_STARTALL
#         call MPI_STARTALL(c,r,ierr)
#     end subroutine MPI_STARTALL_V

print MPIBASEFD "       END INTERFACE\n";

if ($buildScalarVector) {

    # Create the interface modules
    foreach my $routine (keys(%scalarVectorRoutines)) {
        $ucname = uc($routine);
        print MPIBASEFD "       INTERFACE ${out_prefix}$ucname\n";
        print MPIBASEFD
          "           MODULE PROCEDURE ${out_prefix}${ucname}_S\n";
        print MPIBASEFD
          "           MODULE PROCEDURE ${out_prefix}${ucname}_V\n";
        print MPIBASEFD "       END INTERFACE ! ${out_prefix}$ucname\n\n";

    }
    print MPIBASEFD "\n        CONTAINS\n";

    # This is much like the base name (interface) block code
    foreach my $routine (keys(%scalarVectorRoutines)) {
        $ucname = uc($routine);
        my @argtypes = split(/,/, $mpi_routines{$routine}[0]);
        my @argnames = split(/,/, $mpi_routines{$routine}[1]);
        $svArgs = $scalarVectorRoutines{$routine};

        # The scalar version
        print MPIBASEFD "       SUBROUTINE ${out_prefix}${ucname}_S";
        &PrintArgBrace(MPIBASEFD,
            length("       SUBROUTINE ${out_prefix}${ucname}_S"),
            length("       SUBROUTINE  "),
            $line_limit, @argnames
        );
        &PrintArgDecls($routine, 1, $svArgs);

        print MPIBASEFD "       EXTERNAL ${out_prefix}${ucname}\n";
        print MPIBASEFD "       call ${out_prefix}$ucname";
        &PrintArgBrace(MPIBASEFD, length("       call ${out_prefix}$ucname"),
            length("       call  "), $line_limit, @argnames);
        print MPIBASEFD "       END SUBROUTINE ${out_prefix}${ucname}_S\n\n";

        # The vector version
        print MPIBASEFD "       SUBROUTINE ${out_prefix}${ucname}_V(";
        &PrintArgBrace(MPIBASEFD,
            length("       SUBROUTINE ${out_prefix}${ucname}_S"),
            length("       SUBROUTINE  "),
            $line_limit, @argnames
        );
        &PrintArgDecls($routine, 0, "");

        print MPIBASEFD "       EXTERNAL ${out_prefix}${ucname}\n";
        print MPIBASEFD "       call ${out_prefix}$ucname";
        &PrintArgBrace(MPIBASEFD, length("       call ${out_prefix}$ucname"),
            length("       call  "), $line_limit, @argnames);
        print MPIBASEFD "       END SUBROUTINE ${out_prefix}${ucname}_V\n\n";
    }
}

print MPIBASEFD "       END MODULE ${ucoutfile_prefix}_BASE\n";
close MPIBASEFD;
&ReplaceIfDifferent("${outfile_prefix}_base.f90.in",
    "${outfile_prefix}_base.f90.in.new");

open(MPIFD, ">${outfile_prefix}_constants.f90.in.new")
  || die "Cannot open ${outfile_prefix}_constants.f90.in.new\n";
print MPIFD "! Copyright (C) by Argonne National Laboratory
!     See COPYRIGHT in top-level directory
        MODULE ${ucoutfile_prefix}_CONSTANTS
        IMPLICIT NONE
        INCLUDE 'mpifnoext.h'\n";

# MPI-3 Requires that even the MPI module (not just mpi_f08) include
# the MPI_Status type, as well as handle types
# WARNING: INTEGER is incorrect; it should be INTEGER(C_INT) if this
# is to be used directly by a C routine.  That may also require using
# USE ISO_C_BINDING, ONLY :: C_INT
# Note that by using Fortran types with BIND(C), some compilers will
# general warnings about not being interoperable with C.
# See page 611, lines 3-13 in MPI-3.  SEQUENCE is used for pre
# Fortran 2003 compilers.
# QUESTION: With BIND(C), all of these will generate warning statements
# because they don't use C integers, and they are not equivalent to the
# C types.  Was that intended (even for Status?)
# Pick one of these two:
$BINDACCESS = "";
$BINDDEF    = "SEQUENCE";

# PUBLIC and PRIVATE were not present in the original F90; at least one
# compiler, the Absoft Fortran (from 2009) installed at ANL will not
# accept these qualifiers.  Thus, we make these optional (but disabled
# by default).
# Use these to describe which fields are accessible to the user.
# Define these as empty to with early Fortran 90/95 compilers
#$PUBLICVAR = ", PUBLIC";
#$PRIVATEVAR = ", PRIVATE";
# Use the following for compilers that do not support pubilc and private
# qualifiers on declarations in derived types.
$PUBLICVAR  = "";
$PRIVATEVAR = "";
#
#$BINDACCESS = ", BIND(C)";
#$BINDDEF ="";
# Yet another problem.
# Because MPI_Count may be longer than a single (Fortran) INTEGER,
# alignment restrictions may introduce padding in the structure
# And one more problem: If a Fortran INTEGER is not the same as a C int,
# then these are also wrong (see the "fint" option in
# src/binding/fortran/mpif_h/buildiface
print MPIFD <<EOT;
        TYPE$BINDACCESS :: MPI_Status
           $BINDDEF
           INTEGER$PRIVATEVAR :: count_lo
           INTEGER$PRIVATEVAR :: count_hi_and_cancelled
           INTEGER$PUBLICVAR :: MPI_SOURCE, MPI_TAG, MPI_ERROR
        END TYPE MPI_Status
EOT

%handles = (
    'comm'       => 'Comm',
    'datatype'   => 'Datatype',
    'group'      => 'Group',
    'win'        => 'Win',
    'file'       => 'File',
    'op'         => 'Op',
    'errhandler' => 'Errhandler',
    'request'    => 'Request',
    'message'    => 'Message',
    'info'       => 'Info'
);

foreach $handle (keys(%handles)) {
    $mpitype = $handles{$handle};
    print MPIFD "       TYPE$BINDACCESS :: MPI_$mpitype
          $BINDDEF
          INTEGER$PUBLICVAR :: MPI_VAL
       END TYPE MPI_$mpitype\n";
}

print MPIFD "        INTERFACE OPERATOR(.EQ.)\n";
foreach $handle (keys(%handles)) {
    print MPIFD "            MODULE PROCEDURE ${handle}eq\n";
}
print MPIFD "        END INTERFACE\n";

# == and .EQ. appear to be synonyms, not separate names
#print MPIFD "        INTERFACE OPERATOR(==)\n";
#foreach $handle (keys(%handles)) {
#    print MPIFD "            MODULE PROCEDURE ${handle}eq\n";
#}
#print MPIFD "        END INTERFACE\n";

print MPIFD "        INTERFACE OPERATOR(.NE.)\n";
foreach $handle (keys(%handles)) {
    print MPIFD "            MODULE PROCEDURE ${handle}neq\n";
}
print MPIFD "        END INTERFACE\n";

# /= and .NE. appear to be synonyms, not separate names
#
#print MPIFD "        INTERFACE OPERATOR(/=)\n";
#foreach $handle (keys(%handles)) {
#    print MPIFD "            MODULE PROCEDURE ${handle}neq\n";
#}
#print MPIFD "        END INTERFACE\n";

print MPIFD "        CONTAINS\n";
foreach $handle (keys(%handles)) {
    $mpitype = $handles{$handle};
    print MPIFD "            LOGICAL FUNCTION ${handle}eq(lhs,rhs)
            TYPE(MPI_$mpitype), INTENT(IN) :: lhs, rhs
            ${handle}eq = lhs%MPI_VAL .EQ. rhs%MPI_VAL
            END FUNCTION ${handle}eq
            LOGICAL FUNCTION ${handle}neq(lhs,rhs)
            TYPE(MPI_$mpitype), INTENT(IN) :: lhs, rhs
            ${handle}neq = lhs%MPI_VAL .NE. rhs%MPI_VAL
            END FUNCTION ${handle}neq\n";
}

print MPIFD "        END MODULE ${ucoutfile_prefix}_CONSTANTS\n";
close MPIFD;
&ReplaceIfDifferent(
    "${outfile_prefix}_constants.f90.in",
    "${outfile_prefix}_constants.f90.in.new"
);

#
# Generate the choice argument routines
# FIXME: This file is not quite right.  Also note that it is
# *input* for yet another step, one that generates particular values
# for the types of the choice arguments.  We should consider using
# a different extension for this file, such as sed or in, so that
# it is clearly not a ready-to-use Fortran 90 input file.
# In particular, it needs to be set up so that
#   <typesize>
#   <type>
#   <dims>
#   <type1>
#   <dims1>
# can all be substituted as necessary.  For example
#   <typesize> => 4
#   <type> => real
#   <dims> => (*)
#   <type1> => real
#   <dims1> => (*)
# For scalar arguments, <dims> should be empty.
# Finally, the module name needs to be distinct for each choice of
# <type>, <dims>, <type1>, and <dims1>
open(MPIFD, ">${outfile_prefix}_t1.f90.new")
  || die "Cannot open ${outfile_prefix}_t1.f90.new\n";
print MPIFD "! Copyright (C) by Argonne National Laboratory
!     See COPYRIGHT in top-level directory
        MODULE ${ucoutfile_prefix}_t1_s
        IMPLICIT NONE
        PRIVATE\n";

# Generate the interface specs
foreach $routine (keys(%mpi_choice_routines)) {
    $ucname = uc($routine);

    print MPIFD "        PUBLIC :: ${out_prefix}$ucname\n";
    print MPIFD "        INTERFACE ${out_prefix}$ucname\n";
    print MPIFD "           MODULE PROCEDURE ${out_prefix}${ucname}_T\n";
    print MPIFD "        END INTERFACE ${out_prefix}$ucname\n\n";
}

# MPI_Sizeof has its own module

print MPIFD "        CONTAINS\n\n";

# For each choice routine, add the modules
foreach $routine (keys(%mpi_choice_routines)) {
    $ucname = uc($routine);
    my @argtypes = split(/,/, $mpi_routines{$routine}[0]);
    my @argnames = split(/,/, $mpi_routines{$routine}[1]);

    print MPIFD "      SUBROUTINE ${out_prefix}${ucname}_T";
    &PrintArgBrace(MPIFD,
        length("      SUBROUTINE ${out_prefix}${ucname}_T"),
        length("      SUBROUTINE  "),
        $line_limit, @argnames
    );

    if (defined($NeedConstants{$routine})) {
        print MPIFD "      USE ${out_prefix}CONSTANTS,ONLY:";
        $sep = "";
        foreach $name (split(/\s+/, $NeedConstants{$routine})) {
            print MPIFD "$sep$name";
            $sep = ", ";
        }
        print MPIFD "\n";
    }

    # print the arg decls ...
    # convert %type% to the various types and %dims% to the dimensions,
    # including scalar.
    $nchoice = 0;
    for ($i = 0 ; $i <= $#argtypes ; $i++) {
        $argtypes[$i] =~ s/^const\s//;    # Remove const if present
        $argtype = $argtypes[$i];

        # Check for special args
        $loc = $i + 1;
        if (defined($special_args{"$routine-$loc"})) {
            $argtype = $special_args{"$routine-$loc"};
        }

        if ($argtype =~ /void/) {

            # An alternative to this is to have a separate file for
            # routines with 2 choice arguments
            if ($nchoice == 0) {
                print MPIFD "        <type> $argnames[$i]<dims>\n";
            } else {
                print MPIFD
                  "        <type$nchoice> $argnames[$i]<dims$nchoice>\n";
            }
            $nchoice++;
        } else {

            # Map the C type to the Fortran type
            $cargtype = $argtype;
            $cargtype =~ s/\s+//g;
            $fargtype = $argtypec2f{$cargtype};
            if ($fargtype eq "") {
                print STDERR
                  "$routine: No Fortran type for $cargtype ($argtype)\n";
            }
            if ($fargtype =~ /%name%/) {
                $fargtype =~ s/%name%/$argnames[$i]/;

                # In the name case, convert any %nl% to newlines and spaces
                $fargtype =~ s/%nl%/\n       /g;
                print MPIFD "        $fargtype\n";
            } else {
                print MPIFD "        $fargtype $argnames[$i]\n";
            }
        }
    }

    print MPIFD "        EXTERNAL ${out_prefix}${ucname}\n";
    print MPIFD "        CALL ${out_prefix}${ucname}";
    &PrintArgBrace(MPIFD,
        length("              CALL ${out_prefix}${ucname}"),
        length("              CALL  "),
        $line_limit, @argnames
    );

    print MPIFD "      END SUBROUTINE ${out_prefix}${ucname}_T\n\n";
}

# The base sizeof's are handled separately now in their own file

print MPIFD "      END MODULE ${ucoutfile_prefix}_t1_s\n";
close MPIFD;
&ReplaceIfDifferent("${outfile_prefix}_t1.f90", "${outfile_prefix}_t1.f90.new");

#
# Still to do
# make sure that we fit within the Fortran line length rules
# Look into alternatives for generating a zillion files
# Handle routines with more than one choice argument
#
# ------------------------------------------------------------------------
# Procedures
# print_line( FD, line, count, continue, continuelen )
# Print line to FD; if line size > count, output continue string and
# continue.  Use print_endline to finish a line
sub print_line {
    my $FD           = $_[0];
    my $line         = $_[1];
    my $count        = $_[2];
    my $continue     = $_[3];
    my $continue_len = $_[4];

    $linelen = length($line);

    #print "linelen = $linelen, print_line_len = $print_line_len\n";
    if ($print_line_len + $linelen > $count) {
        print $FD $continue;
        $print_line_len = $continue_len;
    }
    print $FD $line;
    $print_line_len += $linelen;
}

sub print_endline {
    my $FD = $_[0];
    print $FD "\n";
    $print_line_len = 0;
}

# This routine adds to the Makefile.mk the instructions to create
# a module, handling the strange requirements of some Fortran 90 compilers.
#
# Pass any true value as the second argument to indicate that the source file
# lives in the srcdir rather than being generated in the builddir by
# config.status.
sub createModSteps {
    my ($module, $deps, $srcFile, $use_srcdir) = @_;

    # Get a version of the source file with $(FCEXT) instead of .f90
    # as the extension
    my $srcFileWithExt = $srcFile;
    $srcFileWithExt =~ s/\.f90$/\.\$(FCEXT)/;

    # get the "libtool object" file name
    my $loFile = $srcFile;
    $loFile =~ s/\.f90$/\.lo/;

    # the no-extension name of the source file
    my $noext = $srcFile;
    $noext =~ s/\.f90$//;

    # filenames used by the make target
    my $stamp    = "src/binding/fortran/use_mpi/${noext}.\$(MOD)-stamp";
    my $lockfile = "src/binding/fortran/use_mpi/${noext}-lock";

    # This code formerly supported the Intel Fortran Compiler's curious
    # "-cl,blah.pcl" argument in a fragile and complicated way.  Since this
    # argument has been eliminated starting with Intel Fortran v7 (ca. 2002),
    # I have dropped support for this behavior.  A solution is theoretically
    # possible, but a real PITA to get right for parallel-build safety and
    # general cleanliness. [goodell@ 2011-06-06]

    # Attempt to deal with Fortran module files in a mostly sane way.  Quick
    # overview for the less Fortran literate:
    #
    # MPICH has four Fortran modules: mpi, mpi_constants, mpi_sizeofs, and
    # mpi_base.  Each module is produced as a side effect of compiling the
    # corresponding .f90 file into a .lo.  The .lo is produced by libtool and is
    # actually just a text file pointing at the one or two object files that
    # libtool actually creates (PIC/no-PIC).  So we have to be careful when
    # attempting to both support parallel make correctly and support a rebuild
    # of only a missing .mod file.  And we want to stay within the
    # automake+libtool system to the greatest extent possible
    #
    # See "Handling Tools that Produce Many Outputs" from the automake-1.11.1
    # manual for an explanation of the make pattern used below.  One odd thing
    # is that our single invocation of FC_COMPILE_MODS will result in the
    # libtool shell script actually compiling the source file twice and
    # generating the .mod file twice.  This appears to be harmless.
    #
    # A previous version of this code tried to use the "simple" recipe for
    # parallel safety from the automake manual, but it is flawed:
    #   https://lists.gnu.org/archive/html/automake/2011-10/msg00004.html

    print MAKEFD <<EOT;
${stamp}: ${deps}
\t\@rm -f src/binding/fortran/use_mpi/${noext}-tmp
\t\@touch src/binding/fortran/use_mpi/${noext}-tmp
EOT

    if ($use_srcdir) {
        print MAKEFD <<EOT;
\t\@( cd src/binding/fortran/use_mpi && \\
\t   if [ \"\$(FCEXT)\" != \"f90\" ] || [ ! -f $srcFileWithExt ] ; then \\
\t       rm -f $srcFileWithExt ; \\
\t       \$(LN_S) \$(abs_top_srcdir)/src/binding/fortran/use_mpi/$srcFile $srcFileWithExt ; \\
\t   fi )
\t\$(mod_verbose)\$(FC_COMPILE_MODS) -c src/binding/fortran/use_mpi/$srcFileWithExt -o src/binding/fortran/use_mpi/$loFile
\t\@( cd src/binding/fortran/use_mpi && \\
\t   if [ \"\$(FCEXT)\" != \"f90\" ] || [ ! -f $srcFileWithExt ] ; then \\
\t       rm -f $srcFileWithExt ; \\
\t   fi )
EOT
    } else {
        print MAKEFD <<EOT;
\t\@( cd src/binding/fortran/use_mpi && \\
\t   if [ \"\$(FCEXT)\" != \"f90\" ] ; then \\
\t       rm -f $srcFileWithExt ; \\
\t       \$(LN_S) $srcFile $srcFileWithExt ; \\
\t   fi )
\t\$(mod_verbose)\$(FC_COMPILE_MODS) -c src/binding/fortran/use_mpi/$srcFileWithExt -o src/binding/fortran/use_mpi/$loFile
\t\@( cd src/binding/fortran/use_mpi && \\
\t   if [ \"\$(FCEXT)\" != \"f90\" ] ; then \\
\t       rm -f $srcFileWithExt ; \\
\t   fi )
EOT
    }

    print MAKEFD <<EOT;
\t\@mv src/binding/fortran/use_mpi/${noext}-tmp ${stamp}

src/binding/fortran/use_mpi/${loFile} ${module}: ${stamp}
## Recover from the removal of \$\@
\t\@if test -f \$\@; then :; else \\
\t  trap 'rm -rf ${lockfile} ${stamp}' 1 2 13 15; \\
\t  if mkdir ${lockfile} 2>/dev/null; then \\
## This code is being executed by the first process.
\t    rm -f ${stamp}; \\
\t    \$(MAKE) \$(AM_MAKEFLAGS) ${stamp}; \\
\t    rmdir ${lockfile}; \\
\t  else \\
## This code is being executed by the follower processes.
## Wait until the first process is done.
\t    while test -d ${lockfile}; do sleep 1; done; \\
## Succeed if and only if the first process succeeded.
\t    test -f ${stamp}; exit \$\$?; \\
\t  fi; \\
\tfi

CLEANFILES += ${stamp} ${module} src/binding/fortran/use_mpi/${loFile} src/binding/fortran/use_mpi/${noext}-tmp


EOT

}

# Print arguments in a pair of braces and end with a new line.
# $fd : File handle to print to.
# $curlen : Length of the current line.
# $indent : Indentation length of the following lines when they exist.
# $line_length : Maximal length of a line.
# @argnames : argument names to print out.
sub PrintArgBrace {
    my ($fd, $curlen, $indent, $line_length, @argnames) = @_;
    my $i = 0;

    print $fd "(";
    $curlen++;
    foreach my $arg (@argnames) {
        if ($curlen + length($arg) + 2 > $line_length)
        {    # + 2 for the trailing ',&'
            $curlen = $indent;
            print $fd "&\n";
            print $fd " " x $indent;
            print $fd "$arg";
        } else {
            print $fd "$arg";
        }

        if ($i++ < $#argnames) {
            print $fd ",";
        }

        $curlen += length($arg) + 1;
    }

    print $fd ")\n";
}

# Print the declarations for the given routine.
sub PrintArgDecls {
    my ($routine, $svflag, $svArgs) = @_;

    my $ucname   = uc($routine);
    my @argtypes = split(/,/, $mpi_routines{$routine}[0]);
    my @argnames = split(/,/, $mpi_routines{$routine}[1]);

    print "Printing argument delartion for $ucname\n" if $gDebug;
    print "argtypes = $mpi_routines{$routine}[0]\n"   if $gDebug;
    print "argnames = $mpi_routines{$routine}[1]\n"   if $gDebug;

    # preload the svargs if requested.  This is used to decide whether
    # an array arg is output as a scalar or a vector
    my %svargs = ();
    if ($svflag) {
        for my $val (split(/:/, $svArgs)) {
            my $loc   = $val;
            my $count = "-1";
            if ($loc =~ /(\d+)-(\d+)/) {
                $loc   = $1;
                $count = $2;
            }
            $svargs{$loc} = $count;
        }
    }

    # Determine if we need any constants (e.g., MPI_STATUS_SIZE,
    # MPI_OFFSET_KIND)
    my %use_constants   = ();
    my $found_constants = 0;
    for (my $i = 0 ; $i <= $#argtypes ; $i++) {
        $argtypes[$i] =~ s/^const\s+//;    # Remove const if present
        my $argtype = $argtypes[$i];

        # Check for special args
        $loc = $i + 1;
        if (defined($special_args{"$routine-$loc"})) {
            $argtype = $special_args{"$routine-$loc"};
        }

        # Map the C type to the Fortran type
        my $cargtype = $argtype;
        $cargtype =~ s/\s+//g;
        my $fargtype = $argtypec2f{$cargtype};

        # Now, does this type contain an MPI constant?
        if (!defined($fargtype)) {
            print "$cargtype value has no matching fortran argtype\n";
        }
        if ($fargtype =~ /(MPI_[A-Z_]*)/) {
            $use_constants{$1} = 1;
            $found_constants = 1;
        }
    }
    if ($found_constants) {
        print MPIBASEFD "           USE MPI_CONSTANTS,ONLY:";
        $sep = "";
        foreach $name (keys(%use_constants)) {
            print MPIBASEFD "$sep$name";
            $sep = ", ";
            $NeedConstants{$routine} .= "$name ";
        }
        print MPIBASEFD "\n";
    }

    # Output argument types
    for (my $i = 0 ; $i <= $#argtypes ; $i++) {
        $argtype = $argtypes[$i];

        # Check for special args
        $loc = $i + 1;
        if (defined($special_args{"$routine-$loc"})) {
            $argtype = $special_args{"$routine-$loc"};
        }

        # Map the C type to the Fortran type
        $cargtype = $argtype;
        $cargtype =~ s/\s+//g;
        $fargtype = $argtypec2f{$cargtype};
        if ($fargtype eq "") {
            print STDERR "$routine: No Fortran type for $cargtype ($argtype)\n";
        }

        # Split out the base type from the name
        if ($fargtype =~ /(\w+.*)\s+(%name\S.*)/) {
            $varType = $1;
            $varName = $2;
            if ($varName =~ /%name%/) {
                $varName =~ s/%name%/$argnames[$i]/;
            }
            $varName =~ s/%nl%/\n       /g;
            $varType =~ s/%nl%/\n       /g;

            # Here's where we might change vector to scalar args
            if ($svflag) {
                if (defined($svargs{$loc})) {

                    # The value is the count arg for the array; later, we
                    # can make use of that to improve the definitions
                    if ($varName =~ /,\*/) {
                        $varName =~ s/,\*//;
                    } elsif ($varName =~ /\(\*\)/) {
                        $varName =~ s/\(\*\)//;
                    } else {
                        print STDERR
                          "Failed to make arg $i in $routine a scalar\n";
                    }
                }
            }
        } else {
            $varType = $fargtype;
            $varName = $argnames[$i];
        }

        print MPIBASEFD "           $varType $varName\n";
    }
}

#
# Replace old file with new file only if new file is different
# Otherwise, remove new filename
sub ReplaceIfDifferent {
    my ($oldfilename, $newfilename) = @_;
    my $rc = 1;
    if (-s $oldfilename) {
        $rc = system "cmp -s $newfilename $oldfilename";
        $rc >>= 8;    # Shift right to get exit status
    }
    if ($rc != 0) {

        # The files differ.  Replace the old file
        # with the new one
        if (-s $oldfilename) {
            print STDERR "Replacing $oldfilename\n";

            # If debugging and there is a difference, show that difference
            if ($gDebug) { system "diff $newfilename $oldfilename"; }

            unlink $oldfilename;
        } else {
            print STDERR "Creating $oldfilename\n";
        }
        rename $newfilename, $oldfilename
          || die "Could not replace $oldfilename";
    } else {
        unlink $newfilename;
    }
}
