Skip to content

Commit b6086ce

Browse files
sebastian-mutzsebastian-mutz
authored
Merge pull request #1133 from Calluumm/gammafunc
fix: issue with gamma function fypp template
2 parents 1c534cb + 4c38baa commit b6086ce

3 files changed

Lines changed: 54 additions & 48 deletions

File tree

‎.github/workflows/fpm-deployment.yml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,10 @@ jobs:
4646
python config/fypp_deployment.py --with_xdp --with_qp
4747
fpm test --profile release --flag '-DWITH_XDP -DWITH_QP'
4848
49+
- run: | # Tests without xdp and qp
50+
python config/fypp_deployment.py
51+
fpm test --profile release
52+
4953
# Update and deploy the f90 files generated by github-ci to the `stdlib-fpm` branch.
5054
- name: Deploy 🚀
5155
uses: JamesIves/github-pages-deploy-action@4.1.5

‎src/specialfunctions/stdlib_specialfunctions_gamma.fypp‎

Lines changed: 40 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,9 @@
11
#:include "common.fypp"
2-
#:set CI_KINDS_TYPES = INT_KINDS_TYPES + CMPLX_KINDS_TYPES
3-
#:set IDX_CMPLX_KINDS_TYPES = [(i, CMPLX_KINDS[i], CMPLX_TYPES[i], CMPLX_INIT[i]) for i in range(len(CMPLX_KINDS))]
4-
#:set IDX_REAL_KINDS_TYPES = [(i, REAL_KINDS[i], REAL_TYPES[i], REAL_INIT[i]) for i in range(len(REAL_KINDS))]
2+
#:set GAMMA_REAL_KINDS_TYPES = [item for item in REAL_KINDS_TYPES if item[0] in ('sp', 'dp', 'xdp')]
3+
#:set GAMMA_CMPLX_KINDS_TYPES = [item for item in CMPLX_KINDS_TYPES if item[0] in ('sp', 'dp', 'xdp')]
4+
#:set GAMMA_CI_KINDS_TYPES = INT_KINDS_TYPES + GAMMA_CMPLX_KINDS_TYPES
5+
#:set GAMMA_IDX_CMPLX_KINDS_TYPES = [(i, CMPLX_KINDS[i], CMPLX_TYPES[i], CMPLX_INIT[i]) for i in range(len(CMPLX_KINDS)) if CMPLX_KINDS[i] in ('sp', 'dp', 'xdp')]
6+
#:set GAMMA_IDX_REAL_KINDS_TYPES = [(i, REAL_KINDS[i], REAL_TYPES[i], REAL_INIT[i]) for i in range(len(REAL_KINDS)) if REAL_KINDS[i] in ('sp', 'dp', 'xdp')]
57
module stdlib_specialfunctions_gamma
68
use ieee_arithmetic, only: ieee_value, ieee_quiet_nan
79
use stdlib_kinds, only : sp, dp, xdp, qp, int8, int16, int32, int64
@@ -29,7 +31,7 @@ module stdlib_specialfunctions_gamma
2931
interface gamma
3032
!! Gamma function for integer and complex numbers
3133
!!
32-
#:for k1, t1 in CI_KINDS_TYPES[:-1]
34+
#:for k1, t1 in GAMMA_CI_KINDS_TYPES
3335
module procedure gamma_${t1[0]}$${k1}$
3436
#:endfor
3537
end interface gamma
@@ -39,7 +41,7 @@ module stdlib_specialfunctions_gamma
3941
interface log_gamma
4042
!! Logarithm of gamma function
4143
!!
42-
#:for k1, t1 in CI_KINDS_TYPES[:-1]
44+
#:for k1, t1 in GAMMA_CI_KINDS_TYPES
4345
module procedure l_gamma_${t1[0]}$${k1}$
4446
#:endfor
4547
end interface log_gamma
@@ -60,12 +62,12 @@ module stdlib_specialfunctions_gamma
6062
!! Lower incomplete gamma function
6163
!!
6264
#:for k1, t1 in INT_KINDS_TYPES
63-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
65+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
6466
module procedure ingamma_low_${t1[0]}$${k1}$${k2}$
6567
#:endfor
6668
#:endfor
6769

68-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
70+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
6971
module procedure ingamma_low_${t1[0]}$${k1}$
7072
#:endfor
7173
end interface lower_incomplete_gamma
@@ -76,12 +78,12 @@ module stdlib_specialfunctions_gamma
7678
!! Logarithm of lower incomplete gamma function
7779
!!
7880
#:for k1, t1 in INT_KINDS_TYPES
79-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
81+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
8082
module procedure l_ingamma_low_${t1[0]}$${k1}$${k2}$
8183
#:endfor
8284
#:endfor
8385

