如何将Nodecart的C代码集成到Fortran MPI程序中？

1. 编译Nodecart C库 #

先将Nodecart的C源码编译为Fortran可调用的库：

• 用MPI编译器编译C源文件：

  mpicc -c nodecart.c -o nodecart.o
  

• 打包为静态库：

  ar rcs libnodecart.a nodecart.o
  

2. 编写Fortran-C接口绑定 #

Fortran需要显式接口才能调用C函数，在程序中添加以下接口块（放在use mpi之后）：

interface
    ! MPIX_Nodecart_create 接口
    subroutine MPIX_Nodecart_create(comm, ndims, dims, periods, reorder, newcomm, ierror) bind(C, name='MPIX_Nodecart_create')
        use, intrinsic :: iso_c_binding
        integer(c_int), value :: comm, ndims, reorder
        integer(c_int), intent(in) :: dims(*)
        logical(c_bool), intent(in) :: periods(*)
        integer(c_int), intent(out) :: newcomm
        integer(c_int), intent(out) :: ierror
    end subroutine

    ! MPIX_Nodecart_coords 接口
    subroutine MPIX_Nodecart_coords(comm, rank, ndims, coords, ierror) bind(C, name='MPIX_Nodecart_coords')
        use, intrinsic :: iso_c_binding
        integer(c_int), value :: comm, rank, ndims
        integer(c_int), intent(out) :: coords(*)
        integer(c_int), intent(out) :: ierror
    end subroutine

    ! MPIX_Nodecart_shift 接口
    subroutine MPIX_Nodecart_shift(comm, direction, disp, rank_source, rank_dest, ierror) bind(C, name='MPIX_Nodecart_shift')
        use, intrinsic :: iso_c_binding
        integer(c_int), value :: comm, direction, disp
        integer(c_int), intent(out) :: rank_source, rank_dest
        integer(c_int), intent(out) :: ierror
    end subroutine

    ! 按需补充其他函数接口
    subroutine MPIX_Nodecart_get(comm, maxdims, dims, periods, coords, ierror) bind(C, name='MPIX_Nodecart_get')
        use, intrinsic :: iso_c_binding
        integer(c_int), value :: comm, maxdims
        integer(c_int), intent(out) :: dims(*), coords(*)
        logical(c_bool), intent(out) :: periods(*)
        integer(c_int), intent(out) :: ierror
    end subroutine

    subroutine MPIX_Nodecart_rank(comm, coords, rank, ierror) bind(C, name='MPIX_Nodecart_rank')
        use, intrinsic :: iso_c_binding
        integer(c_int), value :: comm
        integer(c_int), intent(in) :: coords(*)
        integer(c_int), intent(out) :: rank
        integer(c_int), intent(out) :: ierror
    end subroutine

    subroutine MPIX_Nodecart_dim_get(comm, ndims, ierror) bind(C, name='MPIX_Nodecart_dim_get')
        use, intrinsic :: iso_c_binding
        integer(c_int), value :: comm
        integer(c_int), intent(out) :: ndims
        integer(c_int), intent(out) :: ierror
    end subroutine

    subroutine MPIX_Nodecart_sub(comm, remain_dims, newcomm, ierror) bind(C, name='MPIX_Nodecart_sub')
        use, intrinsic :: iso_c_binding
        integer(c_int), value :: comm
        logical(c_bool), intent(in) :: remain_dims(*)
        integer(c_int), intent(out) :: newcomm
        integer(c_int), intent(out) :: ierror
    end subroutine
end interface

3. 修改原Fortran程序替换函数调用 #

将原程序中的MPI_Cart_*系列函数替换为MPIX_Nodecart_*，注意Fortran与C的类型转换：

PROGRAM hello_world_mpi
use, intrinsic :: iso_fortran_env
use mpi
use, intrinsic :: iso_c_binding
implicit none

