Commit f3cf3006 authored by Luca's avatar Luca

shuffle complex vectors

parent b408c492
MODULE shuffle MODULE shuffle
use globals use globals
use utils
implicit none implicit none
CONTAINS CONTAINS
FUNCTION append_to_each_row(a, m) result(res) FUNCTION append_to_each_row(a, m) result(res)
! appends element a to each row of m ! appends element a to each row of m
integer :: a, m(:,:), i complex(kind=prec) :: a, m(:,:)
integer :: res(size(m,1),size(m,2)+1) integer :: i
complex(kind=prec) :: res(size(m,1),size(m,2)+1)
do i=1,size(m,1) do i=1,size(m,1)
res(i,:) = [a,m(i,:)] res(i,:) = [a,m(i,:)]
end do end do
...@@ -16,31 +18,25 @@ CONTAINS ...@@ -16,31 +18,25 @@ CONTAINS
FUNCTION stack_matrices_vertically(m1, m2) result(res) FUNCTION stack_matrices_vertically(m1, m2) result(res)
! appends to matrix m1 the rows of matrix m2 ! appends to matrix m1 the rows of matrix m2
integer :: m1(:,:), m2(:,:) complex(kind=prec) :: m1(:,:), m2(:,:)
integer :: res(size(m1,1)+size(m2,1), size(m1,2)) complex(kind=prec) :: res(size(m1,1)+size(m2,1), size(m1,2))
res(1:size(m1,1), :) = m1 res(1:size(m1,1), :) = m1
res(size(m1,1)+1:size(res,1),:) = m2 res(size(m1,1)+1:size(res,1),:) = m2
END FUNCTION stack_matrices_vertically 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) RECURSIVE FUNCTION shuffle_product(v1, v2) result(res)
integer :: v1(:), v2(:) complex(kind=prec) :: v1(:), v2(:)
integer :: i 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))/))), & (product((/(i,i=1,size(v1))/))*product((/(i,i=1,size(v2))/))), &
size(v1) + 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))/))), & (product((/(i,i=1,size(v1)-1)/))*product((/(i,i=1,size(v2))/))), &
size(v1) + size(v2) - 1) 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)/))), & (product((/(i,i=1,size(v1))/))*product((/(i,i=1,size(v2)-1)/))), &
size(v1) + 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 res = 0
if(size(v1) == 0) then if(size(v1) == 0) then
...@@ -59,22 +55,23 @@ CONTAINS ...@@ -59,22 +55,23 @@ CONTAINS
res = stack_matrices_vertically( & res = stack_matrices_vertically( &
append_to_each_row(alpha, shuffle_product(w1, v2)), & append_to_each_row(alpha, shuffle_product(w1, v2)), &
append_to_each_row(beta, shuffle_product(v1, w2)) ) append_to_each_row(beta, shuffle_product(v1, w2)) )
END FUNCTION shuffle_product END FUNCTION shuffle_product
END MODULE shuffle END MODULE shuffle
! PROGRAM test PROGRAM test
! use shuffle_algebra use utils
! implicit none use shuffle
implicit none
! integer :: v1(3), v2(3) complex(kind=prec) :: v1(3), v2(2)
! integer :: amount_shuffles integer :: amount_shuffles
! integer :: res(3,3)
! v1 = (/1,2,3/) v1 = cmplx((/1,2,3/))
! v2 = (/-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
...@@ -8,26 +8,12 @@ ...@@ -8,26 +8,12 @@
MODULE utils MODULE utils
use globals use globals
implicit none implicit none
! logical :: print_enabled = .true. ! logical :: print_enabled = .true.
! logical :: warnings_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 CONTAINS
FUNCTION get_condensed_m(z) result(m) FUNCTION get_condensed_m(z) result(m)
! returns condensed m where the ones not needed are filled with 0 ! returns condensed m where the ones not needed are filled with 0
complex(kind=prec), intent(in) :: z(:) complex(kind=prec), intent(in) :: z(:)
...@@ -101,6 +87,12 @@ CONTAINS ...@@ -101,6 +87,12 @@ CONTAINS
complex(kind=prec) :: res(n) complex(kind=prec) :: res(n)
res = 0 res = 0
END FUNCTION zero_array 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) FUNCTION shuffle_with_zero(a) result(res)
! rows of result are shuffles of a with 0 ! rows of result are shuffles of a with 0
...@@ -118,6 +110,15 @@ CONTAINS ...@@ -118,6 +110,15 @@ CONTAINS
end do end do
END FUNCTION shuffle_with_zero 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) ! subroutine print(s1,s2,s3,s4,s5)
! character(len = *), intent(in), optional :: s1, s2, s3, s4, s5 ! character(len = *), intent(in), optional :: s1, s2, s3, s4, s5
! if(print_enabled) then ! if(print_enabled) then
...@@ -135,24 +136,6 @@ CONTAINS ...@@ -135,24 +136,6 @@ CONTAINS
END MODULE utils 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 ! PROGRAM test
! use utils ! use utils
! implicit none ! implicit none
...@@ -172,5 +155,4 @@ END SUBROUTINE print_complex_matrix ...@@ -172,5 +155,4 @@ END SUBROUTINE print_complex_matrix
! condensed_size = find_first_zero(m_prime)-1 ! condensed_size = find_first_zero(m_prime)-1
! end if ! end if
! print*, condensed_size ! print*, condensed_size
! END PROGRAM test ! END PROGRAM test
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment