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

merge not needed

This commit is contained in:
Martin Diehl 2021-04-13 16:51:59 +02:00
parent 248bc539cc
commit 1762245b69
2 changed files with 15 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/prec.f90
View File

@ -108,17 +108,13 @@ logical elemental pure function dEq(a,b,tol)
real(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
dEq = abs(a-b) <= tol
else
eps = PREAL_EPSILON * maxval(abs([a,b]))
dEq = abs(a-b) <= PREAL_EPSILON * maxval(abs([a,b]))
endif
dEq = merge(.True.,.False.,abs(a-b) <= eps)
end function dEq
@ -150,17 +146,13 @@ logical elemental pure function dEq0(a,tol)
real(pReal), intent(in) :: a
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
dEq0 = abs(a) <= tol
else
eps = PREAL_MIN * 10.0_pReal
dEq0 = abs(a) <= PREAL_MIN * 10.0_pReal
endif
dEq0 = merge(.True.,.False.,abs(a) <= eps)
end function dEq0
@ -193,17 +185,13 @@ logical elemental pure function cEq(a,b,tol)
complex(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal) :: eps
if (present(tol)) then
eps = tol
cEq = abs(a-b) <= tol
else
eps = PREAL_EPSILON * maxval(abs([a,b]))
cEq = abs(a-b) <= PREAL_EPSILON * maxval(abs([a,b]))
endif
cEq = merge(.True.,.False.,abs(a-b) <= eps)
end function cEq

10
src/system_routines.f90
View File

@ -83,7 +83,8 @@ logical function setCWD(path)
character(len=*), intent(in) :: path
setCWD=merge(.True.,.False.,setCWD_C(f_c_string(path)) /= 0_C_INT)
setCWD = setCWD_C(f_c_string(path)) /= 0_C_INT
end function setCWD
@ -98,6 +99,7 @@ function getCWD()
character(kind=C_CHAR), dimension(pPathLen+1) :: getCWD_Cstring
integer(C_INT) :: stat
call getCWD_C(getCWD_Cstring,stat)
if(stat == 0) then
@ -119,6 +121,7 @@ function getHostName()
character(kind=C_CHAR), dimension(pStringLen+1) :: getHostName_Cstring
integer(C_INT) :: stat
call getHostName_C(getHostName_Cstring,stat)
if(stat == 0) then
@ -140,6 +143,7 @@ function getUserName()
character(kind=C_CHAR), dimension(pStringLen+1) :: getUserName_Cstring
integer(C_INT) :: stat
call getUserName_C(getUserName_Cstring,stat)
if(stat == 0) then
@ -159,8 +163,10 @@ pure function c_f_string(c_string) result(f_string)
character(kind=C_CHAR), dimension(:), intent(in) :: c_string
character(len=:), allocatable :: f_string
integer :: i
allocate(character(len=size(c_string))::f_string)
arrayToString: do i=1,len(f_string)
if (c_string(i) /= C_NULL_CHAR) then
@ -182,8 +188,10 @@ pure function f_c_string(f_string) result(c_string)
character(len=*), intent(in) :: f_string
character(kind=C_CHAR), dimension(len_trim(f_string)+1) :: c_string
integer :: i
do i=1,len_trim(f_string)
c_string(i)=f_string(i:i)
enddo