share/odepack/fortran/dsetpk.f

   1 *DECK DSETPK
   2       SUBROUTINE DSETPK (NEQ, Y, YSV, EWT, FTEM, SAVF, JOK, WM, IWM,
   3      1                  F, JAC)
   4       EXTERNAL F, JAC
   5       INTEGER NEQ, JOK, IWM
   6       DOUBLE PRECISION Y, YSV, EWT, FTEM, SAVF, WM
   7       DIMENSION NEQ(*), Y(*), YSV(*), EWT(*), FTEM(*), SAVF(*),
   8      1   WM(*), IWM(*)
   9       INTEGER IOWND, IOWNS,
  10      1   ICF, IERPJ, IERSL, JCUR, JSTART, KFLAG, L,
  11      2   LYH, LEWT, LACOR, LSAVF, LWM, LIWM, METH, MITER,
  12      3   MAXORD, MAXCOR, MSBP, MXNCF, N, NQ, NST, NFE, NJE, NQU
  13       INTEGER JPRE, JACFLG, LOCWP, LOCIWP, LSAVX, KMP, MAXL, MNEWT,
  14      1   NNI, NLI, NPS, NCFN, NCFL
  15       DOUBLE PRECISION ROWNS,
  16      1   CCMAX, EL0, H, HMIN, HMXI, HU, RC, TN, UROUND
  17       DOUBLE PRECISION DELT, EPCON, SQRTN, RSQRTN
  18       COMMON /DLS001/ ROWNS(209),
  19      1   CCMAX, EL0, H, HMIN, HMXI, HU, RC, TN, UROUND,
  20      2   IOWND(6), IOWNS(6),
  21      3   ICF, IERPJ, IERSL, JCUR, JSTART, KFLAG, L,
  22      4   LYH, LEWT, LACOR, LSAVF, LWM, LIWM, METH, MITER,
  23      5   MAXORD, MAXCOR, MSBP, MXNCF, N, NQ, NST, NFE, NJE, NQU
  24       COMMON /DLPK01/ DELT, EPCON, SQRTN, RSQRTN,
  25      1   JPRE, JACFLG, LOCWP, LOCIWP, LSAVX, KMP, MAXL, MNEWT,
  26      2   NNI, NLI, NPS, NCFN, NCFL
  27 C-----------------------------------------------------------------------
  28 C DSETPK is called by DSTOKA to interface with the user-supplied
  29 C routine JAC, to compute and process relevant parts of
  30 C the matrix P = I - H*EL(1)*J , where J is the Jacobian df/dy,
  31 C as need for preconditioning matrix operations later.
  32 C
  33 C In addition to variables described previously, communication
  34 C with DSETPK uses the following:
  35 C Y     = array containing predicted values on entry.
  36 C YSV   = array containing predicted y, to be saved (YH1 in DSTOKA).
  37 C FTEM  = work array of length N (ACOR in DSTOKA).
  38 C SAVF  = array containing f evaluated at predicted y.
  39 C JOK   = input flag showing whether it was judged that Jacobian matrix
  40 C         data need not be recomputed (JOK = 1) or needs to be
  41 C         (JOK = -1).
  42 C WM    = real work space for matrices.
  43 C         Space for preconditioning data starts at WM(LOCWP).
  44 C IWM   = integer work space.
  45 C         Space for preconditioning data starts at IWM(LOCIWP).
  46 C IERPJ = output error flag,  = 0 if no trouble, .gt. 0 if
  47 C         JAC returned an error flag.
  48 C JCUR  = output flag to indicate whether the matrix data involved
  49 C         is now current (JCUR = 1) or not (JCUR = 0).
  50 C This routine also uses Common variables EL0, H, TN, IERPJ, JCUR, NJE.
  51 C-----------------------------------------------------------------------
  52       INTEGER IER
  53       DOUBLE PRECISION HL0
  54 C
  55       IERPJ = 0
  56       JCUR = 0
  57       IF (JOK .EQ. -1) JCUR = 1
  58       HL0 = EL0*H
  59       CALL JAC (F, NEQ, TN, Y, YSV, EWT, SAVF, FTEM, HL0, JOK,
  60      1   WM(LOCWP), IWM(LOCIWP), IER)
  61       NJE = NJE + 1
  62       IF (IER .EQ. 0) RETURN
  63       IERPJ = 1
  64       RETURN
  65 C----------------------- End of Subroutine DSETPK ----------------------
  66       END