sewset.f

Go to the documentation of this file.

      SUBROUTINE sewset (N, ITOL, RTOL, ATOL, YCUR, EWT)
C***BEGIN PROLOGUE  SEWSET
C***SUBSIDIARY
C***PURPOSE  Set error weight vector.
C***TYPE      SINGLE PRECISION (SEWSET-S, DEWSET-D)
C***AUTHOR  Hindmarsh, Alan C., (LLNL)
C***DESCRIPTION
C
C  This subroutine sets the error weight vector EWT according to
C      EWT(i) = RTOL(i)*ABS(YCUR(i)) + ATOL(i),  i = 1,...,N,
C  with the subscript on RTOL and/or ATOL possibly replaced by 1 above,
C  depending on the value of ITOL.
C
C***SEE ALSO  SLSODE
C***ROUTINES CALLED  (NONE)
C***REVISION HISTORY  (YYMMDD)
C   791129  DATE WRITTEN
C   890501  Modified prologue to SLATEC/LDOC format.  (FNF)
C   890503  Minor cosmetic changes.  (FNF)
C   930809  Renamed to allow single/double precision versions. (ACH)
C***END PROLOGUE  SEWSET
C**End
      INTEGER n, itol
      INTEGER i
      REAL rtol, atol, ycur, ewt
      dimension rtol(*), atol(*), ycur(n), ewt(n)
C
C***FIRST EXECUTABLE STATEMENT  SEWSET
      go to(10, 20, 30, 40), itol
 10   CONTINUE
      DO 15 i = 1,n
 15     ewt(i) = rtol(1)*abs(ycur(i)) + atol(1)
      RETURN
 20   CONTINUE
      DO 25 i = 1,n
 25     ewt(i) = rtol(1)*abs(ycur(i)) + atol(i)
      RETURN
 30   CONTINUE
      DO 35 i = 1,n
 35     ewt(i) = rtol(i)*abs(ycur(i)) + atol(1)
      RETURN
 40   CONTINUE
      DO 45 i = 1,n
 45     ewt(i) = rtol(i)*abs(ycur(i)) + atol(i)
      RETURN
C----------------------- END OF SUBROUTINE SEWSET ----------------------
      END