Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fixes for extended and quad precision checking. Add CI cheks with fpm #821

Merged
merged 15 commits into from
Jun 13, 2024
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 4 additions & 1 deletion .github/workflows/fpm-deployment.yml
Original file line number Diff line number Diff line change
Expand Up @@ -35,8 +35,11 @@ jobs:
with:
fpm-version: 'v0.10.0'

- run: |
- run: | # Just for deployment: create stdlib-fpm folder
python config/fypp_deployment.py --deploy_stdlib_fpm

- run: | # Use fpm gnu ci to check xdp and qp
python config/fypp_deployment.py --with_xdp --with_qp
fpm test --profile release

# Update and deploy the f90 files generated by github-ci to the `stdlib-fpm` branch.
Expand Down
71 changes: 35 additions & 36 deletions src/stdlib_specialfunctions_gamma.fypp
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
#:set WITH_QP = False
#:set WITH_XDP = False
#:include "common.fypp"
#:set CI_KINDS_TYPES = INT_KINDS_TYPES + CMPLX_KINDS_TYPES
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES[0:2]
#:set CI_KINDS_TYPES = INT_KINDS_TYPES + CMPLX_KINDS_TYPES[0:2]
jalvesz marked this conversation as resolved.
Show resolved Hide resolved
jalvesz marked this conversation as resolved.
Show resolved Hide resolved
module stdlib_specialfunctions_gamma
use iso_fortran_env, only : qp => real128
use stdlib_kinds, only : sp, dp, int8, int16, int32, int64
Expand All @@ -15,7 +14,7 @@ module stdlib_specialfunctions_gamma
integer(int32), parameter :: max_fact_int32 = 13_int32
integer(int64), parameter :: max_fact_int64 = 21_int64

#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
${t1}$, parameter :: tol_${k1}$ = epsilon(1.0_${k1}$)
#:endfor
real(qp), parameter :: tol_qp = epsilon(1.0_qp)
Expand Down Expand Up @@ -63,12 +62,12 @@ module stdlib_specialfunctions_gamma
!! Lower incomplete gamma function
!!
#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
module procedure ingamma_low_${t1[0]}$${k1}$${k2}$
#:endfor
#:endfor

#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
module procedure ingamma_low_${t1[0]}$${k1}$
#:endfor
end interface lower_incomplete_gamma
Expand All @@ -79,12 +78,12 @@ module stdlib_specialfunctions_gamma
!! Logarithm of lower incomplete gamma function
!!
#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
module procedure l_ingamma_low_${t1[0]}$${k1}$${k2}$
#:endfor
#:endfor

#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
module procedure l_ingamma_low_${t1[0]}$${k1}$
#:endfor
end interface log_lower_incomplete_gamma
Expand All @@ -95,12 +94,12 @@ module stdlib_specialfunctions_gamma
!! Upper incomplete gamma function
!!
#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
module procedure ingamma_up_${t1[0]}$${k1}$${k2}$
#:endfor
#:endfor

#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
module procedure ingamma_up_${t1[0]}$${k1}$
#:endfor
end interface upper_incomplete_gamma
Expand All @@ -111,12 +110,12 @@ module stdlib_specialfunctions_gamma
!! Logarithm of upper incomplete gamma function
!!
#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
module procedure l_ingamma_up_${t1[0]}$${k1}$${k2}$
#:endfor
#:endfor

#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
module procedure l_ingamma_up_${t1[0]}$${k1}$
#:endfor
end interface log_upper_incomplete_gamma
Expand All @@ -127,12 +126,12 @@ module stdlib_specialfunctions_gamma
!! Regularized (normalized) lower incomplete gamma function, P
!!
#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
module procedure regamma_p_${t1[0]}$${k1}$${k2}$
#:endfor
#:endfor

