Perturb the x
vector and evaluate the function.
If the function evaluation is not valid, it will perturb and try again. Until a valid function is obtained or the maximum number of function evaluations is reached.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
class(simulated_annealing_type), | intent(inout) | :: | me | |||
real(kind=wp), | intent(in), | dimension(:) | :: | x |
input optimization variable vector to perturb |
|
real(kind=wp), | intent(in), | dimension(:) | :: | vm |
step length vector |
|
real(kind=wp), | intent(out), | dimension(:) | :: | xp |
the perturbed |
|
real(kind=wp), | intent(out) | :: | fp |
the value of the user function at |
||
integer, | intent(inout) | :: | nfcnev |
total number of function evaluations |
||
integer, | intent(inout) | :: | ier |
status output code |
||
logical, | intent(in), | optional | :: | first |
to use the input |
subroutine perturb_and_evaluate(me,x,vm,xp,fp,nfcnev,ier,first) implicit none class(simulated_annealing_type),intent(inout) :: me real(wp),dimension(:),intent(in) :: x !! input optimization variable vector to perturb real(wp),dimension(:),intent(in) :: vm !! step length vector real(wp),dimension(:),intent(out) :: xp !! the perturbed `x` value real(wp),intent(out) :: fp !! the value of the user function at `xp` integer,intent(inout) :: nfcnev !! total number of function evaluations integer,intent(inout) :: ier !! status output code logical,intent(in),optional :: first !! to use the input `x` the first time integer :: i !! counter integer :: istat !! user function status code logical :: first_try !! local copy of `first` real(wp) :: lower !! lower bound to use for random interval real(wp) :: upper !! upper bound to use for random interval if (present(first)) then first_try = first else first_try = .false. end if do if (first_try) then if (me%use_initial_guess) then ! use the initial guess ! [note if this evauation fails, the subsequent ones ! are perturbed from this one] xp = x first_try = .false. else ! a random point in the bounds: ! [if it fails, a new random one is tried next time] do i = 1, me%n xp(i) = uniform(me%lb(i),me%ub(i)) !xp(i) = me%lb(i) + (me%ub(i)-me%lb(i))*uniform_random_number() end do end if else ! perturb all of them: do i = 1, me%n lower = max( me%lb(i), x(i) - vm(i) ) upper = min( me%ub(i), x(i) + vm(i) ) xp(i) = uniform(lower,upper) !xp(i) = lower + (upper-lower)*uniform_random_number() end do end if ! evaluate the function with the trial ! point xp and return as fp. call me%fcn(xp, fp, istat) ! function eval counter: nfcnev = nfcnev + 1 ! if too many function evaluations occur, terminate the algorithm. if (nfcnev > me%maxevl) then if (me%iprint>0) then write(me%iunit, '(A)') ' too many function evaluations; consider' write(me%iunit, '(A)') ' increasing maxevl or eps, or decreasing' write(me%iunit, '(A)') ' nt or rt. these results are likely to be' write(me%iunit, '(A)') ' poor.' end if ier = 1 return end if select case (istat) case(-2) ! user stop write(me%iunit, '(A)') ' user stopped in function.' ier = 4 exit case(-1) ! try another one until we get a valid evaluation cycle case default ! continue end select exit ! finished end do end subroutine perturb_and_evaluate