!! module to implement mutation options for a genetic algorithm program

module ga_mutation
	use ga_aux
!	use formats
	implicit none

	contains

	!--------------------------------------------------------------------	
          subroutine jump_mutate(npopsiz,nchrome,nowrite,pmutate,ichild,verb)
            !--------------------------------------------------------------------
            ! This subroutine performs junmp mutations on the children generation.
            ! Perform random jump mutation if a random number is less than pmutate.
            !---------------------------------------------------------------------

            !! subroutine arguments
            integer, intent(in) :: npopsiz,verb
            integer, intent(in) :: nchrome
            integer, intent(in) :: nowrite
            real, intent(in)	:: pmutate
            integer, dimension(nchrome,npopsiz), intent(out)	:: ichild

            !! local variables
            integer :: j,k,b
            integer :: nmutate ! number of jump mutations occurred during reproduction
            real 	:: rand
            b=1
            nmutate=0
            do j=1,npopsiz
               ! jump mutation (may affect any bit in an individual)
               do k=1,nchrome
                  call ran3(b,rand)
                  if (rand <= pmutate) then
                     nmutate=nmutate+1
                     if(ichild(k,j) == 0) then
                        ichild(k,j)=1
                     else
                        ichild(k,j)=0
                     end if
                     if (nowrite == 0) write(0,1300) j,k
                     if (nowrite == 0) write(24,1300) j,k
                  end if
               end do

            end do
            if(verb.gt.5)write(0,1251) nmutate
            write(24,1251) nmutate

            !		include 'formats'
            !! formats for ga_mutation
1251        format(/'  Number of Jump Mutations  =',i5/)
1252        format(/'  Number of Creep Mutations =',i5/)
1300        format('*** Jump mutation performed on individual  ',i4, &
            &	', chromosome ',i3,' ***')
1350        format('*** Creep mutation performed on individual ',i4, &
            &	', parameter  ',i3,' ***')

            return

          end subroutine jump_mutate
	!---------------------------------------------------------------------

	!---------------------------------------------------------------------	
          subroutine creep_mutate(nparam,npopsiz,nchrome,nowrite,pcreep, &
          & ichild,child,nposibl,g0,g1,ig2,parmax,parmin,verb)
            !---------------------------------------------------------------------
            ! This subroutine performs creep mutations on the children generation.
            ! Perform random creep mutation if a random number is less than pcreep.
            !---------------------------------------------------------------------
            !! subroutine arguments
            integer, intent(in) :: nparam,verb
            integer, intent(in) :: npopsiz
            integer, intent(in) :: nchrome
            integer, intent(in) :: nowrite
            real, intent(in)	:: pcreep
            real, dimension(nparam),intent(in)					:: g0
            real, dimension(nparam),intent(in)					:: g1
            real, dimension(nparam),intent(in)					:: parmax
            real, dimension(nparam),intent(in)					:: parmin
            integer, dimension(nparam),intent(in)				:: ig2
            integer, dimension(nparam), intent(in)				:: nposibl
            real, dimension(nparam,npopsiz), intent(out)		:: child
            integer, dimension(nchrome,npopsiz), intent(out)	:: ichild

            !! local variables
            integer :: j,k,b
            integer :: ncreep ! number of creep mutations occurred during reproduction
            real 	:: rand
            real	:: creep  ! +/- 1. : indicate which direction parameter creeps

            ! creep mutation (one discrete position away). Maximum one
            ! per parameter (as oppossed to maybe one per bit in jump mutation)
            ncreep=0
            b=1
            do j=1,npopsiz
               do k=1,nparam

                  call ran3(b,rand)
                  if(rand <= pcreep) then

                     !! decode parameter to decide direction of creep
                     call decode(j,nparam,npopsiz,nchrome, &
                     &	child,ichild,g0,g1,ig2)
                     ncreep=ncreep+1

                     !! decide if creeps up or down
                     creep=1.0d0
                     b=1
                     call ran3(b,rand)
                     if (rand < 0.5d0) creep=-1.0d0

                     !! apply creep making sure that parmax and parmin
                     !! values are honored.
                     child(k,j)=child(k,j)+g1(k)*creep
                     if (child(k,j) > parmax(k)) then
                        child(k,j)=parmax(k)-1.0d0*g1(k)
                     elseif (child(k,j) < parmin(k)) then
                        child(k,j)=parmin(k)+1.0d0*g1(k)
                     end if

                     !! code new parameter back in binary
                     call code(j,k,nparam,npopsiz,nchrome, &
                     &	child,ichild,g0,g1,ig2)
                     if (nowrite == 0) write(0,1350) j,k
                     if (nowrite == 0) write(24,1350) j,k
                  end if
               end do
            end do
            if(verb.gt.5)write(0,1252) ncreep
            write(24,1252) ncreep
!		include 'formats'
            !! formats for ga_mutation
1251        format(/'  Number of Jump Mutations  =',i5/)
1252        format(/'  Number of Creep Mutations =',i5/)
1300        format('*** Jump mutation performed on individual  ',i4, &
            &	', chromosome ',i3,' ***')
1350        format('*** Creep mutation performed on individual ',i4, &
            &	', parameter  ',i3,' ***')



            return

          end subroutine creep_mutate
	!---------------------------------------------------------------------
end module ga_mutation
