mpi-f90-interfaces.h.sh

MPI stands for the Message Passing Interface. Written by the MPI Forum (a large committee comprising

#! /bin/sh
#
# Copyright (c) 2004-2006 The Trustees of Indiana University and Indiana
#                         University Research and Technology
#                         Corporation.  All rights reserved.
# Copyright (c) 2004-2006 The Regents of the University of California.
#                         All rights reserved.
# Copyright (c) 2006-2007 Cisco Systems, Inc.  All rights reserved.
# $COPYRIGHT$
# 
# Additional copyrights may follow
# 
# $HEADER$
#

# Do a little error checking

if test ! -f "$1/fortran_kinds.sh"; then
    echo "ERROR: Cannot find fortran_kinds.sh" >&2
    exit 1
elif test -z "$1/fortran_kinds.sh"; then
    echo "ERROR: fortran_kinds.sh appears to be empty!" >&2
    exit 1
fi

# Read in the KIND information

. "$1/fortran_kinds.sh"

# Setup

output=1
allranks="0 $ranks"

#------------------------------------------------------------------------

# Helper functions

start() {
    check_size $2
    if test "$output" = "1"; then        
        echo "interface $1"
    fi
}

end() {
    if test "$output" = "1"; then
        cat <<EOF
end interface $1


EOF
    fi
}

# A few hard-coded functions that cannot pass through to the F77
# equivalents

start MPI_Wtick small
if test "$output" = "1"; then
    cat <<EOF

function MPI_Wtick()
    double precision MPI_Wtick
end function MPI_Wtick

EOF
fi
end MPI_Wtick

start MPI_Wtime small
if test "$output" = "1"; then
    cat <<EOF

function MPI_Wtime()
    double precision MPI_Wtime
end function MPI_Wtime

EOF
fi
end MPI_Wtime

#------------------------------------------------------------------------

output_1() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    cat <<EOF

subroutine ${procedure}(comm, errorcode, ierr)
  integer, intent(in) :: comm
  integer, intent(in) :: errorcode
  integer, intent(out) :: ierr
end subroutine ${procedure}

EOF
}

start MPI_Abort small
output_1 MPI_Abort
end MPI_Abort

#------------------------------------------------------------------------

output_2() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    rank=$2
    type=$4
    proc="$1$2D$3"
    cat <<EOF

subroutine ${proc}(origin_addr, origin_count, origin_datatype, target_rank, target_disp, &
        target_count, target_datatype, op, win, ierr)
  include 'mpif-common.h'
  ${type}, intent(in) :: origin_addr
  integer, intent(in) :: origin_count
  integer, intent(in) :: origin_datatype
  integer, intent(in) :: target_rank
  integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp
  integer, intent(in) :: target_count
  integer, intent(in) :: target_datatype
  integer, intent(in) :: op
  integer, intent(in) :: win
  integer, intent(out) :: ierr
end subroutine ${proc}

EOF
}

start MPI_Accumulate medium

for rank in $allranks
do
  case "$rank" in  0)  dim=''  ;  esac
  case "$rank" in  1)  dim=', dimension(*)'  ;  esac
  case "$rank" in  2)  dim=', dimension(1,*)'  ;  esac
  case "$rank" in  3)  dim=', dimension(1,1,*)'  ;  esac
  case "$rank" in  4)  dim=', dimension(1,1,1,*)'  ;  esac
  case "$rank" in  5)  dim=', dimension(1,1,1,1,*)'  ;  esac
  case "$rank" in  6)  dim=', dimension(1,1,1,1,1,*)'  ;  esac
  case "$rank" in  7)  dim=', dimension(1,1,1,1,1,1,*)'  ;  esac

  output_2 MPI_Accumulate ${rank} CH "character${dim}"
  output_2 MPI_Accumulate ${rank} L "logical${dim}"
  for kind in $ikinds
  do
    output_2 MPI_Accumulate ${rank} I${kind} "integer*${kind}${dim}"
  done
  for kind in $rkinds
  do
    output_2 MPI_Accumulate ${rank} R${kind} "real*${kind}${dim}"
  done
  for kind in $ckinds
  do
    output_2 MPI_Accumulate ${rank} C${kind} "complex*${kind}${dim}"
  done
