|
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 SUBROUTINE DFNRMK (NEQ, Y, T, YPRIME, SAVR, R, CJ, WT, |
|
|
6 * SQRTN, RSQRTN, RES, IRES, PSOL, IRIN, IER, |
|
|
7 * FNORM, EPLIN, WP, IWP, PWK, RPAR, IPAR) |
|
|
8 C |
|
|
9 C***BEGIN PROLOGUE DFNRMK |
|
|
10 C***REFER TO DLINSK |
|
|
11 C***DATE WRITTEN 940830 (YYMMDD) |
|
|
12 C***REVISION DATE 951006 (SQRTN, RSQRTN, and scaling of WT added.) |
|
|
13 C |
|
|
14 C |
|
|
15 C----------------------------------------------------------------------- |
|
|
16 C***DESCRIPTION |
|
|
17 C |
|
|
18 C DFNRMK calculates the scaled preconditioned norm of the nonlinear |
|
|
19 C function used in the nonlinear iteration for obtaining consistent |
|
|
20 C initial conditions. Specifically, DFNRMK calculates the weighted |
|
|
21 C root-mean-square norm of the vector (P-inverse)*G(T,Y,YPRIME), |
|
|
22 C where P is the preconditioner matrix. |
|
|
23 C |
|
|
24 C In addition to the parameters described in the calling program |
|
|
25 C DLINSK, the parameters represent |
|
|
26 C |
|
|
27 C IRIN -- Flag showing whether the current residual vector is |
|
|
28 C input in SAVR. 1 means it is, 0 means it is not. |
|
|
29 C R -- Array of length NEQ that contains |
|
|
30 C (P-inverse)*G(T,Y,YPRIME) on return. |
|
|
31 C FNORM -- Scalar containing the weighted norm of R on return. |
|
|
32 C----------------------------------------------------------------------- |
|
|
33 C |
|
|
34 C***ROUTINES CALLED |
|
|
35 C RES, DCOPY, DSCAL, PSOL, DDWNRM |
|
|
36 C |
|
|
37 C***END PROLOGUE DFNRMK |
|
|
38 C |
|
|
39 C |
|
|
40 IMPLICIT DOUBLE PRECISION (A-H,O-Z) |
|
|
41 EXTERNAL RES, PSOL |
|
|
42 DIMENSION Y(*), YPRIME(*), WT(*), SAVR(*), R(*), PWK(*) |
|
|
43 DIMENSION WP(*), IWP(*), RPAR(*), IPAR(*) |
|
|
44 C----------------------------------------------------------------------- |
|
|
45 C Call RES routine if IRIN = 0. |
|
|
46 C----------------------------------------------------------------------- |
|
|
47 IF (IRIN .EQ. 0) THEN |
|
|
48 IRES = 0 |
|
|
49 CALL RES (T, Y, YPRIME, CJ, SAVR, IRES, RPAR, IPAR) |
|
|
50 IF (IRES .LT. 0) RETURN |
|
|
51 ENDIF |
|
|
52 C----------------------------------------------------------------------- |
|
|
53 C Apply inverse of left preconditioner to vector R. |
|
|
54 C First scale WT array by 1/sqrt(N), and undo scaling afterward. |
|
|
55 C----------------------------------------------------------------------- |
|
|
56 CALL DCOPY(NEQ, SAVR, 1, R, 1) |
|
|
57 CALL DSCAL (NEQ, RSQRTN, WT, 1) |
|
|
58 IER = 0 |
|
|
59 CALL PSOL (NEQ, T, Y, YPRIME, SAVR, PWK, CJ, WT, WP, IWP, |
|
|
60 * R, EPLIN, IER, RPAR, IPAR) |
|
|
61 CALL DSCAL (NEQ, SQRTN, WT, 1) |
|
|
62 IF (IER .NE. 0) RETURN |
|
|
63 C----------------------------------------------------------------------- |
|
|
64 C Calculate norm of R. |
|
|
65 C----------------------------------------------------------------------- |
|
|
66 FNORM = DDWNRM (NEQ, R, WT, RPAR, IPAR) |
|
|
67 C |
|
|
68 RETURN |
|
|
69 C----------------------- END OF SUBROUTINE DFNRMK ---------------------- |
|
|
70 END |