84-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
86+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
8587
module procedure l_ingamma_low_${t1[0]}$${k1}$
8688
#:endfor
8789
end interface log_lower_incomplete_gamma
@@ -92,12 +94,12 @@ module stdlib_specialfunctions_gamma
9294
!! Upper incomplete gamma function
9395
!!
9496
#:for k1, t1 in INT_KINDS_TYPES
95-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
97+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
9698
module procedure ingamma_up_${t1[0]}$${k1}$${k2}$
9799
#:endfor
98100
#:endfor
99101

100-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
102+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
101103
module procedure ingamma_up_${t1[0]}$${k1}$
102104
#:endfor
103105
end interface upper_incomplete_gamma
@@ -108,12 +110,12 @@ module stdlib_specialfunctions_gamma
108110
!! Logarithm of upper incomplete gamma function
109111
!!
110112
#:for k1, t1 in INT_KINDS_TYPES
111-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
113+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
112114
module procedure l_ingamma_up_${t1[0]}$${k1}$${k2}$
113115
#:endfor
114116
#:endfor
115117

116-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
118+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
117119
module procedure l_ingamma_up_${t1[0]}$${k1}$
118120
#:endfor
119121
end interface log_upper_incomplete_gamma
@@ -124,12 +126,12 @@ module stdlib_specialfunctions_gamma
124126
!! Regularized (normalized) lower incomplete gamma function, P
125127
!!
126128
#:for k1, t1 in INT_KINDS_TYPES
127-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
129+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
128130
module procedure regamma_p_${t1[0]}$${k1}$${k2}$
129131
#:endfor
130132
#:endfor
131133

132-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
134+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
133135
module procedure regamma_p_${t1[0]}$${k1}$
134136
#:endfor
135137
end interface regularized_gamma_p
@@ -140,12 +142,12 @@ module stdlib_specialfunctions_gamma
140142
!! Regularized (normalized) upper incomplete gamma function, Q
141143
!!
142144
#:for k1, t1 in INT_KINDS_TYPES
143-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
145+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
144146
module procedure regamma_q_${t1[0]}$${k1}$${k2}$
145147
#:endfor
146148
#:endfor
147149

148-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
150+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
149151
module procedure regamma_q_${t1[0]}$${k1}$
150152
#:endfor
151153
end interface regularized_gamma_q
@@ -156,12 +158,12 @@ module stdlib_specialfunctions_gamma
156158
! Incomplete gamma G function.
157159
! Internal use only
158160
!
159-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
161+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
160162
module procedure gpx_${t1[0]}$${k1}$ !for real p and x
161163
#:endfor
162164

163165
#:for k1, t1 in INT_KINDS_TYPES
164-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
166+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
165167
module procedure gpx_${t1[0]}$${k1}$${k2}$ !for integer p and real x
166168
#:endfor
167169
#:endfor
@@ -174,7 +176,7 @@ module stdlib_specialfunctions_gamma
174176
! Internal use only
175177
!
176178
#:for k1, t1 in INT_KINDS_TYPES
177-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
179+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
178180
module procedure l_gamma_${t1[0]}$${k1}$${k2}$
179181
#:endfor
180182
#:endfor
@@ -218,7 +220,7 @@ contains
218220
#! Because the KIND lists are sorted by increasing accuracy,
219221
#! gamma will use the next available more accurate KIND for the
220222
#! internal more accurate solver.
221-
#:for i, k1, t1, i1 in IDX_CMPLX_KINDS_TYPES[:-1]
223+
#:for i, k1, t1, i1 in GAMMA_IDX_CMPLX_KINDS_TYPES
222224
#:set k2 = CMPLX_KINDS[i + 1] if k1 == "sp" else CMPLX_KINDS[-1]
223225
#:set t2 = "real({})".format(k2)
224226
impure elemental function gamma_${t1[0]}$${k1}$(z) result(res)
@@ -363,7 +365,7 @@ contains
363365

364366

365367
#:for k1, t1 in INT_KINDS_TYPES
366-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
368+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
367369

