source: LMDZ5/trunk/libf/bibio/arth.F90 @ 1934

Last change on this file since 1934 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 1.8 KB
Line 
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".
10
11     MODULE PROCEDURE arth_r, arth_i
12     ! The difference between the procedures is the 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, DIMENSION(n) :: arth_r
25
26    ! Variables local to the procedure:
27
28    INTEGER :: k,k2
29    REAL :: temp
30
31    !---------------------------------------
32
33    if (n > 0) arth_r(1)=first
34    if (n <= NPAR_ARTH) then
35       do k=2,n
36          arth_r(k)=arth_r(k-1)+increment
37       end do
38    else
39       do k=2,NPAR2_ARTH
40          arth_r(k)=arth_r(k-1)+increment
41       end do
42       temp=increment*NPAR2_ARTH
43       k=NPAR2_ARTH
44       do
45          if (k >= n) exit
46          k2=k+k
47          arth_r(k+1:min(k2,n)) = temp + arth_r(1:min(k,n-k))
48          temp=temp+temp
49          k=k2
50       end do
51    end if
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, DIMENSION(n) :: arth_i
60    INTEGER :: k,k2,temp
61    if (n > 0) arth_i(1)=first
62    if (n <= NPAR_ARTH) then
63       do k=2,n
64          arth_i(k)=arth_i(k-1)+increment
65       end do
66    else
67       do k=2,NPAR2_ARTH
68          arth_i(k)=arth_i(k-1)+increment
69       end do
70       temp=increment*NPAR2_ARTH
71       k=NPAR2_ARTH
72       do
73          if (k >= n) exit
74          k2=k+k
75          arth_i(k+1:min(k2,n))=temp+arth_i(1:min(k,n-k))
76          temp=temp+temp
77          k=k2
78       end do
79    end if
80  END FUNCTION arth_i
81
82END MODULE arth_m
Note: See TracBrowser for help on using the repository browser.