! module to deal with all the computations to select parents for mating
! and to create a new generation. The functions to compute the crossover
! and mutation are on separate modules

module ga_mate
  use ga_aux
!	use formats
  implicit none

contains
  !-----------------------------------------------------------------------
  subroutine selectn(ipick,j,itourny,nparam,npopsiz, &
  & nchrome,nchild,mate1,mate2,parent,iparent,child,ichild,fitness)
    !-----------------------------------------------------------------------
    ! Subroutine for selection operator.  Presently, tournament selection
    ! is the only option available.
    !-----------------------------------------------------------------------

    !! subroutine parameters
    integer, intent(in) :: j
    integer, intent(in) :: itourny
    integer, intent(in) :: nparam
    integer, intent(in) :: nchrome
    integer, intent(in) :: nchild
    integer, intent(in) :: npopsiz
    integer, intent(inout) :: ipick
    integer, intent(inout) :: mate1
    integer, intent(inout) :: mate2
    real, dimension(nparam,npopsiz)	    :: parent
    real, dimension(nparam,npopsiz)     :: child
    real, dimension(npopsiz)            :: fitness
    integer, dimension(nchrome,npopsiz) :: iparent
    integer, dimension(nchrome,npopsiz) :: ichild

    !! if tournament selection is chosen (i.e. itourny=1), then
    !! implement "tournament" selection for selection of new population.
    if (itourny == 1) then

       call select(mate1,ipick,nparam,npopsiz,nchrome,&
       & parent,iparent,fitness)
       call select(mate2,ipick,nparam,npopsiz,nchrome,&
       & parent,iparent,fitness)

       !write(0,*) mate1,fitness(mate1),mate2,fitness(mate2)

       !! initialize children in preparation for crossover
       ichild(1:nchrome,j)=iparent(1:nchrome,mate1)
       if(nchild == 2) ichild(1:nchrome,j+1)=iparent(1:nchrome,mate2)

    end if

    return

  end subroutine selectn

  !-----------------------------------------------------------------------
  subroutine newgen(ielite,npossum,ig2sum,npopsiz,nparam,nchrome,nowrite, &
  & ibest,nposibl,parent,child,iparent,ichild,g0,g1,ig2,parmax)

    ! Write child array back into parent array for new generation. Check
    ! to see if the best parent was replicated; if not, and if ielite=1,
    ! then reproduce the best parent into a random slot.
    !-----------------------------------------------------------------------

    !! subroutine parameters
    integer, intent(in) :: npopsiz
    integer, intent(in) :: npossum
    integer, intent(in) :: ig2sum
    integer, intent(in) :: ielite
    integer, intent(in) :: nparam
    integer, intent(in) :: nchrome
    integer, intent(in) :: nowrite
    real,dimension(nparam),intent(in)	:: g0
    real,dimension(nparam),intent(in)	:: g1
    real,dimension(nparam),intent(in)	:: parmax
    real, dimension(nparam,npopsiz)	:: parent
    real, dimension(nparam,npopsiz)	:: child
    integer,dimension(nparam),intent(in)	:: ig2
    integer,dimension(nparam)		:: nposibl
    integer, dimension(nchrome)		:: ibest
    integer, dimension(nchrome,npopsiz)	:: ichild
    integer, dimension(nchrome,npopsiz)	:: iparent

    !! local variables
    integer :: n,j,irand,b
    integer :: jelite	! counter to track the number of bits of an individual
    ! which match those of the best individual
    integer :: kelite   ! set to unity when jelite=nchrome, indicates that
    ! the best parent was replicated amongst the children
    real 	:: rand

    !! make sure individuals for next generation are within bounds
    if (npossum < ig2sum) then
       call possibl(nparam,nchrome,npopsiz,nowrite, &
       & child,ichild,g0,g1,ig2,nposibl,parmax)
    end if

    !! check if best individual is replicated
    kelite=0
    do j=1,npopsiz
       jelite=0
       do n=1,nchrome
          iparent(n,j)=ichild(n,j)
          if (iparent(n,j) == ibest(n)) jelite=jelite+1
          if (jelite == nchrome) kelite=1
       end do
    end do

    if (ielite /= 0 .and. kelite == 0) then
       b=1
       !! best individual not replicated, so replicate it in random slot
       call ran3(b,rand)
       irand=1d0+dint(dble(npopsiz)*rand)
       iparent(1:nchrome,irand)=ibest(1:nchrome)
       write(24,1260) irand

    end if

    !		include 'formats'
    !! formats for ga_mate
1260 format('  Elitist Reproduction on Individual ',i4)


    return
  end subroutine newgen

  !----------------------------------------------------------------------	
  subroutine select(mate,ipick,nparam,npopsiz,nchrome, &
  & parent,iparent,fitness)
    !----------------------------------------------------------------------
    ! This routine selects the better of two possible parents for mating.
    !----------------------------------------------------------------------

    !! subroutine arguments
    integer,intent(in)	:: nparam
    integer,intent(in)	:: npopsiz
    integer,intent(in)	:: nchrome
    integer,intent(out)	:: ipick
    integer,intent(out)	:: mate
    real,dimension(nparam,npopsiz),intent(in):: parent
    real,dimension(npopsiz),intent(out)	:: fitness
    integer,dimension(nchrome,npopsiz)	:: iparent

    !! local variables
    integer :: ifirst, isecond

    !! shuffle the parents arrays to select individuals for the tournament
    if(ipick+1 > npopsiz) then
       call shuffle(ipick,nparam,npopsiz,nchrome,parent,iparent,fitness)
    end if

    !! of the two selected indivduals, pick the mate
    ifirst=ipick
    isecond=ipick+1
    ipick=ipick+2
    if(fitness(ifirst) < fitness(isecond)) then
       mate=ifirst
    else
       mate=isecond
    end if
    !     write(3,*)'select',ifirst,isecond,fitness(ifirst),fitness(isecond)

    return

  end subroutine select

	!----------------------------------------------------------------------
	subroutine shuffle(ipick,nparam,npopsiz,nchrome,parent,iparent,fitness)
          !----------------------------------------------------------------------
          ! This routine shuffles the parent array and its corresponding fitness
          !----------------------------------------------------------------------

          !! subroutine arguments
          integer, intent(in)		:: nparam
          integer, intent(in)		:: npopsiz
          integer, intent(in)		:: nchrome
          integer, intent(out)	:: ipick
          real, dimension(nparam,npopsiz), intent(in)		:: parent
          real, dimension(npopsiz), intent(out)			:: fitness
          integer, dimension(nchrome,npopsiz) :: iparent

          !! local variables
          integer :: j,n,itemp,iother,b
          real	:: rand,temp
          b=1
          ipick=1
          do j=1,npopsiz-1
             call ran3(b,rand)
             iother=j+1+dint(dble(npopsiz-j)*rand)
             do n=1,nchrome
                itemp=iparent(n,iother)
                iparent(n,iother)=iparent(n,j)
                iparent(n,j)=itemp
             end do
             temp=fitness(iother)
             fitness(iother)=fitness(j)
             fitness(j)=temp
          end do

          return

	end subroutine shuffle
	!-------------------------------------------------------------------------

end module ga_mate