#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
module procedure regamma_p_${t1[0]}$${k1}$
#:endfor
end interface regularized_gamma_p
Expand All @@ -143,12 +142,12 @@ module stdlib_specialfunctions_gamma
!! Regularized (normalized) upper incomplete gamma function, Q
!!
#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
module procedure regamma_q_${t1[0]}$${k1}$${k2}$
#:endfor
#:endfor

#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
module procedure regamma_q_${t1[0]}$${k1}$
#:endfor
end interface regularized_gamma_q
Expand All @@ -159,12 +158,12 @@ module stdlib_specialfunctions_gamma
! Incomplete gamma G function.
! Internal use only
!
#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
module procedure gpx_${t1[0]}$${k1}$ !for real p and x
#:endfor

#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
module procedure gpx_${t1[0]}$${k1}$${k2}$ !for integer p and real x
#:endfor
#:endfor
Expand All @@ -177,7 +176,7 @@ module stdlib_specialfunctions_gamma
! Internal use only
!
#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
module procedure l_gamma_${t1[0]}$${k1}$${k2}$
#:endfor
#:endfor
Expand Down Expand Up @@ -218,7 +217,7 @@ contains



#:for k1, t1 in CMPLX_KINDS_TYPES
#:for k1, t1 in CMPLX_KINDS_TYPES[0:2]
#:if k1 == "sp"
jalvesz marked this conversation as resolved.
Show resolved Hide resolved
#:set k2 = "dp"
#:elif k1 == "dp"
Expand Down Expand Up @@ -373,7 +372,7 @@ contains


#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES

impure elemental function l_gamma_${t1[0]}$${k1}$${k2}$(z, x) result(res)
!
Expand Down Expand Up @@ -414,7 +413,7 @@ contains



#:for k1, t1 in CMPLX_KINDS_TYPES
#:for k1, t1 in CMPLX_KINDS_TYPES[0:2]
#:if k1 == "sp"
jalvesz marked this conversation as resolved.
Show resolved Hide resolved
#:set k2 = "dp"
#:elif k1 == "dp"
Expand Down Expand Up @@ -556,7 +555,7 @@ contains



#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
#:if k1 == "sp"
#:set k2 = "dp"
#:elif k1 == "dp"
Expand Down Expand Up @@ -702,7 +701,7 @@ contains


#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
impure elemental function gpx_${t1[0]}$${k1}$${k2}$(p, x) result(res)
!
! Approximation of incomplete gamma G function with integer argument p.
Expand Down Expand Up @@ -841,7 +840,7 @@ contains



#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
impure elemental function ingamma_low_${t1[0]}$${k1}$(p, x) result(res)
!
! Approximation of lower incomplete gamma function with real p.
Expand Down Expand Up @@ -878,7 +877,7 @@ contains


#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
impure elemental function ingamma_low_${t1[0]}$${k1}$${k2}$(p, x) &
result(res)
!
Expand Down Expand Up @@ -918,7 +917,7 @@ contains



#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
impure elemental function l_ingamma_low_${t1[0]}$${k1}$(p, x) result(res)

${t1}$, intent(in) :: p, x
Expand Down Expand Up @@ -955,7 +954,7 @@ contains


#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
impure elemental function l_ingamma_low_${t1[0]}$${k1}$${k2}$(p, x) &
result(res)

Expand Down Expand Up @@ -987,7 +986,7 @@ contains



#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
impure elemental function ingamma_up_${t1[0]}$${k1}$(p, x) result(res)
!
! Approximation of upper incomplete gamma function with real p.
Expand Down Expand Up @@ -1025,7 +1024,7 @@ contains


#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
impure elemental function ingamma_up_${t1[0]}$${k1}$${k2}$(p, x) &
result(res)
!
Expand Down Expand Up @@ -1067,7 +1066,7 @@ contains



#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
impure elemental function l_ingamma_up_${t1[0]}$${k1}$(p, x) result(res)

${t1}$, intent(in) :: p, x
Expand Down Expand Up @@ -1105,7 +1104,7 @@ contains


