dewset_default Subroutine

private subroutine dewset_default(me, n, itol, rtol, atol, ycur, ewt)

Set error weight vector.

this subroutine sets the error weight vector ewt according to

      ewt(i) = rtol(i)*abs(ycur(i)) + atol(i),  i = 1,...,n,

with the subscript on rtol and/or atol possibly replaced by 1 above, depending on the value of itol.

Author

  • hindmarsh, alan c., (llnl)

Revision history

  • 791129 date written
  • 890501 modified prologue to slatec/ldoc format. (fnf)
  • 890503 minor cosmetic changes. (fnf)
  • 930809 renamed to allow single/real(wp) versions. (ach)

Arguments

Type IntentOptional Attributes Name
class(dvode_t), intent(inout) :: me
integer, intent(in) :: n
integer, intent(in) :: itol
real(kind=wp), intent(in) :: rtol(*)
real(kind=wp), intent(in) :: atol(*)
real(kind=wp), intent(in) :: ycur(n)
real(kind=wp), intent(out) :: ewt(n)

Source Code

   subroutine dewset_default(me,n,itol,rtol,atol,ycur,ewt)

      class(dvode_t),intent(inout) :: me
      integer,intent(in) :: n
      integer,intent(in) :: itol
      real(wp),intent(in) :: rtol(*)
      real(wp),intent(in) :: atol(*)
      real(wp),intent(in) :: ycur(n)
      real(wp),intent(out) :: ewt(n)

      integer :: i

      select case (itol)
      case (2)
         do i = 1 , n
            ewt(i) = rtol(1)*abs(ycur(i)) + atol(i)
         enddo
         return
      case (3)
         do i = 1 , n
            ewt(i) = rtol(i)*abs(ycur(i)) + atol(1)
         enddo
         return
      case (4)
         do i = 1 , n
            ewt(i) = rtol(i)*abs(ycur(i)) + atol(i)
         enddo
         return
      case default
      end select

      do i = 1 , n
         ewt(i) = rtol(1)*abs(ycur(i)) + atol(1)
      enddo

   end subroutine dewset_default