bugfic: Blocksize parameter was too small

This commit is contained in:
Martin Diehl 2019-09-21 23:45:54 -07:00
parent 51bd67fa29
commit 30afaf2a95
1 changed files with 22 additions and 23 deletions

View File

@ -546,35 +546,34 @@ end function om2eu
!---------------------------------------------------------------------------------------------------
function om2ax(om) result(ax)
real(pReal), intent(in) :: om(3,3)
real(pReal) :: ax(4)
real(pReal), intent(in), dimension(3,3) :: om
real(pReal), dimension(4) :: ax
real(pReal) :: t
real(pReal), dimension(3) :: Wr, Wi
real(pReal), dimension(10) :: WORK
real(pReal), dimension(3,3) :: VR, devNull, o
integer :: INFO, LWORK, i
real(pReal) :: t
real(pReal), dimension(3) :: Wr, Wi
real(pReal), dimension((64+2)*3) :: work
real(pReal), dimension(3,3) :: VR, devNull, om_
integer :: ierr, i
external :: dgeev,sgeev
external :: dgeev
o = om
om_ = om
! first get the rotation angle
t = 0.5_pReal * (math_trace33(om) - 1.0)
t = 0.5_pReal * (math_trace33(om) - 1.0_pReal)
ax(4) = acos(math_clip(t,-1.0_pReal,1.0_pReal))
if (dEq0(ax(4))) then
ax(1:3) = [ 0.0, 0.0, 1.0 ]
else
! set some initial LAPACK variables
INFO = 0
! first initialize the parameters for the LAPACK DGEEV routines
LWORK = 20
! call the eigenvalue solver
call dgeev('N','V',3,o,3,Wr,Wi,devNull,3,VR,3,WORK,LWORK,INFO)
if (INFO /= 0) call IO_error(0,ext_msg='Error in om2ax DGEEV return not zero')
i = maxloc(merge(1.0_pReal,0.0_pReal,cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal)),dim=1) ! poor substitute for findloc
call dgeev('N','V',3,om_,3,Wr,Wi,devNull,3,VR,3,work,size(work,1),ierr)
if (ierr /= 0) call IO_error(0,ext_msg='Error in om2ax DGEEV return not zero')
#if defined(__GFORTRAN__) && __GNUC__ < 9 || __INTEL_COMPILER < 1800
i = maxloc(merge(1,0,cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal)),dim=1)
#else
i = findloc(cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal),.true.,dim=1) !find eigenvalue (1,0)
#endif
if (i == 0) call IO_error(0,ext_msg='Error in om2ax Real eigenvalue not found')
ax(1:3) = VR(1:3,i)
where ( dNeq0([om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])) &
ax(1:3) = sign(ax(1:3),-P *[om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])
@ -958,10 +957,10 @@ end function ro2ax
!---------------------------------------------------------------------------------------------------
pure function ro2ho(ro) result(ho)
real(pReal), intent(in), dimension(4) :: ro
real(pReal), dimension(3) :: ho
real(pReal), intent(in), dimension(4) :: ro
real(pReal), dimension(3) :: ho
real(pReal) :: f
real(pReal) :: f
if (dEq0(norm2(ro(1:3)))) then
ho = [ 0.0, 0.0, 0.0 ]