当前位置：首页 > news >正文

Fortran: select type

news 2025/8/14 0:44:45

Fortran: select type

实现类似C++的template函数功能

module M_reduceuse mpi_f08interface reducemodule procedure reduce_scalar,reduce_arrayend interface reducecontains!!https://docs.open-mpi.org/en/v5.0.x/man-openmpi/man3/MPI_Reduce.3.htmlsubroutine reduce_array(n,x,op,root,comm)implicit noneinteger::nclass(*)::x(n)type(MPI_Op)::op!optional integer,optional::roottype(MPI_Comm),optional::comm!localinteger::my_root,my_ranktype(MPI_Comm)::my_commtype(MPI_Datatype)::dtypeinteger::ierr my_root=0if(present(root)) thenmy_root=rootend ifmy_comm=MPI_COMM_WORLDif(present(comm)) thenmy_comm=commend ifselect type(x)type is (integer)dtype=MPI_INTEGERtype is(logical)dtype=MPI_LOGICALtype is(real(4))dtype=MPI_REAL4type is(real(8))dtype=MPI_REAL8class defaulterror stop 'unsupported type'end selectcall MPI_Comm_rank(my_comm,my_rank,ierr)if(my_rank==my_root) thencall MPI_Reduce(MPI_IN_PLACE,x,n,dtype,op,my_root,my_comm,ierr)elsecall MPI_Reduce(x,MPI_IN_PLACE,n,dtype,op,my_root,my_comm,ierr)endif!!call CHECKMPI(ierr)end subroutine reduce_arraysubroutine reduce_scalar(x,op,root,comm)implicit noneclass(*)::xtype(MPI_Op)::op!optional integer,optional::roottype(MPI_Comm),optional::comm!localinteger::my_root,my_ranktype(MPI_Comm)::my_commtype(MPI_Datatype)::dtypeinteger::ierr my_root=0if(present(root)) thenmy_root=rootend ifmy_comm=MPI_COMM_WORLDif(present(comm)) thenmy_comm=commend ifselect type(x)type is (integer)dtype=MPI_INTEGERtype is(logical)dtype=MPI_LOGICALtype is(real(4))dtype=MPI_REAL4type is(real(8))dtype=MPI_REAL8class defaulterror stop 'unsupported type'end selectcall MPI_Comm_rank(my_comm,my_rank,ierr)if(my_rank==my_root) thencall MPI_Reduce(MPI_IN_PLACE,x,1,dtype,op,my_root,my_comm,ierr)elsecall MPI_Reduce(x,MPI_IN_PLACE,1,dtype,op,my_root,my_comm,ierr)endif!!call CHECKMPI(ierr)end subroutine reduce_scalarend module M_reduce