c laces2.f
c counts cycles with no adjacent triple i, i+1, i+2 or
c i i-1 i-2 mod n
c Ref. Latt 91 p 110
c Produces A078628
c compile with
c laces2: laces2.f
c         f90 -static -o laces2 laces2.f
c
      integer a(40)
      logical mtc,even
	do 3 ntrue=4,10
      	n=ntrue-1
      	mtc=.false.
	ntot=0
 10   continue
      call nexper(n,a,mtc,even)
	if(a(1).eq.1.and.a(2).eq.2)goto 1
	if(a(1).eq.n.and.a(2).eq.n-1)goto 1
	if(a(1).eq.1.and.a(n).eq.n)goto 1
	if(a(1).eq.n.and.a(n).eq.1)goto 1
	if(a(n-1).eq.2.and.a(n).eq.1)goto 1
	if(a(n-1).eq.n-1.and.a(n).eq.n)goto 1
	do 2 i=1,n-2
	if(a(i).eq.a(i+1)-1.and.a(i).eq.a(i+2)-2)goto 1
	if(a(i).eq.a(i+1)+1.and.a(i).eq.a(i+2)+2)goto 1
2	continue
	ntot=ntot+1
c      	write(06,100)ntrue,(a(i),i=1,n)
1	continue
 100  format(16i4)
      if(mtc)goto 10
	write(*,4)ntrue,ntot
4	format(" Ans.: ",i4,i12)
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