diff --git a/shuffle.f90 b/shuffle.f90 index 195a042695abde77c6af69d46ebe41ce69dbe6bc..ca61c9f05e8450dafe4f776c8616b5519b4bdaa5 100644 --- a/shuffle.f90 +++ b/shuffle.f90 @@ -1,14 +1,16 @@ MODULE shuffle use globals + use utils implicit none CONTAINS FUNCTION append_to_each_row(a, m) result(res) ! appends element a to each row of m - integer :: a, m(:,:), i - integer :: res(size(m,1),size(m,2)+1) + complex(kind=prec) :: a, m(:,:) + integer :: i + complex(kind=prec) :: res(size(m,1),size(m,2)+1) do i=1,size(m,1) res(i,:) = [a,m(i,:)] end do @@ -16,31 +18,25 @@ CONTAINS FUNCTION stack_matrices_vertically(m1, m2) result(res) ! appends to matrix m1 the rows of matrix m2 - integer :: m1(:,:), m2(:,:) - integer :: res(size(m1,1)+size(m2,1), size(m1,2)) + complex(kind=prec) :: m1(:,:), m2(:,:) + complex(kind=prec) :: res(size(m1,1)+size(m2,1), size(m1,2)) res(1:size(m1,1), :) = m1 res(size(m1,1)+1:size(res,1),:) = m2 END FUNCTION stack_matrices_vertically - - RECURSIVE FUNCTION factorial(n) result(res) - integer, intent(in) :: n - integer :: res - res = merge(1,n*factorial(n-1),n==0) - END FUNCTION factorial RECURSIVE FUNCTION shuffle_product(v1, v2) result(res) - integer :: v1(:), v2(:) + complex(kind=prec) :: v1(:), v2(:) integer :: i - integer :: res(product((/(i,i=1,size(v1)+size(v2))/))/ & + complex(kind=prec) :: res(product((/(i,i=1,size(v1)+size(v2))/))/ & (product((/(i,i=1,size(v1))/))*product((/(i,i=1,size(v2))/))), & size(v1) + size(v2)) - integer :: p1(product((/(i,i=1,size(v1)+size(v2)-1)/))/ & + complex(kind=prec) :: p1(product((/(i,i=1,size(v1)+size(v2)-1)/))/ & (product((/(i,i=1,size(v1)-1)/))*product((/(i,i=1,size(v2))/))), & size(v1) + size(v2) - 1) - integer :: p2(product((/(i,i=1,size(v1)+size(v2)-1)/))/ & + complex(kind=prec) :: p2(product((/(i,i=1,size(v1)+size(v2)-1)/))/ & (product((/(i,i=1,size(v1))/))*product((/(i,i=1,size(v2)-1)/))), & size(v1) + size(v2) - 1) - integer :: alpha, beta, w1(size(v1)-1), w2(size(v2)-1) + complex(kind=prec) :: alpha, beta, w1(size(v1)-1), w2(size(v2)-1) res = 0 if(size(v1) == 0) then @@ -59,22 +55,23 @@ CONTAINS res = stack_matrices_vertically( & append_to_each_row(alpha, shuffle_product(w1, v2)), & append_to_each_row(beta, shuffle_product(v1, w2)) ) + END FUNCTION shuffle_product END MODULE shuffle -! PROGRAM test -! use shuffle_algebra -! implicit none +PROGRAM test + use utils + use shuffle + implicit none -! integer :: v1(3), v2(3) -! integer :: amount_shuffles -! integer :: res(3,3) + complex(kind=prec) :: v1(3), v2(2) + integer :: amount_shuffles -! v1 = (/1,2,3/) -! v2 = (/-1,-2,-3/) + v1 = cmplx((/1,2,3/)) + v2 = cmplx((/4,5/)) -! call print_as_matrix(shuffle_product(v1, v2)) + call print_matrix(shuffle_product(v1,v2)) -! END PROGRAM test +END PROGRAM test diff --git a/utils.f90 b/utils.f90 index 8fd2dccbd30a17e26a3dcd0b2de7fba2c62ba7d9..96eb8c6ee8fc844cff1a8f3fc7304a329d1c3ea6 100644 --- a/utils.f90 +++ b/utils.f90 @@ -8,26 +8,12 @@ MODULE utils use globals implicit none + ! logical :: print_enabled = .true. ! logical :: warnings_enabled = .true. - INTERFACE print_matrix - ! prints 2d array as matrix. For complex it takes absolutes - - SUBROUTINE print_integer_matrix(m) - integer :: m(:,:) - integer :: s(2) - END SUBROUTINE print_integer_matrix - - SUBROUTINE print_complex_matrix(m) - complex :: m(:,:) - integer :: s(2) - END SUBROUTINE print_complex_matrix - - END INTERFACE print_matrix - CONTAINS - + FUNCTION get_condensed_m(z) result(m) ! returns condensed m where the ones not needed are filled with 0 complex(kind=prec), intent(in) :: z(:) @@ -101,6 +87,12 @@ CONTAINS complex(kind=prec) :: res(n) res = 0 END FUNCTION zero_array + + RECURSIVE FUNCTION factorial(n) result(res) + integer, intent(in) :: n + integer :: res + res = merge(1,n*factorial(n-1),n==0) + END FUNCTION factorial FUNCTION shuffle_with_zero(a) result(res) ! rows of result are shuffles of a with 0 @@ -118,6 +110,15 @@ CONTAINS end do END FUNCTION shuffle_with_zero + SUBROUTINE print_matrix(m) + complex(kind=prec) :: m(:,:) + integer :: s(2), i + s = shape(m) + do i = 1,s(1) + print*, abs(m(i,:)) + end do + END SUBROUTINE print_matrix + ! subroutine print(s1,s2,s3,s4,s5) ! character(len = *), intent(in), optional :: s1, s2, s3, s4, s5 ! if(print_enabled) then @@ -135,24 +136,6 @@ CONTAINS END MODULE utils -SUBROUTINE print_integer_matrix(m) - integer :: m(:,:) - integer :: s(2), i - s = shape(m) - do i = 1,s(1) - print*, m(i,:) - end do -END SUBROUTINE print_integer_matrix - -SUBROUTINE print_complex_matrix(m) - complex :: m(:,:) - integer :: s(2), i - s = shape(m) - do i = 1,s(1) - print*, abs(m(i,:)) - end do -END SUBROUTINE print_complex_matrix - ! PROGRAM test ! use utils ! implicit none @@ -172,5 +155,4 @@ END SUBROUTINE print_complex_matrix ! condensed_size = find_first_zero(m_prime)-1 ! end if ! print*, condensed_size - ! END PROGRAM test