share/odepack/fortran/dewset.f

   1 *DECK DEWSET
   2       SUBROUTINE DEWSET (N, ITOL, RTOL, ATOL, YCUR, EWT)
   3 C***BEGIN PROLOGUE  DEWSET
   4 C***SUBSIDIARY
   5 C***PURPOSE  Set error weight vector.
   6 C***TYPE      DOUBLE PRECISION (SEWSET-S, DEWSET-D)
   7 C***AUTHOR  Hindmarsh, Alan C., (LLNL)
   8 C***DESCRIPTION
   9 C
  10 C  This subroutine sets the error weight vector EWT according to
  11 C      EWT(i) = RTOL(i)*ABS(YCUR(i)) + ATOL(i),  i = 1,...,N,
  12 C  with the subscript on RTOL and/or ATOL possibly replaced by 1 above,
  13 C  depending on the value of ITOL.
  14 C
  15 C***SEE ALSO  DLSODE
  16 C***ROUTINES CALLED  (NONE)
  17 C***REVISION HISTORY  (YYMMDD)
  18 C   791129  DATE WRITTEN
  19 C   890501  Modified prologue to SLATEC/LDOC format.  (FNF)
  20 C   890503  Minor cosmetic changes.  (FNF)
  21 C   930809  Renamed to allow single/double precision versions. (ACH)
  22 C***END PROLOGUE  DEWSET
  23 C**End
  24       INTEGER N, ITOL
  25       INTEGER I
  26       DOUBLE PRECISION RTOL, ATOL, YCUR, EWT
  27       DIMENSION RTOL(*), ATOL(*), YCUR(N), EWT(N)
  28 C
  29 C***FIRST EXECUTABLE STATEMENT  DEWSET
  30       GO TO (10, 20, 30, 40), ITOL
  31  10   CONTINUE
  32       DO 15 I = 1,N
  33  15     EWT(I) = RTOL(1)*ABS(YCUR(I)) + ATOL(1)
  34       RETURN
  35  20   CONTINUE
  36       DO 25 I = 1,N
  37  25     EWT(I) = RTOL(1)*ABS(YCUR(I)) + ATOL(I)
  38       RETURN
  39  30   CONTINUE
  40       DO 35 I = 1,N
  41  35     EWT(I) = RTOL(I)*ABS(YCUR(I)) + ATOL(1)
  42       RETURN
  43  40   CONTINUE
  44       DO 45 I = 1,N
  45  45     EWT(I) = RTOL(I)*ABS(YCUR(I)) + ATOL(I)
  46       RETURN
  47 C----------------------- END OF SUBROUTINE DEWSET ----------------------
  48       END