diff --git a/src/IO.f90 b/src/IO.f90 index bc9f494fe..7b7494d1a 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -549,8 +549,6 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) ! math errors case (400) msg = 'matrix inversion error' - case (401) - msg = 'math_check failed' case (402) msg = 'invalid orientation specified' @@ -920,16 +918,28 @@ end function verifyFloatValue !-------------------------------------------------------------------------------------------------- subroutine unitTest - if(dNeq(1.0_pReal, verifyFloatValue('1.0'))) call IO_error(401,ext_msg='verifyFloatValue') - if(dNeq(1.0_pReal, verifyFloatValue('1e0'))) call IO_error(401,ext_msg='verifyFloatValue') - if(dNeq(0.1_pReal, verifyFloatValue('1e-1'))) call IO_error(401,ext_msg='verifyFloatValue') + integer, dimension(:), allocatable :: chunkPos + character(len=:), allocatable :: str - if(3112019 /= verifyIntValue( '3112019')) call IO_error(401,ext_msg='verifyIntValue') - if(3112019 /= verifyIntValue(' 3112019')) call IO_error(401,ext_msg='verifyIntValue') - if(-3112019 /= verifyIntValue('-3112019')) call IO_error(401,ext_msg='verifyIntValue') - if(3112019 /= verifyIntValue('+3112019 ')) call IO_error(401,ext_msg='verifyIntValue') + if(dNeq(1.0_pReal, verifyFloatValue('1.0'))) call IO_error(0,ext_msg='verifyFloatValue') + if(dNeq(1.0_pReal, verifyFloatValue('1e0'))) call IO_error(0,ext_msg='verifyFloatValue') + if(dNeq(0.1_pReal, verifyFloatValue('1e-1'))) call IO_error(0,ext_msg='verifyFloatValue') - if(any([2,1,2,4,4] /= IO_stringPos('aa b'))) call IO_error(401,ext_msg='IO_stringPos') + if(3112019 /= verifyIntValue( '3112019')) call IO_error(0,ext_msg='verifyIntValue') + if(3112019 /= verifyIntValue(' 3112019')) call IO_error(0,ext_msg='verifyIntValue') + if(-3112019 /= verifyIntValue('-3112019')) call IO_error(0,ext_msg='verifyIntValue') + if(3112019 /= verifyIntValue('+3112019 ')) call IO_error(0,ext_msg='verifyIntValue') + + if(any([1,1,1] /= IO_stringPos('a'))) call IO_error(0,ext_msg='IO_stringPos') + if(any([2,2,3,5,5] /= IO_stringPos(' aa b'))) call IO_error(0,ext_msg='IO_stringPos') + + str=' 1.0 xxx' + chunkPos = IO_stringPos(str) + if(dNeq(1.0,IO_floatValue(str,chunkPos,1))) call IO_error(0,ext_msg='IO_floatValue') + + str='M 3112019 F' + chunkPos = IO_stringPos(str) + if(3112019 /= IO_intValue(str,chunkPos,2)) call IO_error(0,ext_msg='IO_intValue') end subroutine unitTest diff --git a/src/math.f90 b/src/math.f90 index 62c22b6d8..292fc2483 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -1346,44 +1346,44 @@ subroutine unitTest 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)) & - 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(0,ext_msg='math_expand [1,2,3] by [1,2,3,0] => [1,2,2,3,3,3]') if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal] - & math_expand([1.0_pReal,2.0_pReal,3.0_pReal],[1,2])) > tol_math_check)) & - call IO_error(401,ext_msg='math_expand [1,2,3] by [1,2] => [1,2,2]') + call IO_error(0,ext_msg='math_expand [1,2,3] by [1,2] => [1,2,2]') if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal,1.0_pReal,1.0_pReal,1.0_pReal] - & math_expand([1.0_pReal,2.0_pReal],[1,2,3])) > tol_math_check)) & - call IO_error(401,ext_msg='math_expand [1,2] by [1,2,3] => [1,2,2,1,1,1]') + call IO_error(0,ext_msg='math_expand [1,2] by [1,2,3] => [1,2,2,1,1,1]') call math_sort(sort_in_,1,3,2) if(any(sort_in_ /= sort_out_)) & - call IO_error(401,ext_msg='math_sort') + call IO_error(0,ext_msg='math_sort') if(any(math_range(5) /= range_out_)) & - call IO_error(401,ext_msg='math_range') + call IO_error(0,ext_msg='math_range') call random_number(v9) if(any(dNeq(math_33to9(math_9to33(v9)),v9))) & - call IO_error(401,ext_msg='math_33to9/math_9to33') + call IO_error(0,ext_msg='math_33to9/math_9to33') call random_number(t99) if(any(dNeq(math_3333to99(math_99to3333(t99)),t99))) & - call IO_error(401,ext_msg='math_3333to99/math_99to3333') + call IO_error(0,ext_msg='math_3333to99/math_99to3333') call random_number(v6) if(any(dNeq(math_sym33to6(math_6toSym33(v6)),v6))) & - call IO_error(401,ext_msg='math_sym33to6/math_6toSym33') + call IO_error(0,ext_msg='math_sym33to6/math_6toSym33') call random_number(t66) if(any(dNeq(math_sym3333to66(math_66toSym3333(t66)),t66))) & - call IO_error(401,ext_msg='math_sym3333to66/math_66toSym3333') + call IO_error(0,ext_msg='math_sym3333to66/math_66toSym3333') call random_number(v6) if(any(dNeq0(math_6toSym33(v6) - math_symmetric33(math_6toSym33(v6))))) & - call IO_error(401,ext_msg='math_symmetric33') + call IO_error(0,ext_msg='math_symmetric33') call random_number(v3_1) call random_number(v3_2) @@ -1392,45 +1392,45 @@ subroutine unitTest if(dNeq(abs(dot_product(math_cross(v3_1-v3_4,v3_2-v3_4),v3_3-v3_4))/6.0, & math_volTetrahedron(v3_1,v3_2,v3_3,v3_4),tol=1.0e-12_pReal)) & - call IO_error(401,ext_msg='math_volTetrahedron') + call IO_error(0,ext_msg='math_volTetrahedron') call random_number(t33) if(dNeq(math_det33(math_symmetric33(t33)),math_detSym33(math_symmetric33(t33)),tol=1.0e-12_pReal)) & - call IO_error(401,ext_msg='math_det33/math_detSym33') + call IO_error(0,ext_msg='math_det33/math_detSym33') do while(abs(math_det33(t33))<1.0e-9_pReal) call random_number(t33) enddo if(any(dNeq0(matmul(t33,math_inv33(t33)) - math_identity2nd(3),tol=1.0e-9_pReal))) & - call IO_error(401,ext_msg='math_inv33') + call IO_error(0,ext_msg='math_inv33') call math_invert33(t33_2,det,e,t33) if(any(dNeq0(matmul(t33,t33_2) - math_identity2nd(3),tol=1.0e-9_pReal)) .or. e) & - call IO_error(401,ext_msg='math_invert33: T:T^-1 != I') + call IO_error(0,ext_msg='math_invert33: T:T^-1 != I') if(dNeq(det,math_det33(t33),tol=1.0e-12_pReal)) & - call IO_error(401,ext_msg='math_invert33 (determinant)') + call IO_error(0,ext_msg='math_invert33 (determinant)') call math_invert(t33_2,e,t33) if(any(dNeq0(matmul(t33,t33_2) - math_identity2nd(3),tol=1.0e-9_pReal)) .or. e) & - call IO_error(401,ext_msg='math_invert t33') + call IO_error(0,ext_msg='math_invert t33') t33_2 = transpose(math_rotationalPart33(t33)) if(any(dNeq0(math_rotationalPart33(matmul(t33_2,t33)) - MATH_I3,tol=5.0e-4_pReal))) & - call IO_error(401,ext_msg='math_rotationalPart33') + call IO_error(0,ext_msg='math_rotationalPart33') call math_invert(t99_2,e,t99) ! not sure how likely it is that we get a singular matrix if(any(dNeq0(matmul(t99_2,t99)-math_identity2nd(9),tol=1.0e-9_pReal)) .or. e) & - call IO_error(401,ext_msg='math_invert t99') + call IO_error(0,ext_msg='math_invert t99') if(any(dNeq(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(0,ext_msg='math_clip') if(math_factorial(10) /= 3628800) & - call IO_error(401,ext_msg='math_factorial') + call IO_error(0,ext_msg='math_factorial') if(math_binomial(49,6) /= 13983816) & - call IO_error(401,ext_msg='math_binomial') + call IO_error(0,ext_msg='math_binomial') end subroutine unitTest diff --git a/src/quaternions.f90 b/src/quaternions.f90 index 0215aca6e..37131800a 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -463,59 +463,59 @@ subroutine unitTest q = quaternion(qu) q_2= qu - if(any(dNeq(q%asArray(),q_2%asArray()))) call IO_error(401,ext_msg='assign_vec__') + if(any(dNeq(q%asArray(),q_2%asArray()))) call IO_error(0,ext_msg='assign_vec__') q_2 = q + q - if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) call IO_error(401,ext_msg='add__') + if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) call IO_error(0,ext_msg='add__') q_2 = q - q - if(any(dNeq0(q_2%asArray()))) call IO_error(401,ext_msg='sub__') + if(any(dNeq0(q_2%asArray()))) call IO_error(0,ext_msg='sub__') q_2 = q * 5.0_pReal - if(any(dNeq(q_2%asArray(),5.0_pReal*qu))) call IO_error(401,ext_msg='mul__') + if(any(dNeq(q_2%asArray(),5.0_pReal*qu))) call IO_error(0,ext_msg='mul__') q_2 = q / 0.5_pReal - if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) call IO_error(401,ext_msg='div__') + if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) call IO_error(0,ext_msg='div__') q_2 = q * 0.3_pReal - if(dNeq0(abs(q)) .and. q_2 == q) call IO_error(401,ext_msg='eq__') + if(dNeq0(abs(q)) .and. q_2 == q) call IO_error(0,ext_msg='eq__') q_2 = q - if(q_2 /= q) call IO_error(401,ext_msg='neq__') + if(q_2 /= q) call IO_error(0,ext_msg='neq__') - if(dNeq(abs(q),norm2(qu))) call IO_error(401,ext_msg='abs__') + if(dNeq(abs(q),norm2(qu))) call IO_error(0,ext_msg='abs__') if(dNeq(abs(q)**2.0_pReal, real(q*q%conjg()),1.0e-14_pReal)) & - call IO_error(401,ext_msg='abs__/*conjg') + call IO_error(0,ext_msg='abs__/*conjg') - if(any(dNeq(q%asArray(),qu))) call IO_error(401,ext_msg='eq__') - if(dNeq(q%real(), qu(1))) call IO_error(401,ext_msg='real()') - if(any(dNeq(q%aimag(), qu(2:4)))) call IO_error(401,ext_msg='aimag()') + if(any(dNeq(q%asArray(),qu))) call IO_error(0,ext_msg='eq__') + if(dNeq(q%real(), qu(1))) call IO_error(0,ext_msg='real()') + if(any(dNeq(q%aimag(), qu(2:4)))) call IO_error(0,ext_msg='aimag()') q_2 = q%homomorphed() - if(q /= q_2* (-1.0_pReal)) call IO_error(401,ext_msg='homomorphed') - if(dNeq(q_2%real(), qu(1)* (-1.0_pReal))) call IO_error(401,ext_msg='homomorphed/real') - if(any(dNeq(q_2%aimag(),qu(2:4)*(-1.0_pReal)))) call IO_error(401,ext_msg='homomorphed/aimag') + if(q /= q_2* (-1.0_pReal)) call IO_error(0,ext_msg='homomorphed') + if(dNeq(q_2%real(), qu(1)* (-1.0_pReal))) call IO_error(0,ext_msg='homomorphed/real') + if(any(dNeq(q_2%aimag(),qu(2:4)*(-1.0_pReal)))) call IO_error(0,ext_msg='homomorphed/aimag') q_2 = conjg(q) - if(dNeq(abs(q),abs(q_2))) call IO_error(401,ext_msg='conjg/abs') - if(q /= conjg(q_2)) call IO_error(401,ext_msg='conjg/involution') - if(dNeq(q_2%real(), q%real())) call IO_error(401,ext_msg='conjg/real') - if(any(dNeq(q_2%aimag(),q%aimag()*(-1.0_pReal)))) call IO_error(401,ext_msg='conjg/aimag') + if(dNeq(abs(q),abs(q_2))) call IO_error(0,ext_msg='conjg/abs') + if(q /= conjg(q_2)) call IO_error(0,ext_msg='conjg/involution') + if(dNeq(q_2%real(), q%real())) call IO_error(0,ext_msg='conjg/real') + if(any(dNeq(q_2%aimag(),q%aimag()*(-1.0_pReal)))) call IO_error(0,ext_msg='conjg/aimag') if(abs(q) > 0.0_pReal) then q_2 = q * q%inverse() - if( dNeq(real(q_2), 1.0_pReal,1.0e-15_pReal)) call IO_error(401,ext_msg='inverse/real') - if(any(dNeq0(aimag(q_2), 1.0e-15_pReal))) call IO_error(401,ext_msg='inverse/aimag') + if( dNeq(real(q_2), 1.0_pReal,1.0e-15_pReal)) call IO_error(0,ext_msg='inverse/real') + if(any(dNeq0(aimag(q_2), 1.0e-15_pReal))) call IO_error(0,ext_msg='inverse/aimag') q_2 = q/abs(q) q_2 = conjg(q_2) - inverse(q_2) - if(any(dNeq0(q_2%asArray(),1.0e-15_pReal))) call IO_error(401,ext_msg='inverse/conjg') + if(any(dNeq0(q_2%asArray(),1.0e-15_pReal))) call IO_error(0,ext_msg='inverse/conjg') endif #if !(defined(__GFORTRAN__) && __GNUC__ < 9) if (norm2(aimag(q)) > 0.0_pReal) then - if (dNeq0(abs(q-exp(log(q))),1.0e-13_pReal)) call IO_error(401,ext_msg='exp/log') - if (dNeq0(abs(q-log(exp(q))),1.0e-13_pReal)) call IO_error(401,ext_msg='log/exp') + if (dNeq0(abs(q-exp(log(q))),1.0e-13_pReal)) call IO_error(0,ext_msg='exp/log') + if (dNeq0(abs(q-log(exp(q))),1.0e-13_pReal)) call IO_error(0,ext_msg='log/exp') endif #endif diff --git a/src/rotations.f90 b/src/rotations.f90 index a2394dc96..ec4de32d5 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -1324,7 +1324,7 @@ subroutine unitTest if(all(dNeq(R%rotTensor4(R%rotTensor4(t3333),active=.true.),t3333,1.0e-12_pReal))) & msg = trim(msg)//'rotTensor4,' - if(len_trim(msg) /= 0) call IO_error(401,ext_msg=msg) + if(len_trim(msg) /= 0) call IO_error(0,ext_msg=msg) enddo