bugfic: Blocksize parameter was too small
This commit is contained in:
parent
51bd67fa29
commit
30afaf2a95
|
@ -546,35 +546,34 @@ end function om2eu
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
function om2ax(om) result(ax)
|
function om2ax(om) result(ax)
|
||||||
|
|
||||||
real(pReal), intent(in) :: om(3,3)
|
real(pReal), intent(in), dimension(3,3) :: om
|
||||||
real(pReal) :: ax(4)
|
real(pReal), dimension(4) :: ax
|
||||||
|
|
||||||
real(pReal) :: t
|
real(pReal) :: t
|
||||||
real(pReal), dimension(3) :: Wr, Wi
|
real(pReal), dimension(3) :: Wr, Wi
|
||||||
real(pReal), dimension(10) :: WORK
|
real(pReal), dimension((64+2)*3) :: work
|
||||||
real(pReal), dimension(3,3) :: VR, devNull, o
|
real(pReal), dimension(3,3) :: VR, devNull, om_
|
||||||
integer :: INFO, LWORK, i
|
integer :: ierr, i
|
||||||
|
|
||||||
external :: dgeev,sgeev
|
external :: dgeev
|
||||||
|
|
||||||
o = om
|
om_ = om
|
||||||
|
|
||||||
! first get the rotation angle
|
! 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))
|
ax(4) = acos(math_clip(t,-1.0_pReal,1.0_pReal))
|
||||||
|
|
||||||
if (dEq0(ax(4))) then
|
if (dEq0(ax(4))) then
|
||||||
ax(1:3) = [ 0.0, 0.0, 1.0 ]
|
ax(1:3) = [ 0.0, 0.0, 1.0 ]
|
||||||
else
|
else
|
||||||
! set some initial LAPACK variables
|
call dgeev('N','V',3,om_,3,Wr,Wi,devNull,3,VR,3,work,size(work,1),ierr)
|
||||||
INFO = 0
|
if (ierr /= 0) call IO_error(0,ext_msg='Error in om2ax DGEEV return not zero')
|
||||||
! first initialize the parameters for the LAPACK DGEEV routines
|
#if defined(__GFORTRAN__) && __GNUC__ < 9 || __INTEL_COMPILER < 1800
|
||||||
LWORK = 20
|
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
|
||||||
! call the eigenvalue solver
|
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)
|
||||||
call dgeev('N','V',3,o,3,Wr,Wi,devNull,3,VR,3,WORK,LWORK,INFO)
|
#endif
|
||||||
if (INFO /= 0) call IO_error(0,ext_msg='Error in om2ax DGEEV return not zero')
|
if (i == 0) call IO_error(0,ext_msg='Error in om2ax Real eigenvalue not found')
|
||||||
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
|
|
||||||
ax(1:3) = VR(1:3,i)
|
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)])) &
|
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)])
|
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)])
|
||||||
|
|
Loading…
Reference in New Issue