DUVMIF Fortran Error 1（计算机舍入误差）排查求助

我用DUVMIF估算目标函数最小值，目标函数本身比较平坦，DUVMIF看似已经找到极小值区域，但始终报Error 1（计算机舍入误差）。调整DUVMIF的精度阈值参数后问题仍未解决，希望能让DUVMIF稳定在输出最后五行所示的区域。相关代码如下：

!********************************************************************************************
subroutine optimize(b_next,gn_value, h_value,v_value,a_initial2,b_initial2,i_default_global2)

USE GLOBAL
USE UVMIF_INT

implicit none

REAL(8),INTENT(IN)::a_initial2,b_initial2
INTEGER,INTENT(IN)::i_default_global2

REAL(8),INTENT(OUT)::b_next,gn_value,h_value,v_value

INTEGER, PARAMETER::num=100,XACC = 1d-4,MAXFN = 1000

integer :: i,t, d, index_opt, index_vector(1) ,index_opt2       
REAL(8) :: new_value, old_value,old_value2, b, q,vector(nb),&
                    b_next_grid(num), STEP, BOUND, b_next_guess
real(8)::b_next_inf,b_next_sup 
EXTERNAL  DUVMIF

REAL(8)::value1,value2

    b_next_inf = bmin 
    b_next_sup = -0.48d0 

old_value = 10d+33
do i=1,num 

   b_next_grid(i) = b_next_inf + (b_next_sup - b_next_inf) * (i-1)/ (num - 1)
   new_value = objective_fun2(b_next_grid(i))
   if (new_value <= old_value) then
      index_opt = i
      b_next_guess = b_next_grid(i)
      old_value = new_value
   end if
      if ((DABS(old_value-new_value) <= 1d-6)) then
      index_opt2 = i
      old_value2 = new_value
   end if

end do

STEP = (b_next_grid(2) - b_next_grid(1))*0.5
BOUND = EXP(amax)

PRINT*,'initial guess obtained'
PRINT*,' '
IF (old_value.GE.1d5) THEN
    b_next = 0d0
    gn_value=0d0
    h_value=0d0
    v_value = -old_value
ELSEIF (((DABS(old_value2 - old_value)) < 1d-6).AND.(index_opt2.NE.index_opt)) THEN        
    b_next  = b_next_grid(index_opt2)
    call objective_fun(b_next,gn_value,h_value,v_value,a_initial2,b_initial2,i_default_global2)
    v_value=-v_value
ELSE        

    call DUVMIF(objective_fun2, b_next_guess, STEP, BOUND, XACC, MAXFN, b_next)
        call objective_fun(b_next,gn_value,h_value,v_value,a_initial2,b_initial2,i_default_global2)
        v_value = -v_value
end if

CONTAINS

REAL(8) FUNCTION objective_fun2(x)

REAL(8),INTENT(IN)::x
REAL(8)::xgn,xh,xvalue

CALL objective_fun(x,xgn,xh,xvalue,a_initial2,b_initial2,i_default_global2)

objective_fun2 = xvalue

END FUNCTION
end subroutine
!*******************************************************************************************

解决建议 #

• 适配平坦函数，放宽精度阈值：
  目标函数平坦区域内，函数值变化远小于当前设置的XACC=1d-4，算法会将这种微小变化判定为舍入误差。尝试把XACC调大至1d-3或1d-2，因为平坦区域内极小值点的微小偏移对结果影响可忽略，无需过高精度。

• 缩小DUVMIF的搜索范围：
  当前BOUND使用EXP(amax)可能导致搜索范围过大，增加舍入误差触发概率。将BOUND设置为网格搜索的上下限（b_next_inf到b_next_sup），限制算法在已确定的潜在极小值区域内搜索。

• 优化平坦区域的判断逻辑：
  现有代码中index_opt2的更新逻辑存在缺陷，无法准确识别连续的平坦区间。可修改为收集所有函数值接近最小值的网格点，直接取该区间中点作为结果，跳过DUVMIF调用：

  ! 替换原网格搜索后的判断分支
  integer, allocatable :: flat_indices(:)
  flat_indices = pack([(i,i=1,num)], DABS(objective_fun2(b_next_grid(i)) - old_value) <= 1d-6)
  if (size(flat_indices) > 1) then
      b_next = (b_next_grid(flat_indices(1)) + b_next_grid(flat_indices(size(flat_indices)))) / 2d0
      call objective_fun(b_next, gn_value, h_value, v_value, a_initial2, b_initial2, i_default_global2)
      v_value = -v_value
  else
      call DUVMIF(objective_fun2, b_next_guess, STEP, BOUND, XACC, MAXFN, b_next)
      call objective_fun(b_next, gn_value, h_value, v_value, a_initial2, b_initial2, i_default_global2)
      v_value = -v_value
  end if
  

• 排查目标函数的数值稳定性：
  在objective_fun中添加中间变量输出，检查是否存在除法、指数运算等导致的数值溢出或精度损失，这类问题会间接引发DUVMIF的舍入误差报错。

• 增加迭代次数上限：
  把MAXFN从1000增大至2000，给算法更多迭代次数尝试收敛，避免因迭代次数不足误判为舍入误差。

内容的提问来源于stack exchange，提问作者bellman_1913