368370
impure elemental function l_gamma_${t1[0]}$${k1}$${k2}$(z, x) result(res)
369371
!
@@ -407,7 +409,7 @@ contains
407409
#! Because the KIND lists are sorted by increasing accuracy,
408410
#! gamma will use the next available more accurate KIND for the
409411
#! internal more accurate solver.
410-
#:for i, k1, t1, i1 in IDX_CMPLX_KINDS_TYPES[:-1]
412+
#:for i, k1, t1, i1 in GAMMA_IDX_CMPLX_KINDS_TYPES
411413
#:set k2 = CMPLX_KINDS[i + 1] if k1 == "sp" else CMPLX_KINDS[-1]
412414
#:set t2 = "real({})".format(k2)
413415
impure elemental function l_gamma_${t1[0]}$${k1}$(z) result (res)
@@ -549,9 +551,9 @@ contains
549551
#! Because the KIND lists are sorted by increasing accuracy,
550552
#! gamma will use the next available more accurate KIND for the
551553
#! internal more accurate solver.
552-
#:for i, k1, t1, i1 in IDX_REAL_KINDS_TYPES[:-1]
554+
#:for i, k1, t1, i1 in GAMMA_IDX_REAL_KINDS_TYPES
553555
#:set k2 = REAL_KINDS[i + 1] if k1 == "sp" else REAL_KINDS[-1]
554-
#:set t2 = REAL_TYPES[i + 1]
556+
#:set t2 = "real({})".format(k2)
555557
impure elemental function gpx_${t1[0]}$${k1}$(p, x) result(res)
556558
!
557559
! Approximation of incomplete gamma G function with real argument p.
@@ -672,7 +674,7 @@ contains
672674

673675

674676
#:for k1, t1 in INT_KINDS_TYPES
675-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
677+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
676678
impure elemental function gpx_${t1[0]}$${k1}$${k2}$(p, x) result(res)
677679
!
678680
! Approximation of incomplete gamma G function with integer argument p.
@@ -811,7 +813,7 @@ contains
811813

812814

813815

814-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
816+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
815817
impure elemental function ingamma_low_${t1[0]}$${k1}$(p, x) result(res)
816818
!
817819
! Approximation of lower incomplete gamma function with real p.
@@ -848,7 +850,7 @@ contains
848850

849851

850852
#:for k1, t1 in INT_KINDS_TYPES
851-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
853+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
852854
impure elemental function ingamma_low_${t1[0]}$${k1}$${k2}$(p, x) &
853855
result(res)
854856
!
@@ -888,7 +890,7 @@ contains
888890

889891

890892

891-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
893+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
892894
impure elemental function l_ingamma_low_${t1[0]}$${k1}$(p, x) result(res)
893895

894896
${t1}$, intent(in) :: p, x
@@ -925,7 +927,7 @@ contains
925927

926928

927929
#:for k1, t1 in INT_KINDS_TYPES
928-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
930+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
929931
impure elemental function l_ingamma_low_${t1[0]}$${k1}$${k2}$(p, x) &
930932
result(res)
931933

@@ -957,7 +959,7 @@ contains
957959

958960

959961

960-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
962+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
961963
impure elemental function ingamma_up_${t1[0]}$${k1}$(p, x) result(res)
962964
!
963965
! Approximation of upper incomplete gamma function with real p.
@@ -995,7 +997,7 @@ contains
995997

996998

997999
#:for k1, t1 in INT_KINDS_TYPES
998-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
1000+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
9991001
impure elemental function ingamma_up_${t1[0]}$${k1}$${k2}$(p, x) &
10001002
result(res)
10011003
!
@@ -1037,7 +1039,7 @@ contains
10371039

10381040

10391041

1040-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
1042+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
10411043
impure elemental function l_ingamma_up_${t1[0]}$${k1}$(p, x) result(res)
10421044

10431045
${t1}$, intent(in) :: p, x
@@ -1075,7 +1077,7 @@ contains
10751077

10761078

10771079
#:for k1, t1 in INT_KINDS_TYPES
1078-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
1080+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
10791081
impure elemental function l_ingamma_up_${t1[0]}$${k1}$${k2}$(p, x) &
10801082
result(res)
10811083

@@ -1116,7 +1118,7 @@ contains
11161118

11171119

11181120

1119-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
1121+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
11201122
impure elemental function regamma_p_${t1[0]}$${k1}$(p, x) result(res)
11211123
!
11221124
! Approximation of regularized incomplete gamma function P(p,x) for real p
@@ -1151,7 +1153,7 @@ contains
11511153

11521154

11531155
#:for k1, t1 in INT_KINDS_TYPES
1154-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
1156+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
11551157
impure elemental function regamma_p_${t1[0]}$${k1}$${k2}$(p, x) result(res)
11561158
!
11571159
! Approximation of regularized incomplete gamma function P(p,x) for integer p
@@ -1187,7 +1189,7 @@ contains
11871189

11881190

11891191

1190-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
1192+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
11911193
impure elemental function regamma_q_${t1[0]}$${k1}$(p, x) result(res)
11921194
!
11931195
! Approximation of regularized incomplete gamma function Q(p,x) for real p
@@ -1222,7 +1224,7 @@ contains
12221224

