c This is a simple program to compute cycles of a 1-d map. Example here is
c the logistic map f(x)=4.5*x*(1-x). The program takes cycle length and
c initial guess as input. To try another map simply change the subroutine
c map. Freddy

      program logistic_simple
      implicit none
c max is the maximal cycle length. If you really want longer cycles just
c change max in all the subroutines.
      integer max
      parameter (max=25)

      integer q,i
      real*8 x(max),eigval

      write(*,*) 'This program finds periodic orbits of a 1-d map,'
      write(*,*) 'the example here is the logistic map f(x)=9/2 x(1-x).'
      write(*,*) 'The input is the cycle length q and an initial guess'
      write(*,*) 'for the cycle, x(i),i=1,q .'
      write(*,*) 'If you want to find a cycle with a specific symbol'
      write(*,*) 'sequence try x(i)=.2 for symb(i)=0 and x(i)=.8 for'
      write(*,*) 'symb(i)=1.'
      write(*,*)

 10   write(*,'(a,i3,x,a)') 'q? 0<q<',max,'(0 to stop)'
      read(*,*) q
      if(q.le.0.or.q.gt.max) stop

      write(*,'(a,i2,a)') 'x(i),i=1,',q,'? (0<x(i)<1)'
      read(*,*) (x(i),i=1,q)

      call cyc(q,x,eigval)

      write(*,*)
      write(*,*) 'stability eigenvalue',eigval,'for the cycle'
      write(*,*) (x(i),i=1,q)
      write(*,*)

      goto 10

      end


c cyc is the heart of the program. We solve the equations 
c f(i)=x(i)-fx(x(i-1))=0, where fx is the given map, by Newton iteration. 
c This leads to solving the linear equation df(i)/dx(j) (x'(i)-x(i)) = -f(i)
c in each step. df(i)/dx(j) is a qxq matrix with 1's in the diagonal and
c dfx/dx (x(i-1)) below the diagonal. First we eliminate the below
c diagonal elements, this leads to entries in the last column of the matrix.
c These are then eliminated. And we are done.

      subroutine cyc(q,x,eigval)
      implicit none
      integer max
      parameter (max=25)

      integer q,i,iter
      real*8 x(max),f(max),col(max),fx(max),dfx(max),err,eigval

      do iter=1,1000

c map gives (surprise!) the map fx and its derivative dfx.
         call map(q,x,fx,dfx)

c f(i) is really -f(i), but we are trying to make it 0 anyway.
         do i=1,q
            if(i.eq.1) then
               f(i)=-x(i)+fx(q)
            else
               f(i)=-x(i)+fx(i-1)
            endif
         enddo

         err=0
         do i=1,q
            err=err+abs(f(i))
         enddo
         write(*,*) 'error=',err

c Here we eliminate the subdiagonal but create entries in the q'th column
c which is here denoted col(i).
         col(1)=-dfx(q)
         do i=2,q
            col(i)=col(i-1)*dfx(i-1)
            f(i)=f(i)+f(i-1)*dfx(i-1)
         enddo

c eliminate the q'th element in the digonal
         f(q)=f(q)/(1+col(q))

c eliminate the rest of the q'the column
         do i=1,q-1
            f(i)=f(i)-f(q)*col(i)
         enddo

c Voila!, new estimate of the cycle
         do i=1,q
            x(i)=x(i)+f(i)
         enddo

c is the error low enough?
         if(err.lt.1.d-14) then
            eigval=-col(q)
            return
         endif
      enddo

      write(*,*) 'Ups, cycle not found. We write it out anyway:'

      return
      end


c The map fx and the derivative dfx. Example here is the logistic map
c f(x)=rx(1-x), r=9/2
c No problem to change this routine to try other maps.
      subroutine map(q,x,fx,dfx)
      implicit none
      integer max
      parameter (max=25)

      integer q,i
      real*8 x(max),fx(max),dfx(max),r

      r=4.5d0

      do i=1,q
         fx(i)=r*x(i)*(1-x(i))
         dfx(i)=r*(1-2*x(i))
      enddo

      return
      end
