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