codekingpro/portable-devtools

1! Check that parameter arrays are correctly intercepted.
2subroutine foo_array(x, y, z)
3  implicit none
4  integer, parameter :: dp = selected_real_kind(15)
5  integer, parameter :: pa = 2
6  integer, parameter :: intparamarray(2) = (/ 3, 5 /)
7  integer, dimension(pa), parameter :: pb = (/ 2, 10 /)
8  integer, parameter, dimension(intparamarray(1)) :: pc = (/ 2, 10, 20 /)
9  real(dp), parameter :: doubleparamarray(3) = (/ 3.14_dp, 4._dp, 6.44_dp /)
10  real(dp), intent(inout) :: x(intparamarray(1))
11  real(dp), intent(inout) :: y(intparamarray(2))
12  real(dp), intent(out) :: z
13
14  x = x/pb(2)
15  y = y*pc(2)
16  z = doubleparamarray(1)*doubleparamarray(2) + doubleparamarray(3)
17
18  return
19end subroutine
20
21subroutine foo_array_any_index(x, y)
22  implicit none
23  integer, parameter :: dp = selected_real_kind(15)
24  integer, parameter, dimension(-1:1) :: myparamarray = (/ 6, 3, 1 /)
25  integer, parameter, dimension(2) :: nested = (/ 2, 0 /)
26  integer, parameter :: dim = 2
27  real(dp), intent(in) :: x(myparamarray(-1))
28  real(dp), intent(out) :: y(nested(1), myparamarray(nested(dim)))
29
30  y = reshape(x, (/nested(1), myparamarray(nested(2))/))
31
32  return
33end subroutine
34
35subroutine foo_array_delims(x)
36  implicit none
37  integer, parameter :: dp = selected_real_kind(15)
38  integer, parameter, dimension(2) :: myparamarray = (/ (6), 1 /)
39  integer, parameter, dimension(3) :: test = (/2, 1, (3)/)
40  real(dp), intent(out) :: x
41
42  x = myparamarray(1)+test(3)
43
44  return
45end subroutine
46