shuffle.f90 2.04 KB
 Luca committed May 08, 2019 1 `````` `````` Luca committed May 08, 2019 2 3 ``````MODULE shuffle use globals `````` Luca committed May 09, 2019 4 `````` use utils `````` Luca committed May 08, 2019 5 6 7 8 9 10 `````` implicit none CONTAINS FUNCTION append_to_each_row(a, m) result(res) ! appends element a to each row of m `````` Luca committed May 09, 2019 11 12 13 `````` complex(kind=prec) :: a, m(:,:) integer :: i complex(kind=prec) :: res(size(m,1),size(m,2)+1) `````` Luca committed May 08, 2019 14 15 16 17 `````` do i=1,size(m,1) res(i,:) = [a,m(i,:)] end do END FUNCTION append_to_each_row `````` Luca committed May 08, 2019 18 `````` `````` Luca committed May 08, 2019 19 20 `````` FUNCTION stack_matrices_vertically(m1, m2) result(res) ! appends to matrix m1 the rows of matrix m2 `````` Luca committed May 09, 2019 21 22 `````` complex(kind=prec) :: m1(:,:), m2(:,:) complex(kind=prec) :: res(size(m1,1)+size(m2,1), size(m1,2)) `````` Luca committed May 08, 2019 23 24 25 26 27 `````` res(1:size(m1,1), :) = m1 res(size(m1,1)+1:size(res,1),:) = m2 END FUNCTION stack_matrices_vertically RECURSIVE FUNCTION shuffle_product(v1, v2) result(res) `````` Luca committed May 09, 2019 28 `````` complex(kind=prec) :: v1(:), v2(:) `````` Luca committed May 08, 2019 29 `````` integer :: i `````` Luca committed May 09, 2019 30 `````` complex(kind=prec) :: res(product((/(i,i=1,size(v1)+size(v2))/))/ & `````` Luca committed May 08, 2019 31 32 `````` (product((/(i,i=1,size(v1))/))*product((/(i,i=1,size(v2))/))), & size(v1) + size(v2)) `````` Luca committed May 09, 2019 33 `````` complex(kind=prec) :: p1(product((/(i,i=1,size(v1)+size(v2)-1)/))/ & `````` Luca committed May 08, 2019 34 35 `````` (product((/(i,i=1,size(v1)-1)/))*product((/(i,i=1,size(v2))/))), & size(v1) + size(v2) - 1) `````` Luca committed May 09, 2019 36 `````` complex(kind=prec) :: p2(product((/(i,i=1,size(v1)+size(v2)-1)/))/ & `````` Luca committed May 08, 2019 37 38 `````` (product((/(i,i=1,size(v1))/))*product((/(i,i=1,size(v2)-1)/))), & size(v1) + size(v2) - 1) `````` Luca committed May 09, 2019 39 `````` complex(kind=prec) :: alpha, beta, w1(size(v1)-1), w2(size(v2)-1) `````` Luca committed May 08, 2019 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 `````` res = 0 if(size(v1) == 0) then res(1,:) = v2 return else if(size(v2) == 0) then res(1,:) = v1 return end if alpha = v1(1) beta = v2(1) w1 = v1(2:size(v1)) w2 = v2(2:size(v2)) res = stack_matrices_vertically( & append_to_each_row(alpha, shuffle_product(w1, v2)), & append_to_each_row(beta, shuffle_product(v1, w2)) ) `````` Luca committed May 09, 2019 58 `````` `````` Luca committed May 08, 2019 59 60 `````` END FUNCTION shuffle_product `````` Luca committed May 08, 2019 61 62 ``````END MODULE shuffle `````` Luca committed May 09, 2019 63 64 65 66 ``````PROGRAM test use utils use shuffle implicit none `````` Luca committed May 08, 2019 67 `````` `````` Luca committed May 09, 2019 68 69 `````` complex(kind=prec) :: v1(3), v2(2) integer :: amount_shuffles `````` Luca committed May 08, 2019 70 `````` `````` Luca committed May 09, 2019 71 72 `````` v1 = cmplx((/1,2,3/)) v2 = cmplx((/4,5/)) `````` Luca committed May 08, 2019 73 `````` `````` Luca committed May 09, 2019 74 `````` call print_matrix(shuffle_product(v1,v2)) `````` Luca committed May 08, 2019 75 `````` `````` Luca committed May 09, 2019 76 ``````END PROGRAM test `````` Luca committed May 08, 2019 77