Commit f3cf3006 by 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!