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

shortening

This commit is contained in:
Martin Diehl 2020-01-29 22:53:19 +01:00
parent 9690f170e1
commit 59fe9d06b0
2 changed files with 12 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/IO.f90
View File

@ -400,15 +400,14 @@ pure function IO_lc(string)
character(len=*), intent(in) :: string !< string to convert character(len=*), intent(in) :: string !< string to convert
character(len=len(string)) :: IO_lc character(len=len(string)) :: IO_lc
character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' character(len=*), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' character(len=len(LOWER)), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n integer :: i,n
do i=1,len(string) do i=1,len(string)
IO_lc(i:i) = string(i:i)
n = index(UPPER,IO_lc(i:i)) n = index(UPPER,IO_lc(i:i))
if (n/=0) IO_lc(i:i) = LOWER(n:n) IO_lc(i:i) = merge(LOWER(n:n),string(i:i),n/=0)
enddo enddo
end function IO_lc end function IO_lc
@ -549,6 +548,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
! math errors ! math errors
case (400) case (400)
msg = 'matrix inversion error' msg = 'matrix inversion error'
case (401)
msg = 'error in Eigenvalue calculation'
case (402) case (402)
msg = 'invalid orientation specified' msg = 'invalid orientation specified'
@ -876,11 +877,10 @@ integer function verifyIntValue(string)
character(len=*), intent(in) :: string !< string for conversion to int value character(len=*), intent(in) :: string !< string for conversion to int value
integer :: readStatus, invalidWhere integer :: readStatus
character(len=*), parameter :: VALIDCHARS = '0123456789+- ' character(len=*), parameter :: VALIDCHARS = '0123456789+- '
invalidWhere = verify(string,VALIDCHARS) valid: if (verify(string,VALIDCHARS) == 0) then
valid: if (invalidWhere == 0) then
read(string,*,iostat=readStatus) verifyIntValue read(string,*,iostat=readStatus) verifyIntValue
if (readStatus /= 0) call IO_error(111,ext_msg=string) if (readStatus /= 0) call IO_error(111,ext_msg=string)
else valid else valid
@ -898,11 +898,10 @@ real(pReal) function verifyFloatValue(string)
character(len=*), intent(in) :: string !< string for conversion to float value character(len=*), intent(in) :: string !< string for conversion to float value
integer :: readStatus, invalidWhere integer :: readStatus
character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- ' character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- '
invalidWhere = verify(string,VALIDCHARS) valid: if (verify(string,VALIDCHARS) == 0) then
valid: if (invalidWhere == 0) then
read(string,*,iostat=readStatus) verifyFloatValue read(string,*,iostat=readStatus) verifyFloatValue
if (readStatus /= 0) call IO_error(112,ext_msg=string) if (readStatus /= 0) call IO_error(112,ext_msg=string)
else valid else valid

4
src/rotations.f90
View File

@ -608,13 +608,13 @@ function om2ax(om) result(ax)
ax(1:3) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal ] ax(1:3) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal ]
else else
call dgeev('N','V',3,om_,3,Wr,Wi,devNull,3,VR,3,work,size(work,1),ierr) 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 (ierr /= 0) call IO_error(401,ext_msg='Error in om2ax: DGEEV return not zero')
#if defined(__GFORTRAN__) && __GNUC__<9 || defined(__INTEL_COMPILER) && INTEL_COMPILER<1800 || defined(__PGI) #if defined(__GFORTRAN__) && __GNUC__<9 || defined(__INTEL_COMPILER) && INTEL_COMPILER<1800 || defined(__PGI)
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) 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 #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) 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 #endif
if (i == 0) call IO_error(0,ext_msg='Error in om2ax Real: eigenvalue not found') if (i == 0) call IO_error(401,ext_msg='Error in om2ax Real: eigenvalue not found')
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)])