source: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_arth.f90 @ 5159

Last change on this file since 5159 was 5113, checked in by abarral, 5 months ago

Rename modules in misc from *_mod > lmdz_*
Put cbrt.f90, ch*.f90, pch*.f90 in new lmdz_libmath_pch.f90

File size: 1.9 KB
Line 
1MODULE lmdz_arth
2
3  IMPLICIT NONE; PRIVATE
4  PUBLIC arth
5
6  INTEGER, PARAMETER :: NPAR_ARTH = 16, NPAR2_ARTH = 8
7
8  INTERFACE arth
9    ! Returns an arithmetic progression, given a first term "first", an
10    ! increment and a number of terms "n" (including "first").
11
12    MODULE PROCEDURE arth_r, arth_i
13    ! The difference between the procedures is the kind and type of
14    ! arguments first and increment and of function result.
15  END INTERFACE
16
17CONTAINS
18
19  PURE FUNCTION arth_r(first, increment, n)
20
21    REAL, INTENT(IN) :: first, increment
22    INTEGER, INTENT(IN) :: n
23    REAL arth_r(n)
24
25    ! Local:
26    INTEGER :: k, k2
27    REAL :: temp
28
29    !---------------------------------------
30
31    IF (n > 0) arth_r(1) = first
32    IF (n <= NPAR_ARTH) THEN
33      DO k = 2, n
34        arth_r(k) = arth_r(k - 1) + increment
35      END DO
36    ELSE
37      DO k = 2, NPAR2_ARTH
38        arth_r(k) = arth_r(k - 1) + increment
39      END DO
40      temp = increment * NPAR2_ARTH
41      k = NPAR2_ARTH
42      DO
43        IF (k >= n) EXIT
44        k2 = k + k
45        arth_r(k + 1:min(k2, n)) = temp + arth_r(1:min(k, n - k))
46        temp = temp + temp
47        k = k2
48      END DO
49    END IF
50
51  END FUNCTION arth_r
52
53  !*************************************
54
55  PURE FUNCTION arth_i(first, increment, n)
56
57    INTEGER, INTENT(IN) :: first, increment, n
58    INTEGER arth_i(n)
59
60    ! Local:
61    INTEGER :: k, k2, temp
62
63    !---------------------------------------
64
65    IF (n > 0) arth_i(1) = first
66    IF (n <= NPAR_ARTH) THEN
67      DO k = 2, n
68        arth_i(k) = arth_i(k - 1) + increment
69      END DO
70    ELSE
71      DO k = 2, NPAR2_ARTH
72        arth_i(k) = arth_i(k - 1) + increment
73      END DO
74      temp = increment * NPAR2_ARTH
75      k = NPAR2_ARTH
76      DO
77        IF (k >= n) EXIT
78        k2 = k + k
79        arth_i(k + 1:min(k2, n)) = temp + arth_i(1:min(k, n - k))
80        temp = temp + temp
81        k = k2
82      END DO
83    END IF
84
85  END FUNCTION arth_i
86
87END MODULE lmdz_arth
Note: See TracBrowser for help on using the repository browser.