source: LMDZ5/trunk/tools/Max_diff_nc_with_lib/NR_util/cumprod.f90 @ 1907

Last change on this file since 1907 was 1907, checked in by lguez, 10 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: 843 bytes
Line 
1module cumprod_m
2
3  implicit none
4
5contains
6
7  RECURSIVE FUNCTION cumprod(arr,seed) RESULT(ans)
8
9    ! Cumulative product on an array, with optional multiplicative seed.
10
11    USE nrtype, only: wp
12
13    REAL(WP), DIMENSION(:), INTENT(IN) :: arr
14    REAL(WP), OPTIONAL, INTENT(IN) :: seed
15    REAL(WP), DIMENSION(size(arr)) :: ans
16
17    ! Local:
18    INTEGER n,j
19    REAL(WP) :: sd
20    INTEGER, PARAMETER :: NPAR_CUMPROD=8
21
22    !--------------------------------------------------------
23
24    n=size(arr)
25    if (n == 0) RETURN
26    sd=1.0_wp
27    if (present(seed)) sd=seed
28    ans(1)=arr(1)*sd
29    if (n < NPAR_CUMPROD) then
30       do j=2,n
31          ans(j)=ans(j-1)*arr(j)
32       end do
33    else
34       ans(2:n:2)=cumprod(arr(2:n:2)*arr(1:n-1:2),sd)
35       ans(3:n:2)=ans(2:n-1:2)*arr(3:n:2)
36    end if
37
38  END FUNCTION cumprod
39
40end module cumprod_m
Note: See TracBrowser for help on using the repository browser.