'present' propagates to called function
This commit is contained in:
parent
6207432f7a
commit
bb9fa228ab
32
src/prec.f90
32
src/prec.f90
|
@ -108,8 +108,10 @@ logical elemental pure function dEq(a,b,tol)
|
||||||
|
|
||||||
real(pReal), intent(in) :: a,b
|
real(pReal), intent(in) :: a,b
|
||||||
real(pReal), intent(in), optional :: tol
|
real(pReal), intent(in), optional :: tol
|
||||||
|
|
||||||
real(pReal) :: eps
|
real(pReal) :: eps
|
||||||
|
|
||||||
|
|
||||||
if (present(tol)) then
|
if (present(tol)) then
|
||||||
eps = tol
|
eps = tol
|
||||||
else
|
else
|
||||||
|
@ -132,11 +134,8 @@ logical elemental pure function dNeq(a,b,tol)
|
||||||
real(pReal), intent(in) :: a,b
|
real(pReal), intent(in) :: a,b
|
||||||
real(pReal), intent(in), optional :: tol
|
real(pReal), intent(in), optional :: tol
|
||||||
|
|
||||||
if (present(tol)) then
|
|
||||||
dNeq = .not. dEq(a,b,tol)
|
dNeq = .not. dEq(a,b,tol)
|
||||||
else
|
|
||||||
dNeq = .not. dEq(a,b)
|
|
||||||
endif
|
|
||||||
|
|
||||||
end function dNeq
|
end function dNeq
|
||||||
|
|
||||||
|
@ -151,8 +150,10 @@ logical elemental pure function dEq0(a,tol)
|
||||||
|
|
||||||
real(pReal), intent(in) :: a
|
real(pReal), intent(in) :: a
|
||||||
real(pReal), intent(in), optional :: tol
|
real(pReal), intent(in), optional :: tol
|
||||||
|
|
||||||
real(pReal) :: eps
|
real(pReal) :: eps
|
||||||
|
|
||||||
|
|
||||||
if (present(tol)) then
|
if (present(tol)) then
|
||||||
eps = tol
|
eps = tol
|
||||||
else
|
else
|
||||||
|
@ -175,11 +176,8 @@ logical elemental pure function dNeq0(a,tol)
|
||||||
real(pReal), intent(in) :: a
|
real(pReal), intent(in) :: a
|
||||||
real(pReal), intent(in), optional :: tol
|
real(pReal), intent(in), optional :: tol
|
||||||
|
|
||||||
if (present(tol)) then
|
|
||||||
dNeq0 = .not. dEq0(a,tol)
|
dNeq0 = .not. dEq0(a,tol)
|
||||||
else
|
|
||||||
dNeq0 = .not. dEq0(a)
|
|
||||||
endif
|
|
||||||
|
|
||||||
end function dNeq0
|
end function dNeq0
|
||||||
|
|
||||||
|
@ -195,8 +193,10 @@ logical elemental pure function cEq(a,b,tol)
|
||||||
|
|
||||||
complex(pReal), intent(in) :: a,b
|
complex(pReal), intent(in) :: a,b
|
||||||
real(pReal), intent(in), optional :: tol
|
real(pReal), intent(in), optional :: tol
|
||||||
|
|
||||||
real(pReal) :: eps
|
real(pReal) :: eps
|
||||||
|
|
||||||
|
|
||||||
if (present(tol)) then
|
if (present(tol)) then
|
||||||
eps = tol
|
eps = tol
|
||||||
else
|
else
|
||||||
|
@ -220,11 +220,8 @@ logical elemental pure function cNeq(a,b,tol)
|
||||||
complex(pReal), intent(in) :: a,b
|
complex(pReal), intent(in) :: a,b
|
||||||
real(pReal), intent(in), optional :: tol
|
real(pReal), intent(in), optional :: tol
|
||||||
|
|
||||||
if (present(tol)) then
|
|
||||||
cNeq = .not. cEq(a,b,tol)
|
cNeq = .not. cEq(a,b,tol)
|
||||||
else
|
|
||||||
cNeq = .not. cEq(a,b)
|
|
||||||
endif
|
|
||||||
|
|
||||||
end function cNeq
|
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)) :: &
|
real(C_FLOAT), dimension(size(bytes,kind=pI64)/(storage_size(0._C_FLOAT,pI64)/8_pI64)) :: &
|
||||||
prec_bytesToC_FLOAT
|
prec_bytesToC_FLOAT
|
||||||
|
|
||||||
|
|
||||||
prec_bytesToC_FLOAT = transfer(bytes,prec_bytesToC_FLOAT,size(prec_bytesToC_FLOAT))
|
prec_bytesToC_FLOAT = transfer(bytes,prec_bytesToC_FLOAT,size(prec_bytesToC_FLOAT))
|
||||||
|
|
||||||
end function 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)) :: &
|
real(C_DOUBLE), dimension(size(bytes,kind=pI64)/(storage_size(0._C_DOUBLE,pI64)/8_pI64)) :: &
|
||||||
prec_bytesToC_DOUBLE
|
prec_bytesToC_DOUBLE
|
||||||
|
|
||||||
|
|
||||||
prec_bytesToC_DOUBLE = transfer(bytes,prec_bytesToC_DOUBLE,size(prec_bytesToC_DOUBLE))
|
prec_bytesToC_DOUBLE = transfer(bytes,prec_bytesToC_DOUBLE,size(prec_bytesToC_DOUBLE))
|
||||||
|
|
||||||
end function 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)) :: &
|
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
|
||||||
|
|
||||||
|
|
||||||
prec_bytesToC_INT32_T = transfer(bytes,prec_bytesToC_INT32_T,size(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
|
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)) :: &
|
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
|
||||||
|
|
||||||
|
|
||||||
prec_bytesToC_INT64_T = transfer(bytes,prec_bytesToC_INT64_T,size(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
|
end function prec_bytesToC_INT64_T
|
||||||
|
@ -295,6 +296,7 @@ subroutine selfTest
|
||||||
integer(pInt), dimension(1) :: i
|
integer(pInt), dimension(1) :: i
|
||||||
real(pReal), dimension(2) :: r
|
real(pReal), dimension(2) :: r
|
||||||
|
|
||||||
|
|
||||||
realloc_lhs_test = [1,2]
|
realloc_lhs_test = [1,2]
|
||||||
if (any(realloc_lhs_test/=[1,2])) error stop 'LHS allocation'
|
if (any(realloc_lhs_test/=[1,2])) error stop 'LHS allocation'
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue