GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
sewset.f
Go to the documentation of this file.
1  SUBROUTINE sewset (N, ITOL, RTOL, ATOL, YCUR, EWT)
2 C***BEGIN PROLOGUE SEWSET
3 C***SUBSIDIARY
4 C***PURPOSE Set error weight vector.
5 C***TYPE SINGLE PRECISION (SEWSET-S, DEWSET-D)
6 C***AUTHOR Hindmarsh, Alan C., (LLNL)
7 C***DESCRIPTION
8 C
9 C This subroutine sets the error weight vector EWT according to
10 C EWT(i) = RTOL(i)*ABS(YCUR(i)) + ATOL(i), i = 1,...,N,
11 C with the subscript on RTOL and/or ATOL possibly replaced by 1 above,
12 C depending on the value of ITOL.
13 C
14 C***SEE ALSO SLSODE
15 C***ROUTINES CALLED (NONE)
16 C***REVISION HISTORY (YYMMDD)
17 C 791129 DATE WRITTEN
18 C 890501 Modified prologue to SLATEC/LDOC format. (FNF)
19 C 890503 Minor cosmetic changes. (FNF)
20 C 930809 Renamed to allow single/double precision versions. (ACH)
21 C***END PROLOGUE SEWSET
22 C**End
23  INTEGER n, itol
24  INTEGER i
25  REAL rtol, atol, ycur, ewt
26  dimension rtol(*), atol(*), ycur(n), ewt(n)
27 C
28 C***FIRST EXECUTABLE STATEMENT SEWSET
29  go to(10, 20, 30, 40), itol
30  10 CONTINUE
31  DO 15 i = 1,n
32  15 ewt(i) = rtol(1)*abs(ycur(i)) + atol(1)
33  RETURN
34  20 CONTINUE
35  DO 25 i = 1,n
36  25 ewt(i) = rtol(1)*abs(ycur(i)) + atol(i)
37  RETURN
38  30 CONTINUE
39  DO 35 i = 1,n
40  35 ewt(i) = rtol(i)*abs(ycur(i)) + atol(1)
41  RETURN
42  40 CONTINUE
43  DO 45 i = 1,n
44  45 ewt(i) = rtol(i)*abs(ycur(i)) + atol(i)
45  RETURN
46 C----------------------- END OF SUBROUTINE SEWSET ----------------------
47  END