source: LMDZ6/trunk/libf/misc/arth_m.f90 @ 5425

Last change on this file since 5425 was 5268, checked in by abarral, 2 months ago

.f90 <-> .F90 depending on cpp key use

File size: 1.9 KB
RevLine 
[2232]1MODULE 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
18CONTAINS
19
20  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    if (n > 0) arth_r(1)=first
33    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       do k=2,NPAR2_ARTH
39          arth_r(k)=arth_r(k-1)+increment
40       end do
41       temp=increment*NPAR2_ARTH
42       k=NPAR2_ARTH
43       do
44          if (k >= n) exit
45          k2=k+k
46          arth_r(k+1:min(k2,n)) = temp + arth_r(1:min(k,n-k))
47          temp=temp+temp
48          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
88END MODULE arth_m
Note: See TracBrowser for help on using the repository browser.