Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
 Path: blob/devel/mathlibs/src/parpack/pscnorm2.f
5194 views
1
c\BeginDoc

2
c

3
c\Name: pscnorm2

4
c

5
c Message Passing Layer: MPI

6
c

7
c\Description:

8
c

9
c\Usage:

10
c  call pscnorm2 ( 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: 3/6/96

17
c

18
c-----------------------------------------------------------------------

19
c

20
      Real function pscnorm2 ( 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
      Complex

41
     &             x(n)

42
c

43
c     %---------------%

44
c     | Local Scalars |

45
c     %---------------%

46
c

47
      Real

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
      Real       

62
     &             scnrm2

63
      External     scnrm2

64
c

65
c     %-----------------------%

66
c     | Executable Statements |

67
c     %-----------------------%

68
c

69
      pscnorm2 = scnrm2( n, x, inc)

70
c

71
      buf = pscnorm2

72
      call MPI_ALLREDUCE( buf, max, 1, MPI_REAL,

73
     &                    MPI_MAX, comm, ierr )

74
      if ( max .eq. zero ) then

75
         pscnorm2 = zero

76
      else

77
         buf = (pscnorm2/max)**2.0

78
         call MPI_ALLREDUCE( buf, pscnorm2, 1, MPI_REAL,

79
     &                       MPI_SUM, comm, ierr )

80
         pscnorm2 = max * sqrt(abs(pscnorm2))

81
      endif

82
c

83
c     %-----------------%

84
c     | End of pscnorm2 |

85
c     %-----------------%

86
c

87
      return

88
      end

89


90