Source module last modified on Wed, 20 Nov 2002, 13:10;
HTML image of Fortran source automatically generated by
for2html on Wed, 20 Nov 2002, 13:12.
program MyGa
implicit none
include parameter.inc
integer k, i,j, kbest,it, nbstag,stag,q, elit,nbmultip,niche,
$ newfx(popsize),stagtot,nbtot,irandom,savefich,affichecran,
$ restartini,restartfin,initpop
double precision pop(popsize,dimx), xmin(dimx), xmax(dimx),
$ solx(dimx),solfx,norme
double precision alpha, pc,pm,tm,b,kb,b0,sigmaniche,alphaniche,
$ mx(popsize)
double precision fx,sol(dimx),best(0:genemax),bestfx
double precision fitnesspop(popsize), pmi(popsize),eps,temp,tmp
double precision scal,scalvar1,scalvar2,scalvarp
character*6 typeconv,typec,typem,types,RafLoc,scaling,scalingvar
logical arret,newx
integer info
#
# Initialaisation des parametres
#
irandom = -1! time()
call uniforme(irandom,temp)
arret =.false.
do k=1,popsize
newfx(k) = 1
enddo
call initparm(affichecran,savefich,typeconv,solx,solfx,eps,xmin,
$ xmax,pc,typec,alpha,nbmultip,pm,tm,q,typem,b,nbstag,rafloc,
$ nbtot,kb,types,elit,niche,sigmaniche,alphaniche,scaling,scal,
$ scalingvar,scalvar1,scalvar2,scalvarp,restartini,restartfin,
$ initpop)
# Initialaisation de la population
if(restartini.eq.1) then
call init(pop,xmin,xmax)
if(initpop.ge.1) then
open(unit=3,file='initx.dat',status='unknown')
do k=1,initpop
do j=1,dimx
read(3,*) pop(k,j)
enddo
enddo
close(3)
endif
else
open(unit=3,file='restart.dat',status='unknown')
do k=1,popsize
do j=1,dimx
read(3,*) pop(k,j)
enddo
enddo
close(3)
endif
call initpmi(pmi,pm)
stag = 0
stagtot = 0
b0 = b
# Affichage de la population
if(niche.eq.1) then
call nich (pop,mx,sigmaniche,alphaniche,q,xmin,xmax)
else
do k=1, popsize
mx(k) = 1.D0
enddo
endif
call fitnessall(pop,fitnesspop,newfx)
call bestfitness(fitnesspop,kbest)
bestfx = fitnesspop(kbest)
best(restartini-1) = bestfx
do i=1,dimx
sol(i) = pop(kbest,i)
enddo
newx=.true.
if(typeconv.eq.'solx') then
call normel2(solx,sol,norme)
endif
if(affichecran.ge.3) then
write(*,*) '************************************'
write(*,*) '* Generation initiale *'
call affichepop(pop,popsize)
write(*,*) 'Son fitness = ', fitnesspop
write(*,*) 'Meilleur fitness =',fitnesspop(kbest)
if(typeconv.eq.'solx') then
write(*,*) 'le meilleur individu se trouve a un distance =',
$ norme,' de la solution.'
endif
write(*,*) '* *'
write(*,*) '************************************'
endif
if(savefich.ge.2) then
open(unit=2,file='bestfx.dat',status='unknown')
open(unit=4,file='bestx.dat',status='unknown')
write(2,*) 0,' ',bestfx
write(4,*) 0,' ',sol
endif
do it=restartini,restartfin
# test d arret
# test par rapport a la solution
if(typeconv.eq.'solx') then
if(newx) then
# call normel2(solx,sol,norme)
call normelinf(solx,sol,norme)
if(norme.le.eps) then
arret=.true.
endif
endif
# test par rapport a la valeur de la fonction
elseif(typeconv.eq.'solfx') then
if(abs(bestfx-solfx).le.eps) then
arret=.true.
endif
endif
if(arret) then
goto 9999
endif
# write(*,*) ' ********* Selection ********* '
call selection(it,pop,fitnesspop,types,elit,niche,mx,
$ sigmaniche,alphaniche,q,xmin,xmax,scaling,scal,
$ scalingvar,scalvar1,scalvar2,scalvarp)
# write(*,*) ' ********* Croisement ********* '
call croisement(pop,fitnesspop,pc,typec,alpha,nbmultip,pmi,
$ tm,xmin,xmax,q,newfx)
# write(*,*) ' ********* Mutation ********* '
call mutation(it,pop,fitnesspop,pmi,pm,typem,b,xmin,xmax,
$ newfx)
# on remet les proba de mutation a leur valeur initiales.
call initpmi(pmi,pm)
# on recalcule le fitness des nouveaux individus.
call fitnessall(pop,fitnesspop,newfx)
# on cherche le meilleur individu de la population courante
call bestfitness(fitnesspop,kbest)
#CC
if((elit.eq.1).and.(best(it-1).lt.fitnesspop(kbest))) then
call nuniforme(popsize,i)
do j=1,dimx
pop(i,j) = sol(j)
enddo
fitnesspop(i) = best(it-1)
best(it) = best(it-1)
else
best(it) = fitnesspop(kbest)
endif
#CC
if(savefich.ge.2) then
write(2,*)it,' ',best(it)
write(4,*) it,' ',sol
endif
if(affichecran.ge.2) then
write(*,*)it,' ',best(it)
endif
# on verifie si le fitness s est ameliore, sinon on a une stagnation.
if(best(it).lt.bestfx) then
bestfx = best(it)
stag = 0
b = b0
do i=1,dimx
sol(i) = pop(kbest,i)
enddo
newx=.true.
else
newx=.false.
stag = stag + 1
b = b0
if(stag.ge.nbstag) then
b = kb * b0
if(affichecran.ge.2) then
write(*,*) 'Stagnation a it =',it,' ==> b = ',b
endif
stag = 0
endif
endif
# si on fait du rafinnement local.
if(rafloc.eq.'rafloc') then
if(newx) then
stagtot = 0
else
stagtot = stagtot + 1
endif
if(stagtot.ge.nbtot) then
stag = 0
stagtot = 0
do i=1,dimx
temp = sol(i)
tmp = (xmax(i) + xmin(i)) /2.D0
if(temp.ge.tmp) then
xmin(i) = (xmax(i) + 3.D0*xmin(i)) /4.D0
else
xmax(i) = (3.D0*xmax(i) + xmin(i)) /4.D0
endif
enddo
if(affichecran.ge.2) then
write(*,*)'Lancement de la recherche locale au tours'
write(*,*)' de ', sol
write(*,*)'entre ',xmin
write(*,*)'et ',xmax
endif
call reinit(xmin,xmax,pop,newfx,fitnesspop)
if(niche.eq.1) then
call nich (pop,mx,sigmaniche,alphaniche,q,xmin,xmax)
else
do k=1, popsize
mx(k) = 1.D0
enddo
endif
call fitnessall(pop,fitnesspop,newfx)
call bestfitness(fitnesspop,kbest)
bestfx = fitnesspop(kbest)
do i=1,dimx
sol(i) = pop(kbest,i)
enddo
# call normel2(solx,sol,norme)
call normelinf(solx,sol,norme)
endif
endif
enddo
9999 Continue
if(savefich.ge.2) then
close(2)
endif
if(affichecran.ge.1) then
write(*,*) '************************************'
write(*,*) '* Generation Finale *'
call affichepop(pop,popsize)
write(*,*) '************************************'
write(*,*) '* Generation Finale *'
write(*,*) 'fitnesspop = ', fitnesspop
write(*,*) 'Meilleur individu trouve = ',sol
write(*,*) 'Son fitness =',bestfx
if(typeconv.eq.'solx') then
call normel2(solx,sol,norme)
write(*,*) 'norme par rapport a la solution cherchee'
write(*,*) ' Norme L2 =', norme
call normelinf(solx,sol,norme)
write(*,*) ' Norme Inf =',norme
endif
write(*,*) '* *'
write(*,*) '************************************'
endif
if(savefich.ge.1) then
open(unit=3,file='resultat.dat',status='unknown')
write(3,*) '************************************'
write(3,*) '* Generation Finale *'
write(3,*) 'fitnesspop = ', fitnesspop
write(3,*) 'Meilleur individu trouve = ',sol
write(3,*) 'Son fitness =',bestfx
if(typeconv.eq.'solx') then
call normel2(solx,sol,norme)
write(3,*) 'norme par rapport a la solution cherchee'
write(3,*) ' Norme L2 =', norme
call normelinf(solx,sol,norme)
write(3,*) ' Norme Inf =',norme
endif
write(3,*) '* *'
write(3,*) '************************************'
close(3)
open(unit=3,file='restart.dat',status='unknown')
do k=1,popsize
do j=1,dimx
write(3,*) pop(k,j)
enddo
enddo
close(3)
endif
end