done
end MPI_Accumulate

#------------------------------------------------------------------------

output_3() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    cat <<EOF

subroutine ${procedure}(errorclass, ierr)
  integer, intent(in) :: errorclass
  integer, intent(out) :: ierr
end subroutine ${procedure}

EOF
}

start MPI_Add_error_class small
output_3 MPI_Add_error_class
end MPI_Add_error_class

#------------------------------------------------------------------------

output_4() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    cat <<EOF

subroutine ${procedure}(errorclass, errorcode, ierr)
  integer, intent(in) :: errorclass
  integer, intent(out) :: errorcode
  integer, intent(out) :: ierr
end subroutine ${procedure}

EOF
}

start MPI_Add_error_code small
output_4 MPI_Add_error_code
end MPI_Add_error_code

#------------------------------------------------------------------------

output_5() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    cat <<EOF

subroutine ${procedure}(errorcode, string, ierr)
  integer, intent(in) :: errorcode
  character(len=*), intent(in) :: string
  integer, intent(out) :: ierr
end subroutine ${procedure}

EOF
}

start MPI_Add_error_string small
output_5 MPI_Add_error_string
end MPI_Add_error_string

#------------------------------------------------------------------------

output_6() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    rank=$2
    type=$4
    proc="$1$2D$3"
    cat <<EOF

subroutine ${proc}(location, address, ierr)
  ${type}, intent(in) :: location
  integer, intent(out) :: address
  integer, intent(out) :: ierr
end subroutine ${proc}

EOF
}

start MPI_Address medium

for rank in $allranks
do
  case "$rank" in  0)  dim=''  ;  esac
  case "$rank" in  1)  dim=', dimension(*)'  ;  esac
  case "$rank" in  2)  dim=', dimension(1,*)'  ;  esac
  case "$rank" in  3)  dim=', dimension(1,1,*)'  ;  esac
  case "$rank" in  4)  dim=', dimension(1,1,1,*)'  ;  esac
  case "$rank" in  5)  dim=', dimension(1,1,1,1,*)'  ;  esac
  case "$rank" in  6)  dim=', dimension(1,1,1,1,1,*)'  ;  esac
  case "$rank" in  7)  dim=', dimension(1,1,1,1,1,1,*)'  ;  esac

  output_6 MPI_Address ${rank} CH "character${dim}"
  output_6 MPI_Address ${rank} L "logical${dim}"
  for kind in $ikinds
  do
    output_6 MPI_Address ${rank} I${kind} "integer*${kind}${dim}"
  done
  for kind in $rkinds
  do
    output_6 MPI_Address ${rank} R${kind} "real*${kind}${dim}"
  done
  for kind in $ckinds
  do
    output_6 MPI_Address ${rank} C${kind} "complex*${kind}${dim}"
  done
done
end MPI_Address

#------------------------------------------------------------------------

output_7() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    rank=$2
    type=$4
    proc="$1$2D$3"
    cat <<EOF

subroutine ${proc}(sendbuf, sendcount, sendtype, recvbuf, recvcount, &
        recvtype, comm, ierr)
  ${type}, intent(in) :: sendbuf
  integer, intent(in) :: sendcount
  integer, intent(in) :: sendtype
  ${type}, intent(out) :: recvbuf
  integer, intent(in) :: recvcount
  integer, intent(in) :: recvtype
  integer, intent(in) :: comm
  integer, intent(out) :: ierr
end subroutine ${proc}

EOF
}

start MPI_Allgather large

