c RSA4.f c Jun 06 2008 Latt 100 p 95 c Given n, study number of even (i) and odd (j) exponents in its c binary representation implicit integer(a-z) integer*1 na(1000) integer ni(0:20000),nj(0:20000) integer miltj(5000),milej(5000),mieqj(5000) integer migej(5000),migtj(5000) M=3000 len=20 niltj=0 nilej=0 nieqj=0 nigej=0 nigtj=0 do 10 n=0,M i=0 j=0 call binexp(n,na,len,nwt) do 20 k=1,len/2 i=i+na(2*k-1) j=j+na(2*k) 20 continue ni(n)=i nj(n)=j c write(*,102)n,i,j if(i.eq.j)goto 30 if(i.lt.j)goto 31 if(i.gt.j)goto 32 30 continue nieqj=nieqj+1 mieqj(nieqj)=n nilej=nilej+1 milej(nilej)=n nigej=nigej+1 migej(nigej)=n goto 10 31 continue niltj=niltj+1 miltj(niltj)=n nilej=nilej+1 milej(nilej)=n goto 10 32 continue nigtj=nigtj+1 migtj(nigtj)=n nigej=nigej+1 migej(nigej)=n goto 10 10 continue 300 continue 98 format(60i1) 99 format(6i4) 100 format(60i1) 102 format(16i4) 103 format(10i6) 104 format(3i12) 1002 format(12(i5,1h,)) write(*,*)"i" write(*,102)(ni(n),n=0,M) write(*,*)"j" write(*,102)(nj(n),n=0,M) c Binary weight: A000720 c write(*,*)"i+j" c write(*,102)(ni(n)+nj(n),n=0,M) write(*,*)"i*j" write(*,102)(ni(n)*nj(n),n=0,M) write(*,*)"min(i,j)" write(*,102)(min(ni(n),nj(n)),n=0,M) write(*,*)"max(i,j)" write(*,102)(max(ni(n),nj(n)),n=0,M) c write(*,*)"i <j" write(*,103)(miltj(i),i=1,niltj) write(*,*)"i <=j" write(*,103)(milej(i),i=1,nilej) write(*,*)"i =j" write(*,103)(mieqj(i),i=1,nieqj) write(*,*)"i >=j" write(*,103)(migej(i),i=1,nigej) write(*,*)"i >j" write(*,103)(migtj(i),i=1,nigtj) cc test ischild c n=9 c len=20 c call binexp(n,na,len,nwt) c do 2 i=0,16 c call binexp(i,ni,len,nwt) c call ischild(na,len,ni,len,j) c write(*,99)n,i,j c2 continue cc test bin expansion c do 1 n=0,8 c len=8 c call binexp(n,na,len,nwt) c write(*,*)"n = ",n c write(*,98)(na(iii),iii=1,len) c write(*,*)"nwt = ", nwt c1 continue stop end c is k a child of n? c if so also return the Hamming distance as nwt subroutine ischild(na,lenn,nk,lenk,nwt) implicit integer(a-z) integer*1 na(1000),nk(1000) l=min(lenn,lenk) nwt=0 do 10 i=1,l if(na(i).eq.0.and.nk(i).eq.0)goto 10 if(na(i).eq.1.and.nk(i).eq.0)goto 100 if(na(i).eq.0.and.nk(i).eq.1)goto 101 if(na(i).eq.1.and.nk(i).eq.1)goto 10 101 continue nwt=-1 goto 20 100 continue nwt=nwt+1 10 continue if(l.eq.lenn)return do 30 i=l+1,lenn nwt=nwt+na(i) 30 continue 20 continue return end c get bin expansion of number c also returns the weight as nwt subroutine binexp(n,na,len,nwt) c n = input c na = array for bin expansion c len = dim of na c nwt = binary wt of n integer*1 na(1000) nwt=0 do 10 i=1,len 10 na(i)=0 i1=n do 20 i=1,len c temp c write(*,*)"i1 = ",i1 c temp c write(*,100)(na(iii),iii=1,len) if(i1.eq.0)RETURN j=mod(i1,2) i1=(i1-j)/2 nwt=nwt+j na(i)=j 20 continue if(i1.ne.0)write(*,*)"ERROR in binexp at n = ",n RETURN 100 format(60i1) 99 format(6i4) end