EVOLVE.F is a streamlined version of the White Dwarf Evolution Code (WDEC) described in § 4.3.2 with references to its origins and to the sources of data for the input physics. WDEC takes as input a hot starter model with a specific mass, which can come from detailed evolutionary calculations in the case of DOV stars, or from a simple polytropic approximation in the case of DBV and DAV stars. Using this starter model and other parameters specified in the header, WDEC adds an envelope with the specified composition and fractional mass and evolves the model quasi-statically until it reaches the specified temperature.
PULSATE.F uses the final output model produced by WDEC and calculates
the m=0 adiabatic non-radial oscillation periods of a specified
spherical degree (
)
within a specified period range. The periods
resulting from the adiabatic approximation typically differ from the
non-adiabatic results by only a few thousandths of a second, which is
well below the present level of observational noise.
PVM_FITNESS.F is the code that uses the message-passing routines of the Parallel Virtual Machine (PVM) software to allow the public-domain genetic algorithm PIKAIA to evaluate the fitnesses of trials in parallel rather than sequentially. This code automatically determines the number of processors available for the calculation, balances the load when machines with differing speeds are used, and works around crashed jobs in a sensible way.
FF_SLAVE.F is an interface between the parallel genetic algorithm and the streamlined version of WDEC. This code runs on each machine that is used to calculate white dwarf models. It uses the message-passing routines of PVM to receive sets of parameters from the master process, evaluates the white dwarf model specified by those parameters, compares the model periods to the observations, and returns a measure of fitness to PIKAIA.
The practical aspects of running the evolution and pulsation codes are addressed in the documentation archive at the end of this appendix.
In digital dissertation: Hypertext version of evolution code.
In digital dissertation: Hypertext version of pulsation code.
subroutine pvm_fitness (slave, num_jobs, npar, oldph, fitness)
c ---------------------------------------------
c parallel fitness evaluation using PVM
c ---------------------------------------------
implicit none
c
include '../include/fpvm3.h'
c
integer job, info, nhost, msgtype, iwhich, i
integer mytid, dtid, tids(0:128), flag, ntask
integer ttids(64), ptids(64), htids(64), flags(64)
integer speed, narch, numt, npar, nspawn, last, wait
integer num_jobs, ndone, length, par, trial, listen
integer finished(1024),resubmitted(1024)
c
double precision result, data(64)
real fitness(1024), oldph(64,1024)
c
character*40 hostname
character*18 host
character*8 slave, arch
character*8 aout(64)
c ---------------------------------------------
c initialize book-keeping variables
c ---------------------------------------------
listen = 0
wait = 0
ndone = 0
do job=1,num_jobs
finished(job) = 0
resubmitted(job) = 0
enddo
c ---------------------------------------------
c enroll this program in PVM
c ---------------------------------------------
call pvmfmytid( mytid )
call pvmfconfig( nhost, narch, dtid, host, arch, speed, info )
c ---------------------------------------------
c run jobs on slave nodes only
c ---------------------------------------------
arch = '.'
flag = PvmTaskHost+PvmHostCompl
nspawn = nhost-1
call pvmfspawn( slave, flag, arch, nspawn, tids, numt )
c ---------------------------------------------
c check for problems spawning slaves
c ---------------------------------------------
if( numt .lt. nspawn ) then
write(*,*) 'trouble spawning ',slave
write(*,*) ' Check tids for error code'
call shutdown( numt, tids )
endif
c
write(*,*)
c ---------------------------------------------
c send an initial job to each node
c ---------------------------------------------
do job=0,nspawn-1
c
trial = job + 1
do par=1,npar
data(par) = INT((100*oldph(par,trial))+0.5)/100.
enddo
c
call pvmfinitsend( PVMDEFAULT, info )
call pvmfpack( INTEGER4, trial, 1, 1, info )
call pvmfpack( INTEGER4, npar, 1, 1, info )
call pvmfpack( REAL8, data, npar, 1, info )
msgtype = 1
call pvmfsend( tids(job), msgtype, info )
c
11 format("job ",i3,3(2x,f4.2))
write(*,11) trial,data(1),data(2),data(3)
c
enddo
c
write(*,*)
c
do job=1,num_jobs
c ---------------------------------------------
c listen for responses
c ---------------------------------------------
25 msgtype = 2
call pvmfnrecv( -1, msgtype, info )
listen = listen + 1
c
if (info .GT. 0) then
write(*,*) "<-- job ",job
listen = 0
wait = 0
c ---------------------------------------------
c get data from responding node
c ---------------------------------------------
call pvmfunpack( INTEGER4, trial, 1, 1, info )
call pvmfunpack( REAL8, result, 1, 1, info )
call pvmfunpack( INTEGER4, length, 1, 1, info )
call pvmfunpack( STRING, hostname, length, 1, info )
c ---------------------------------------------
c re-send jobs that return crash signal
c ---------------------------------------------
if ((result .eq. 0.0).and.(resubmitted(trial).ne.1)) then
write(*,*) "detected fitness=0 job: trial ",trial
call sendjob
& (trial,hostname,'ffrslave',npar,resubmitted,oldph)
goto 25
endif
c
fitness(trial) = result
finished(trial) = 1
ndone = ndone + 1
c
33 format(i4,2x,i4,2x,a8,2x,3(f4.2,2x),f12.8)
write(*,33) ndone,trial,hostname,oldph(1,trial),
& oldph(2,trial),oldph(3,trial),result
c ---------------------------------------------
c send new job to responding node
c ---------------------------------------------
140 if (ndone .LE. (num_jobs-nspawn)) then
trial = job + nspawn
call sendjob
& (trial,hostname,slave,npar,resubmitted,oldph)
endif
goto 100
endif
c ---------------------------------------------
c re-submit crashed jobs to free nodes
c ---------------------------------------------
if (ndone .GT.(num_jobs-nspawn)) then
last = ndone-nspawn
if (ndone .GE.(num_jobs-5)) last=ndone
do trial=1,last
if ((finished(trial).NE.1).AND.
& (resubmitted(trial).NE.1).AND.(wait.NE.1)) then
write(*,*) "detected crashed job: trial ",trial
call sendjob
& (trial,hostname,'ffrslave',npar,resubmitted,oldph)
wait = 1
goto 25
endif
enddo
endif
c ---------------------------------------------
c return to listen again or move on
c ---------------------------------------------
if ((info .EQ. 0).AND.(listen .LT. 10000000)) goto 25
c
write(*,*) "detected unstable jobs: setting fitness=0"
do trial=1,num_jobs
if ((finished(trial) .NE. 1).AND.
& (resubmitted(trial) .EQ. 1)) then
fitness(trial) = 0.0
finished(trial) = 1
ndone = ndone + 1
write(*,33) ndone,trial,hostname,oldph(1,trial),
& oldph(2,trial),oldph(3,trial),fitness(trial)
endif
enddo
goto 199
100 continue
enddo
c ---------------------------------------------
c kill any remaining jobs
c ---------------------------------------------
199 iwhich = PVMDEFAULT
call pvmftasks( iwhich, ntask, ttids(1), ptids(1),
& htids(1), flags(1), aout(1), info )
do i=2,ntask
call pvmftasks( iwhich, ntask, ttids(i), ptids(i),
& htids(i), flags(i), aout(i), info )
if ((aout(i) .EQ. 'ff_slave').OR.
& (aout(i) .EQ. 'ffrslave')) then
call pvmfkill (ttids(i), info)
endif
enddo
c
call pvmfexit(info)
c
return
end
c**********************************************************************
subroutine sendjob(trial,hostname,slave,npar,resubmitted,oldph)
c
implicit none
c
include '../include/fpvm3.h'
c
integer tids(0:128), numt, msgtype, par, npar, trial, info, flag
integer resubmitted(1024)
c
double precision data(64)
real oldph(64,1024)
c
character*40 hostname
character*8 slave
c
call pvmfspawn( slave, 1, hostname, 1, tids, numt )
c
if ( numt .lt. 1 ) then
write(*,*) 'trouble spawning',slave
write(*,*) ' Check tids for error code'
call shutdown( numt, tids )
endif
c
do par=1,npar
data(par) = INT((100*oldph(par,trial))+0.5)/100.
enddo
c
call pvmfinitsend( PVMDEFAULT, info )
call pvmfpack( INTEGER4, trial, 1, 1, info )
call pvmfpack( INTEGER4, npar, 1, 1, info )
call pvmfpack( REAL8, data, npar, 1, info )
msgtype = 1
call pvmfsend( tids(0), msgtype, info )
c
55 format("job --> ",a8,3(2x,f4.2))
write(*,55) hostname,data(1),data(2),data(3)
c
if (slave .EQ. 'ffrslave') resubmitted(trial) = 1
c
return
end
c**********************************************************************
subroutine shutdown( nproc, tids )
c
implicit none
c
integer nproc, i, info, tids(*)
c
do i=0, nproc
call pvmfkill( tids(i), info )
enddo
c
call pvmfexit( info )
c
return
end
c**********************************************************************
program ff_slave
c ---------------------------------------------
c fitness function slave program
c ---------------------------------------------
implicit none
c
include '../include/fpvm3.h'
c
integer info, mytid, mtid, msgtype, speed, length, i
integer n, nhost, narch, dtid, hostid, trial
c
double precision ff, data(32), result
c
character*40 hostname,machine,arch
c ---------------------------------------------
c enroll this program in PVM
c ---------------------------------------------
call pvmfmytid( mytid )
c ---------------------------------------------
c get the master's task id
c ---------------------------------------------
call pvmfparent( mtid )
c ---------------------------------------------
c receive data from master host
c ---------------------------------------------
msgtype = 1
call pvmfrecv( mtid, msgtype, info )
call pvmfunpack( INTEGER4, trial, 1, 1, info )
call pvmfunpack( INTEGER4, n, 1, 1, info )
call pvmfunpack( REAL8, data, n, 1, info )
c ---------------------------------------------
c perform calculations with data
c ---------------------------------------------
result = ff( n, data )
c ---------------------------------------------
c send result to master host
c ---------------------------------------------
call pvmftidtohost( mytid, hostid )
100 call pvmfconfig( nhost, narch, dtid, hostname, arch, speed, info )
if (dtid .ne. hostid) goto 100
length = len(hostname)
machine = hostname(1:length)
c
call pvmfinitsend( PVMDEFAULT, info )
call pvmfpack( INTEGER4, trial, 1, 1, info )
call pvmfpack( REAL8, result, 1, 1, info )
call pvmfpack( INTEGER4, length, 1, 1, info )
call pvmfpack( STRING, machine, length, 1, info )
msgtype = 2
call pvmfsend( mtid, msgtype, info )
c ---------------------------------------------
c leave PVM before exiting
c ---------------------------------------------
call pvmfexit(info)
c
stop
end
c*********************************************************************
In digital dissertation: Documentation archive.
|
|
|
|
|
|