Mercurial > hg > octave-nkf
view libcruft/odepack/sewset.f @ 13818:a05e5db7b94e
have some fun with waitbar demo #2
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Fri, 04 Nov 2011 14:33:44 -0400 |
parents | 96ba591be50f |
children |
line wrap: on
line source
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