223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

more robust agains overflow + tests

This commit is contained in:
Martin Diehl 2019-09-22 21:41:00 -07:00
parent dc56556075
commit c1398e5fa4
1 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/math.f90
View File

@ -1269,10 +1269,15 @@ end function math_factorial
integer pure function math_binomial(n,k) integer pure function math_binomial(n,k)
integer, intent(in) :: n, k integer, intent(in) :: n, k
integer :: i, j integer :: i, k_, n_
j = min(k,n-k) k_ = min(k,n-k)
math_binomial = product([(i, i=n, n-j+1, -1)])/math_factorial(j) n_ = n
math_binomial = merge(1,0,k_>-1) ! handling special cases k < 0 or k > n
do i = 1, k_
math_binomial = (math_binomial * n_)/i
n_ = n_ -1
enddo
end function math_binomial end function math_binomial
@ -1406,7 +1411,7 @@ subroutine unitTest
real(pReal), dimension(9,9) :: t99,t99_2 real(pReal), dimension(9,9) :: t99,t99_2
logical :: e logical :: e
integer :: i
if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal,3.0_pReal,3.0_pReal,3.0_pReal] - & if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal,3.0_pReal,3.0_pReal,3.0_pReal] - &
math_expand([1.0_pReal,2.0_pReal,3.0_pReal],[1,2,3,0])) > tol_math_check)) & math_expand([1.0_pReal,2.0_pReal,3.0_pReal],[1,2,3,0])) > tol_math_check)) &
call IO_error(401,ext_msg='math_expand [1,2,3] by [1,2,3,0] => [1,2,2,3,3,3]') call IO_error(401,ext_msg='math_expand [1,2,3] by [1,2,3,0] => [1,2,2,3,3,3]')
@ -1480,6 +1485,12 @@ subroutine unitTest
if(any(math_clip([4.0_pReal,9.0_pReal],5.0_pReal,6.5_pReal)/=[5.0_pReal,6.5_pReal])) & if(any(math_clip([4.0_pReal,9.0_pReal],5.0_pReal,6.5_pReal)/=[5.0_pReal,6.5_pReal])) &
call IO_error(401,ext_msg='math_clip') call IO_error(401,ext_msg='math_clip')
if(math_factorial(10) /= 3628800) &
call IO_error(401,ext_msg='math_factorial')
if(math_binomial(49,6) /= 13983816) &
call IO_error(401,ext_msg='math_binomial')
end subroutine unitTest end subroutine unitTest
end module math end module math