File: intrinsics_253.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 (56 lines) | stat: -rw-r--r-- 2,018 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
program intrinsics_253
    use, intrinsic :: iso_fortran_env, only: dp => real64
    real(dp), parameter :: r1 = derfc(1.1_dp)
    real(dp), parameter :: r2 = derfc(4.12_dp)
    real(dp), parameter :: ar1(3) = derfc([0.5_dp, -1.5_dp, 2.2_dp])
    real(dp), parameter :: ar2(2) = derfc([-0.2_dp, 0.0_dp])
    real(dp) :: x, y, z
    real(dp) :: arr1(3), arr2(3), res(3)

    x = 6.738377383_dp
    y = 3.1473863781_dp
    z = 7389.83936383_dp

    print *, derfc(x)
    if (abs(derfc(x) - 1.58035442023170862e-21_dp) > 1e-12) error stop
    print *, derfc(y)
    if (abs(derfc(y) - 8.54408946394494113e-06_dp) > 1e-12) error stop
    print *, derfc(z)
    if (abs(derfc(z) - 0.00000000000000000e+00_dp) > 1e-12) error stop

    x = -6.738377383_dp
    y = -3.1473863781_dp
    z = -7389.83936383_dp

    print *, derfc(x)
    if (abs(derfc(x) - 2.00000000000000000e+00_dp) > 1e-12) error stop
    print *, derfc(y)
    if (abs(derfc(y) - 1.99999145591053606e+00_dp) > 1e-12) error stop
    print *, derfc(z)
    if (abs(derfc(z) - 2.00000000000000000e+00_dp) > 1e-12) error stop

    print *, r1
    if (abs(r1 - 1.19794930425918267e-01_dp) > 1e-12_dp) error stop

    print *, r2
    if (abs(r2 - 5.65815721936131674e-09_dp) > 1e-12_dp) error stop

    print *, ar1
    if (any(abs(ar1 - [4.79500122186953481e-01_dp, 1.96610514647531076e+00_dp, &
    1.86284629798188941e-03_dp]) > 1e-12_dp)) error stop

    print *, ar2
    if (any(abs(ar2 - [1.22270258921047859e+00_dp, 1.00000000000000000e+00_dp]) > 1e-12_dp)) error stop

    arr1 = [-6.738377383_dp, -3.1473863781_dp, -7389.83936383_dp]
    print *, derfc(arr1)
    if (any(abs(derfc(arr1) - [2.00000000000000000e+00_dp, 1.99999145591053606e+00_dp, &
    2.00000000000000000e+00_dp]) > 1e-12_dp)) error stop

    arr2 = [6.738377383_dp, 3.1473863781_dp, 7389.83936383_dp]
    res = derfc(arr2)
    print *, res
    if (any(abs(res - [1.58035442023170862e-21_dp, 8.54408946394494113e-06_dp, & 
    0.00000000000000000e+00_dp]) > 1e-12_dp)) error stop

end program