utils.f90 3.8 KB
Newer Older
Luca's avatar
init  
Luca committed
1 2 3

! Contains some functions that might be useful later

4 5 6 7
! Write your own print function with ability to suppress print
! Muss immer alle prints und warnings ausschalten können
! Test Programm schreiben mit exit codes -> gfortran 'test.f90' und dann 'echo $?'

Luca's avatar
init  
Luca committed
8
MODULE utils
9
  use globals
Luca's avatar
init  
Luca committed
10
  implicit none
Luca's avatar
Luca committed
11

12 13
  ! logical :: print_enabled = .true.
  ! logical :: warnings_enabled = .true.
14

Luca's avatar
init  
Luca committed
15
CONTAINS
Luca's avatar
Luca committed
16
  
17 18
  FUNCTION  get_condensed_m(z) result(m)
    ! returns condensed m where the ones not needed are filled with 0
19 20
    complex(kind=prec), intent(in) :: z(:)
    integer :: m(size(z)), pos, i 
21
    m = 1
22
    pos = 1
23
    do i = 1,size(z)
24
      if(abs(z(i)) < zero) then
25 26 27 28 29 30 31 32 33 34 35 36
        if(i == size(z)) then
          pos = pos + 1
        else 
          m(pos) = m(pos) + 1
        end if
      else 
        pos = pos + 1
      end if
    end do
    m(pos:) = 0
  END FUNCTION get_condensed_m

37
  FUNCTION get_condensed_z(m, z_in) result(z_out)
38 39 40 41 42 43 44 45
    ! 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
46
  END FUNCTION get_condensed_z
47 48 49 50 51 52 53 54 55 56 57 58 59

  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

60 61 62 63 64
  FUNCTION find_amount_trailing_zeros(z) result(res)
    complex(kind=prec) :: z(:)
    integer :: res, i
    res = 0
    do i = size(z), 1, -1
65
      if( abs(z(i)) < zero ) then
66 67 68 69 70 71 72
        res = res + 1
      else
        exit
      end if
    end do
  END FUNCTION find_amount_trailing_zeros

73 74 75 76 77 78 79 80 81 82 83 84
  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 do
  END FUNCTION find_first_zero

85 86 87 88 89
  FUNCTION zero_array(n) result(res)
    integer :: n
    complex(kind=prec) :: res(n)
    res = 0
  END FUNCTION zero_array
Luca's avatar
Luca committed
90 91 92 93 94 95
  
  RECURSIVE FUNCTION factorial(n) result(res)
    integer, intent(in) :: n
    integer :: res
    res = merge(1,n*factorial(n-1),n==0)
  END FUNCTION factorial
96

97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
  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

Luca's avatar
Luca committed
113 114 115 116 117 118 119 120 121
  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

122 123 124 125 126 127 128 129 130 131 132 133 134
  ! 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
Luca's avatar
init  
Luca committed
135 136 137

END MODULE utils

138

139 140 141
! PROGRAM test
!   use  utils
!   implicit none
142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157
  
!   complex(kind=prec) :: z(4)
!   integer :: m_prime(4), condensed_size
!   z = cmplx((/0.0,1.7,0.0,0.0/))

!   ! transform to condensed notation
!   m_prime = get_condensed_m(z)
!   print*, abs(z)
!   m_prime = get_condensed_m(z)
!   print*, abs(z)
!   if(find_first_zero(m_prime) == -1) then
!     condensed_size = size(m_prime)
!   else
!     condensed_size = find_first_zero(m_prime)-1 
!   end if
!   print*, condensed_size
158
! END  PROGRAM test