|
3911
|
1 C Work performed under the auspices of the U.S. Department of Energy |
|
|
2 C by Lawrence Livermore National Laboratory under contract number |
|
|
3 C W-7405-Eng-48. |
|
|
4 C |
|
|
5 DOUBLE PRECISION FUNCTION DDWNRM(NEQ,V,RWT,RPAR,IPAR) |
|
|
6 C |
|
|
7 C***BEGIN PROLOGUE DDWNRM |
|
|
8 C***ROUTINES CALLED (NONE) |
|
|
9 C***DATE WRITTEN 890101 (YYMMDD) |
|
|
10 C***REVISION DATE 900926 (YYMMDD) |
|
|
11 C***END PROLOGUE DDWNRM |
|
|
12 C----------------------------------------------------------------------- |
|
|
13 C This function routine computes the weighted |
|
|
14 C root-mean-square norm of the vector of length |
|
|
15 C NEQ contained in the array V, with reciprocal weights |
|
|
16 C contained in the array RWT of length NEQ. |
|
|
17 C DDWNRM=SQRT((1/NEQ)*SUM(V(I)*RWT(I))**2) |
|
|
18 C----------------------------------------------------------------------- |
|
|
19 C |
|
|
20 IMPLICIT DOUBLE PRECISION(A-H,O-Z) |
|
|
21 DIMENSION V(*),RWT(*) |
|
|
22 DIMENSION RPAR(*),IPAR(*) |
|
|
23 DDWNRM = 0.0D0 |
|
|
24 VMAX = 0.0D0 |
|
|
25 DO 10 I = 1,NEQ |
|
|
26 IF(ABS(V(I)*RWT(I)) .GT. VMAX) VMAX = ABS(V(I)*RWT(I)) |
|
|
27 10 CONTINUE |
|
|
28 IF(VMAX .LE. 0.0D0) GO TO 30 |
|
|
29 SUM = 0.0D0 |
|
|
30 DO 20 I = 1,NEQ |
|
|
31 20 SUM = SUM + ((V(I)*RWT(I))/VMAX)**2 |
|
|
32 DDWNRM = VMAX*SQRT(SUM/NEQ) |
|
|
33 30 CONTINUE |
|
|
34 RETURN |
|
|
35 C |
|
|
36 C------END OF FUNCTION DDWNRM------------------------------------------- |
|
|
37 END |