for rank in $allranks
do
  case "$rank" in  0)  dim=''  ;  esac
  case "$rank" in  1)  dim=', dimension(*)'  ;  esac
  case "$rank" in  2)  dim=', dimension(1,*)'  ;  esac
  case "$rank" in  3)  dim=', dimension(1,1,*)'  ;  esac
  case "$rank" in  4)  dim=', dimension(1,1,1,*)'  ;  esac
  case "$rank" in  5)  dim=', dimension(1,1,1,1,*)'  ;  esac
  case "$rank" in  6)  dim=', dimension(1,1,1,1,1,*)'  ;  esac
  case "$rank" in  7)  dim=', dimension(1,1,1,1,1,1,*)'  ;  esac

  output_7 MPI_Allgather ${rank} CH "character${dim}"
  output_7 MPI_Allgather ${rank} L "logical${dim}"
  for kind in $ikinds
  do
    output_7 MPI_Allgather ${rank} I${kind} "integer*${kind}${dim}"
  done
  for kind in $rkinds
  do
    output_7 MPI_Allgather ${rank} R${kind} "real*${kind}${dim}"
  done
  for kind in $ckinds
  do
    output_7 MPI_Allgather ${rank} C${kind} "complex*${kind}${dim}"
  done
done
end MPI_Allgather

#------------------------------------------------------------------------

output_8() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    rank=$2
    type=$4
    proc="$1$2D$3"
    cat <<EOF

subroutine ${proc}(sendbuf, sendcount, sendtype, recvbuf, recvcounts, &
        displs, recvtype, comm, ierr)
  ${type}, intent(in) :: sendbuf
  integer, intent(in) :: sendcount
  integer, intent(in) :: sendtype
  ${type}, intent(out) :: recvbuf
  integer, dimension(*), intent(in) :: recvcounts
  integer, dimension(*), intent(in) :: displs
  integer, intent(in) :: recvtype
  integer, intent(in) :: comm
  integer, intent(out) :: ierr
end subroutine ${proc}

EOF
}

start MPI_Allgatherv large

for rank in $allranks
do
  case "$rank" in  0)  dim=''  ;  esac
  case "$rank" in  1)  dim=', dimension(*)'  ;  esac
  case "$rank" in  2)  dim=', dimension(1,*)'  ;  esac
  case "$rank" in  3)  dim=', dimension(1,1,*)'  ;  esac
  case "$rank" in  4)  dim=', dimension(1,1,1,*)'  ;  esac
  case "$rank" in  5)  dim=', dimension(1,1,1,1,*)'  ;  esac
  case "$rank" in  6)  dim=', dimension(1,1,1,1,1,*)'  ;  esac
  case "$rank" in  7)  dim=', dimension(1,1,1,1,1,1,*)'  ;  esac

  output_8 MPI_Allgatherv ${rank} CH "character${dim}"
  output_8 MPI_Allgatherv ${rank} L "logical${dim}"
  for kind in $ikinds
  do
    output_8 MPI_Allgatherv ${rank} I${kind} "integer*${kind}${dim}"
  done
  for kind in $rkinds
  do
    output_8 MPI_Allgatherv ${rank} R${kind} "real*${kind}${dim}"
  done
  for kind in $ckinds
  do
    output_8 MPI_Allgatherv ${rank} C${kind} "complex*${kind}${dim}"
  done
done
end MPI_Allgatherv

#------------------------------------------------------------------------

output_9() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    cat <<EOF

subroutine ${procedure}(size, info, baseptr, ierr)
  include 'mpif-config.h'
  integer(kind=MPI_ADDRESS_KIND), intent(in) :: size
  integer, intent(in) :: info
  integer(kind=MPI_ADDRESS_KIND), intent(out) :: baseptr
  integer, intent(out) :: ierr
end subroutine ${procedure}

EOF
}

start MPI_Alloc_mem medium
output_9 MPI_Alloc_mem
end MPI_Alloc_mem

#------------------------------------------------------------------------

output_10() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    rank=$2
    type=$4
    proc="$1$2D$3"
    cat <<EOF

subroutine ${proc}(sendbuf, recvbuf, count, datatype, op, &
        comm, ierr)
  ${type}, intent(in) :: sendbuf
  ${type}, intent(out) :: recvbuf
  integer, intent(in) :: count
  integer, intent(in) :: datatype
  integer, intent(in) :: op
  integer, intent(in) :: comm
  integer, intent(out) :: ierr
end subroutine ${proc}

EOF
}

start MPI_Allreduce large

