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