c This is a program that finds all cycles of a 1-d map of lengths q1-q2.
c It writes the result in the file cycles.dat in the form:

c cycle length, symbol sequence
c stability eigenvalue
c cycle points

c The program is in essence the same as logistic_simple.f, but has some
c code to produce the symbol sequences for all cycles (and only one
c representative for each cycle. 
c The example here is the logistic map f=rx(1-x), r=9/2. You can change the
c map in the subroutine map, but you may also have to change the initial
c guesses that the program produces and the check for correct symbol sequence.
c If you use a map with more than binary symbolic dynamics you will also
c have to change the relevant pieces of the program. If you understand the
c program this is of course no problem.


      program logistic_total
      implicit none

c max is the maximal cycle length. You do NOT need to have all cycles
c of any length higher than 25. (of length 25 there are already 1.342.176
c cycles.)
      integer max
      parameter (max=25)
      integer q,q1,q2,nq,bit(max),i,j,k

      open(1,file='cycles.dat',status='unknown')

      write(*,*) 'minimal and maximal cycle length, 0<q1<=q2<=25'
      read(*,*) q1,q2

      do q=q1,q2
         nq=0

c cycle length 1 is a little special when it comes to the symbol sequences
         if(q.eq.1) then
            bit(1)=0
            call cyc(q,bit,nq)
            bit(1)=1
            call cyc(q,bit,nq)
         else

c finding one representative of all prime sequences of length q
c by representing the symbol sequence as an integer i between 0 and
c 2**q-1. Think of i as a binary number.
c first symbol always a '1' therefore check only odd numbers
c last symbol always a '0' therefore check only up to 2**(q-1)-1

            do i=1,2**(q-1)-1,2
               k=i
               do j=1,q-1
c make a rotation of the bits
                  k=k/2+(k-2*(k/2))*2**(q-1)
c do we have the lexicografic lowest (.lt.) symbol sequence and 
c is it prime (.eq.)
                  if(k.le.i) goto 10
               enddo

c make the actual symbol sequence
               bit(1)=1
               bit(q)=0
               k=i/2
               do j=2,q-1
                  bit(j)=k-2*(k/2)
                  k=k/2
               enddo
               call cyc(q,bit,nq)
 10         enddo
         endif
         write(*,*) 'found',nq,' cycles of length',q
      enddo
      end


c cyc is the haert 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,bit,nq)
      implicit none
      integer max
      parameter (max=25)

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

c NB NB NB: Here I put in an initial guess according to the symbol sequence
c but this is specific for the logistic map above r=4. It may need other
c values for other maps and for pruned maps it is altogether a bad idea
c to make initial guesses like this. An inverse iteration according to
c symbol sequence is much safer.
      do i=1,q
         if(bit(i).eq.0) then
            x(i)=.2
         else
            x(i)=.8
         endif
      enddo

      do iter=1,1000

c map returns the map fx and the derivative dfx
         call map(q,bit,x,fx,dfx)

         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

c eliminating the subdiagonal
         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 eliminating the q'th element of the diagonal
         f(q)=f(q)/(1+col(q))

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

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

c do we have a winner
         if(err.lt.1.d-14) goto 20
      enddo

      write(*,*) 'Ups! Newton iteration did not converge for'
      write(*,'(a,1x,25i2)') ' the cycle',(bit(i),i=1,q)
      return

c does the cycle correspond to the symbol sequence?
 20   do i=1,q
         if((x(i)-.5)*(bit(i)-.5).lt.0) then
            write(*,*) 'Ups! Cycle does not correspond to the'
            write(*,'(a,1x,25i2)') ' symbol sequence',(bit(j),j=1,q)
            return
         endif
      enddo

      write(1,'(i3,3x,25i1)') q,(bit(i),i=1,q)
      write(1,*) -col(q)
      write(1,*)
      do i=1,q
         write(1,*) x(i)
      enddo
      write(1,*)

      nq=nq+1

      return
      end

      subroutine map(q,bit,x,fx,dfx)
      implicit none
      integer max
      parameter (max=25)

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

c Map is here the logistic map. Ok to change this, but be careful to
c change initial guesses and check for correct symbol sequence.

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

