diff --git a/AMSS_NCKU_source/fmisc.f90 b/AMSS_NCKU_source/fmisc.f90 index 925922d..f119ae9 100644 --- a/AMSS_NCKU_source/fmisc.f90 +++ b/AMSS_NCKU_source/fmisc.f90 @@ -1189,8 +1189,10 @@ end subroutine d2dump real*8, intent(out) :: y, dy integer :: i, j + logical :: is_uniform real*8, dimension(6) :: lambda - real*8 :: dx, den_i, term, num, den + real*8 :: dx, den_i, term, num, den, step, tol + real*8, parameter :: c_uniform(6) = (/ -1.d0, 5.d0, -10.d0, 10.d0, -5.d0, 1.d0 /) do i = 1, 6 if (x == xa(i)) then @@ -1200,6 +1202,31 @@ end subroutine d2dump end if end do + step = xa(2) - xa(1) + is_uniform = (step /= 0.d0) + if (is_uniform) then + tol = 64.d0 * epsilon(1.d0) * max(1.d0, abs(step)) + do i = 3, 6 + if (abs((xa(i) - xa(i-1)) - step) > tol) then + is_uniform = .false. + exit + end if + end do + end if + + if (is_uniform) then + num = 0.d0 + den = 0.d0 + do i = 1, 6 + term = c_uniform(i) / (x - xa(i)) + num = num + term * ya(i) + den = den + term + end do + y = num / den + dy = 0.d0 + return + end if + do i = 1, 6 den_i = 1.d0 do j = 1, 6