GNU Octave: libcruft/odepack/sewset.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SEWSET (N, ITOL, RTOL, ATOL, YCUR, EWT)
00002 C***BEGIN PROLOGUE  SEWSET
00003 C***SUBSIDIARY
00004 C***PURPOSE  Set error weight vector.
00005 C***TYPE      SINGLE PRECISION (SEWSET-S, DEWSET-D)
00006 C***AUTHOR  Hindmarsh, Alan C., (LLNL)
00007 C***DESCRIPTION
00008 C
00009 C  This subroutine sets the error weight vector EWT according to
00010 C      EWT(i) = RTOL(i)*ABS(YCUR(i)) + ATOL(i),  i = 1,...,N,
00011 C  with the subscript on RTOL and/or ATOL possibly replaced by 1 above,
00012 C  depending on the value of ITOL.
00013 C
00014 C***SEE ALSO  SLSODE
00015 C***ROUTINES CALLED  (NONE)
00016 C***REVISION HISTORY  (YYMMDD)
00017 C   791129  DATE WRITTEN
00018 C   890501  Modified prologue to SLATEC/LDOC format.  (FNF)
00019 C   890503  Minor cosmetic changes.  (FNF)
00020 C   930809  Renamed to allow single/double precision versions. (ACH)
00021 C***END PROLOGUE  SEWSET
00022 C**End
00023       INTEGER N, ITOL
00024       INTEGER I
00025       REAL RTOL, ATOL, YCUR, EWT
00026       DIMENSION RTOL(*), ATOL(*), YCUR(N), EWT(N)
00027 C
00028 C***FIRST EXECUTABLE STATEMENT  SEWSET
00029       GO TO (10, 20, 30, 40), ITOL
00030  10   CONTINUE
00031       DO 15 I = 1,N
00032  15     EWT(I) = RTOL(1)*ABS(YCUR(I)) + ATOL(1)
00033       RETURN
00034  20   CONTINUE
00035       DO 25 I = 1,N
00036  25     EWT(I) = RTOL(1)*ABS(YCUR(I)) + ATOL(I)
00037       RETURN
00038  30   CONTINUE
00039       DO 35 I = 1,N
00040  35     EWT(I) = RTOL(I)*ABS(YCUR(I)) + ATOL(1)
00041       RETURN
00042  40   CONTINUE
00043       DO 45 I = 1,N
00044  45     EWT(I) = RTOL(I)*ABS(YCUR(I)) + ATOL(I)
00045       RETURN
00046 C----------------------- END OF SUBROUTINE SEWSET ----------------------
00047       END