ddawts.f 1.5 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243
  1. *DECK DDAWTS
  2. SUBROUTINE DDAWTS (NEQ, IWT, RTOL, ATOL, Y, WT, RPAR, IPAR)
  3. C***BEGIN PROLOGUE DDAWTS
  4. C***SUBSIDIARY
  5. C***PURPOSE Set error weight vector for DDASSL.
  6. C***LIBRARY SLATEC (DASSL)
  7. C***TYPE DOUBLE PRECISION (SDAWTS-S, DDAWTS-D)
  8. C***AUTHOR Petzold, Linda R., (LLNL)
  9. C***DESCRIPTION
  10. C-----------------------------------------------------------------------
  11. C THIS SUBROUTINE SETS THE ERROR WEIGHT VECTOR
  12. C WT ACCORDING TO WT(I)=RTOL(I)*ABS(Y(I))+ATOL(I),
  13. C I=1,-,N.
  14. C RTOL AND ATOL ARE SCALARS IF IWT = 0,
  15. C AND VECTORS IF IWT = 1.
  16. C-----------------------------------------------------------------------
  17. C***ROUTINES CALLED (NONE)
  18. C***REVISION HISTORY (YYMMDD)
  19. C 830315 DATE WRITTEN
  20. C 901009 Finished conversion to SLATEC 4.0 format (F.N.Fritsch)
  21. C 901019 Merged changes made by C. Ulrich with SLATEC 4.0 format.
  22. C 901026 Added explicit declarations for all variables and minor
  23. C cosmetic changes to prologue. (FNF)
  24. C***END PROLOGUE DDAWTS
  25. C
  26. INTEGER NEQ, IWT, IPAR(*)
  27. DOUBLE PRECISION RTOL(*), ATOL(*), Y(*), WT(*), RPAR(*)
  28. C
  29. INTEGER I
  30. DOUBLE PRECISION ATOLI, RTOLI
  31. C
  32. C***FIRST EXECUTABLE STATEMENT DDAWTS
  33. RTOLI=RTOL(1)
  34. ATOLI=ATOL(1)
  35. DO 20 I=1,NEQ
  36. IF (IWT .EQ.0) GO TO 10
  37. RTOLI=RTOL(I)
  38. ATOLI=ATOL(I)
  39. 10 WT(I)=RTOLI*ABS(Y(I))+ATOLI
  40. 20 CONTINUE
  41. RETURN
  42. C-----------END OF SUBROUTINE DDAWTS------------------------------------
  43. END