Commit 6b3522c1 by Luca

condensing, flattening and shuffling helper functions

parent a528d95f
 ... ... @@ -14,22 +14,135 @@ MODULE utils logical :: print_enabled = .true. logical :: warnings_enabled = .true. integer, parameter :: prec = selected_real_kind(15,32) CONTAINS subroutine print(s1,s2,s3,s4,s5) character(len = *), intent(in), optional :: s1, s2, s3, s4, s5 if(print_enabled) then print*, s1, s2, s3, s4, s5 FUNCTION get_condensed_m(z) result(m) ! returns condensed m where the ones not needed are filled with 0 complex(kind=prec) :: z(:), m(size(z)) integer :: pos = 1, i m = 1 do i = 1,size(z) if(z(i) == 0) then if(i == size(z)) then pos = pos + 1 else m(pos) = m(pos) + 1 end if end subroutine print else pos = pos + 1 end if end do m(pos:) = 0 END FUNCTION get_condensed_m FUNCTION get_condenced_z(m, z_in) result(z_out) ! returns condensed z vector integer :: m(:), i, pos complex(kind=prec) :: z_in(:), z_out(size(m)) pos = 0 do i=1,size(m) pos = pos + m(i) z_out(i) = z_in(pos) end do END FUNCTION get_condenced_z FUNCTION get_flattened_z(m,z_in) result(z_out) ! returns flattened version of z based on m and z integer :: m(:), i, pos complex(kind=prec) :: z_in(:), z_out(sum(m)) z_out = 0 pos = 0 do i=1,size(m) pos = pos + m(i) z_out(pos) = z_in(i) end do END FUNCTION get_flattened_z subroutine warn(s1,s2,s3,s4,s5) character(len = *), intent(in), optional :: s1, s2, s3, s4, s5 if(warnings_enabled) then print*, 'Warning: ', s1, s2, s3, s4, s5 FUNCTION find_first_zero(v) result(res) ! returns index of first zero, or -1 if there is no zero integer :: v(:), i, res res = -1 do i = 1,size(v) if(v(i) == 0) then res = i return end if end subroutine warn end do END FUNCTION find_first_zero SUBROUTINE print_as_matrix(m) ! prints a 2d array as a matrix complex :: m(:,:) integer :: s(2), i s = shape(m) do i = 1,s(1) print*, m(i,:) end do END SUBROUTINE print_as_matrix FUNCTION shuffle_with_zero(a) result(res) ! rows of result are shuffles of a with 0 complex :: a(:) complex :: res(size(a)+1,size(a)+1) integer :: i,j, N N = size(a)+1 do i = 1,N ! i is the index of the row ! j is the index of the zero j = N+1-i res(i,j) = 0 res(i,1:j-1) = a(1:j-1) res(i,j+1:N) = a(j:) end do END FUNCTION shuffle_with_zero ! subroutine print(s1,s2,s3,s4,s5) ! character(len = *), intent(in), optional :: s1, s2, s3, s4, s5 ! if(print_enabled) then ! print*, s1, s2, s3, s4, s5 ! end if ! end subroutine print ! subroutine warn(s1,s2,s3,s4,s5) ! character(len = *), intent(in), optional :: s1, s2, s3, s4, s5 ! if(warnings_enabled) then ! print*, 'Warning: ', s1, s2, s3, s4, s5 ! end if ! end subroutine warn END MODULE utils ! PROGRAM test ! use utils ! implicit none ! complex(kind=prec), dimension(3) :: a = cmplx((/1,2,3/)) ! complex(kind=prec) :: z_flat(7) ! complex(kind=prec), allocatable :: z(:) ! integer :: m_prime(7), condensed_size ! integer, allocatable :: m(:) ! complex(kind=prec) :: b(size(a)+1,size(a)+1) ! ! ! test shuffling ! ! b = 1 ! ! b = shuffle_with_zero(a) ! ! call print_as_matrix(b) ! ! ! test condensing ! ! z_flat = cmplx((/0,0,0,2,1,0,1/)) ! ! m_prime = get_condensed_m(z_flat) ! ! condensed_size = find_first_zero(m_prime)-1 ! ! allocate(m(condensed_size)) ! ! allocate(z(condensed_size)) ! ! m = m_prime(1:condensed_size) ! ! z = get_condenced_z(m,z_flat) ! ! z_flat = get_flattened_z(m,z) ! ! print*, z_flat ! ! print*, m ! ! deallocate(m) ! ! deallocate(z) ! 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!