! 声明C绑定接口
interface
    subroutine MPIX_Nodecart_create(comm, ndims, dims, periods, reorder, newcomm, ierror) bind(C, name='MPIX_Nodecart_create')
        use, intrinsic :: iso_c_binding
        integer(c_int), value :: comm, ndims, reorder
        integer(c_int), intent(in) :: dims(*)
        logical(c_bool), intent(in) :: periods(*)
        integer(c_int), intent(out) :: newcomm
        integer(c_int), intent(out) :: ierror
    end subroutine

    subroutine MPIX_Nodecart_coords(comm, rank, ndims, coords, ierror) bind(C, name='MPIX_Nodecart_coords')
        use, intrinsic :: iso_c_binding
        integer(c_int), value :: comm, rank, ndims
        integer(c_int), intent(out) :: coords(*)
        integer(c_int), intent(out) :: ierror
    end subroutine

    subroutine MPIX_Nodecart_shift(comm, direction, disp, rank_source, rank_dest, ierror) bind(C, name='MPIX_Nodecart_shift')
        use, intrinsic :: iso_c_binding
        integer(c_int), value :: comm, direction, disp
        integer(c_int), intent(out) :: rank_source, rank_dest
        integer(c_int), intent(out) :: ierror
    end subroutine
end interface

integer process_Rank, size_Of_Cluster, ierror, tag, Nx, Ny, Nz, Ngl
real(kind=real64), allocatable, dimension(:) :: array_x, array_y, array_z
real(kind=real64), allocatable, dimension(:,:,:) :: ALPHA, BETA, GAMMA

INTEGER, DIMENSION(3) :: NumProcArr, myCOORDS
LOGICAL, DIMENSION(3) :: PeriodicArr
INTEGER :: MaxDims, CommCart, reorder, myCartRank
INTEGER :: myWest, myEast, mySouth, myNorth, myBack, myFront
! C类型转换变量
integer(c_int) :: comm_world_c, newcomm_c, rank_c, ndims_c, ierror_c
integer(c_int), dimension(3) :: numprocarr_c, mycoords_c
logical(c_bool), dimension(3) :: periodicarr_c

call MPI_INIT(ierror)
call MPI_COMM_SIZE(MPI_COMM_WORLD, size_Of_Cluster, ierror)
call MPI_COMM_RANK(MPI_COMM_WORLD, process_Rank, ierror)

NumProcArr=(/1,2,2/);
PeriodicArr=(/.false.,.false.,.false./)
reorder=1;
MaxDims=3

! 转换为C兼容类型
comm_world_c = int(MPI_COMM_WORLD, c_int)
ndims_c = int(MaxDims, c_int)
numprocarr_c = int(NumProcArr, c_int)
periodicarr_c = merge(.true._c_bool, .false._c_bool, PeriodicArr)
rank_c = int(process_Rank, c_int)

print *, 'Hello World from process: ', process_Rank, 'of ', size_Of_Cluster

!! 替换为Nodecart创建调用
call MPIX_Nodecart_create(comm_world_c, ndims_c, numprocarr_c, periodicarr_c, int(reorder,c_int), newcomm_c, ierror_c)
CommCart = int(newcomm_c, kind(MPI_COMM_WORLD))

! 获取当前rank在Nodecart中的位置
call MPI_Comm_rank(CommCart, myCartRank, ierror);
call MPIX_Nodecart_coords(newcomm_c, int(myCartRank,c_int), ndims_c, mycoords_c, ierror_c)
myCOORDS = int(mycoords_c, kind(myCOORDS))

WRITE(*,*) "I am MPI Process" , myCartRank," out of ", size_Of_Cluster,", and I am located at",myCOORDS

!! 替换为Nodecart shift调用
call MPIX_Nodecart_shift(newcomm_c, 0_c_int, 1_c_int, int(myWest,c_int), int(myEast,c_int), ierror_c)
myWest = int(myWest, kind(myWest))
myEast = int(myEast, kind(myEast))

call MPIX_Nodecart_shift(newcomm_c, 1_c_int, 1_c_int, int(mySouth,c_int), int(myNorth,c_int), ierror_c)
mySouth = int(mySouth, kind(mySouth))
myNorth = int(myNorth, kind(myNorth))

call MPIX_Nodecart_shift(newcomm_c, 2_c_int, 1_c_int, int(myBack,c_int), int(myFront,c_int), ierror_c)
myBack = int(myBack, kind(myBack))
myFront = int(myFront, kind(myFront))

CALL MPI_Barrier(CommCart,ierror)
call MPI_FINALIZE(ierror)
END PROGRAM

4. 编译运行程序 #

用MPI Fortran编译器编译并链接Nodecart库：

mpif90 your_program.f90 -o nodecart_mpi -L./ -lnodecart

运行程序：

mpirun -np 4 ./nodecart_mpi

内容的提问来源于stack exchange，提问作者Sahaj Jain