12231225

12241226
#:for k1, t1 in INT_KINDS_TYPES
1225-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
1227+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
12261228
impure elemental function regamma_q_${t1[0]}$${k1}$${k2}$(p, x) result(res)
12271229
!
12281230
! Approximation of regularized incomplet gamma function Q(p,x) for integer p

‎test/specialfunctions/test_specialfunctions_gamma.fypp‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
#:include "common.fypp"
2-
#:set CI_KINDS_TYPES = INT_KINDS_TYPES + CMPLX_KINDS_TYPES
3-
#:set IDX_CMPLX_KINDS_TYPES = [(i, CMPLX_KINDS[i], CMPLX_TYPES[i], CMPLX_INIT[i]) for i in range(len(CMPLX_KINDS))]
4-
#:set IDX_REAL_KINDS_TYPES = [(i, REAL_KINDS[i], REAL_TYPES[i], REAL_INIT[i]) for i in range(len(REAL_KINDS))]
2+
#:set GAMMA_REAL_KINDS_TYPES = [item for item in REAL_KINDS_TYPES if item[0] in ('sp', 'dp', 'xdp')]
3+
#:set GAMMA_CMPLX_KINDS_TYPES = [item for item in CMPLX_KINDS_TYPES if item[0] in ('sp', 'dp', 'xdp')]
4+
#:set GAMMA_CI_KINDS_TYPES = INT_KINDS_TYPES + GAMMA_CMPLX_KINDS_TYPES
55
module test_specialfunctions_gamma
66
use testdrive, only : new_unittest, unittest_type, error_type, check
77
use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64
@@ -19,7 +19,7 @@ module test_specialfunctions_gamma
1919

2020
public :: collect_specialfunctions_gamma
2121

22-
#:for k1, t1 in REAL_KINDS_TYPES
22+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
2323
${t1}$, parameter :: tol_${k1}$ = sqrt(epsilon(1.0_${k1}$))
2424
#:endfor
2525

@@ -36,15 +36,15 @@ contains
3636
test_logfact_${t1[0]}$${k1}$) &
3737
#:endfor
3838

39-
#:for k1, t1 in CI_KINDS_TYPES[:-1]
39+
#:for k1, t1 in GAMMA_CI_KINDS_TYPES
4040
, new_unittest("gamma_${t1[0]}$${k1}$", &
4141
test_gamma_${t1[0]}$${k1}$) &
4242
, new_unittest("log_gamma_${t1[0]}$${k1}$", &
4343
test_loggamma_${t1[0]}$${k1}$) &
4444
#:endfor
4545

4646
#:for k1, t1 in INT_KINDS_TYPES
47-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
47+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
4848
, new_unittest("lower_incomplete_gamma_${t1[0]}$${k1}$${k2}$", &
4949
test_lincgamma_${t1[0]}$${k1}$${k2}$) &
5050
, new_unittest("log_lower_incomplete_gamma_${t1[0]}$${k1}$${k2}$", &
@@ -60,7 +60,7 @@ contains
6060
#:endfor
6161
#:endfor
6262

63-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
63+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
6464
, new_unittest("lower_incomplete_gamma_${t1[0]}$${k1}$", &
6565
test_lincgamma_${t1[0]}$${k1}$) &
6666
, new_unittest("log_lower_incomplete_gamma_${t1[0]}$${k1}$", &
@@ -114,7 +114,7 @@ contains
114114

115115

116116

117-
#:for k1, t1 in CI_KINDS_TYPES[:-1]
117+
#:for k1, t1 in GAMMA_CI_KINDS_TYPES
118118

119119
subroutine test_gamma_${t1[0]}$${k1}$(error)
120120
type(error_type), allocatable, intent(out) :: error
@@ -253,7 +253,7 @@ contains
253253

254254

255255
#:for k1, t1 in INT_KINDS_TYPES
256-
#:for k2, t2 in REAL_KINDS_TYPES[:-1]
256+
#:for k2, t2 in GAMMA_REAL_KINDS_TYPES
257257

258258
subroutine test_lincgamma_${t1[0]}$${k1}$${k2}$(error)
259259
type(error_type), allocatable, intent(out) :: error
@@ -402,7 +402,7 @@ contains
402402

403403

404404

405-
#:for k1, t1 in REAL_KINDS_TYPES[:-1]
405+
#:for k1, t1 in GAMMA_REAL_KINDS_TYPES
406406

407407
subroutine test_lincgamma_${t1[0]}$${k1}$(error)
408408
type(error_type), allocatable, intent(out) :: error

0 commit comments

Comments
 (0)