Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
Path: blob/devel/mathlibs/src/parpack/pdnorm2.f
5191 views
1
c\BeginDoc
2
c
3
c\Name: pdnorm2
4
c
5
c Message Passing Layer: MPI
6
c
7
c\Description:
8
c
9
c\Usage:
10
c call pdnorm2 ( COMM, N, X, INC )
11
c
12
c\Arguments
13
c COMM MPI Communicator for the processor grid. (INPUT)
14
c
15
c\SCCS Information:
16
c FILE: norm2.F SID: 1.2 DATE OF SID: 2/22/96
17
c
18
c-----------------------------------------------------------------------
19
c
20
Double precision function pdnorm2 ( comm, n, x, inc )
21
c
22
include 'mpif.h'
23
c
24
c %---------------%
25
c | MPI Variables |
26
c %---------------%
27
c
28
integer comm, ierr
29
c
30
c %------------------%
31
c | Scalar Arguments |
32
c %------------------%
33
c
34
integer n, inc
35
c
36
c %-----------------%
37
c | Array Arguments |
38
c %-----------------%
39
c
40
Double precision
41
& x(n)
42
c
43
c %---------------%
44
c | Local Scalars |
45
c %---------------%
46
c
47
Double precision
48
& max, buf, zero
49
parameter ( zero = 0.0 )
50
c
51
c %---------------------%
52
c | Intrinsic Functions |
53
c %---------------------%
54
c
55
intrinsic abs, sqrt
56
c
57
c %--------------------%
58
c | External Functions |
59
c %--------------------%
60
c
61
Double precision
62
& dnrm2
63
External dnrm2
64
c
65
c %-----------------------%
66
c | Executable Statements |
67
c %-----------------------%
68
c
69
pdnorm2 = dnrm2( n, x, inc)
70
c
71
buf = pdnorm2
72
call MPI_ALLREDUCE( buf, max, 1, MPI_DOUBLE_PRECISION,
73
& MPI_MAX, comm, ierr )
74
if ( max .eq. zero ) then
75
pdnorm2 = zero
76
else
77
buf = (pdnorm2/max)**2.0
78
call MPI_ALLREDUCE( buf, pdnorm2, 1, MPI_DOUBLE_PRECISION,
79
& MPI_SUM, comm, ierr )
80
pdnorm2 = max * sqrt(abs(pdnorm2))
81
endif
82
c
83
c %----------------%
84
c | End of pdnorm2 |
85
c %----------------%
86
c
87
return
88
end
89
90