Dear all,
I have my mympi.f90 module below. I always use it with Intel Fortran and it works fine and compile with no warning or error. It has been used for some years in nuclear quantum Monte Carlo calculations and on supercomputers (with intel fortran and mpi).
However, the thing bothers me a little is that whenever I use mpif90 gfortran and compile it,
mpif90 -c mympi.f90
it always give me various warnings mainly type mismatch which I cannot figure out why.
Could anyone perhaps
- have a look and point out how to fix some of those warnings
- or suggest how to improve it?
Thank you very much in advance!
mympi module is below,
module mympi
implicit none
include 'mpif.h'
integer, private, parameter :: i4=selected_int_kind(9)
integer, private, parameter :: i8=selected_int_kind(15)
integer, private, parameter :: r8=selected_real_kind(15,9)
integer, private, save :: mpii4,mpii8,mpir8
integer(kind=i4), private, save :: irank,iproc
!type, private :: var_char
! character(:), allocatable :: str
!end type var_char
interface bcast ! broadcast from process 0
module procedure bcasti1,bcasti1d,bcasti2d,bcasti3d,bcasti4d
module procedure bcasti1_8,bcasti1d_8
module procedure bcastr1,bcastr1d,bcastr2d,bcastr3d,bcastr4d
module procedure bcastlogi
module procedure bcastchar
!module procedure bcast_varchar
end interface bcast
interface addall ! return sum to process 0
module procedure addalli1,addalli1d,addalli1_8,addalli1d_8
module procedure addallr1,addallr1d,addallr2d,addallr3d,addallr4d
module procedure addallc1,addallc1d
end interface addall
interface gather ! gather to process 0
module procedure gatheri1,gatheri1d,gatheri1_8
module procedure gatherr1,gatherr1d
module procedure gatherr2d_1d,gatherr3d_1d,gatherr4d_1d,gatherr5d_1d
end interface gather
interface allgather ! gather to all process
module procedure allgatheri1,allgatheri1d,allgatheri1_8
module procedure allgatherr1,allgatherr1d
end interface allgather
interface scatter ! scatter from process 0 to all process, evenly scatter. inverse of gather
module procedure scatteri1,scatteri1d,scatteri81
module procedure scatterr1,scatterr1d
end interface scatter
interface send ! send to someone else
module procedure sendi1,sendi1d
module procedure sendr1,sendr1d
module procedure sendc1,sendc1d
end interface send
interface recv ! recv from someone else
module procedure recvi1,recvi1d
module procedure recvr1,recvr1d
module procedure recvc1,recvc1d
end interface recv
contains
subroutine init0 ! call this before anything else
use mpi
integer :: ierror,isize,ir,ip
integer(kind=i4) :: itest4
integer(kind=i8) :: itest8
real(kind=r8) :: rtest8
call mpi_init(ierror)
call mpi_comm_rank(mpi_comm_world,ir,ierror)
irank=ir
call mpi_comm_size(mpi_comm_world,ip,ierror)
iproc=ip
call mpi_sizeof(itest4,isize,ierror)
call mpi_type_match_size(mpi_typeclass_integer,isize,mpii4,ierror)
call mpi_sizeof(itest8,isize,ierror)
call mpi_type_match_size(mpi_typeclass_integer,isize,mpii8,ierror)
call mpi_sizeof(rtest8,isize,ierror)
call mpi_type_match_size(mpi_typeclass_real,isize,mpir8,ierror)
return
end subroutine init0
subroutine done ! wrapper for finalize routine
integer :: ierror
call mpi_finalize(ierror)
return
end subroutine done
subroutine bcastlogi(i)
logical :: i
integer :: ierror
call mpi_bcast(i,1,mpi_logical,0,mpi_comm_world,ierror)
return
end subroutine bcastlogi
subroutine bcasti1(i)
integer(kind=i4) :: i
integer :: ierror
call mpi_bcast(i,1,mpii4,0,mpi_comm_world,ierror)
return
end subroutine bcasti1
subroutine bcasti1_8(i)
integer(kind=i8) :: i
integer :: ierror
call mpi_bcast(i,1,mpii8,0,mpi_comm_world,ierror)
return
end subroutine bcasti1_8
subroutine bcasti1d(i)
integer(kind=i4) :: i(:)
integer :: ierror
call mpi_bcast(i,size(i),mpii4,0,mpi_comm_world,ierror)
return
end subroutine bcasti1d
subroutine bcasti1d_8(i)
integer(kind=i8) :: i(:)
integer :: ierror
call mpi_bcast(i,size(i),mpii8,0,mpi_comm_world,ierror)
return
end subroutine bcasti1d_8
subroutine bcasti2d(i)
integer(kind=i4) :: i(:,:)
integer :: ierror
call mpi_bcast(i,size(i),mpii4,0,mpi_comm_world,ierror)
return
end subroutine bcasti2d
subroutine bcasti3d(i)
integer(kind=i4) :: i(:,:,:)
integer :: ierror
call mpi_bcast(i,size(i),mpii4,0,mpi_comm_world,ierror)
return
end subroutine bcasti3d
subroutine bcasti4d(i)
integer(kind=i4) :: i(:,:,:,:)
integer :: ierror
call mpi_bcast(i,size(i),mpii4,0,mpi_comm_world,ierror)
return
end subroutine bcasti4d
subroutine bcastr1d(r)
real(kind=r8) :: r(:)
integer :: ierror
call mpi_bcast(r,size(r),mpir8,0,mpi_comm_world,ierror)
return
end subroutine bcastr1d
subroutine bcastr2d(r)
real(kind=r8) :: r(:,:)
integer :: ierror
call mpi_bcast(r,size(r),mpir8,0,mpi_comm_world,ierror)
return
end subroutine bcastr2d
subroutine bcastr3d(r)
real(kind=r8) :: r(:,:,:)
integer :: ierror
call mpi_bcast(r,size(r),mpir8,0,mpi_comm_world,ierror)
end subroutine bcastr3d
subroutine bcastr4d(r)
real(kind=r8) :: r(:,:,:,:)
integer :: ierror
call mpi_bcast(r,size(r),mpir8,0,mpi_comm_world,ierror)
end subroutine bcastr4d
subroutine bcastr1(r)
real(kind=r8) :: r
integer :: ierror
call mpi_bcast(r,1,mpir8,0,mpi_comm_world,ierror)
end subroutine bcastr1
subroutine bcastchar(w)
integer(kind=i4) :: ierror
character(len=*) :: w
call mpi_bcast(w,len(w),mpi_character,0,mpi_comm_world,ierror)
return
end subroutine bcastchar
subroutine bcast_varchar(w)
integer(kind=i4) :: ierror
character(:), allocatable :: w
integer(kind=i4) :: wlen
if (myrank()==0) wlen = len(w)
call bcast(wlen)
if (myrank()/=0) then
if (allocated(w)) deallocate(w)
allocate( character(wlen) :: w )
endif
call mpi_bcast(w,wlen,mpi_character,0,mpi_comm_world,ierror)
return
end subroutine bcast_varchar
function myrank() ! which process am I?
integer(kind=i4) :: myrank
myrank=irank
return
end function myrank
function nproc() ! How many of use are there anyway?
integer(kind=i4) :: nproc
nproc=iproc
return
end function nproc
subroutine addalli1(i,isum)
integer(kind=i4) :: ierror,i,isum
call mpi_reduce(i,isum,1,mpi_integer,mpi_sum,0,mpi_comm_world,ierror)
return
end subroutine addalli1
subroutine addalli1d(i,isum)
integer(kind=i4) :: ierror,i(:),isum(:)
call mpi_reduce(i,isum,size(i),mpi_integer,mpi_sum,0,mpi_comm_world,ierror)
return
end subroutine addalli1d
subroutine addalli1_8(i,isum)
integer(kind=i4) :: ierror
integer(kind=i8) :: i,isum
call mpi_reduce(i,isum,1,mpi_integer8,mpi_sum,0,mpi_comm_world,ierror)
return
end subroutine addalli1_8
subroutine addalli1d_8(i,isum)
integer(kind=i4) :: ierror
integer(kind=i8) :: i(:),isum(:)
call mpi_reduce(i,isum,size(i),mpi_integer8,mpi_sum,0,mpi_comm_world,ierror)
return
end subroutine addalli1d_8
subroutine addallr1(r,rsum)
integer(kind=i4) :: ierror
real(kind=r8) :: r,rsum
call mpi_reduce(r,rsum,1,mpi_double_precision,mpi_sum,0, &
mpi_comm_world,ierror)
return
end subroutine addallr1
subroutine addallr1d(r,rsum)
real(kind=r8) :: r(:),rsum(:)
integer(kind=i4) :: ierror
call mpi_reduce(r,rsum,size(r),mpi_double_precision,mpi_sum,0, &
mpi_comm_world,ierror)
return
end subroutine addallr1d
subroutine addallr2d(r,rsum)
real(kind=r8) :: r(:,:),rsum(:,:)
integer(kind=i4) :: ierror
call mpi_reduce(r,rsum,size(r),mpi_double_precision,mpi_sum,0, &
mpi_comm_world,ierror)
return
end subroutine addallr2d
subroutine addallr3d(r,rsum)
real(kind=r8) :: r(:,:,:),rsum(:,:,:)
integer(kind=i4) :: ierror
call mpi_reduce(r,rsum,size(r),mpi_double_precision,mpi_sum,0, &
mpi_comm_world,ierror)
return
end subroutine addallr3d
subroutine addallr4d(r,rsum)
real(kind=r8) :: r(:,:,:,:),rsum(:,:,:,:)
integer(kind=i4) :: ierror
call mpi_reduce(r,rsum,size(r),mpi_double_precision,mpi_sum,0, &
mpi_comm_world,ierror)
return
end subroutine addallr4d
subroutine addallc1(c,csum)
integer(kind=i4) :: ierror
complex(kind=r8) :: c,csum
call mpi_reduce(c,csum,1,mpi_double_complex,mpi_sum,0, &
mpi_comm_world,ierror)
return
end subroutine addallc1
subroutine addallc1d(c,csum)
complex(kind=r8) :: c(:),csum(:)
integer(kind=i4) :: ierror
call mpi_reduce(c,csum,size(c),mpi_double_complex,mpi_sum,0, &
mpi_comm_world,ierror)
return
end subroutine addallc1d
subroutine gatheri1(i,igather)
integer(kind=i4) :: i,igather(:)
integer :: ierror
call mpi_gather(i,1,mpii4,igather,1,mpii4,0,mpi_comm_world,ierror)
return
end subroutine gatheri1
subroutine gatheri1d(i,igather)
integer(kind=i4) :: i(:),igather(:)
integer :: ierror
call mpi_gather(i,size(i),mpii4,igather,size(i),mpii4,0, &
mpi_comm_world,ierror)
return
end subroutine gatheri1d
subroutine gatheri1_8(i,igather)
integer(kind=i8) :: i,igather(:)
integer :: ierror
call mpi_gather(i,1,mpii8,igather,1,mpii8,0, &
mpi_comm_world,ierror)
return
end subroutine gatheri1_8
subroutine gatherr1(r,rgather)
real(kind=r8) :: r,rgather(:)
integer :: ierror
call mpi_gather(r,1,mpir8,rgather,1,mpir8,0,mpi_comm_world,ierror)
return
end subroutine gatherr1
subroutine gatherr1d(r,rgather)
real(kind=r8) :: r(:),rgather(:)
integer :: ierror
call mpi_gather(r,size(r),mpir8,rgather,size(r),mpir8,0, &
mpi_comm_world,ierror)
return
end subroutine gatherr1d
subroutine gatherr2d_1d(r,rgather)
real(kind=r8) :: r(:,:),rgather(:)
integer :: ierror
call mpi_gather(r,size(r),mpir8,rgather,size(r),mpir8,0, &
mpi_comm_world,ierror)
return
end subroutine gatherr2d_1d
subroutine gatherr3d_1d(r,rgather)
real(kind=r8) :: r(:,:,:),rgather(:)
integer :: ierror
call mpi_gather(r,size(r),mpir8,rgather,size(r),mpir8,0, &
mpi_comm_world,ierror)
return
end subroutine gatherr3d_1d
subroutine gatherr4d_1d(r,rgather)
real(kind=r8) :: r(:,:,:,:),rgather(:)
integer :: ierror
call mpi_gather(r,size(r),mpir8,rgather,size(r),mpir8,0, &
mpi_comm_world,ierror)
return
end subroutine gatherr4d_1d
subroutine gatherr5d_1d(r,rgather)
real(kind=r8) :: r(:,:,:,:,:),rgather(:)
integer :: ierror
call mpi_gather(r,size(r),mpir8,rgather,size(r),mpir8,0, &
mpi_comm_world,ierror)
return
end subroutine gatherr5d_1d
subroutine allgatheri1(i,igather)
integer(kind=i4) :: i,igather(:)
integer :: ierror
call mpi_allgather(i,1,mpii4,igather,1,mpii4,mpi_comm_world,ierror)
return
end subroutine allgatheri1
subroutine allgatheri1d(i,igather)
integer(kind=i4) :: i(:),igather(:)
integer :: ierror
call mpi_allgather(i,size(i),mpii4,igather,size(i),mpii4, &
mpi_comm_world,ierror)
return
end subroutine allgatheri1d
subroutine allgatheri1_8(i,igather)
integer(kind=i8) :: i,igather(:)
integer :: ierror
call mpi_allgather(i,1,mpii8,igather,1,mpii8, &
mpi_comm_world,ierror)
return
end subroutine allgatheri1_8
subroutine allgatherr1(r,rgather)
real(kind=r8) :: r,rgather(:)
integer :: ierror
call mpi_allgather(r,1,mpir8,rgather,1,mpir8,mpi_comm_world,ierror)
return
end subroutine allgatherr1
subroutine allgatherr1d(r,rgather)
real(kind=r8) :: r(:),rgather(:)
integer :: ierror
call mpi_allgather(r,size(r),mpir8,rgather,size(r),mpir8, &
mpi_comm_world,ierror)
return
end subroutine allgatherr1d
subroutine scatteri1(i,iscatter)
integer(kind=i4) :: i(:),iscatter
integer :: ierror
call mpi_scatter(i,1,mpii4,iscatter,1,mpii4,0, &
mpi_comm_world,ierror)
return
end subroutine scatteri1
subroutine scatteri81(i,iscatter)
integer(kind=i8) :: i(:),iscatter
integer :: ierror
call mpi_scatter(i,1,mpii8,iscatter,1,mpii8,0, &
mpi_comm_world,ierror)
return
end subroutine scatteri81
subroutine scatteri1d(i,iscatter)
integer(kind=i4) :: i(:),iscatter(:)
integer :: ierror
call mpi_scatter(i,size(iscatter),mpii4,iscatter,size(iscatter),mpii4,0, &
mpi_comm_world,ierror)
return
end subroutine scatteri1d
subroutine scatterr1(r,rscatter)
real(kind=r8) :: r(:),rscatter
integer :: ierror
call mpi_scatter(r,1,mpir8,rscatter,1,mpir8,0, &
mpi_comm_world,ierror)
return
end subroutine scatterr1
subroutine scatterr1d(r,rscatter)
real(kind=r8) :: r(:),rscatter(:)
integer :: ierror
call mpi_scatter(r,size(rscatter),mpir8,rscatter,size(rscatter),mpir8,0, &
mpi_comm_world,ierror)
return
end subroutine scatterr1d
subroutine sendi1(i,idto,itag)
integer(kind=i4) :: i,idto,itag,ierror
call mpi_send(i,1,mpi_integer,idto,itag,mpi_comm_world,ierror)
return
end subroutine sendi1
subroutine sendi1d(i,idto,itag)
integer(kind=i4) :: i(:),idto,itag,ierror
call mpi_send(i,size(i),mpi_integer,idto,itag,mpi_comm_world,ierror)
return
end subroutine sendi1d
subroutine sendr1(r,idto,itag)
integer(kind=i4) :: idto,itag,ierror
real(kind=r8) :: r
call mpi_send(r,1,mpi_double_precision,idto,itag,mpi_comm_world,ierror)
return
end subroutine sendr1
subroutine sendr1d(r,idto,itag)
integer(kind=i4) :: idto,itag,ierror
real(kind=r8) :: r(:)
call mpi_send(r,size(r),mpi_double_precision,idto,itag,mpi_comm_world,ierror)
return
end subroutine sendr1d
subroutine sendc1(c,idto,itag)
integer(kind=i4) :: idto,itag,ierror
complex (kind=r8) :: c
call mpi_send(c,1,mpi_double_complex,idto,itag,mpi_comm_world,ierror)
return
end subroutine sendc1
subroutine sendc1d(c,idto,itag)
integer(kind=i4) :: idto,itag,ierror
complex(kind=r8) :: c(:)
call mpi_send(c,size(c),mpi_double_complex,idto,itag,mpi_comm_world,ierror)
return
end subroutine sendc1d
subroutine recvi1(i,idfrom,itag)
integer(kind=i4) :: i,idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)
call mpi_recv(i,1,mpi_integer,idfrom,itag,mpi_comm_world,status,ierror)
return
end subroutine recvi1
subroutine recvi1d(i,idfrom,itag)
integer(kind=i4) :: i(:),idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)
call mpi_recv(i,size(i),mpi_integer,idfrom,itag,mpi_comm_world,status,ierror)
return
end subroutine recvi1d
subroutine recvr1(r,idfrom,itag)
integer(kind=i4) :: idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)
real(kind=r8) :: r
call mpi_recv(r,1,mpi_double_precision,idfrom,itag,mpi_comm_world,status,ierror)
return
end subroutine recvr1
subroutine recvr1d(r,idfrom,itag)
integer(kind=i4) :: idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)
real(kind=r8) :: r(:)
call mpi_recv(r,size(r),mpi_double_precision,idfrom,itag,mpi_comm_world, &
status,ierror)
return
end subroutine recvr1d
subroutine recvc1(c,idfrom,itag)
integer(kind=i4) :: idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)
complex (kind=r8) :: c
call mpi_recv(c,1,mpi_double_complex,idfrom,itag,mpi_comm_world,status,ierror)
return
end subroutine recvc1
subroutine recvc1d(c,idfrom,itag)
integer(kind=i4) :: idfrom,itag,ierror,STATUS(MPI_STATUS_SIZE)
complex(kind=r8) :: c(:)
call mpi_recv(c,size(c),mpi_double_complex,idfrom,itag,mpi_comm_world,status,ierror)
return
end subroutine recvc1d
subroutine barrier ! wrapper for mpi_barrier
integer(kind=i4) :: ierror
call mpi_barrier(mpi_comm_world,ierror)
return
end subroutine barrier
subroutine abort
integer :: ierror,errorcode
call mpi_abort(mpi_comm_world,errorcode,ierror)
!stop
return
end subroutine abort
subroutine mpiwait
integer :: REQUEST, STATUS(MPI_STATUS_SIZE), IERROR
call MPI_WAIT(REQUEST, STATUS, IERROR)
return
end subroutine mpiwait
end module mympi
The warning’s are,
mympi.f90:518:17:
518 | call mpi_recv(c,1,mpi_double_complex,idfrom,itag,mpi_comm_world,status,ierror)
| 1
......
526 | call mpi_recv(c,size(c),mpi_double_complex,idfrom,itag,mpi_comm_world,status,ierror)
| 2
Warning: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar)
mympi.f90:509:17:
509 | call mpi_recv(r,size(r),mpi_double_precision,idfrom,itag,mpi_comm_world, &
| 1
......
526 | call mpi_recv(c,size(c),mpi_double_complex,idfrom,itag,mpi_comm_world,status,ierror)
| 2
Warning: Type mismatch between actual argument at (1) and actual argument at (2) (REAL(8)/COMPLEX(8)).
mympi.f90:471:17:
471 | call mpi_send(c,1,mpi_double_complex,idto,itag,mpi_comm_world,ierror)
| 1
......
479 | call mpi_send(c,size(c),mpi_double_complex,idto,itag,mpi_comm_world,ierror)
| 2
Warning: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar)
mympi.f90:463:17:
463 | call mpi_send(r,size(r),mpi_double_precision,idto,itag,mpi_comm_world,ierror)
| 1
......
479 | call mpi_send(c,size(c),mpi_double_complex,idto,itag,mpi_comm_world,ierror)
| 2
Warning: Type mismatch between actual argument at (1) and actual argument at (2) (REAL(8)/COMPLEX(8)).
mympi.f90:425:30:
425 | call mpi_scatter(r,1,mpir8,rscatter,1,mpir8,0, &
| 1
......
433 | call mpi_scatter(r,size(rscatter),mpir8,rscatter,size(rscatter),mpir8,0, &
| 2
Warning: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar)
mympi.f90:417:20:
417 | call mpi_scatter(i,size(iscatter),mpii4,iscatter,size(iscatter),mpii4,0, &
| 1
......
433 | call mpi_scatter(r,size(rscatter),mpir8,rscatter,size(rscatter),mpir8,0, &
| 2
Warning: Type mismatch between actual argument at (1) and actual argument at (2) (INTEGER(4)/REAL(8)).
mympi.f90:386:22:
386 | call mpi_allgather(r,1,mpir8,rgather,1,mpir8,mpi_comm_world,ierror)
| 1
......
393 | call mpi_allgather(r,size(r),mpir8,rgather,size(r),mpir8, &
| 2
Warning: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar)
mympi.f90:378:22:
378 | call mpi_allgather(i,1,mpii8,igather,1,mpii8, &
| 1
......
393 | call mpi_allgather(r,size(r),mpir8,rgather,size(r),mpir8, &
| 2
Warning: Type mismatch between actual argument at (1) and actual argument at (2) (INTEGER(8)/REAL(8)).
mympi.f90:316:19:
316 | call mpi_gather(r,1,mpir8,rgather,1,mpir8,0,mpi_comm_world,ierror)
| 1
......
355 | call mpi_gather(r,size(r),mpir8,rgather,size(r),mpir8,0, &
| 2
Warning: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar)
mympi.f90:308:19:
308 | call mpi_gather(i,1,mpii8,igather,1,mpii8,0, &
| 1
......
355 | call mpi_gather(r,size(r),mpir8,rgather,size(r),mpir8,0, &
| 2
Warning: Type mismatch between actual argument at (1) and actual argument at (2) (INTEGER(8)/REAL(8)).
mympi.f90:277:19:
277 | call mpi_reduce(c,csum,1,mpi_double_complex,mpi_sum,0, &
| 1
......
285 | call mpi_reduce(c,csum,size(c),mpi_double_complex,mpi_sum,0, &
| 2
Warning: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar)
mympi.f90:269:19:
269 | call mpi_reduce(r,rsum,size(r),mpi_double_precision,mpi_sum,0, &
| 1
......
285 | call mpi_reduce(c,csum,size(c),mpi_double_complex,mpi_sum,0, &
| 2
Warning: Type mismatch between actual argument at (1) and actual argument at (2) (REAL(8)/COMPLEX(8)).
mympi.f90:170:18:
170 | call mpi_bcast(r,1,mpir8,0,mpi_comm_world,ierror)
| 1
......
190 | call mpi_bcast(w,wlen,mpi_character,0,mpi_comm_world,ierror)
| 2
Warning: Type mismatch between actual argument at (1) and actual argument at (2) (REAL(8)/CHARACTER(*)).
I make my module smaller and check but still have similar issue.
However if I only have one subroutine in the module it does not give me warning so I am confused, like in this thread,