GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
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