164 lines
5.1 KiB
Fortran
164 lines
5.1 KiB
Fortran
program genetic
|
|
! module for dimensioning parameters
|
|
use dim_parameter,only: qn,ntot,numdatpt,dealloc_dim
|
|
!data module
|
|
use data_module, only: init_data, dealloc_data
|
|
! parser module
|
|
use parser, only: les
|
|
! matrix derivatives module
|
|
! use matrix_derivatives, only: dealloc_dw_ptr
|
|
! monome module
|
|
! use monome_module, only: dealloc_vwzprec
|
|
! diab3D precalculate module
|
|
! use diab3D_precalculate, only: dealloc_diab3D
|
|
! parameter initialization module
|
|
use init_mod,only: rinit,pinit
|
|
! fitting module
|
|
use fit_mod,only: fit
|
|
! writing module
|
|
use write_mod,only: write_output
|
|
! MPI module
|
|
#ifdef mpi_version
|
|
use mpi
|
|
#endif
|
|
|
|
implicit none
|
|
|
|
! Declare Variables
|
|
! MPI variables
|
|
#ifdef mpi_version
|
|
integer my_rank,ierror,threadnum,stopnum,ping(8),i
|
|
#endif
|
|
! Data variables
|
|
double precision, allocatable :: q_in(:,:),x1_in(:,:),x2_in(:,:)
|
|
double precision, allocatable :: y_in(:,:),wt_in(:,:)
|
|
! Fiting Model Parameters
|
|
double precision, allocatable :: p(:),par(:,:) !< vector(npar) for the values of read parameters
|
|
integer, allocatable :: p_act(:) !< vector(npar) containing 0 or 1 defining if corresponding parameters are activ in Fit
|
|
double precision, allocatable :: p_spread(:),prange(:,:) !< vector(npar) for the spread values for each parameter
|
|
integer npar !< read length of parameter arrays
|
|
! Fit control Parameters
|
|
integer seed !< Seed for RNG
|
|
integer nset !< number of diffrent parameter sets
|
|
logical freeze !< determines if parameters are active
|
|
double precision mut, difper !< percentage of selected Parents, number of mutations in parents, minimum diffrence between selected parents
|
|
integer nsel !< number of selected parameter sets for parents
|
|
integer gtype !< type of RNG used
|
|
integer maxit, micit !<maximum makro and micro iterations for the genetic program
|
|
! -----------------------------
|
|
! Fabian
|
|
integer iter
|
|
double precision rms,old
|
|
character(len=80) filename
|
|
character(len=80) chkpnt
|
|
|
|
! -----------------------------
|
|
|
|
#ifdef mpi_version
|
|
call MPI_Init(ierror)
|
|
call MPI_Comm_rank(MPI_COMM_WORLD,my_rank,ierror)
|
|
call MPI_Comm_size(MPI_COMM_WORLD,threadnum,ierror)
|
|
if(threadnum.lt.2) then
|
|
write(*,*) 'USING MPI VERSION WITH 1 THREAD: ABORTING'
|
|
stop
|
|
endif
|
|
#endif
|
|
|
|
! -----------------------------
|
|
nsel=0
|
|
mut=0.d0
|
|
difper=0.d0
|
|
call les(q_in,y_in,wt_in,p,p_act,p_spread,npar,
|
|
> seed,gtype,nset,maxit,micit,nsel,mut,difper,freeze)
|
|
|
|
allocate(par(npar,nset),prange(2,npar))
|
|
allocate(x1_in(qn,numdatpt),x2_in(qn,numdatpt))
|
|
|
|
call rinit(p,prange,p_spread,p_act,npar)
|
|
par=0.d0
|
|
par(1:npar,1)=p(1:npar)
|
|
call pinit(par,prange,npar,nset,seed,gtype)
|
|
|
|
|
|
!-------------------------------------------------
|
|
call data_transform(q_in,x1_in,x2_in,y_in,wt_in,p,npar,p_act)
|
|
!Fabian: Read data into module
|
|
call init_data(numdatpt,q_in,x1_in,x2_in,y_in,wt_in,y_in)
|
|
|
|
!-------------------------------------------------
|
|
#ifdef mpi_version
|
|
if(my_rank.eq.0) then
|
|
#endif
|
|
call write_output(q_in,x1_in,x2_in,y_in,wt_in,par,p_act,p_spread,
|
|
> nset,npar,0,0)
|
|
#ifdef mpi_version
|
|
endif
|
|
#endif
|
|
|
|
!-------------------------------------------------
|
|
|
|
!Fabian: THIS IS THE PLACE WHERE MY ROUTINES START THERE EXECUTION
|
|
!Fabian: We should either include these into Maiks routines or remove it from the fitting routines
|
|
chkpnt='test'
|
|
filename='test2'
|
|
old=1.e+5
|
|
iter=1
|
|
|
|
|
|
#ifdef mpi_version
|
|
if(my_rank.eq.0) then
|
|
#endif
|
|
if(.not.freeze) then
|
|
call fit(q_in,x1_in,x2_in,y_in,rms,difper,wt_in,
|
|
$ par,p_spread,mut,npar,p_act,
|
|
$ seed,gtype,nset,nsel,chkpnt,old,iter,
|
|
$ maxit,micit,y_in,
|
|
$ filename)
|
|
endif
|
|
#ifdef mpi_version
|
|
else
|
|
call mpi_rest_control(micit,npar)
|
|
endif
|
|
#endif
|
|
|
|
#ifdef mpi_version
|
|
if(my_rank.eq.0) then
|
|
#endif
|
|
call write_output(q_in,x1_in,x2_in,y_in,wt_in,par,p_act,p_spread,
|
|
> nset,npar,1,iter)
|
|
#ifdef mpi_version
|
|
endif
|
|
#endif
|
|
|
|
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
|
! Final cleanup of programm (quit MPI, deallocate data, etc.)
|
|
|
|
#ifdef mpi_version
|
|
if(my_rank.eq.0) then
|
|
call MPI_Comm_size(MPI_COMM_WORLD,threadnum,ierror)
|
|
stopnum = 0
|
|
do i = 1,threadnum-1
|
|
call MPI_Send(stopnum, 1, MPI_INTEGER,
|
|
$ i, 69, MPI_COMM_WORLD, ping, ierror)
|
|
enddo
|
|
call MPI_Barrier(MPI_COMM_WORLD, ierror)
|
|
endif
|
|
#endif
|
|
|
|
deallocate(q_in,x1_in,x2_in,y_in,wt_in,
|
|
$ p,par,p_act,p_spread,prange)
|
|
call dealloc_data
|
|
call dealloc_dim
|
|
! call dealloc_dw_ptr
|
|
! call dealloc_vwzprec
|
|
! call dealloc_diab3D
|
|
|
|
#ifdef mpi_version
|
|
call MPI_Barrier(MPI_COMM_WORLD, ierror)
|
|
call MPI_Finalize(ierror)
|
|
#endif
|
|
|
|
|
|
end program
|