Mercurial > octave-nkf
comparison libcruft/daspk/ddwnrm.f @ 3911:8389e78e67d4
[project @ 2002-04-28 02:15:38 by jwe]
| author | jwe |
|---|---|
| date | Sun, 28 Apr 2002 02:15:39 +0000 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 3910:79a90a0f0eff | 3911:8389e78e67d4 |
|---|---|
| 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 |