include 'GA.inc'
include 'common.inc'
include 'io.inc'
- real*16 :: WEIGHTS(18)
+ real*8 :: WEIGHTS(18)
integer*4 :: i,j,m,n,iloc,pos,iter,maxiter,numarg,tmplen
integer*4 :: WybierzOsobnika,Najlepszy,ZnajdzPodobnego,FindWorst
integer*4 :: status
do_ga=.false.
endif
-c End of "fisrst time here?" code
+c End of "first time here?" code
endif
c
c Do we actual use a Genetic Algorithm?
c
- if (do_ga.eq..true.) then
+ if (do_ga.eqv..true.) then
c Yes. This is only done when doing second pass with ZSCORE (without weight minimalizaton)
c or with weight minimalization disabled (maxmin=0) just to obtain final score)
-c \\---//================================================================
-c \\-//
-c "// Genetic Algorithm code starts here
-c //-\\
-c =//---\\===============================================================
+c \\---//================================================================c
+c \\-// c
+c "// Genetic Algorithm code starts here c
+c //-\\ c
+c =//---\\===============================================================c
call ReadZEnergy(BANK_MULTIPLIER*banksize,populacja)
do i=1,BANK_MULTIPLIER*banksize
write(tmptext,'(F7.5)') avrd
call write2log("Average distance between individuals in initial&
& bank is "//trim(tmptext))
+c
+c Cutoff
+c
csacutoff=(maxco*avrd)-generation*avrd*(maxco-minco)/maxgen
write(tmptext,'(F7.5)') csacutoff
call write2log("CSA cutoff is now set to "//trim(tmptext))
if (populacja(i,20).lt.bank(j,20)) then
write(tmptext,'(I4)') j
write(tmptext2,'(I4)') i
- call write2log("Swaping ind"//trim(tmptext)//" from bank to &
- &ind "//trim(tmptext2)//" from population")
- write(tmptext2,'(21F7.5)') bank(j,:)
- call write2log("BANK"//trim(tmptext)//":"//trim(tmptext2))
+ call write2log(" Swaping ind"//trim(tmptext)//" from bank t&
+ &o ind "//trim(tmptext2)//" from population")
+ write(tmptext2,'(19F8.5,E15.7,F8.5)') bank(j,:)
+ call write2log(" BANK"//trim(tmptext)//":"//trim(tmptext2))
write(tmptext,'(I4)') i
- write(tmptext2,'(21F7.5)') populacja(i,:)
- call write2log("POP"//trim(tmptext)//":"//trim(tmptext2))
+ write(tmptext2,'(19F8.5,E15.7,F8.5)') populacja(i,:)
+ call write2log(" POP "//trim(tmptext)//":"//trim(tmptext2))
bank(j,:)=populacja(i,:)
+ else
+ call write2log(" Found simialar but not better")
endif
else ! W banku nie ma podobnego
j=FindWorst(banksize,bank)
- write(tmptext,'(I4)') j
+ write(tmptext2,'(I4)') j
if (populacja(i,20).lt.bank(j,20)) then
- call write2log("Worst in bank is "//trim(tmptext))
- write(tmptext2,'(21F7.5)') bank(j,:)
- call write2log("BANK"//trim(tmptext)//":"//trim(tmptext2))
-
+ call write2log(" Worst in bank is "//trim(tmptext2))
+ write(tmptext,'(I4)') i
+ call write2log(" Swaping worst ind in bank to "//trim(tmpte&
+ &xt))
+ write(tmptext,'(I4)') j
+ write(tmptext2,'(19F8.5,E15.7,F8.5)') bank(j,:)
+ call write2log(" BANK"//trim(tmptext)//":"//trim(tmptext2))
write(tmptext,'(I4)') i
- call write2log("Swaping worst ind in bank to "//trim(tmptext&
- &))
- write(tmptext2,'(21F7.5)') populacja(i,:)
- call write2log("POP"//trim(tmptext)//":"//trim(tmptext2))
+ write(tmptext2,'(19F8.5,E15.7,F8.5)') populacja(i,:)
+ call write2log(" POP "//trim(tmptext)//":"//trim(tmptext2))
bank(j,:)=populacja(i,:)
+ else
+ call write2log(" The worst in bank is better then this Ind"&
+ &)
endif
endif
enddo
endif
case('cluster')
- write(*,*) "Some stuff here in the future"
+ write(*,*) "Well this is not implemented yet"
goto 2010
end select
c
c Create the inputs
c
- write(tmptext,'(I)') generation+1
+ write(tmptext,'(I3)') generation+1
call write2log("Preparing inputs for next generation ("//trim(adju&
&stl(tmptext))//")")
call CreateInputs(BANK_MULTIPLIER*banksize,populacja)
integer*4 function FindWorst(rozmiar,pop)
integer*4 :: rozmiar, i, idx
- real*16 :: pop,last
+ real*8 :: pop,last
dimension pop(rozmiar,21)
last=0.0
include 'TEST.inc'
real*8 :: osobnik(20)
integer*4 :: i
- FunkcjaCeluB = 20 + -exp(-abs(WLONG-osobnik(1))) &
+ FunkcjaCeluB = 20 -exp(-abs(WLONG-osobnik(1))) &
& - exp(-abs(WSCP-osobnik(2))) &
& - exp(-abs(WELEC-osobnik(3))) &
& - exp(-abs(WBOND-osobnik(4))) &
select case (wiersz(1:12))
case('GENERATIONS=','generations=')
tmp = wiersz(13:len_trim(wiersz))
- read(tmp,'(I)') maxgen
+ read(tmp,'(I4)') maxgen
end select
c CICUTOFF=
select case(wiersz(1:11))
case('POPULATION=','population=')
tmp = wiersz(12:len_trim(wiersz))
- read(tmp,'(I)') banksize
+ read(tmp,'(I4)') banksize
call write2log("Bank size is set to "//tmp)
end select
select case(wiersz(1:7))
case('MAXMIN=','maxmin=')
tmp = wiersz(8:len_trim(wiersz))
- read(tmp,'(I)') maxminstep
+ read(tmp,'(I4)') maxminstep
if (maxminstep.gt.0) then
call write2log("ZSCORE weights minimalization set to "//tmp)
do_optima=.true.
if (delta.lt.mindelta) then
mindelta=delta
pozycja=i
- write(tmp,'(F7.5,X,I)') delta,pozycja
- call write2log("Delta is "//tmp)
+ write(tmp,'(F7.5,X,I4)') delta,pozycja
+ call write2log(" Delta is "//tmp)
endif
end do
end subroutine
c ======================================================================
+c WriteBankHistory subroutine
+c ======================================================================
+c Writes CSA BANK History to file
+c ----------------------------------------------------------------------
+ subroutine WriteBankHistory(b)
+ include 'io.inc'
+ include 'common.inc'
+ real*8,dimension(banksize,21) :: b
+ character*250 :: tmptext
+ character*250 :: header
+
+
+ header="# WLONG WSCP WELEC WBOND WANG WSC&
+ &LOC WTOR WTORD WCORRH WCORR4 WCORR5 WCORR6 &
+ &WEL_LOC WTURN3 WTURN4 WTURN6 WVDWPP WHPB WSCCO&
+ &R FFV FITNESS"
+
+ call write2log("Writing Bank history to file "//obankhfn)
+ open(obankh, file = obankhfn)
+ write(iobank, "(A)") trim(adjustl(header))
+
+ do i=1,banksize
+ write(obankh,'(19F10.5,E15.7,F10.5)') (b(i,j),j=1,21)
+ write(tmptext,'(19F10.5,E15.7,F10.5)') (b(i,j),j=1,21)
+ call write2log(trim(tmptext))
+ enddo
+ close(iobank)
+ end subroutine
+
+c
+c ======================================================================
c ReadBank subroutine
c ======================================================================
c Read CSA BANK from file
include 'common.inc'
real*8,dimension(banksize,21) :: b
real*8 :: d,avgd
- integer*4 :: nd
+ integer*4 :: nd,w
d=0.0 ! distance
nd = (banksize-1)*banksize/2 ! number of distances to calculate