OpenMPI tickets 39 & 55 deal with problems with the Fortran 90 large
interface with regards to:
#39: MPI_IN_PLACE in MPI_REDUCE <https://svn.open-mpi.org/trac/ompi/
ticket/39>
#55: MPI_GATHER with arrays of different dimensions <https://svn.open-
mpi.org/trac/ompi/ticket/55>
Attached is a patch to deal with these two issues as applied against
OpenMPI-1.3a1r12364.
Michael
diff -ru openmpi-1.3a1r12364-orig/ompi/mpi/f90/scripts/mpi-f90-interfaces.h.sh
openmpi-1.3a1r12364/ompi/mpi/f90/scripts/mpi-f90-interfaces.h.sh
--- openmpi-1.3a1r12364-orig/ompi/mpi/f90/scripts/mpi-f90-interfaces.h.sh
2006-10-26 00:31:54.000000000 -0400
+++ openmpi-1.3a1r12364/ompi/mpi/f90/scripts/mpi-f90-interfaces.h.sh
2006-10-26 07:56:10.000000000 -0400
@@ -4378,8 +4378,12 @@
procedure=$1
rank=$2
- type=$4
- proc="$1$2D$3"
+# type=$4
+# proc="$1$2D$3"
+ rank2=$3
+ type=$5
+ type2=$6
+ proc="$1$2$3D$4"
cat <<EOF
subroutine ${proc}(sendbuf, sendcount, sendtype, recvbuf, recvcount, &
@@ -4387,7 +4391,7 @@
${type}, intent(in) :: sendbuf
integer, intent(in) :: sendcount
integer, intent(in) :: sendtype
- ${type}, intent(out) :: recvbuf
+ ${type2}, intent(out) :: recvbuf
integer, intent(in) :: recvcount
integer, intent(in) :: recvtype
integer, intent(in) :: root
@@ -4411,19 +4415,34 @@
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_120 MPI_Gather ${rank} CH "character${dim}"
- output_120 MPI_Gather ${rank} L "logical${dim}"
+ for rank2 in $allranks
+ do
+ case "$rank2" in 0) dim2='' ; esac
+ case "$rank2" in 1) dim2=', dimension(*)' ; esac
+ case "$rank2" in 2) dim2=', dimension(1,*)' ; esac
+ case "$rank2" in 3) dim2=', dimension(1,1,*)' ; esac
+ case "$rank2" in 4) dim2=', dimension(1,1,1,*)' ; esac
+ case "$rank2" in 5) dim2=', dimension(1,1,1,1,*)' ; esac
+ case "$rank2" in 6) dim2=', dimension(1,1,1,1,1,*)' ; esac
+ case "$rank2" in 7) dim2=', dimension(1,1,1,1,1,1,*)' ; esac
+
+ if [ ${rank2} != "0" ] && [ ${rank2} -ge ${rank} ]; then
+
+ output_120 MPI_Gather ${rank} ${rank2} CH "character${dim}"
"character${dim2}"
+ output_120 MPI_Gather ${rank} ${rank2} L "logical${dim}" "logical${dim2}"
for kind in $ikinds
do
- output_120 MPI_Gather ${rank} I${kind} "integer*${kind}${dim}"
+ output_120 MPI_Gather ${rank} ${rank2} I${kind} "integer*${kind}${dim}"
"integer*${kind}${dim2}"
done
for kind in $rkinds
do
- output_120 MPI_Gather ${rank} R${kind} "real*${kind}${dim}"
+ output_120 MPI_Gather ${rank} ${rank2} R${kind} "real*${kind}${dim}"
"real*${kind}${dim2}"
done
for kind in $ckinds
do
- output_120 MPI_Gather ${rank} C${kind} "complex*${kind}${dim}"
+ output_120 MPI_Gather ${rank} ${rank2} C${kind} "complex*${kind}${dim}"
"complex*${kind}${dim2}"
+ done
+ fi
done
done
end MPI_Gather
@@ -6397,6 +6416,26 @@
end subroutine ${proc}
EOF
+
+ if test "$type" != "integer*4"; then
+
+ cat <<EOF
+
+subroutine ${proc}M(sendbuf, recvbuf, count, datatype, op, &
+ root, comm, ierr)
+ integer, intent(in) :: sendbuf
+ ${type}, intent(out) :: recvbuf
+ integer, intent(in) :: count
+ integer, intent(in) :: datatype
+ integer, intent(in) :: op
+ integer, intent(in) :: root
+ integer, intent(in) :: comm
+ integer, intent(out) :: ierr
+end subroutine ${proc}M
+
+EOF
+
+ fi
}
start MPI_Reduce large
diff -ru openmpi-1.3a1r12364-orig/ompi/mpi/f90/scripts/mpi_gather_f90.f90.sh
openmpi-1.3a1r12364/ompi/mpi/f90/scripts/mpi_gather_f90.f90.sh
--- openmpi-1.3a1r12364-orig/ompi/mpi/f90/scripts/mpi_gather_f90.f90.sh
2006-10-26 00:31:55.000000000 -0400
+++ openmpi-1.3a1r12364/ompi/mpi/f90/scripts/mpi_gather_f90.f90.sh
2006-10-26 07:57:32.000000000 -0400
@@ -41,8 +41,12 @@
output() {
procedure=$1
rank=$2
- type=$4
- proc="$1$2D$3"
+# type=$4
+# proc="$1$2D$3"
+ rank2=$3
+ type=$5
+ type2=$6
+ proc="$1$2$3D$4"
cat <<EOF
@@ -52,7 +56,7 @@
${type}, intent(in) :: sendbuf
integer, intent(in) :: sendcount
integer, intent(in) :: sendtype
- ${type}, intent(out) :: recvbuf
+ ${type2}, intent(out) :: recvbuf
integer, intent(in) :: recvcount
integer, intent(in) :: recvtype
integer, intent(in) :: root
@@ -76,18 +80,33 @@
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 MPI_Gather ${rank} CH "character${dim}"
- output MPI_Gather ${rank} L "logical${dim}"
+ for rank2 in $allranks
+ do
+ case "$rank2" in 0) dim2='' ; esac
+ case "$rank2" in 1) dim2=', dimension(*)' ; esac
+ case "$rank2" in 2) dim2=', dimension(1,*)' ; esac
+ case "$rank2" in 3) dim2=', dimension(1,1,*)' ; esac
+ case "$rank2" in 4) dim2=', dimension(1,1,1,*)' ; esac
+ case "$rank2" in 5) dim2=', dimension(1,1,1,1,*)' ; esac
+ case "$rank2" in 6) dim2=', dimension(1,1,1,1,1,*)' ; esac
+ case "$rank2" in 7) dim2=', dimension(1,1,1,1,1,1,*)' ; esac
+
+ if [ ${rank2} != "0" ] && [ ${rank2} -ge ${rank} ]; then
+
+ output MPI_Gather ${rank} ${rank2} CH "character${dim}" "character${dim2}"
+ output MPI_Gather ${rank} ${rank2} L "logical${dim}" "logical${dim2}"
for kind in $ikinds
do
- output MPI_Gather ${rank} I${kind} "integer*${kind}${dim}"
+ output MPI_Gather ${rank} ${rank2} I${kind} "integer*${kind}${dim}"
"integer*${kind}${dim2}"
done
for kind in $rkinds
do
- output MPI_Gather ${rank} R${kind} "real*${kind}${dim}"
+ output MPI_Gather ${rank} ${rank2} R${kind} "real*${kind}${dim}"
"real*${kind}${dim2}"
done
for kind in $ckinds
do
- output MPI_Gather ${rank} C${kind} "complex*${kind}${dim}"
+ output MPI_Gather ${rank} ${rank2} C${kind} "complex*${kind}${dim}"
"complex*${kind}${dim2}"
+ done
+ fi
done
done
diff -ru openmpi-1.3a1r12364-orig/ompi/mpi/f90/scripts/mpi_reduce_f90.f90.sh
openmpi-1.3a1r12364/ompi/mpi/f90/scripts/mpi_reduce_f90.f90.sh
--- openmpi-1.3a1r12364-orig/ompi/mpi/f90/scripts/mpi_reduce_f90.f90.sh
2006-10-26 00:31:55.000000000 -0400
+++ openmpi-1.3a1r12364/ompi/mpi/f90/scripts/mpi_reduce_f90.f90.sh
2006-10-26 07:56:45.000000000 -0400
@@ -62,6 +62,29 @@
end subroutine ${proc}
EOF
+
+ if test "$type" != "integer*4"; then
+
+ cat <<EOF
+
+subroutine ${proc}M(sendbuf, recvbuf, count, datatype, op, &
+ root, comm, ierr)
+ include "mpif-config.h"
+ integer, intent(in) :: sendbuf
+ ${type}, intent(out) :: recvbuf
+ integer, intent(in) :: count
+ integer, intent(in) :: datatype
+ integer, intent(in) :: op
+ integer, intent(in) :: root
+ integer, intent(in) :: comm
+ integer, intent(out) :: ierr
+ call ${procedure}(sendbuf, recvbuf, count, datatype, op, &
+ root, comm, ierr)
+end subroutine ${proc}M
+
+EOF
+
+ fi
}
for rank in $allranks
