Line data    Source code

       1              : module test_bobyqa
       2              : 
       3              :    use num_def
       4              :    use num_lib
       5              : 
       6              :    implicit none
       7              : 
       8              :    integer :: nfcn
       9              : 
      10              : contains
      11              : 
      12            1 :    subroutine do_test_bobyqa
      13          303 :       real(dp), dimension(100) :: X, XL, XU
      14        10001 :       real(dp), dimension(10000) :: W
      15              :       real(dp), parameter :: max_valid_value = 1d99
      16              :       real(dp), parameter :: BDL = -1.0d0
      17              :       real(dp), parameter :: BDU = 1.0d0
      18            1 :       real(dp) :: f, RHOBEG, RHOend
      19              :       integer :: I, IPRINT, N, MAXFUN, NPT
      20              :       include 'formats'
      21            1 :       IPRINT = 0
      22            1 :       MAXFUN = 5000
      23            1 :       RHOend = 1.0D-6
      24            4 :       do N = 2, 6, 2
      25            3 :          nfcn = 0
      26            3 :          NPT = 2*N + 1
      27           15 :          do I = 1, N
      28           12 :             XL(I) = BDL
      29           12 :             XU(I) = BDU
      30           15 :             X(I) = DBLE(I)/DBLE(N + 1)
      31              :          end do
      32            3 :          RHOBEG = 0.2D0*X(1)
      33            3 :          write (*, '(4X,A,I2,A,I3)') 'test BOBYQA with N =', N, ' and NPT =', NPT
      34            3 :          call BOBYQA(N, NPT, X, XL, XU, RHOBEG, RHOend, IPRINT, MAXFUN, W, CALFUN, max_valid_value)
      35            3 :          call calfun(n, x, f)
      36              :          !write(*,2) 'f', nfcn, f
      37            4 :          if (abs(f) > 1d-10) write (*, *) 'failed in test of BOBYQA: min f', f
      38              :       end do
      39            1 :    end subroutine do_test_bobyqa
      40              : 
      41          293 :    subroutine calfun(n, x, f)
      42              :       use const_def, only: dp
      43              :       integer, intent(in) :: n
      44              :       real(dp), intent(in) :: x(*)
      45              :       real(dp), intent(out) :: f
      46              :       integer :: i, j, iw, np
      47          293 :       real(dp) :: sum
      48              : 
      49        32523 :       real(dp) :: Y(10, 10)
      50          293 :       nfcn = nfcn + 1
      51         1743 :       do J = 1, N
      52         1450 :          Y(1, J) = 1.0D0
      53         1743 :          Y(2, J) = 2.0D0*X(J) - 1.0D0
      54              :       end do
      55         1450 :       do I = 2, N
      56         7740 :       do J = 1, N
      57         7447 :          Y(I + 1, J) = 2.0D0*Y(2, J)*Y(I, J) - Y(I - 1, J)
      58              :       end do
      59              :       end do
      60          293 :       F = 0.0D0
      61          293 :       NP = N + 1
      62          293 :       IW = 1
      63         2036 :       do I = 1, NP
      64              :          SUM = 0.0D0
      65        10933 :          do J = 1, N
      66        10933 :             SUM = SUM + Y(I, J)
      67              :          end do
      68         1743 :          SUM = SUM/DBLE(N)
      69         1743 :          IF (IW > 0) SUM = SUM + 1.0D0/DBLE(I*I - 2*I)
      70         1743 :          IW = -IW
      71         2036 :          F = F + SUM*SUM
      72              :       end do
      73          293 :       RETURN
      74              :    end subroutine CALFUN
      75              : 
      76            0 :    subroutine xCALFUN(N, X, F)
      77              :       integer, intent(in) :: n
      78              :       real(dp), intent(in) :: x(*)
      79              :       real(dp), intent(out) :: f
      80              :       integer :: i, j
      81            0 :       real(dp) :: temp
      82            0 :       F = 0.0D0
      83            0 :       do I = 4, N, 2
      84            0 :       do J = 2, I - 2, 2
      85            0 :          TEMP = (X(I - 1) - X(J - 1))**2 + (X(I) - X(J))**2
      86            0 :          TEMP = DMAX1(TEMP, 1.0D-6)
      87            0 :          F = F + 1.0D0/DSQRT(TEMP)
      88              :       end do
      89              :       end do
      90            0 :       RETURN
      91              :    end subroutine xCALFUN
      92              : 
      93              : end module test_bobyqa