program omp_parallel
use omp_lib
implicit none
integer, parameter :: rk = 8
integer :: n_threads, i, n_limit, c1, c2, c_rate
real(kind=rk) :: pi
print *, "n_limit="
read(*,*) n_limit
print *, 'num_threads='
read(*,*) n_threads
pi = 0.0
call system_clock(c1, c_rate)
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i) NUM_THREADS(n_threads) REDUCTION(+:pi)
do i = 1, n_limit
pi = pi + (-1)**(i+1) / real( 2*i-1, kind=rk )
end do
!$OMP END PARALLEL DO
pi = pi * 4.0_rk
call system_clock(c2, c_rate)
write(*,*) pi, real(c2-c1)/real(c_rate), n_threads
end program omp_parallel
program MPI_parallel
use mpi
implicit none
integer, parameter :: rk = 8
integer :: i, n_limit, ierr, numprocs, myid, c1, c2, c_rate
real(kind=rk) :: pi, picalc
call MPI_INIT(ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD, myid, ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD, numprocs, ierr)
if(myid == 0) then
print *, "n_limit="
read(*,*) n_limit
end if
call MPI_BCAST(n_limit, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
pi = 0.0
call system_clock(c1, c_rate)
do i = myid + 1, n_limit, numprocs
pi = pi + (-1)**(i+1) / real( 2*i-1, kind=rk )
end do
call MPI_REDUCE( pi, picalc, 1, MPI_DOUBLE_PRECISION, &
MPI_SUM, 0, MPI_COMM_WORLD, ierr )
picalc = picalc * 4.0_rk
call system_clock(c2, c_rate)
if(myid == 0) then
write(*,*) picalc, real(c2-c1)/real(c_rate), numprocs
end if
call MPI_FINALIZE(ierr)
end program MPI_parallel
program coarray_parallel
implicit none
integer, parameter :: rk = 8
integer :: n_images, i, c1, c2, c_rate, n_limit
!---------------------------------------
! Intel Core2 Quad @2.83GHz, Windows 10
! Compiler default optimizations
!
! Intel 9 (sec)
!
! GNU 14
! Absooft 21
! G95 21
! Lahey 24
!
! NAG 121
! PGI 127
!
! Silverfrost 331
! Compaq 546
!---------------------------------------
program no_parallel
implicit none
integer, parameter :: rk = SELECTED_REAL_KIND(P=15)
real(kind=rk) :: pi
integer :: i, n_limit, c1, c2, c_rate, c_max
!-----------------
n_limit = 2000000000
call system_clock(c1, c_rate, c_max)
pi = 0.0_rk
do i = 1, n_limit
pi = pi + (-1)**(i+1) / real( 2*i-1, kind=rk )
end do
pi = pi * 4.0_rk
call system_clock(c2, c_rate)
IF( c2 < c1 ) c2 = c2 + c_max
write(*,*) pi, real(c2-c1)/real(c_rate)
end program no_parallel
weixing1531 发表于 2020-11-4 18:38
Coarray法得不到PI的正确结果
! Verify broadcasting of character data from image 1
c_char_co_broadcast: block
character(kind=c_char,len=14), save :: string_received
唐汉 发表于 2021-7-19 19:26
这个帖子有些时间了,不知道答主有没有后续检查。我运行了一下coarray的例子也并没有发现问题,提供一点可 ...
欢迎光临 Fortran Coder (http://bbs.fcode.cn/) | Powered by Discuz! X3.2 |