home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / odepack / ewset.f < prev    next >
Text File  |  1996-09-28  |  1KB  |  33 lines
  1.       SUBROUTINE EWSET (N, ITOL, RTOL, ATOL, YCUR, EWT)
  2. CLLL. OPTIMIZE
  3. C-----------------------------------------------------------------------
  4. C THIS SUBROUTINE SETS THE ERROR WEIGHT VECTOR EWT ACCORDING TO
  5. C     EWT(I) = RTOL(I)*ABS(YCUR(I)) + ATOL(I),  I = 1,...,N,
  6. C WITH THE SUBSCRIPT ON RTOL AND/OR ATOL POSSIBLY REPLACED BY 1 ABOVE,
  7. C DEPENDING ON THE VALUE OF ITOL.
  8. C-----------------------------------------------------------------------
  9.       INTEGER N, ITOL
  10.       INTEGER I
  11.       DOUBLE PRECISION RTOL, ATOL, YCUR, EWT
  12.       DIMENSION RTOL(1), ATOL(1), YCUR(N), EWT(N) 
  13. C
  14.       GO TO (10, 20, 30, 40), ITOL
  15.  10   CONTINUE
  16.       DO 15 I = 1,N 
  17.  15     EWT(I) = RTOL(1)*DABS(YCUR(I)) + ATOL(1)
  18.       RETURN
  19.  20   CONTINUE
  20.       DO 25 I = 1,N 
  21.  25     EWT(I) = RTOL(1)*DABS(YCUR(I)) + ATOL(I)
  22.       RETURN
  23.  30   CONTINUE
  24.       DO 35 I = 1,N 
  25.  35     EWT(I) = RTOL(I)*DABS(YCUR(I)) + ATOL(1)
  26.       RETURN
  27.  40   CONTINUE
  28.       DO 45 I = 1,N 
  29.  45     EWT(I) = RTOL(I)*DABS(YCUR(I)) + ATOL(I)
  30.       RETURN
  31. C----------------------- END OF SUBROUTINE EWSET -----------------------
  32.       END 
  33.