codekingpro/portable-devtools

1! Check that parameters are correct intercepted.
2! Constants with comma separations are commonly
3! used, for instance Pi = 3._dp
4subroutine foo(x)
5  implicit none
6  integer, parameter :: sp = selected_real_kind(6)
7  integer, parameter :: dp = selected_real_kind(15)
8  integer, parameter :: ii = selected_int_kind(9)
9  integer, parameter :: il = selected_int_kind(18)
10  real(dp), intent(inout) :: x
11  dimension x(3)
12  real(sp), parameter :: three_s = 3._sp
13  real(dp), parameter :: three_d = 3._dp
14  integer(ii), parameter :: three_i = 3_ii
15  integer(il), parameter :: three_l = 3_il
16  x(1) = x(1) + x(2) * three_s * three_i + x(3) * three_d * three_l
17  x(2) = x(2) * three_s
18  x(3) = x(3) * three_l
19  return
20end subroutine
21
22
23subroutine foo_no(x)
24  implicit none
25  integer, parameter :: sp = selected_real_kind(6)
26  integer, parameter :: dp = selected_real_kind(15)
27  integer, parameter :: ii = selected_int_kind(9)
28  integer, parameter :: il = selected_int_kind(18)
29  real(dp), intent(inout) :: x
30  dimension x(3)
31  real(sp), parameter :: three_s = 3.
32  real(dp), parameter :: three_d = 3.
33  integer(ii), parameter :: three_i = 3
34  integer(il), parameter :: three_l = 3
35  x(1) = x(1) + x(2) * three_s * three_i + x(3) * three_d * three_l
36  x(2) = x(2) * three_s
37  x(3) = x(3) * three_l
38  return
39end subroutine
40
41subroutine foo_sum(x)
42  implicit none
43  integer, parameter :: sp = selected_real_kind(6)
44  integer, parameter :: dp = selected_real_kind(15)
45  integer, parameter :: ii = selected_int_kind(9)
46  integer, parameter :: il = selected_int_kind(18)
47  real(dp), intent(inout) :: x
48  dimension x(3)
49  real(sp), parameter :: three_s = 2._sp + 1._sp
50  real(dp), parameter :: three_d = 1._dp + 2._dp
51  integer(ii), parameter :: three_i = 2_ii + 1_ii
52  integer(il), parameter :: three_l = 1_il + 2_il
53  x(1) = x(1) + x(2) * three_s * three_i + x(3) * three_d * three_l
54  x(2) = x(2) * three_s
55  x(3) = x(3) * three_l
56  return
57end subroutine
58