Пример, который вы предоставили, был неполным: он не компилировался. Я решил построить небольшой
(полная) программа, которая делает что-то похожее. Надеюсь, это поможет!
Программа запускает параллельный сеанс, в котором обнаруживаются новые группы населения.
Всякий раз, когда найдено лучшее население, чем лучшее, лучшее население
обновляется. Итерация останавливается, когда глобальные вычисления проводят слишком много итераций.
между последовательными улучшениями.
В этой программе каждое следующее население построено полностью с нуля.
В вашей программе более развитое поколение следующего населения. в пользу
«лучшие» популяции по сравнению с «худшими».
В наивной параллеллизации каждый поток будет следовать своему поиску
пространство, и он не будет «учиться» из того, что обнаружили другие темы.
Для обмена поисковой информацией между потоками вам необходимо разработать метод, а затем
запрограммируйте это. Казалось, что это выходит за рамки этого вопроса.
А вот и программа:
program optimize_population
use Population ! contains the target function
use omp_lib
implicit none
integer, parameter :: really_long = 100000
real(kind=dp) :: best, targetFun
real(kind=dp) :: pop(2,npop), best_pop(2,npop)
integer, allocatable :: iter(:)
integer :: i, nt, it, ierr, last_improvement
call initTarget() ! initialize the target function
! Allocate an iteration count for every thread
nt = omp_get_max_threads()
allocate(iter(nt), stat=ierr)
if (ierr/=0) stop('allocation error')
iter = 0
best = -1e10
last_improvement = 0
!$OMP PARALLEL PRIVATE(it, pop, i, targetFun)
it = omp_get_thread_num()+1 ! thread number
do
iter(it) = iter(it) + 1
! Create a new population
do i = 1,npop
pop(1,i) = rand()
pop(2,i) = rand()
end do
! Evaluate target function
targetFun = popFun(pop)
if (targetFun>best) then
! If this is the best population so far,
! then register this
!$OMP CRITICAL
best_pop = pop
best = targetFun
print '(a,i0,a,i7,a,1p,e13.5)', '[',it,'] iteration ',sum(iter),' Best score until now: ',TargetFun
last_improvement = sum(iter) ! remember the global iteration count for the last time an improved population was found
!$OMP END CRITICAL
end if
! Done when further improvement takes too long
if (last_improvement < sum(iter) - really_long) exit
end do
!$OMP END PARALLEL
! Report the best population found
targetFun = popFun(best_pop)
print '(a,1p,e13.5)', 'Best score found: ',targetFun
print '(a,1p,e13.5)', ' best population found:'
do i = 1,npop
print '(1p,10(a,e13.5))', ' (',best_pop(1,i),',',best_pop(2,i),')'
end do
end program optimize_population
Программа нуждается в целевой функции, предоставляемой модулем Population, ниже:
module Population
integer, parameter :: npop = 20, ncenter = 3
integer, parameter :: dp = kind(1d0)
real(kind=dp) :: center(2,ncenter)
contains
subroutine initTarget()
implicit none
integer :: i
do i = 1,ncenter
center(1,i) = rand()
center(2,i) = rand()
end do
print '(a,i0,a)', &
'Looking for a population of ',npop,' points in the unit square,'
print '(a,i0,a)', &
'equally spread out in space, but clustered around the points'
print '(1p,10(a,e13.5))', &
' (',center(1,1),',',center(2,1), &
('), (',center(1,i),',',center(2,i), i=2,ncenter-1), &
') and (',center(1,ncenter),',',center(2,ncenter),')'
end subroutine initTarget
function popFun(pop) result(targetFun)
implicit none
real(kind=dp), intent(in) :: pop(:,:)
real(kind=dp) :: targetFun
integer :: i,j
real(kind=dp) :: sum_center, sum_dist
sum_dist = 0
sum_center = 0
do i = 1,npop
do j = i+1,npop
sum_dist = sum_dist + (pop(1,i)-pop(1,j))**2 + (pop(2,i)-pop(2,j))**2
end do
do j = 1,ncenter
sum_center = sum_center + (pop(1,i)-center(1,j))**2 + (pop(2,i)-center(2,j))**2
end do
end do
targetFun = sum_dist - sum_center
end function popFun
end module Population