GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: misc/arth_m.F90 Lines: 12 28 42.9 %
Date: 2023-06-30 12:56:34 Branches: 12 36 33.3 %

Line Branch Exec Source
1
MODULE arth_m
2
3
  IMPLICIT NONE
4
5
  INTEGER, PARAMETER, private:: NPAR_ARTH=16, NPAR2_ARTH=8
6
7
  INTERFACE arth
8
     ! Returns an arithmetic progression, given a first term "first", an
9
     ! increment and a number of terms "n" (including "first").
10
11
     MODULE PROCEDURE arth_r, arth_i
12
     ! The difference between the procedures is the kind and type of
13
     ! arguments first and increment and of function result.
14
  END INTERFACE
15
16
  private arth_r, arth_i
17
18
CONTAINS
19
20
1
  pure FUNCTION arth_r(first,increment,n)
21
22
    REAL, INTENT(IN) :: first,increment
23
    INTEGER, INTENT(IN) :: n
24
    REAL arth_r(n)
25
26
    ! Local:
27
    INTEGER :: k,k2
28
    REAL :: temp
29
30
    !---------------------------------------
31
32
1
    if (n > 0) arth_r(1)=first
33
1
    if (n <= NPAR_ARTH) then
34
       do k=2,n
35
          arth_r(k)=arth_r(k-1)+increment
36
       end do
37
    else
38
8
       do k=2,NPAR2_ARTH
39
8
          arth_r(k)=arth_r(k-1)+increment
40
       end do
41
1
       temp=increment*NPAR2_ARTH
42
       k=NPAR2_ARTH
43
2
       do
44
3
          if (k >= n) exit
45
2
          k2=k+k
46

52
          arth_r(k+1:min(k2,n)) = temp + arth_r(1:min(k,n-k))
47
2
          temp=temp+temp
48
1
          k=k2
49
       end do
50
    end if
51
52
  END FUNCTION arth_r
53
54
  !*************************************
55
56
  pure FUNCTION arth_i(first,increment,n)
57
58
    INTEGER, INTENT(IN) :: first,increment,n
59
    INTEGER arth_i(n)
60
61
    ! Local:
62
    INTEGER :: k,k2,temp
63
64
    !---------------------------------------
65
66
    if (n > 0) arth_i(1)=first
67
    if (n <= NPAR_ARTH) then
68
       do k=2,n
69
          arth_i(k)=arth_i(k-1)+increment
70
       end do
71
    else
72
       do k=2,NPAR2_ARTH
73
          arth_i(k)=arth_i(k-1)+increment
74
       end do
75
       temp=increment*NPAR2_ARTH
76
       k=NPAR2_ARTH
77
       do
78
          if (k >= n) exit
79
          k2=k+k
80
          arth_i(k+1:min(k2,n))=temp+arth_i(1:min(k,n-k))
81
          temp=temp+temp
82
          k=k2
83
       end do
84
    end if
85
86
  END FUNCTION arth_i
87
88
END MODULE arth_m