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

'present' propagates to called function

This commit is contained in:
Martin Diehl 2020-12-28 21:34:34 +01:00
parent 6207432f7a
commit bb9fa228ab
1 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/prec.f90
View File

@ -108,8 +108,10 @@ 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
else
@ -132,11 +134,8 @@ logical elemental pure function dNeq(a,b,tol)
real(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
if (present(tol)) then
dNeq = .not. dEq(a,b,tol)
else
dNeq = .not. dEq(a,b)
endif
dNeq = .not. dEq(a,b,tol)
end function dNeq
@ -151,8 +150,10 @@ 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
else
@ -175,11 +176,8 @@ logical elemental pure function dNeq0(a,tol)
real(pReal), intent(in) :: a
real(pReal), intent(in), optional :: tol
if (present(tol)) then
dNeq0 = .not. dEq0(a,tol)
else
dNeq0 = .not. dEq0(a)
endif
dNeq0 = .not. dEq0(a,tol)
end function dNeq0
@ -195,8 +193,10 @@ 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
else
@ -220,11 +220,8 @@ logical elemental pure function cNeq(a,b,tol)
complex(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
if (present(tol)) then
cNeq = .not. cEq(a,b,tol)
else
cNeq = .not. cEq(a,b)
endif
cNeq = .not. cEq(a,b,tol)
end function cNeq
@ -238,6 +235,7 @@ pure function prec_bytesToC_FLOAT(bytes)
real(C_FLOAT), dimension(size(bytes,kind=pI64)/(storage_size(0._C_FLOAT,pI64)/8_pI64)) :: &
prec_bytesToC_FLOAT
prec_bytesToC_FLOAT = transfer(bytes,prec_bytesToC_FLOAT,size(prec_bytesToC_FLOAT))
end function prec_bytesToC_FLOAT
@ -252,6 +250,7 @@ pure function prec_bytesToC_DOUBLE(bytes)
real(C_DOUBLE), dimension(size(bytes,kind=pI64)/(storage_size(0._C_DOUBLE,pI64)/8_pI64)) :: &
prec_bytesToC_DOUBLE
prec_bytesToC_DOUBLE = transfer(bytes,prec_bytesToC_DOUBLE,size(prec_bytesToC_DOUBLE))
end function prec_bytesToC_DOUBLE
@ -266,6 +265,7 @@ pure function prec_bytesToC_INT32_T(bytes)
integer(C_INT32_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT32_T,pI64)/8_pI64)) :: &
prec_bytesToC_INT32_T
prec_bytesToC_INT32_T = transfer(bytes,prec_bytesToC_INT32_T,size(prec_bytesToC_INT32_T))
end function prec_bytesToC_INT32_T
@ -280,6 +280,7 @@ pure function prec_bytesToC_INT64_T(bytes)
integer(C_INT64_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT64_T,pI64)/8_pI64)) :: &
prec_bytesToC_INT64_T
prec_bytesToC_INT64_T = transfer(bytes,prec_bytesToC_INT64_T,size(prec_bytesToC_INT64_T))
end function prec_bytesToC_INT64_T
@ -295,6 +296,7 @@ subroutine selfTest
integer(pInt), dimension(1) :: i
real(pReal), dimension(2) :: r
realloc_lhs_test = [1,2]
if (any(realloc_lhs_test/=[1,2])) error stop 'LHS allocation'