c laces5.f
c counts shoe-lacings with no adjacent triple i, i+1, i+2 or
c i i-1 i-2 mod n
c and with the lace going between the top two eyelets
c Produces A078602, A078675, A078676
c
c Compile with
c laces5: laces5.f
c         f90 -static -o laces5 laces5.f
c 
	implicit integer(a-z)
      	integer a(40),b(40)
      	logical mtc,even
	do 3 t=2,6
	ntrue=2*t
      	n=ntrue-2
	a(1)=1
	a(ntrue)=2*t
	a(ntrue+1)=1
      	mtc=.false.
	ntot=0
	nsym=0
 10   	continue
      	call nexper(n,b,mtc,even)
	do 30 i=1,n
30	a(i+1)=b(i)+1
	a(ntrue+2)=a(2)
c temp
c	write(*,99)(a(i),i=1,ntrue+2)
99	format("a ",20i4)
	do 2 i=1,ntrue
	if(a(i).ne.a(i+1)-1)goto 5
	if(a(i).ne.a(i+2)-2)goto 5
c now have increasing run of 3, a(i),a(i+1),a(i+2)
c reject if is it in lower half of range - L side of shoe
	if(a(i+2).le.t)goto 1
c reject if is it in upper half of range - R side of shoe
	if(a(i).ge.t+1)goto 1
5	continue
	if(a(i).ne.a(i+1)+1)goto 6
	if(a(i).ne.a(i+2)+2)goto 6
c now have decreasing run of 3, a(i),a(i+1),a(i+2)
c reject if is it in lower half of range - L side of shoe
	if(a(i).le.t)goto 1
c reject if is it in upper half of range - R side of shoe
	if(a(i).ge.t+3)goto 1
6	continue
2	continue
c now have a legal arrangement
c is it symmetric?
	do 31 i=1,t
	if(a(i).ne.ntrue+1-a(ntrue+1-i))goto 32
31	continue
c yes symm
	nsym=nsym+1
32	continue
	ntot=ntot+1
c      	write(06,100)(a(i),i=1,n),ntrue
1	continue
 100  	format(16i4)
      	if(mtc)goto 10
	nineq=(ntot+nsym)/2
	write(*,4)ntrue,ntot,nsym,nineq
4	format(" ntrue,ntot,nsym,nineq. = : ",i4,3i12)
3	continue
      	write(06,*)"all done"
      	stop
      	end
      subroutine nexper(n,a,mtc,even)
c next permutation of {1,...,n}. Ref NW p 59.
      integer a(n),s,d
      logical mtc,even
      if(mtc)goto 10
      nm3=n-3
      do 1 i=1,n
    1 a(i)=i
      mtc=.true.
    5 even=.true.
      if(n.eq.1)goto 8
    6 if(a(n).ne.1.or.a(1).ne.2+mod(n,2))return
      if(n.le.3)goto 8
      do 7 i=1,nm3
      if(a(i+1).ne.a(i)+1)return
    7 continue
    8 mtc=.false.
      return
   10 if(n.eq.1)goto 27
      if(.not.even)goto 20
      ia=a(1)
      a(1)=a(2)
      a(2)=ia
      even=.false.
      goto 6
   20 s=0
      do 26 i1=2,n
   25 ia=a(i1)
      i=i1-1
      d=0
      do 30 j=1,i
   30 if(a(j).gt.ia) d=d+1
      s=d+s
      if(d.ne.i*mod(s,2)) goto 35
   26 continue
   27 a(1)=0
      goto 8
   35 m=mod(s+1,2)*(n+1)
      do 40 j=1,i
      if(isign(1,a(j)-ia).eq.isign(1,a(j)-m))goto 40
      m=a(j)
      l=j
   40 continue
      a(l)=ia
      a(i1)=m
      even=.true.
      return
      end