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

Last change on this file since 5128 was 5113, checked in by abarral, 4 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
RevLine 
[5113]1MODULE lmdz_arth
[2232]2
[5113]3  IMPLICIT NONE; PRIVATE
4  PUBLIC arth
[2232]5
[5113]6  INTEGER, PARAMETER :: NPAR_ARTH = 16, NPAR2_ARTH = 8
[2232]7
8  INTERFACE arth
[5113]9    ! Returns an arithmetic progression, given a first term "first", an
10    ! increment and a number of terms "n" (including "first").
[2232]11
[5113]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.
[2232]15  END INTERFACE
16
17CONTAINS
18
[5113]19  PURE FUNCTION arth_r(first, increment, n)
[2232]20
[5113]21    REAL, INTENT(IN) :: first, increment
[2232]22    INTEGER, INTENT(IN) :: n
23    REAL arth_r(n)
24
25    ! Local:
[5113]26    INTEGER :: k, k2
[2232]27    REAL :: temp
28
29    !---------------------------------------
30
[5113]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
[2232]50
51  END FUNCTION arth_r
52
53  !*************************************
54
[5113]55  PURE FUNCTION arth_i(first, increment, n)
[2232]56
[5113]57    INTEGER, INTENT(IN) :: first, increment, n
[2232]58    INTEGER arth_i(n)
59
60    ! Local:
[5113]61    INTEGER :: k, k2, temp
[2232]62
63    !---------------------------------------
64
[5113]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
[2232]84
85  END FUNCTION arth_i
86
[5113]87END MODULE lmdz_arth
Note: See TracBrowser for help on using the repository browser.