３次対称群の行列表現をヤング対称子を用いて計算します。
D.E.Littlewood の The Theory of Group Characters and Matrix Representations of Groups の Chap.5 に依って求めます。この本は記号の定義などが現代のものと逆さになっていたり色々トラップが多いのですが、できるだけ今風の定義を用いることにします。
ヤング対称子による対称群の行列表現は４次くらいまでならば手計算で求められますが、対称操作の数が階乗で増えてゆくので、５次から先は手計算でやる気になれません。一方で５次の場合から、ヤング対称子で作った基底が直交しなくなる場合が出るので、特別な直交化操作が必要になります。それは Littlewood の本に書いてありますが、実際の計算で確認するに計算機の力を借りることになります。
一応３，４，５次までプログラムを作って、力づくで行列表現を求めてみました。
３次対称群に対して、プログラムを整理し直して、演算子 overload や構造体の user defined I/O ルーチンを用いてすっきりさせたのでのせておきます。
実行結果
ヤング図で表される各既約表現（基底は標準ヤング盤に対応するヤング対称子で求められる）とそれに対応する演算子、そして各対称操作に対応する行列表現を列挙しています。
STY [3] +I +(12) +(13) +(23) +(123) +(132) I^-1 1 (12)^-1 1 (13)^-1 1 (23)^-1 1 (123)^-1 1 (132)^-1 1 STY [21] irow = 1 +I -(13) +(12) -(132) +(23) -(132) +(123) -(13) irow = 2 +(23) -(123) +(132) -(12) +I -(12) +(13) -(123) I^-1 1 0 0 1 (12)^-1 1 -1 0 -1 (13)^-1 -1 0 -1 1 (23)^-1 0 1 1 0 (123)^-1 0 -1 1 -1 (132)^-1 -1 1 -1 0 STY [1^3] +I -(12) -(13) -(23) +(123) +(132) I^-1 1 (12)^-1 -1 (13)^-1 -1 (23)^-1 -1 (123)^-1 1 (132)^-1 1
ソース・プログラム
Fortran2003 セマンティクス を有効にする必要があります。
module m_sub implicit none type :: t_Sn integer :: itab(3) ! ! parameteric type character(len = :), allocatable :: label end type type(t_Sn), allocatable, protected :: sn(:) integer, allocatable, protected :: mul_tbl(:, :) type :: t_Sn_list integer, allocatable :: list(:) contains procedure :: prsn generic :: write(formatted) => prsn end type t_Sn_list type :: t_Sn_labels character(:), allocatable :: label(:) end type t_Sn_labels type(t_Sn_list), protected, allocatable :: sig3(:, :) type(t_Sn_list), protected, allocatable :: sig21(:, :) type(t_Sn_list), protected, allocatable :: sig111(:, :) interface operator (*) module procedure :: mul, mul_list end interface interface assignment (=) module procedure :: text_to_Sn_list, texts_to_Sn_lists_1D, texts_to_Sn_lists_2D end interface contains subroutine init_Sn() integer :: i, j, n type(t_Sn) :: s n = factorial(3) allocate( sn(n) ) sn(1) = t_Sn([1, 2, 3], 'I') sn(2) = t_Sn([2, 1, 3], '(12)') sn(3) = t_Sn([3, 2, 1], '(13)') sn(4) = t_Sn([1, 3, 2], '(23)') sn(5) = t_Sn([2, 3, 1], '(123)') sn(6) = t_Sn([3, 1, 2], '(132)') ! allocate( mul_tbl(n, n) ) do i = 1, n do j = 1, n s = sn(i) * sn(j) mul_tbl(i, j) = search(s) end do end do ! sig3 = reshape(['I'], [1, 1]) sig21 = reshape(['I', '(23)', '(23)', 'I'], [2, 2]) sig111 = reshape(['I'], [1, 1]) return contains integer function factorial(n) integer :: i, n factorial = product([1:n])![(i, i = 1, n)]) ! non-standard return end function factorial end subroutine init_Sn pure elemental type(t_Sn) function mul(s1, s2) type(t_Sn), intent(in) :: s1, s2 mul%itab = s1%itab(s2%itab) mul%label = trim(s1%label) // trim(s2%label) return end function mul type(t_Sn_list) function mul_list(s1, s2) type(t_Sn_list), intent(in) :: s1, s2 integer :: i, j, k allocate( mul_list%list( size(s1%list) * size(s2%list) ) ) k = 0 do i = 1, size(s1%list) do j = 1, size(s2%list) k = k + 1 mul_list%list(k) = isign(1, s1%list(i) * s2%list(j)) * mul_tbl(abs(s1%list(i)), abs(s2%list(j))) end do end do return end function mul_list pure elemental integer function search(s) ! findloc type(t_Sn), intent(in) :: s do search = 1, size(sn) if (all(s%itab == sn(search)%itab)) exit end do return end function search pure elemental integer function search_label(label) character(len = *), intent(in) :: label if (label(1:1) == '+') then search_label = +search2(label(2:)) else if (label(1:1) == '-') then search_label = -search2(label(2:)) else search_label = search2(label) end if end function search_label pure elemental integer function search2(label) character(len = *), intent(in) :: label do search2 = 1, size(sn) if ( trim(sn(search2)%label) == adjustl(trim(label)) ) exit end do ! if (search2 == 7) print *, '***** Caution: label not found! *****' return end function search2 pure elemental function parse(text) result(res) character(len = *), intent(in) :: text type(t_Sn_labels) :: res character(len = 1), allocatable :: tmp(:) character(len = :), allocatable :: buf integer :: k, ip tmp = transfer(text, ' ', size = len(text)) tmp = pack(tmp, tmp /= ' ') buf = transfer(tmp, repeat(' ', size(tmp))) res%label = [character::] ip = 1 do k = scan(buf(ip + 1:), '+-') if (k == 0) exit res%label = [res%label, buf(ip:ip + k - 1)] ip = ip + k end do res%label = [res%label, buf(ip:)] return end function parse pure elemental subroutine text_to_Sn_list(snlst, text) type(t_Sn_list), intent(out) :: snlst character(len = *), intent(in) :: text type(t_Sn_labels) :: tmp tmp = parse(text) snlst%list = search_label(tmp%label) return end subroutine text_to_Sn_list pure subroutine texts_to_Sn_lists_1D(snlst, text) type(t_Sn_list), allocatable, intent(out) :: snlst(:) character(len = *), intent(in) :: text(:) type(t_Sn_labels) :: tmp integer :: i allocate(snlst(size(text))) do i = 1, size(text) tmp = parse(text(i)) snlst(i)%list = search_label(tmp%label) end do return end subroutine texts_to_Sn_lists_1D pure subroutine texts_to_Sn_lists_2D(snlst, text) type(t_Sn_list), allocatable, intent(out) :: snlst(:, :) character(len = *), intent(in) :: text(:, :) type(t_Sn_labels) :: tmp integer :: i, j allocate( snlst(size(text, 1), size(text, 1)) ) do i = 1, size(text, 1) do j = 1, size(text, 1) tmp = parse(text(i, j)) snlst(i, j)%list = search_label(tmp%label) end do end do return end subroutine texts_to_Sn_lists_2D subroutine prsn(ss, unit, iotype, vlist, iostat, iomsg) class(t_Sn_list) , intent(in) :: ss integer , intent(in) :: unit character (len = *), intent(in) :: iotype integer , intent(in) :: vlist(:) integer , intent(out) :: iostat character (len = *), intent(inout) :: iomsg integer :: i character(len = 2) :: sgn do i = 1, size(ss%list) write(sgn, '(sp, i2)') ss%list(i) write(unit, '(*(a1, a, 1x))', advance = 'no', iostat = iostat) sgn, trim(sn(abs(ss%list(i)))%label) end do write(*, *) return end subroutine prsn subroutine pr_mat(matrix) type(t_Sn_list), intent(in) :: matrix(:, :) integer :: k, m, irow, icol do k = 1, size(sn) print *, trim(sn(k)%label), '^-1' do icol = 1, size(matrix, 2) do irow = 1, size(matrix, 1) m = count( k == abs(matrix(irow, icol)%list) ) if ( m == count( k == matrix(irow, icol)%list) ) then write(*, '(ss, i3)', advance = 'no') +m else if ( m == count( k == -matrix(irow, icol)%list) ) then write(*, '(sp, i3)', advance = 'no') -m else write(*, '(ss, i3)', advance = 'no') 0 end if end do print * end do end do return end subroutine pr_mat end module m_sub program sna use m_sub implicit none type(t_Sn_list), allocatable :: p3(:), n3(:) type(t_Sn_list), allocatable :: p21(:), n21(:) type(t_Sn_list), allocatable :: p111(:), n111(:) integer :: irow, icol type(t_Sn_list), allocatable :: matrix(:, :) call init_Sn() p3 = ['I + (12) + (13) + (23) + (123) + (132)'] ! [1, 2, 3, 4, 5, 6] n3 = ['I'] ! [1] p21 = ['I + (12)', 'I + (13)'] ! [[1, 2], [1, 3]] n21 = ['I - (13)', 'I - (12)'] ! [[1, -3], [1, -2]] p111 = ['I'] ! [1] n111 = ['I - (12) - (13) - (23) + (123) + (132)'] ! [1, -2, -3, -4, 5, 6] print '(/, a)', 'STY [3]' allocate(matrix(1, 1)) matrix = p3(1) * sig3(1, 1) * n3(1) write(*, *) matrix(1, 1) call pr_mat(matrix) deallocate(matrix) ! print '(/, a)', 'STY [21]' allocate(matrix(2, 2)) do irow = 1, size(sig21, 1) print *, 'irow =', irow do icol = 1, size(sig21, 2) matrix(irow, icol) = p21(irow) * sig21(irow, icol) * n21(icol) write(*, *) matrix(irow, icol) end do end do call pr_mat(matrix) deallocate(matrix) ! print '(/, a)', 'STY [1^3]' allocate(matrix(1, 1)) matrix(1, 1) = p111(1) * sig111(1, 1) * n111(1) write(*, *) matrix(1, 1) call pr_mat(matrix) deallocate(matrix) ! stop end program sna
