root / synthbench / euroben-dm / mod1i / dddot3.f @ 0:839f52ef7657
History | View | Annotate | Download (1.4 kB)
1 |
Function dddot3( k, partcomm, n, x, y ) Result( dotres ) |
---|---|
2 |
! --------------------------------------------------------------------- |
3 |
Use dist_module |
4 |
Use numerics |
5 |
Implicit None |
6 |
Integer :: k, n, partcomm |
7 |
Real(l_) :: x(n), y(n), dotres |
8 |
|
9 |
Include 'mpif.h' |
10 |
|
11 |
Integer :: datype, ierr |
12 |
Integer :: i |
13 |
Real(l_) :: s |
14 |
! --------------------------------------------------------------------- |
15 |
! --- Do local part of dotproduct. |
16 |
|
17 |
s = 0.0_l_ |
18 |
Do i = 1, n |
19 |
s = s + x(i)*y(i) |
20 |
End Do |
21 |
dotres = s |
22 |
! --------------------------------------------------------------------- |
23 |
! --- If on 1 processor we are done: Return. |
24 |
|
25 |
If ( k == 1 ) Return |
26 |
! --------------------------------------------------------------------- |
27 |
! --- Send partial results from all processors in communicator |
28 |
! partcomm to processor 1. |
29 |
|
30 |
datype = MPI_Real8 |
31 |
Call MPI_Reduce( s, dotres, 1, datype, MPI_Sum, 0, |
32 |
& partcomm, ierr ) |
33 |
! --------------------------------------------------------------------- |
34 |
! --- Send sum to all processors in communicator partcomm. |
35 |
|
36 |
If ( me < k ) Call MPI_Bcast( dotres, 1, datype, 0, partcomm, |
37 |
& ierr ) |
38 |
! --------------------------------------------------------------------- |
39 |
End Function dddot3 |