program basis_to_flat
implicit none
integer(8),parameter::par = 500
integer(8) i,j,k,l,n,m,nb,rk,binom,non
integer(8) s(par),b(par),c(par,par),d(par),e(par,par),f(par,par,par),nf(par,par,par),g(par,par),h(par,par),sr(par)
write(*,*)'台集合の大きさn=?'
read(*,*)n
write(*,*)'与える基底の個数=?'
read(*,*)nb
write(*,*)'与える基底を記述する。'
write(*,*)'例 {1,2,4} → 1101'
do i = 1, nb
write(*,*)i,'つ目'
read(*,'(b32.32)')b(i)
enddo
rk = 0
do i = 1, n
if (iand(b(1),2**(i-1)) == 2**(i-1)) rk = rk + 1
enddo
m = 2**n
s(1) = 0
do i= 2,m
s(i) = s(i-1) + 1
end do
do i= 1,m
do j=1,nb
c(i,j) = iand(s(i),b(j))
enddo
enddo
do i=1,m
do j=1,nb
h(i,j)=0
enddo
enddo
do i=1,m
do j=1,nb
do l=1,n
if (iand(c(i,j),2**(l-1)) == 2**(l-1)) h(i,j) = h(i,j)+1
enddo
enddo
enddo
do i=1,m
sr(i)=0
enddo
do i=1,m
do j=1,nb
if (sr(i) <= h(i,j)) sr(i) = h(i,j)
enddo
enddo
non = -1
do i=1,m
d(i)= ieor(non,s(i))
end do
do i=1,m
do k=1,n
if (iand(d(i),2**(k-1)) == 2**(k-1)) e(i,k) = s(i)+2**(k-1)
if (iand(d(i),2**(k-1)) /= 2**(k-1)) e(i,k) = 0
enddo
enddo
do i = 1,m
do j=1,nb
do k=1,n
f(i,j,k) = iand(e(i,k),b(j))
enddo
enddo
enddo
do i = 1,m
do j=1,nb
do k=1,n
nf(i,j,k) = 0
enddo
enddo
enddo
do i = 1,m
do j=1,nb
do k=1,n
do l=1,n
if (iand(f(i,j,k),2**(l-1)) == 2**(l-1)) nf(i,j,k) = nf(i,j,k) + 1
enddo
enddo
enddo
enddo
do i = 1, m
do k = 1, n
g(i,k) = 0
enddo
enddo
do i=1,m
do j=1,nb
do k=1,n
if (g(i,k) <= nf(i,j,k)) g(i,k) = nf(i,j,k)
enddo
enddo
enddo
do i=1,m
do k=1,n
if (g(i,k) == sr(i)) s(i) = -1
enddo
enddo
do i = 0, rk
print'(A6,I3)','rank =',i
do j = 1, m
if ((sr(j) == i) .and. (s(j) /= -1)) print'(b8.8)',s(j)
enddo
enddo
end program basis_to_flat
function binom(n,k)
implicit none
integer(8) binom,n,k,i
if (n-k > k) k = n-k
binom = n
do i = n-1, k + 1,-1
binom = binom * i
enddo
do i = 1, n-k
binom = binom / i
enddo
end function binom