240404.222352.HKT fix uobyqb.f90, restoring accidentally removed lines

libprima · Apr 4, 2024 · 8e6095d · 8e6095d
1 parent 28ff560
commit 8e6095d
Show file tree

Hide file tree

Showing 6 changed files with 21 additions and 8 deletions.
diff --git a/fortran/bobyqa/trustregion.f90 b/fortran/bobyqa/trustregion.f90
@@ -8,7 +8,7 @@ module trustregion_bobyqa_mod
 !
 ! Started: February 2022
 !
-! Last Modified: Friday, March 15, 2024 PM09:34:56
+! Last Modified: Thursday, April 04, 2024 PM09:26:23
 !--------------------------------------------------------------------------------------------------!
 
 implicit none

diff --git a/fortran/common/history.f90 b/fortran/common/history.f90
@@ -7,7 +7,7 @@ module history_mod
 !
 ! Started: July 2020
 !
-! Last Modified: Thursday, April 04, 2024 PM12:50:43
+! Last Modified: Thursday, April 04, 2024 PM10:15:40
 !--------------------------------------------------------------------------------------------------!
 
 implicit none
@@ -294,10 +294,19 @@ subroutine savehist(nf, x, xhist, f, fhist, cstrv, chist, constr, conhist)
     ! possible to revise the initialization subroutine to avoid repetition, but we choose not to,
     ! a motivation being to keep the initialization parallelizable.
     ! 2. We skip the test if N = 1, as false positive may occur (also possible when N > 1, but rare).
+    ! 3. For segments of length 1, we check whether it repeats three times. For segments of length
+    ! i > 1, we check whether it repeats twice. Due to rounding errors, it may happen that the same
+    ! point is repeated twice, but the solver is not in an infinite cycle, which was observed in an
+    ! experiment of NEWUOA on 20240404.
     nhist = min(nf, maxxhist)
     n = int(size(x), kind(n))
     if (n > 1 .and. nf > (n + 1) * (n + 2) / 2) then
-        do i = 1, min(100_IK, nhist / 2_IK)
+        if (nhist >= 3) then
+            call wassert(.not. (all(abs(xhist(:, nhist) - xhist(:, nhist - 1)) <= 0) .and. &
+                & all(abs(xhist(:, nhist - 1) - xhist(:, nhist - 2)) <= 0)), &
+                & 'XHIST does not contain a repeating segment of length 1', srname)
+        end if
+        do i = 2, min(100_IK, nhist / 2_IK)
             call wassert(.not. all(abs(xhist(:, nhist - i + 1:nhist) - xhist(:, nhist - 2 * i + 1:nhist - i)) <= 0), &
                 & 'XHIST does not contain a repeating segment of length '//num2str(i), srname)
         end do

diff --git a/fortran/newuoa/newuob.f90 b/fortran/newuoa/newuob.f90
@@ -8,7 +8,7 @@ module newuob_mod
 !
 ! Started: July 2020
 !
-! Last Modified: Thursday, April 04, 2024 PM07:12:06
+! Last Modified: Thursday, April 04, 2024 PM09:32:11
 !--------------------------------------------------------------------------------------------------!
 
 implicit none

diff --git a/fortran/newuoa/trustregion.f90 b/fortran/newuoa/trustregion.f90
@@ -8,7 +8,7 @@ module trustregion_newuoa_mod
 !
 ! Started: July 2020
 !
-! Last Modified: Saturday, March 16, 2024 AM05:16:56
+! Last Modified: Thursday, April 04, 2024 PM09:31:44
 !--------------------------------------------------------------------------------------------------!
 
 implicit none

diff --git a/fortran/uobyqa/uobyqb.f90 b/fortran/uobyqa/uobyqb.f90
@@ -8,7 +8,7 @@ module uobyqb_mod
 !
 ! Started: February 2022
 !
-! Last Modified: Thursday, April 04, 2024 AM11:21:53
+! Last Modified: Thursday, April 04, 2024 PM10:07:42
 !--------------------------------------------------------------------------------------------------!
 
 implicit none
@@ -565,6 +565,10 @@ subroutine uobyqb(calfun, iprint, maxfun, eta1, eta2, ftarget, gamma1, gamma2, r
     end if
 end if
 
+! Choose the [X, F] to return.
+x = xbase + xpt(:, kopt)
+f = fval(kopt)
+
 ! Arrange FHIST and XHIST so that they are in the chronological order.
 call rangehist(nf, xhist, fhist)
 

diff --git a/matlab/tests/private/isequiv.m b/matlab/tests/private/isequiv.m
@@ -311,7 +311,7 @@ function isequiv(solvers, options)
 test_options.output_xhist = (rand > 0.5);
 %test_options.output_xhist = 1;
 test_options.output_nlchist = (rand > 0.5);
-test_options.maxhist = floor((randn+6)*100*n);
+test_options.maxhist = floor((randn+8)*100*n);
 %test_options.maxhist = test_options.maxfun;
 if single_test
     % DO NOT INVOKE ANY RANDOMIZATION WITHIN THIS IF. Otherwise, a single test cannot reproduce the
@@ -321,7 +321,7 @@ function isequiv(solvers, options)
     test_options.output_nlchist = true;
 end
 test_options.maxfilt = floor(randn*500);
-test_options.iprint = floor(0.6*abs(randn));
+test_options.iprint = floor(0.5*abs(randn));
 test_options.quiet = (rand < 0.9);
 % Test all precisions. For unavailable precisions, the double-precision version will be called.
 if rand < 0.7  % Prob = 0.6