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