GNU Octave  6.2.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
dfnrmk.f
Go to the documentation of this file.
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
double precision function ddwnrm(NEQ, V, RWT, RPAR, IPAR)
Definition: ddwnrm.f:6
subroutine dfnrmk(NEQ, Y, T, YPRIME, SAVR, R, CJ, WT, SQRTN, RSQRTN, RES, IRES, PSOL, IRIN, IER, FNORM, EPLIN, WP, IWP, PWK, RPAR, IPAR)
Definition: dfnrmk.f:8