00001 C Work performed under the auspices of the U.S. Department of Energy 00002 C by Lawrence Livermore National Laboratory under contract number 00003 C W-7405-Eng-48. 00004 C 00005 DOUBLE PRECISION FUNCTION DDWNRM(NEQ,V,RWT,RPAR,IPAR) 00006 C 00007 C***BEGIN PROLOGUE DDWNRM 00008 C***ROUTINES CALLED (NONE) 00009 C***DATE WRITTEN 890101 (YYMMDD) 00010 C***REVISION DATE 900926 (YYMMDD) 00011 C***END PROLOGUE DDWNRM 00012 C----------------------------------------------------------------------- 00013 C This function routine computes the weighted 00014 C root-mean-square norm of the vector of length 00015 C NEQ contained in the array V, with reciprocal weights 00016 C contained in the array RWT of length NEQ. 00017 C DDWNRM=SQRT((1/NEQ)*SUM(V(I)*RWT(I))**2) 00018 C----------------------------------------------------------------------- 00019 C 00020 IMPLICIT DOUBLE PRECISION(A-H,O-Z) 00021 DIMENSION V(*),RWT(*) 00022 DIMENSION RPAR(*),IPAR(*) 00023 DDWNRM = 0.0D0 00024 VMAX = 0.0D0 00025 DO 10 I = 1,NEQ 00026 IF(ABS(V(I)*RWT(I)) .GT. VMAX) VMAX = ABS(V(I)*RWT(I)) 00027 10 CONTINUE 00028 IF(VMAX .LE. 0.0D0) GO TO 30 00029 SUM = 0.0D0 00030 DO 20 I = 1,NEQ 00031 20 SUM = SUM + ((V(I)*RWT(I))/VMAX)**2 00032 DDWNRM = VMAX*SQRT(SUM/NEQ) 00033 30 CONTINUE 00034 RETURN 00035 C 00036 C------END OF FUNCTION DDWNRM------------------------------------------- 00037 END
1.7.1
