source: LMDZ5/branches/IPSLCM6.0.11pre/tools/Max_diff_nc_with_lib/NR_util/cumsum.f90

Last change on this file 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.3 KB
Line 
1MODULE cumsum_m
2
3  IMPLICIT NONE
4
5  INTEGER, PARAMETER, private :: NPAR_CUMSUM=16
6
7  INTERFACE cumsum
8     MODULE PROCEDURE cumsum_r,cumsum_i
9  END INTERFACE
10
11  private cumsum_r,cumsum_i
12
13CONTAINS
14
15  RECURSIVE FUNCTION cumsum_r(arr,seed) RESULT(ans)
16    REAL, DIMENSION(:), INTENT(IN) :: arr
17    REAL, OPTIONAL, INTENT(IN) :: seed
18    REAL, DIMENSION(size(arr)) :: ans
19    INTEGER :: n,j
20    REAL :: sd
21    n=size(arr)
22    if (n == 0) RETURN
23    sd=0.0
24    if (present(seed)) sd=seed
25    ans(1)=arr(1)+sd
26    if (n < NPAR_CUMSUM) then
27       do j=2,n
28          ans(j)=ans(j-1)+arr(j)
29       end do
30    else
31       ans(2:n:2)=cumsum_r(arr(2:n:2)+arr(1:n-1:2),sd)
32       ans(3:n:2)=ans(2:n-1:2)+arr(3:n:2)
33    end if
34  END FUNCTION cumsum_r
35  !BL
36  RECURSIVE FUNCTION cumsum_i(arr,seed) RESULT(ans)
37    INTEGER, DIMENSION(:), INTENT(IN) :: arr
38    INTEGER, OPTIONAL, INTENT(IN) :: seed
39    INTEGER, DIMENSION(size(arr)) :: ans
40    INTEGER :: n,j,sd
41    n=size(arr)
42    if (n == 0) RETURN
43    sd=0
44    if (present(seed)) sd=seed
45    ans(1)=arr(1)+sd
46    if (n < NPAR_CUMSUM) then
47       do j=2,n
48          ans(j)=ans(j-1)+arr(j)
49       end do
50    else
51       ans(2:n:2)=cumsum_i(arr(2:n:2)+arr(1:n-1:2),sd)
52       ans(3:n:2)=ans(2:n-1:2)+arr(3:n:2)
53    end if
54  END FUNCTION cumsum_i
55
56END MODULE cumsum_m
Note: See TracBrowser for help on using the repository browser.