xref: /phasta/svLS/NORM.f (revision 712d3df0b59ebebaaeaea358162c8d2c043c6e08)
1!     This software is Copyright (c) 2012-2015 The Regents of the
2!     University of California. All Rights Reserved.
3!
4!     Permission to copy and modify this software and its documentation
5!     for educational, research and non-profit purposes, without fee,
6!     and without a written agreement is hereby granted, provided that
7!     the above copyright notice, this paragraph and the following three
8!     paragraphs appear in all copies.
9!
10!     Permission to make commercial use of this software may be obtained
11!     by contacting:
12!
13!     Technology Transfer Office
14!     9500 Gilman Drive, Mail Code 0910
15!     University of California
16!     La Jolla, CA 92093-0910
17!     (858) 534-5815
18!     invent@ucsd.edu
19!
20!     This software program and documentation are copyrighted by The
21!     Regents of the University of California. The software program and
22!     documentation are supplied "as is", without any accompanying
23!     services from The Regents. The Regents does not warrant that the
24!     operation of the program will be uninterrupted or error-free. The
25!     end-user understands that the program was developed for research
26!     purposes and is advised not to rely exclusively on the program for
27!     any reason.
28!
29!     IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY
30!     PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL
31!     DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS
32!     SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
33!     CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34!     THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY
35!     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
36!     OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
37!     SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE
38!     UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS TO PROVIDE
39!     MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
40
41      FUNCTION NORMV(dof, nNo, commu, U)
42
43      INCLUDE "svLS_STD.h"
44
45      INTEGER, INTENT(IN) :: dof, nNo
46      TYPE(svLS_commuType), INTENT(IN) :: commu
47      REAL*8, INTENT(IN) :: U(dof,nNo)
48
49      INTEGER i, ierr
50      REAL*8 tmp, NORMV
51
52      NORMV = 0D0
53      SELECT CASE(dof)
54      CASE(1)
55         DO i=1, nNo
56            NORMV = NORMV + U(1,i)*U(1,i)
57         END DO
58      CASE(2)
59         DO i=1, nNo
60            NORMV = NORMV + U(1,i)*U(1,i) + U(2,i)*U(2,i)
61         END DO
62      CASE(3)
63         DO i=1, nNo
64            NORMV = NORMV+ U(1,i)*U(1,i) + U(2,i)*U(2,i) + U(3,i)*U(3,i)
65         END DO
66      CASE(4)
67         DO i=1, nNo
68            NORMV = NORMV + U(1,i)*U(1,i) + U(2,i)*U(2,i)
69     2                    + U(3,i)*U(3,i) + U(4,i)*U(4,i)
70         END DO
71      CASE DEFAULT
72         DO i=1, nNo
73            NORMV = NORMV + SUM(U(:,i)*U(:,i))
74         END DO
75      END SELECT
76
77      IF (commu%nTasks .NE. 1) THEN
78         CALL MPI_ALLREDUCE(NORMV, tmp, 1, mpreal, MPI_SUM,
79     2        commu%comm, ierr)
80         NORMV = tmp
81      END IF
82
83      NORMV = SQRT(NORMV)
84
85      RETURN
86      END FUNCTION NORMV
87
88!====================================================================
89
90      FUNCTION NORMS(nNo, commu, U)
91
92      INCLUDE "svLS_STD.h"
93
94      INTEGER, INTENT(IN) :: nNo
95      TYPE(svLS_commuType), INTENT(IN) :: commu
96      REAL*8, INTENT(IN) :: U(nNo)
97
98      INTEGER i, ierr
99      REAL*8 tmp, NORMS
100
101      NORMS = 0D0
102      DO i=1, nNo
103         NORMS = NORMS + U(i)*U(i)
104      END DO
105
106      IF (commu%nTasks .NE. 1) THEN
107         CALL MPI_ALLREDUCE(NORMS, tmp, 1, mpreal, MPI_SUM,
108     2        commu%comm, ierr)
109         NORMS = tmp
110      END IF
111
112      NORMS = SQRT(NORMS)
113
114      RETURN
115      END FUNCTION NORMS
116
117
118