uallreducef90.f90

来自「fortran并行计算包」· F90 代码 · 共 57 行

! This file created from test/mpi/f77/coll/uallreducef.f with f77tof90
! -*- Mode: Fortran; -*- 
!
!  (C) 2003 by Argonne National Laboratory.
!      See COPYRIGHT in top-level directory.
!
!
! Test user-defined operations.  This tests a simple commutative operation
!
      subroutine uop( cin, cout, count, datatype )
      integer cin(*), cout(*)
      integer count, datatype
      integer i
      
      do i=1, count
         cout(i) = cin(i) + cout(i)
      enddo
      end

      program main
      use mpi
      external uop
      integer ierr, errs
      integer count, sumop, vin(65000), vout(65000), i, size
      integer comm
      
      errs = 0

      call mtest_init(ierr)
      call mpi_op_create( uop, .true., sumop, ierr )

      comm = MPI_COMM_WORLD
      call mpi_comm_size( comm, size, ierr )
      count = 1
      do while (count .lt. 65000) 
         do i=1, count
            vin(i) = i
            vout(i) = -1
         enddo
         call mpi_allreduce( vin, vout, count, MPI_INTEGER, sumop,  &
      &                       comm, ierr )
!         Check that all results are correct
         do i=1, count
            if (vout(i) .ne. i * size) then
               errs = errs + 1
               if (errs .lt. 10) print *, "vout(",i,") = ", vout(i)
            endif
         enddo
         count = count + count
      enddo

      call mpi_op_free( sumop, ierr )

      call mtest_finalize(errs)
      call mpi_finalize(ierr)
      end