for rank in $allranks
do
  case "$rank" in  0)  dim=''  ;  esac
  case "$rank" in  1)  dim=', dimension(*)'  ;  esac
  case "$rank" in  2)  dim=', dimension(1,*)'  ;  esac
  case "$rank" in  3)  dim=', dimension(1,1,*)'  ;  esac
  case "$rank" in  4)  dim=', dimension(1,1,1,*)'  ;  esac
  case "$rank" in  5)  dim=', dimension(1,1,1,1,*)'  ;  esac
  case "$rank" in  6)  dim=', dimension(1,1,1,1,1,*)'  ;  esac
  case "$rank" in  7)  dim=', dimension(1,1,1,1,1,1,*)'  ;  esac

  output_10 MPI_Allreduce ${rank} CH "character${dim}"
  output_10 MPI_Allreduce ${rank} L "logical${dim}"
  for kind in $ikinds
  do
    output_10 MPI_Allreduce ${rank} I${kind} "integer*${kind}${dim}"
  done
  for kind in $rkinds
  do
    output_10 MPI_Allreduce ${rank} R${kind} "real*${kind}${dim}"
  done
  for kind in $ckinds
  do
    output_10 MPI_Allreduce ${rank} C${kind} "complex*${kind}${dim}"
  done
done
end MPI_Allreduce

#------------------------------------------------------------------------

output_11() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    rank=$2
    type=$4
    proc="$1$2D$3"
    cat <<EOF

subroutine ${proc}(sendbuf, sendcount, sendtype, recvbuf, recvcount, &
        recvtype, comm, ierr)
  ${type}, intent(in) :: sendbuf
  integer, intent(in) :: sendcount
  integer, intent(in) :: sendtype
  ${type}, intent(out) :: recvbuf
  integer, intent(in) :: recvcount
  integer, intent(in) :: recvtype
  integer, intent(in) :: comm
  integer, intent(out) :: ierr
end subroutine ${proc}

EOF
}

start MPI_Alltoall large

for rank in $allranks
do
  case "$rank" in  0)  dim=''  ;  esac
  case "$rank" in  1)  dim=', dimension(*)'  ;  esac
  case "$rank" in  2)  dim=', dimension(1,*)'  ;  esac
  case "$rank" in  3)  dim=', dimension(1,1,*)'  ;  esac
  case "$rank" in  4)  dim=', dimension(1,1,1,*)'  ;  esac
  case "$rank" in  5)  dim=', dimension(1,1,1,1,*)'  ;  esac
  case "$rank" in  6)  dim=', dimension(1,1,1,1,1,*)'  ;  esac
  case "$rank" in  7)  dim=', dimension(1,1,1,1,1,1,*)'  ;  esac

  output_11 MPI_Alltoall ${rank} CH "character${dim}"
  output_11 MPI_Alltoall ${rank} L "logical${dim}"
  for kind in $ikinds
  do
    output_11 MPI_Alltoall ${rank} I${kind} "integer*${kind}${dim}"
  done
  for kind in $rkinds
  do
    output_11 MPI_Alltoall ${rank} R${kind} "real*${kind}${dim}"
  done
  for kind in $ckinds
  do
    output_11 MPI_Alltoall ${rank} C${kind} "complex*${kind}${dim}"
  done
done
end MPI_Alltoall

#------------------------------------------------------------------------

output_12() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    rank=$2
    type=$4
    proc="$1$2D$3"
    cat <<EOF

subroutine ${proc}(sendbuf, sendcounts, sdispls, sendtype, recvbuf, &
        recvcounts, rdispls, recvtype, comm, ierr)
  ${type}, intent(in) :: sendbuf
  integer, dimension(*), intent(in) :: sendcounts
  integer, dimension(*), intent(in) :: sdispls
  integer, intent(in) :: sendtype
  ${type}, intent(out) :: recvbuf
  integer, dimension(*), intent(in) :: recvcounts
  integer, dimension(*), intent(in) :: rdispls
  integer, intent(in) :: recvtype
  integer, intent(in) :: comm
  integer, intent(out) :: ierr
end subroutine ${proc}

EOF
}