#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
impure elemental function l_ingamma_up_${t1[0]}$${k1}$${k2}$(p, x) &
result(res)

Expand Down Expand Up @@ -1146,7 +1145,7 @@ contains



#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
impure elemental function regamma_p_${t1[0]}$${k1}$(p, x) result(res)
!
! Approximation of regularized incomplete gamma function P(p,x) for real p
Expand Down Expand Up @@ -1181,7 +1180,7 @@ contains


#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
impure elemental function regamma_p_${t1[0]}$${k1}$${k2}$(p, x) result(res)
!
! Approximation of regularized incomplete gamma function P(p,x) for integer p
Expand Down Expand Up @@ -1217,7 +1216,7 @@ contains



#:for k1, t1 in REAL_KINDS_TYPES
#:for k1, t1 in RC_KINDS_TYPES
impure elemental function regamma_q_${t1[0]}$${k1}$(p, x) result(res)
!
! Approximation of regularized incomplete gamma function Q(p,x) for real p
Expand Down Expand Up @@ -1252,7 +1251,7 @@ contains


#:for k1, t1 in INT_KINDS_TYPES
#:for k2, t2 in REAL_KINDS_TYPES
#:for k2, t2 in RC_KINDS_TYPES
impure elemental function regamma_q_${t1[0]}$${k1}$${k2}$(p, x) result(res)
!
! Approximation of regularized incomplet gamma function Q(p,x) for integer p
Expand Down
2 changes: 1 addition & 1 deletion test/math/test_meshgrid.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ contains
${"".join(f"xm{j}," for j in range(1, rank + 1)).removesuffix(",")}$ &
${OPTIONAL_PART_IN_SIGNATURE(INDEXING)}$ )
#:for j in range(1, rank + 1)
call check(error, maxval(abs(xm${j}$ - xm${j}$_exact)), ZERO)
call check(error, maxval(abs(xm${j}$ - xm${j}$_exact)) == ZERO)
if (allocated(error)) return
#:endfor
end subroutine test_${RName}$
Expand Down
12 changes: 6 additions & 6 deletions test/math/test_stdlib_math.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -170,9 +170,9 @@ contains
type(error_type), allocatable, intent(out) :: error
! type: real(sp), kind: sp
! valid test case
call check(error, clip(3.025_sp, -5.77_sp, 3.025_sp), 3.025_sp)
call check(error, clip(3.025_sp, -5.77_sp, 3.025_sp) == 3.025_sp)
if (allocated(error)) return
call check(error, clip(0.0_sp, -1578.025_sp, -59.68_sp), -59.68_sp)
call check(error, clip(0.0_sp, -1578.025_sp, -59.68_sp) == -59.68_sp)
if (allocated(error)) return
end subroutine test_clip_rsp

Expand Down Expand Up @@ -215,9 +215,9 @@ contains
#:if WITH_QP
! type: real(qp), kind: qp
! valid test case
call check(error, clip(3.025_qp, -5.77_qp, 3.025_qp), 3.025_qp)
call check(error, clip(3.025_qp, -5.77_qp, 3.025_qp) == 3.025_qp)
if (allocated(error)) return
call check(error, clip(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp), -689712245.23_qp)
call check(error, clip(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp) == -689712245.23_qp)
if (allocated(error)) return
#:else
call skip_test(error, "Quadruple precision is not enabled")
Expand All @@ -230,9 +230,9 @@ contains
type(error_type), allocatable, intent(out) :: error
#:if WITH_QP
! invalid test case
call check(error, clip(3.025_qp, 3.025_qp, -5.77_qp), 3.025_qp)
call check(error, clip(3.025_qp, 3.025_qp, -5.77_qp) == 3.025_qp)
if (allocated(error)) return
call check(error, clip(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp), -689712245.23_qp)
call check(error, clip(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp) == -689712245.23_qp)
if (allocated(error)) return
#:else
call skip_test(error, "Quadruple precision is not enabled")
Expand Down
Loading
Loading