File: elemental_10.f90

package info (click to toggle)
lfortran 0.45.0-1
  • links: PTS, VCS
  • area: main
  • in suites: sid, trixie
  • size: 46,332 kB
  • sloc: cpp: 137,068; f90: 51,260; python: 6,444; ansic: 4,277; yacc: 2,285; fortran: 806; sh: 524; makefile: 30; javascript: 15
file content (92 lines) | stat: -rw-r--r-- 3,074 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
program elemental_10
    implicit none

    real, dimension(1) :: array_param
    real :: scalar_param, expected_ans, epsilon = 1.0e-6
    real, dimension(1) :: result_2param
    real, dimension(1) :: result_3param

    array_param = [1.0]
    scalar_param = 1.0

    expected_ans = 2.0

    print *, "Testing 2-parameter elemental function:"

    result_2param = func2(array_param, array_param)
    if (any(abs(result_2param - 2.0) > epsilon)) then
        error stop "Array, Array does not match 1.0"
    end if

    result_2param = func2(array_param, scalar_param)
    if (any(abs(result_2param - expected_ans) > epsilon)) then
        error stop "Array, Scalar does not match 1.0"
    end if

    result_2param = func2(scalar_param, array_param)
    if (any(abs(result_2param - expected_ans) > epsilon)) then
        error stop "Scalar, Array does not match 1.0"
    end if

    result_2param = func2(scalar_param, scalar_param)
    if (abs(result_2param(1) - expected_ans) > epsilon) then
        error stop "Scalar, Scalar does not match 1.0"
    end if

    print *, "\nTesting 3-parameter elemental function:"

    result_3param = func3(array_param, array_param, array_param)
    if (any(abs(result_3param - expected_ans) > epsilon)) then
        error stop "Array, Array, Array does not match 1.0"
    end if

    result_3param = func3(array_param, array_param, scalar_param)
    if (any(abs(result_3param - expected_ans) > epsilon)) then
        error stop "Array, Array, Scalar does not match 1.0"
    end if

    result_3param = func3(array_param, scalar_param, array_param)
    if (any(abs(result_3param - expected_ans) > epsilon)) then
        error stop "Array, Scalar, Array does not match 1.0"
    end if

    result_3param = func3(array_param, scalar_param, scalar_param)
    if (any(abs(result_3param - expected_ans) > epsilon)) then
        error stop "Array, Scalar, Scalar does not match 1.0"
    end if

    result_3param = func3(scalar_param, array_param, array_param)
    if (any(abs(result_3param - expected_ans) > epsilon)) then
        error stop "Scalar, Array, Array does not match 1.0"
    end if

    result_3param = func3(scalar_param, array_param, scalar_param)
    if (any(abs(result_3param - expected_ans) > epsilon)) then
        error stop "Scalar, Array, Scalar does not match 1.0"
    end if

    result_3param = func3(scalar_param, scalar_param, array_param)
    if (any(abs(result_3param - expected_ans) > epsilon)) then
        error stop "Scalar, Scalar, Array does not match 1.0"
    end if

    result_3param = func3(scalar_param, scalar_param, scalar_param)
    if (abs(result_3param(1) - expected_ans) > epsilon) then
        error stop "Scalar, Scalar, Scalar does not match 1.0"
    end if

contains

    elemental function func2(x, y) result(res)
        real, intent(in) :: x, y
        real :: res
        res = x + y
    end function func2

    elemental function func3(x, y, z) result(res)
        real, intent(in) :: x, y, z
        real :: res
        res = x * y + z
    end function func3

end program elemental_10