diff libcruft/daspk/dnedd.f @ 3911:8389e78e67d4

[project @ 2002-04-28 02:15:38 by jwe]
author jwe
date Sun, 28 Apr 2002 02:15:39 +0000
parents
children
line wrap: on
line diff
new file mode 100644
--- /dev/null
+++ b/libcruft/daspk/dnedd.f
@@ -0,0 +1,270 @@
+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 DNEDD(X,Y,YPRIME,NEQ,RES,JACD,PDUM,H,WT,
+     *   JSTART,IDID,RPAR,IPAR,PHI,GAMMA,DUMSVR,DELTA,E,
+     *   WM,IWM,CJ,CJOLD,CJLAST,S,UROUND,DUME,DUMS,DUMR,
+     *   EPCON,JCALC,JFDUM,KP1,NONNEG,NTYPE,IERNLS)
+C
+C***BEGIN PROLOGUE  DNEDD
+C***REFER TO  DDASPK
+C***DATE WRITTEN   891219   (YYMMDD)
+C***REVISION DATE  900926   (YYMMDD)
+C
+C
+C-----------------------------------------------------------------------
+C***DESCRIPTION
+C
+C     DNEDD solves a nonlinear system of
+C     algebraic equations of the form
+C     G(X,Y,YPRIME) = 0 for the unknown Y.
+C
+C     The method used is a modified Newton scheme.
+C
+C     The parameters represent
+C
+C     X         -- Independent variable.
+C     Y         -- Solution vector.
+C     YPRIME    -- Derivative of solution vector.
+C     NEQ       -- Number of unknowns.
+C     RES       -- External user-supplied subroutine
+C                  to evaluate the residual.  See RES description
+C                  in DDASPK prologue.
+C     JACD      -- External user-supplied routine to evaluate the
+C                  Jacobian.  See JAC description for the case
+C                  INFO(12) = 0 in the DDASPK prologue.
+C     PDUM      -- Dummy argument.
+C     H         -- Appropriate step size for next step.
+C     WT        -- Vector of weights for error criterion.
+C     JSTART    -- Indicates first call to this routine.
+C                  If JSTART = 0, then this is the first call,
+C                  otherwise it is not.
+C     IDID      -- Completion flag, output by DNEDD.
+C                  See IDID description in DDASPK prologue.
+C     RPAR,IPAR -- Real and integer arrays used for communication
+C                  between the calling program and external user
+C                  routines.  They are not altered within DASPK.
+C     PHI       -- Array of divided differences used by
+C                  DNEDD.  The length is NEQ*(K+1),where
+C                  K is the maximum order.
+C     GAMMA     -- Array used to predict Y and YPRIME.  The length
+C                  is MAXORD+1 where MAXORD is the maximum order.
+C     DUMSVR    -- Dummy argument.
+C     DELTA     -- Work vector for NLS of length NEQ.
+C     E         -- Error accumulation vector for NLS of length NEQ.
+C     WM,IWM    -- Real and integer arrays storing
+C                  matrix information such as the matrix
+C                  of partial derivatives, permutation
+C                  vector, and various other information.
+C     CJ        -- Parameter always proportional to 1/H.
+C     CJOLD     -- Saves the value of CJ as of the last call to DMATD.
+C                  Accounts for changes in CJ needed to
+C                  decide whether to call DMATD.
+C     CJLAST    -- Previous value of CJ.
+C     S         -- A scalar determined by the approximate rate
+C                  of convergence of the Newton iteration and used
+C                  in the convergence test for the Newton iteration.
+C
+C                  If RATE is defined to be an estimate of the
+C                  rate of convergence of the Newton iteration,
+C                  then S = RATE/(1.D0-RATE).
+C
+C                  The closer RATE is to 0., the faster the Newton
+C                  iteration is converging; the closer RATE is to 1.,
+C                  the slower the Newton iteration is converging.
+C
+C                  On the first Newton iteration with an up-dated
+C                  preconditioner S = 100.D0, Thus the initial
+C                  RATE of convergence is approximately 1.
+C
+C                  S is preserved from call to call so that the rate
+C                  estimate from a previous step can be applied to
+C                  the current step.
+C     UROUND    -- Unit roundoff.
+C     DUME      -- Dummy argument.
+C     DUMS      -- Dummy argument.
+C     DUMR      -- Dummy argument.
+C     EPCON     -- Tolerance to test for convergence of the Newton
+C                  iteration.
+C     JCALC     -- Flag used to determine when to update
+C                  the Jacobian matrix.  In general:
+C
+C                  JCALC = -1 ==> Call the DMATD routine to update
+C                                 the Jacobian matrix.
+C                  JCALC =  0 ==> Jacobian matrix is up-to-date.
+C                  JCALC =  1 ==> Jacobian matrix is out-dated,
+C                                 but DMATD will not be called unless
+C                                 JCALC is set to -1.
+C     JFDUM     -- Dummy argument.
+C     KP1       -- The current order(K) + 1;  updated across calls.
+C     NONNEG    -- Flag to determine nonnegativity constraints.
+C     NTYPE     -- Identification code for the NLS routine.
+C                   0  ==> modified Newton; direct solver.
+C     IERNLS    -- Error flag for nonlinear solver.
+C                   0  ==> nonlinear solver converged.
+C                   1  ==> recoverable error inside nonlinear solver.
+C                  -1  ==> unrecoverable error inside nonlinear solver.
+C
+C     All variables with "DUM" in their names are dummy variables
+C     which are not used in this routine.
+C
+C     Following is a list and description of local variables which
+C     may not have an obvious usage.  They are listed in roughly the
+C     order they occur in this subroutine.
+C
+C     The following group of variables are passed as arguments to
+C     the Newton iteration solver.  They are explained in greater detail
+C     in DNSD:
+C        TOLNEW, MULDEL, MAXIT, IERNEW
+C
+C     IERTYP -- Flag which tells whether this subroutine is correct.
+C               0 ==> correct subroutine.
+C               1 ==> incorrect subroutine.
+C 
+C-----------------------------------------------------------------------
+C***ROUTINES CALLED
+C   DDWNRM, RES, DMATD, DNSD
+C
+C***END PROLOGUE  DNEDD
+C
+C
+      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+      DIMENSION Y(*),YPRIME(*),WT(*)
+      DIMENSION DELTA(*),E(*)
+      DIMENSION WM(*),IWM(*), RPAR(*),IPAR(*)
+      DIMENSION PHI(NEQ,*),GAMMA(*)
+      EXTERNAL  RES, JACD
+C
+      PARAMETER (LNRE=12, LNJE=13)
+C
+      SAVE MULDEL, MAXIT, XRATE
+      DATA MULDEL/1/, MAXIT/4/, XRATE/0.25D0/
+C
+C     Verify that this is the correct subroutine.
+C
+      IERTYP = 0
+      IF (NTYPE .NE. 0) THEN
+         IERTYP = 1
+         GO TO 380
+         ENDIF
+C
+C     If this is the first step, perform initializations.
+C
+      IF (JSTART .EQ. 0) THEN
+         CJOLD = CJ
+         JCALC = -1
+         ENDIF
+C
+C     Perform all other initializations.
+C
+      IERNLS = 0
+C
+C     Decide whether new Jacobian is needed.
+C
+      TEMP1 = (1.0D0 - XRATE)/(1.0D0 + XRATE)
+      TEMP2 = 1.0D0/TEMP1
+      IF (CJ/CJOLD .LT. TEMP1 .OR. CJ/CJOLD .GT. TEMP2) JCALC = -1
+      IF (CJ .NE. CJLAST) S = 100.D0
+C
+C-----------------------------------------------------------------------
+C     Entry point for updating the Jacobian with current
+C     stepsize.
+C-----------------------------------------------------------------------
+300   CONTINUE
+C
+C     Initialize all error flags to zero.
+C
+      IERJ = 0
+      IRES = 0
+      IERNEW = 0
+C
+C     Predict the solution and derivative and compute the tolerance
+C     for the Newton iteration.
+C
+      DO 310 I=1,NEQ
+         Y(I)=PHI(I,1)
+310      YPRIME(I)=0.0D0
+      DO 330 J=2,KP1
+         DO 320 I=1,NEQ
+            Y(I)=Y(I)+PHI(I,J)
+320         YPRIME(I)=YPRIME(I)+GAMMA(J)*PHI(I,J)
+330   CONTINUE
+      PNORM = DDWNRM (NEQ,Y,WT,RPAR,IPAR)
+      TOLNEW = 100.D0*UROUND*PNORM
+C     
+C     Call RES to initialize DELTA.
+C
+      IWM(LNRE)=IWM(LNRE)+1
+      CALL RES(X,Y,YPRIME,CJ,DELTA,IRES,RPAR,IPAR)
+      IF (IRES .LT. 0) GO TO 380
+C
+C     If indicated, reevaluate the iteration matrix 
+C     J = dG/dY + CJ*dG/dYPRIME (where G(X,Y,YPRIME)=0).
+C     Set JCALC to 0 as an indicator that this has been done.
+C
+      IF(JCALC .EQ. -1) THEN
+         IWM(LNJE)=IWM(LNJE)+1
+         JCALC=0
+         CALL DMATD(NEQ,X,Y,YPRIME,DELTA,CJ,H,IERJ,WT,E,WM,IWM,
+     *              RES,IRES,UROUND,JACD,RPAR,IPAR)
+         CJOLD=CJ
+         S = 100.D0
+         IF (IRES .LT. 0) GO TO 380
+         IF(IERJ .NE. 0)GO TO 380
+      ENDIF
+C
+C     Call the nonlinear Newton solver.
+C
+      TEMP1 = 2.0D0/(1.0D0 + CJ/CJOLD)
+      CALL DNSD(X,Y,YPRIME,NEQ,RES,PDUM,WT,RPAR,IPAR,DUMSVR,
+     *          DELTA,E,WM,IWM,CJ,DUMS,DUMR,DUME,EPCON,S,TEMP1,
+     *          TOLNEW,MULDEL,MAXIT,IRES,IDUM,IERNEW)
+C
+      IF (IERNEW .GT. 0 .AND. JCALC .NE. 0) THEN
+C
+C        The Newton iteration had a recoverable failure with an old
+C        iteration matrix.  Retry the step with a new iteration matrix.
+C
+         JCALC = -1
+         GO TO 300
+      ENDIF
+C
+      IF (IERNEW .NE. 0) GO TO 380
+C
+C     The Newton iteration has converged.  If nonnegativity of
+C     solution is required, set the solution nonnegative, if the
+C     perturbation to do it is small enough.  If the change is too
+C     large, then consider the corrector iteration to have failed.
+C
+375   IF(NONNEG .EQ. 0) GO TO 390
+      DO 377 I = 1,NEQ
+377      DELTA(I) = MIN(Y(I),0.0D0)
+      DELNRM = DDWNRM(NEQ,DELTA,WT,RPAR,IPAR)
+      IF(DELNRM .GT. EPCON) GO TO 380
+      DO 378 I = 1,NEQ
+378      E(I) = E(I) - DELTA(I)
+      GO TO 390
+C
+C
+C     Exits from nonlinear solver.
+C     No convergence with current iteration
+C     matrix, or singular iteration matrix.
+C     Compute IERNLS and IDID accordingly.
+C
+380   CONTINUE
+      IF (IRES .LE. -2 .OR. IERTYP .NE. 0) THEN
+         IERNLS = -1
+         IF (IRES .LE. -2) IDID = -11
+         IF (IERTYP .NE. 0) IDID = -15
+      ELSE
+         IERNLS = 1
+         IF (IRES .LT. 0) IDID = -10
+         IF (IERJ .NE. 0) IDID = -8
+      ENDIF
+C
+390   JCALC = 1
+      RETURN
+C
+C------END OF SUBROUTINE DNEDD------------------------------------------
+      END