ソース・プログラム
適当に作り始めたので、無駄が多いと思います。これから直してゆきたいです。メモ帳代わりに。 2012-7-25 異常値が入力された時に動作がおかしくなるので、少し修正しました。結果そのものは変わりません。
module m_Murnaghan_Nakayama
implicit none
contains
recursive integer function ichi(lambda, rho)
integer, intent(in) :: lambda(:), rho(:)
integer, allocatable :: lam(:)
integer :: isgn
ichi = 0
if ( size(lambda) /= 0 .and. sum(lambda) == sum(rho) ) then
call standardize(lambda, isgn, lam)
if (isgn /= 0) ichi = isgn * ichi0(lam, rho)
end if
return
end function ichi
recursive integer function ichi0(lambda, rho)
integer, intent(in) :: lambda(:), rho(:)
integer :: i, lam(size(lambda))
if ( lambda(1) == 0 ) then
ichi0 = 1
else
ichi0 = 0
do i = 1, size(lambda)
lam = lambda
lam(i) = lam(i) - rho(1)
ichi0 = ichi0 + ichi(lam, rho(2:))
end do
end if
return
end function ichi0
recursive subroutine standardize(lambda, isgn, lam)
integer, intent(in) :: lambda(:)
integer, intent(out) :: isgn
integer, intent(out), allocatable :: lam(:)
integer, allocatable :: l(:)
integer :: i, k
logical :: no_swap
isgn = 1
lam = lambda
outer: do
no_swap = .true.
do k = size(lam), 2, -1
if (lam(k) /= 0) exit
end do
l = lam(:k)
if ( l(k) < 0 .or. any(l(2:) == l(1:) + 1) ) then
lam = [integer::]
isgn = 0
return
end if
lam = l
do i = 1, k - 1
if ( l(i) < l(i + 1) ) then
lam(i) = l(i + 1) - 1
lam(i + 1) = l(i) + 1
isgn = -isgn
no_swap = .false.
end if
end do
if (no_swap) exit
end do outer
return
end subroutine standardize
end module m_Murnaghan_Nakayama
program MN
use m_Murnaghan_Nakayama
implicit none
integer, allocatable :: lambda(:), rho(:)
rho = [1,1,1,1,1,1]
lambda = [6]
print *, ichi(lambda, rho)
lambda = [5,1]
print *, ichi(lambda, rho)
lambda = [4,2]
print *, ichi(lambda, rho)
lambda = [4,1,1]
print *, ichi(lambda, rho)
lambda = [3,3]
print *, ichi(lambda, rho)
lambda = [3,2,1]
print *, ichi(lambda, rho)
lambda = [2,2,2]
print *, ichi(lambda, rho)
lambda = [3,1,1,1]
print *, ichi(lambda, rho)
lambda = [2,2,1,1]
print *, ichi(lambda, rho)
lambda = [2,1,1,1,1]
print *, ichi(lambda, rho)
lambda = [1,1,1,1,1,1]
print *, ichi(lambda, rho)
stop
rho = [1,1,1,1,1]
rho = [1,1,1,2]
rho = [1,1,3]
rho = [1,4]
rho = [1,2,2]
rho = [2,3]
rho = [5]
lambda = [5]
print *, ichi(lambda, rho)
lambda = [4,1]
print *, ichi(lambda, rho)
lambda = [3,2]
print *, ichi(lambda, rho)
lambda = [3,1,1]
print *, ichi(lambda, rho)
lambda = [2,2,1]
print *, ichi(lambda, rho)
lambda = [2,1,1,1]
print *, ichi(lambda, rho)
lambda = [1,1,1,1,1]
print *, ichi(lambda, rho)
stop
rho = [2,2]
lambda = [4]
print *, ichi(lambda, rho)
lambda = [3,1]
print *, ichi(lambda, rho)
lambda = [2,2]
print *, ichi(lambda, rho)
lambda = [2,1,1]
print *, ichi(lambda, rho)
lambda = [1,1,1,1]
print *, ichi(lambda, rho)
stop
end program MN