dfnrmk.f

Go to the documentation of this file.

C Work performed under the auspices of the U.S. Department of Energy
C by Lawrence Livermore National Laboratory under contract number
C W-7405-Eng-48.
C
      SUBROUTINE dfnrmk (NEQ, Y, T, YPRIME, SAVR, R, CJ, WT,
     *                   sqrtn, rsqrtn, res, ires, psol, irin, ier,
     *                   fnorm, eplin, wp, iwp, pwk, rpar, ipar)
C
C***BEGIN PROLOGUE  DFNRMK
C***REFER TO  DLINSK
C***DATE WRITTEN   940830   (YYMMDD)
C***REVISION DATE  951006   (SQRTN, RSQRTN, and scaling of WT added.)
C
C
C-----------------------------------------------------------------------
C***DESCRIPTION
C
C     DFNRMK calculates the scaled preconditioned norm of the nonlinear
C     function used in the nonlinear iteration for obtaining consistent
C     initial conditions.  Specifically, DFNRMK calculates the weighted
C     root-mean-square norm of the vector (P-inverse)*G(T,Y,YPRIME),
C     where P is the preconditioner matrix.
C
C     In addition to the parameters described in the calling program
C     DLINSK, the parameters represent
C
C     IRIN   -- Flag showing whether the current residual vector is
C               input in SAVR.  1 means it is, 0 means it is not.
C     R      -- Array of length NEQ that contains
C               (P-inverse)*G(T,Y,YPRIME) on return.
C     FNORM  -- Scalar containing the weighted norm of R on return.
C-----------------------------------------------------------------------
C
C***ROUTINES CALLED
C   RES, DCOPY, DSCAL, PSOL, DDWNRM
C
C***END PROLOGUE  DFNRMK
C
C
      IMPLICIT DOUBLE PRECISION (a-h,o-z)
      EXTERNAL res, psol
      dimension y(*), yprime(*), wt(*), savr(*), r(*), pwk(*)
      dimension wp(*), iwp(*), rpar(*), ipar(*)
C-----------------------------------------------------------------------
C     Call RES routine if IRIN = 0.
C-----------------------------------------------------------------------
      IF (irin .EQ. 0) THEN
        ires = 0
        CALL res(t, y, yprime, cj, savr, ires, rpar, ipar)
        IF (ires .LT. 0) RETURN
        ENDIF
C-----------------------------------------------------------------------
C     Apply inverse of left preconditioner to vector R.
C     First scale WT array by 1/sqrt(N), and undo scaling afterward.
C-----------------------------------------------------------------------
      CALL dcopy(neq, savr, 1, r, 1)
      CALL dscal(neq, rsqrtn, wt, 1)
      ier = 0
      CALL psol(neq, t, y, yprime, savr, pwk, cj, wt, wp, iwp,
     *           r, eplin, ier, rpar, ipar)
      CALL dscal(neq, sqrtn, wt, 1)
      IF (ier .NE. 0) RETURN
C-----------------------------------------------------------------------
C     Calculate norm of R.
C-----------------------------------------------------------------------
      fnorm = ddwnrm(neq, r, wt, rpar, ipar)
C
      RETURN
C----------------------- END OF SUBROUTINE DFNRMK ----------------------
      END