! Brut Force Search ! ------------------------------------------------------------ ! ! program ga_test ! ------------------------------------------------------------ ! ! NOTE : TO CHANGE THE NUMBER OF ZONES CHANGE plsmzn IN MAIN ! AND SUBFORT. use stopwatch ! integer, parameter :: plsmzns = 6 ! Plas. zones integer, parameter :: plsmzns = 10 ! Plas. zones ZONES integer, parameter :: nset = 2 ! nset={t,dna} integer, parameter :: ntemp = 1 integer, parameter :: ndens = 48 integer :: maxgen = ntemp integer :: ipopsize = ndens ! Num. of plas evaluated per gen. integer :: nin = plsmzns*nset ! Amout data sent to ea. plas -ct integer :: i,j real(8), dimension(10000) :: plistin ! {ipopsize(tempindex,densindex)} real(8), dimension(10000) :: plistout! {ipopsize(fitness)} ! Loading indexes: Each new generation increments a greater temperature ! while the full set of densities are calculated. print*,'plsmzns=',plsmzns call starttime do i=1,ntemp int=0 plistin=0 do j=1,ndens int=int+1 plistin(int)=i int=int+1 plistin(int)=j enddo call subfort(maxgen,ipopsize,nin,nout,plistin,plistout) enddo call stoptime stop end ! ----------------------------------------------------------------- ! subroutine subfort(maxgen,ipopsize,pin,pout,listin,plistout) ! ----------------------------------------------------------------- ! implicit none integer, parameter :: nset = 2 ! nset=2={t,dna} integer, parameter :: plsmzns = 10 ! Plasma zones ZONE integer, parameter :: ipsz = 200 ! Param. pop. size integer, parameter :: nin = plsmzns*nset ! Amount data to ct integer, intent(in) :: pin ! pin=2={t_prof_index,d_prof_index} integer, intent(in) :: pout ! pout=2={fitness,pid} integer :: i,j,k,ict,jred,njred,ival,pindx integer :: igen ! # generation counter integer :: m integer :: ip ! Incrementer of population integer :: ndens, ntemp ! Num. dens. and temp. profiles. integer :: maxgen ! Max # gen integer :: nout ! Len. plistin & plistout integer :: ipopsize ! Population size integer :: ionce ! flag for one time read integer, dimension(40) :: a1,b1 !array containing sequences integer, dimension(ipsz,plsmzns) :: a2,b2 real(8) :: Fig,fitmax,Te_fit,Na_fit ! Best fitness data real(8), dimension(10000) :: fitness real(8), dimension(200) :: densarray ! Density array (mapping) real(8), dimension(200) :: temparray real(8), dimension(10000) :: listin, tempindexs real(8), dimension(10000) :: listout, densindexs real(8), dimension(10000) :: plistin !{10(temp,n_a),10(temp,n_a),...} real(8), dimension(10000) :: plistout ! k-> fitness; k+1->serial# data ionce /0/ data igen /0/ data fitmax /-1/ save igen,ionce,ndens,ntemp,a2,b2,Te_fit,Na_fit,fitmax,fig external fbuff ! ! ------------------------------------------------------------------- ! if(ionce.eq.0)then if(ipopsize.gt.ipsz) then print*,'Error(Stop): population size greater then ipsz parameter' stop endif ! ! -- Read Dens Data Profiles ! open(unit=20,file='seq_d.in') read(20,*) njred read(20,*) (densarray(jred),jred=1,njred) print*,'densarray=',(densarray(jred),jred=1,njred) ict=0 do ! density ict=ict+1 ! Count the number of profile entries read(20,*,end=10) (a2(ict,i),i=1,plsmzns) enddo 10 continue close(20) ndens=ict-1 print*,'ndens=',ndens ! ! -- Read Temp Data Profiles ! open(unit=21,file='seq_t.in') read(21,*) njred read(21,*) (temparray(jred),jred=1,njred) print*,'temparray=',(temparray(jred),jred=1,njred) ict=0 do ! temperature ict=ict+1 ! Count the number of profile entries read(21,*,end=15) (b2(ict,i),i=1,plsmzns) enddo 15 continue close(21) ntemp=ict-1 print*,'ntemp=',ntemp ionce = 1 endif ! Read once ! ! ------------------------------------------------------------------- tempindexs=0.0d0 densindexs=0.0d0 ! ! -- Extracting temp and dens indicies from listin ! do i=1,ipopsize j=(i*2)-1 tempindexs(i)=listin(j) if(tempindexs(i).gt.ntemp)then print*,'ERROR(STOP):tempindexs(',i,')=',tempindexs(i),' > ntemp=',ntemp stop endif if(tempindexs(i).lt.1)then print*,'ERROR(STOP):tempindexs(',i,')=',tempindexs(i),' < 1' stop endif enddo do i=1,ipopsize j=(i*2) densindexs(i)=listin(j) if(densindexs(i).gt.ndens)then print*,'ERROR(STOP):densindexs(',i,')=',densindexs(i),' > ndens=',ndens stop endif if(densindexs(i).lt.1)then print*,'ERROR(STOP):densindexs(',i,')=',densindexs(i),' < 1' stop endif enddo ! do i=1,ipopsize ! print*,tempindexs(i),densindexs(i) ! enddo ! print*,' ' ! ! ------------------------------------------------------------------- ! ip=0 do ict=1,ipopsize ! -- Temp array j=0 m=int(tempindexs(ict)) do i=ip*nin+1,ip*nin+nset*plsmzns,nset j=j+1 plistin(i)=temparray(b2(m,j)) ! print*,'plistin(',i,')=',plistin(i) enddo ! -- Den. array j=0 m=densindexs(ict) do i=ip*nin+2,ip*nin+nset*plsmzns,nset j=j+1 plistin(i)=densarray(a2(m,j)) ! print*,'plistin(',i,')=',plistin(i) enddo ip=ip+1 enddo close(20) close(21) ! ! ------------------------------------------------------------------- ! ! do k=1,ipopsize*nin ! print*,'plistin(',k,')=',plistin(k) ! enddo call subq(maxgen,ipopsize,nin,nout,plistin,plistout) ! ! -- Printing ! write(10,*) write(10,*) 'TempIndx DensIndx Fig.Num. Fitness' write(10,*) '-------------------------------------------' write(10,*) 'gen=',igen write(6,*) write(6,*) 'TempIndx DensIndx Fig.Num. Fitness' write(6,*) '-------------------------------------------' write(6,*) 'gen=',igen do k=1,ipopsize fitness(k)=plistout(k*2-1) if(fitness(k) .gt. fitmax) then fitmax = fitness(k) Te_fit = listin(k*2-1) Na_fit = listin(k*2) Fig = plistout(k*2) endif write(10,901) k,int(listin(k*2-1)),int(listin(k*2)),plistout(k*2),fitness(k) write(6,900) k,listin(k*2-1),listin(k*2),plistout(k*2),fitness(k) call fbuff() enddo write(6,909) Te_fit,Na_fit,Fig,fitmax write(10,909) Te_fit,Na_fit,Fig,fitmax if(igen.eq.(maxgen-1)) then write(10,*) write(10,*) '-------------------------------------------' write(10,910) Te_fit,Na_fit,Fig,fitmax close(10) write(6,*) write(6,*) '-------------------------------------------' write(6,910) Te_fit,Na_fit,Fig,fitmax endif igen=igen+1 900 format(i3,2x,f7.2,2x,f7.2,2x,f12.3,1pe14.7) 901 format(i3,2x,i3,2x,i3,2x,f12.3,1pe14.7) 909 format("BEST FIT SO FAR:",f7.2,2x,f7.2,2x,f12.3,2x,1pe14.7) 910 format("MAXFITNESS:",f7.2,2x,f7.2,2x,f12.3,2x,1pe14.7) end ! ------------------------------------------------------------------- ! subroutine subq(maxgen,ipopsize,nin,nout,plistin,plistout) ! ------------------------------------------------------------------- ! use communicate implicit none integer :: nin ! Total amount of data sent to ea. child integer :: nout ! Total amount of data recv. from ea. child integer :: ipopsize ! See ipsz: needed due to module(ipsz). integer :: nproc = 48 ! Number of child proc. spawned. integer :: strt = 0 ! First node to spawn: 0=current node. integer :: shft = 1 ! Next node to spawn: 1=next node on list. integer :: once ! Flag for one time execution integer :: maxgen ! Max number of generations. integer :: ipsz ! Number of jobs to be queued. integer :: igen ! Generation counter real(8),dimension(10000) :: plistin ! Date sent to be queued. real(8),dimension(10000) :: plistout ! Date returned from queue. character(len=30) :: exec ="ct" ! A single plasma configuration data once /0/ data igen /0/ save once,igen ipsz=ipopsize snd_c = nin r8_frm_p=plistin if(once.eq.0)then call x_sp_c( exec, nproc, strt, shft ) call x_stids( 1, exec, exec ) once=1 endif call x_cque_c( 2, exec, ipsz ) if(igen.eq.maxgen-1) then call x_skflg_c( 2 ,exec ) endif nout = rcv_c plistout=r8_frm_c igen=igen+1 end subroutine subq