module fft_mod
  implicit none
  integer,       parameter :: dp=selected_real_kind(15,300)
  real(kind=dp), parameter :: pi=3.141592653589793238460_dp
contains

  ! In place Cooley-Tukey FFT
  recursive subroutine fft(x)
    complex(kind=dp), dimension(:), intent(inout)  :: x
    complex(kind=dp)                               :: t
    integer                                        :: N
    integer                                        :: i
    complex(kind=dp), dimension(:), allocatable    :: even, odd

    N=size(x)

    if(N .le. 1) return

    allocate(odd((N+1)/2))
    allocate(even(N/2))

    ! divide
    odd =x(1:N:2)
    even=x(2:N:2)

    ! conquer
    call fft(odd)
    call fft(even)

    ! combine
    do i=1,N/2

t=exp(cmplx(0.0_dp,-2.0_dp*pi*real(i-1,dp)/real(N,dp),KIND=DP))*even(i)
       x(i)     = odd(i) + t
       x(i+N/2) = odd(i) - t
    end do

    deallocate(odd)
    deallocate(even)

  end subroutine fft

end module fft_mod

program test
  use fft_mod
  implicit none
  complex(kind=dp), dimension(8) :: data = (/1.0, 1.0, 1.0, 1.0, 0.0,

0.0, 0.0, 0.0/)
  integer :: i

  call fft(data)

  do i=1,8
     write(*,'("(", F20.15, ",", F20.15, "i )")') data(i)
  end do

end program test


!Autor: Claudio Iván Esparza Castañeda
!Título: Eliminación de Gauss
!Descripción: Programa que resuelve un sistema de ecuaciones empleando el método de eliminación de  Gauss
!Fecha: 16/12/2018

Program Gaussito
  implicit none
  INTEGER::i, j, k,  N, M
  REAL::S, sum
  REAL, allocatable, dimension(:, :)::A, B
  REAL, allocatable, dimension(:)::X

  open(unit=14, file="Matriz.dat", status="old")
  N=0
  do i=1, 10000
     read(14, *, end=15) S
     N=N+1
  end do
15 close(14)
  write(*, 1) N, N
1 format("El archivo contiene un sistema de", I2, " X", I2)

  allocate(A(1:N, 1:N), B(1:N, 1:N))
  do i=1, n
     do j=1, n
        if (i==j) then
           B(i, j)=1.0
        end if
     end do
  end do

  WRITE(*, *) "Matriz original"
  open(42, file="Matriz.dat", status="old")
  do i=1, N
     read(42, *) A(i, :)
     write(*, *) A(i, :)
  end do
  close(42)

  do k=1, N-1
     do i=k+1, N
        S=A(i, k)/A(k, k)
        do j=k+1, N
           A(i, j)=A(i, j)-A(k, j)*S
           B(i, j)=A(i, j)-A(k, j)*S
        end do
        A(i, k)=0.0d0
        B(i, k)=0.0d0
        A(i, N)=A(i, N)-S*A(k, N)
        B(i, N)=A(i, N)-S*A(k, N)
     end do
  end do
  write(*, *) "Matriz invertida"
  do i=1, n
     WRITE(*, *) B(i, :)
  end do
  deallocate(A, B)
end Program Gaussito


module binom
  implicit none

  integer, parameter :: iknd = selected_int_kind(36)
  ! 36 is necessary for very large n and k, integer(kind=8) wasn't enough!

  integer(iknd) :: mm(100,100)

contains

  recursive function combo(n,k) result(cmb)
    integer(kind=iknd) :: cmb
    integer(kind=iknd), intent(in) :: n,k

    if (k == n) then
        cmb = 1
    else if (k == 1) then
        cmb = n
    else if (mm(n,k) /=0)  then
        cmb = mm(n,k)
    else if ((k /= 1) .and. (k /= n)) then
        cmb = combo(n-1,k-1) + combo(n-1,k)
        mm(n,k) = cmb
    end if
  end function

end module

program fctrecur
  use binom

  implicit none

  integer(kind=iknd) i,j

  print *, "What is n?"
  read *, i

  print *, "What is k?"
  read *, j

  print *,combo(i,j)
  print *,combo(i,j)

end program fctrecur


FUNCTION det2 (x1,x2,x3,ndime,keep)

  !  calculates determinant (area)

  IMPLICIT NONE
  LOGICAL, INTENT(IN) :: keep
  INTEGER (kind=4), INTENT(IN) :: ndime
  REAL (kind=8), INTENT(IN) :: x1(ndime), x2(ndime), x3(ndime)
  REAL (kind=8) :: det2

  !local variables
  REAL (kind=8) ::  r(ndime), s(ndime), t(ndime)
  REAL (kind=8), SAVE :: tn(3)     !triangle normal for 3-D problems

  r = x2 - x1    !first side of the triangle
  s = x3 - x1    !second side of the triangle

  IF(ndime == 2)THEN                 !for 2-d problems
    det2 = (r(1)*s(2) - r(2)*s(1))

  ELSE                               ! (ndime == 3)
    CALL vecpro( r, s, t)            ! normal vector
    IF( keep )THEN                   ! compute normal vector
      CALL vecuni(ndime,t,det2)   ! unit vector and twice the element area
      tn = t                         ! keep positive normal to compare
    ELSE
      det2 = DOT_PRODUCT(t,tn)       ! proyect over positive normal (existent)
    END IF
  END IF

  RETURN

END FUNCTION det2


      FUNCTION ERF(x)
      USE stel_kinds, ONLY: rprec
!-------------------------------------------------------------------------------
!ERF evaluates the error function erf(x)
!References:
!  M.Abramowitz, L.A.Stegun, Handbook of Math. Functions, p. 299
!  W.A.Houlberg 7/2003
!Comments:
!  The error function can consume a lot of time deep in the multiple species
!    loop so a very efficient calculation is called for
!  Time consumption is much more critical than accuracy as suggested by T.Amano
!  A three term expansion from Abramowitz is not sufficiently accurate because
!    it generates viscosities with singularities in the vicinity of the BP-PS
!    transition for ions
!-------------------------------------------------------------------------------

!Declaration of input variables
      REAL(rprec), INTENT(IN) :: x                   !argument of error function [-]

!Declaration of output variables
      REAL(rprec) ::  ERF                            !value of error function [-]

!Declaration of local variables
      REAL(rprec) :: t

      REAL(rprec), PARAMETER :: one=1, p=0.3275911_rprec,
     1                          a1=0.254829592_rprec,
     2                          a2=-0.284496736_rprec,
     3                          a3=1.421413741_rprec,
     4                          a4=-1.453152027_rprec,
     5                          a5=1.061405429_rprec
!-------------------------------------------------------------------------------
!Apply fit
!-------------------------------------------------------------------------------
      t=one/(one + p*x)
      ERF = one - ( a1
     1          + ( a2
     2          + ( a3
     3          + ( a4
     4          +   a5*t)*t)*t)*t)*t*EXP(-x**2)

      END FUNCTION ERF


module SphereTracersModule

use NumberKindsModule
use SphereGeomModule

implicit none

public

contains

function SlottedCylinderTracer( x, y, z )
	real(kreal) :: SlottedCylinderTracer
	real(kreal), intent(in) :: x, y, z
	real(kreal), parameter :: xx1 = -0.866025403784439_kreal, &
							  yy1 = 0.5_kreal, zz1 = 0.0_kreal
	real(kreal), parameter :: xx2 = -0.866025403784439_kreal, &
							  yy2 = -0.5_kreal, zz2 = 0.0_kreal
	real(kreal), parameter :: lat1 = 0.0_kreal, long1 = 5.0_kreal*PI/6.0_kreal
	real(kreal), parameter :: lat2 = 0.0_kreal, long2 = 7.0_kreal*PI/6.0_kreal
	real(kreal), parameter :: RR = 0.5_kreal, b = 0.1_kreal, c = 1.0_kreal
	real(kreal) :: r1, r2, lat, lon

	lat = Latitude(x, y, z)
	lon = Longitude(x, y, z)
	r1 = SphereArcLength([x,y,z], [xx1,yy1,zz1])
	r2 = SphereArcLength([x,y,z], [xx2,yy2,zz2])

	SlottedCylinderTracer = b

	if ( r1 <= RR ) then
		if ( abs(lon - long1) >= RR / 6.0_kreal ) then
			SlottedCylinderTracer = c
		elseif ( lat - lat1 < -5.0_kreal * RR / 12.0_kreal ) then
			SlottedCylinderTracer = c
		endif
	endif

	if ( r2 <= RR ) then
		if ( abs(lon - long2) >= RR / 6.0_kreal ) then
			SlottedCylinderTracer = c
		elseif ( lat - lat2 > 5.0_kreal * RR / 12.0_kreal ) then
			SlottedCylinderTracer = c
		endif
	endif
end function

function CosineBellsTracer( x, y, z )
	real(kreal) CosineBellsTracer
	real(kreal), intent(in) :: x, y, z
	real(kreal), parameter :: xx1 = -0.866025403784439_kreal, &
							  yy1 = 0.5_kreal, zz1 = 0.0_kreal
	real(kreal), parameter :: xx2 = -0.866025403784439_kreal,&
		  					  yy2 = -0.5_kreal, zz2 = 0.0_kreal
	real(kreal), parameter :: hmax = 1.0_kreal, RR = 0.5_kreal, b = 0.1_kreal, c = 0.9_kreal
	real(kreal) :: r1, r2, h1, h2
	r1 = SphereArcLength([x,y,z], [xx1,yy1,zz1])
	r2 = SphereArcLength([x,y,z], [xx2,yy2,zz2])
	h1 = 0.5_kreal * hmax * (1.0_kreal + cos(PI*r1/RR))
	h2 = 0.5_kreal * hmax * (1.0_kreal + cos(PI*r2/RR))
	if ( r1 < RR ) then
		CosineBellsTracer = b + c * h1
	elseif ( r2 < RR) then
		CosineBellsTracer = b + c * h2
	else
		CosineBellsTracer = b
	endif
end function

function MovingVorticesTracer(x, y, z, t)
	real(kreal) :: MovingVorticesTracer
	real(kreal), intent(in) :: x, y, z, t
	real(kreal) :: lat, lon, rho, omg, lamPrime, rhoDenom
	real(kreal), parameter :: u0 = 2.0_kreal * PI / 12.0_kreal
	real(kreal), parameter :: Omega = u0

	lon = Longitude(x,y,z)
	lat = Latitude(x,y,z)

	lamPrime = atan4( - cos(lon - Omega * t), tan(lat) )

	rho = 3.0_kreal * sqrt( 1.0_kreal - cos(lat) * cos(lat) * sin( lon - Omega * t) * sin( lon - Omega * t))
	rhoDenom = rho / ( rho * rho + ZERO_TOL * ZERO_TOL )

	omg = 1.5_kreal * sqrt(3.0_kreal) * u0 * tanh(rho) / cosh(rho) / cosh(rho)

	MovingVorticesTracer = 1.0_kreal - tanh( 0.2_kreal * rho * sin( lamPrime - omg * t ))
end function

function GaussianHillsTracer( x, y, z )
	real(kreal) :: GaussianHillsTracer
	real(kreal), intent(in) :: x, y, z
	real(kreal), parameter :: beta = 5.0_kreal
	real(kreal), parameter :: center1x = cos(5.0_kreal * PI / 6.0_kreal), &
							  center1y = sin(5.0_kreal * PI / 6.0_kreal ), &
							  center1z = 0.0_kreal
	real(kreal), parameter :: center2x = cos(7.0_kreal * PI / 6.0_kreal), &
						   	  center2y = sin(7.0_kreal * PI / 6.0_kreal ), &
						   	  center2z = 0.0_kreal
	real(kreal), parameter :: hmax = 0.95_kreal
	real(kreal) :: h1, h2

	h1 = hmax * exp( -beta * ( (x - center1x) * (x - center1x) + (y - center1y) * (y - center1y) + &
							   (z - center1z) * (z - center1z) ) )
	h2 = hmax * exp( -beta * ( (x - center2x) * (x - center2x) + (y - center2y) * (y - center2y) + &
							   (z - center2z) * (z - center2z) ) )
	GaussianHillsTracer = h1 + h2
end function

function BlockMVector(x, y, z)
	real(kreal) :: BlockMVector
	real(kreal), intent(in) :: x, y, z
	real(kreal), parameter :: unit = PI/6.0_kreal
	real(kreal) :: lat, lon, xx, yy

	lat = Latitude(x,y,z)
	lon = atan2(y,x)
	xx = lon/unit
	yy = lat/unit
	BlockMVector = ScaledBlockM(xx, yy)
end function

function ScaledBlockM(x,y)
	real(kreal) :: ScaledBlockM
	real(kreal), intent(in) :: x, y
	real(kreal), parameter :: m = 1.6625_kreal, &
							  vert1 = 0.38421_kreal, &
							  horiz1 = 0.315789_kreal, &
							  horiz2 = 0.8421_kreal,&
							  horiz3 = 0.4736842,&
							  top = 0.7_kreal, &
							  right = 1.0_kreal, &
							  bottom = -0.7_kreal, &
							  left = -1.0_kreal, &
							  one = 1.0_kreal, &
							  zero = 0.0_kreal

	ScaledBlockM = 0.1_kreal
	! Left Foot
	if ( (( y < -vert1) .AND. ( y > bottom )) .AND. ( (x < - horiz1) .AND. (x > left))) ScaledBlockM = one
	! Right Foot
	if ( ( (y < -vert1) .AND. ( y > bottom )) .AND. ( (x > horiz1) .AND. (x < right))) ScaledBlockM = one
	! Left Leg
	if ( ( (y > bottom) .AND. (y < top) ) .AND. ( (x > -horiz2) .AND. (x < -horiz3 ))) ScaledBlockM = one
	! Right Leg
	If ( ( (y > bottom) .AND. (y<top)) .AND. ( (x>horiz3) .AND. (x<horiz2))) ScaledBlockM = one
	! Left top
	If ( ( (y > vert1) .AND. (y<top)) .AND. ( (x<-horiz1) .AND. (x> left))) ScaledBlockM = one
	! Right top
	If ( ( (y > vert1) .AND. (y<top)) .AND. ( (x<right) .AND. (x>horiz1))) ScaledBlockM = one
	! Left triangle
	If ( (x <= zero) .AND. ( y < top) ) then
		if (( y > -m*x - top) .AND. ( y < -m*(x + horiz1) + top)) ScaledBlockM = one
	endif
	If ( (x >= zero) .AND. ( y<top)) then
		if ((y > m*x - top) .AND. (y<m*(x-horiz1)+top)) ScaledBlockM = one
	endif
end function

pure function InitLatTracer( x0, y0, z0 )
	real(kreal) :: InitLatTracer
	real(kreal), intent(in) :: x0, y0, z0
	InitLatTracer = Latitude( x0, y0, z0 )
end function

pure function RH54Vorticity(x0, y0, z0 )
	real(kreal) :: RH54Vorticity
	real(kreal), intent(in) :: x0, y0, z0
	!
	real(kreal) :: lat, lon

	lat = Latitude(x0, y0, z0)
	lon = Longitude(x0, y0, z0)

	RH54Vorticity = 30.0_kreal * cos( 4.0_kreal * lon ) * cos( lat ) **4 * sin(lat)
end function

end module


program testeuler
  implicit none

  integer :: neq, nsteps, i
  double precision, allocatable, dimension(:) :: yin, yout, t, f1, f2, u
  double precision, allocatable, dimension(:, :) :: archive
  double precision :: tin, tout, dt, a, b, x, y, xactual, yactual

  neq = 4
  nsteps = 10000
  allocate(yin(neq), yout(neq), t(0:nsteps), u(neq), f1(neq), f2(neq), archive(neq, 0:nsteps))

  a = 0.0d0
  b = 3.0d1

  dt = (b - a) / dble(nsteps)

  do i = 0, nsteps
	   t(i) = a + dble(i) * dt
   end do

   archive (:,0) = (/ 1.0d0, 0.0d0, 0.0d0, 1.0d0 /)

   yin = archive(:,0)

   do i = 0, (nsteps - 1)
     tin = t(i)
	   tout = t(i + 1)
	   yin = archive(:,i)
     call computef(neq, tin, yin, f1)
     u = (yin + (tout - tin) * f1)
	   call computef(neq, tin, yin, f2)
	   yout = (yin + (tout - tin) * (f1 + f2) / 2.0d0)
     ! call computef(neq, tin, yin, f1)
	   ! yout = yin + (tout - tin) * f1
	   archive(:, i + 1) = yout
   end do

   print*,'Creating "out0" '
   open(unit=8,file='out0', status='replace')
   do i = 0, nsteps
     write(8,*) archive(1,i), archive(2,i)
   end do

   close(8)

   print*,'Writing Eulererror'
   open(unit=8, file='Eulererror', status='replace')

   do i = 0, nsteps
	    x = archive(1,i)
	    y = archive(2,i)
	    xactual = cos(t(i))
	    yactual = sin(t(i))
	    write(8,*) i, sqrt((x-xactual) ** 2 + (y - yactual) ** 2)
    end do

    deallocate(yin, yout, t, u, f1, f2, archive)

    stop
end


MODULE mo_moment

  ! This module contains routines for the masked calculation of
  ! statistical properties such as moments and mixed moments of input vectors

  ! Note routines work with optional ddof, i.e. "Delta Degrees of Freedom":
  ! the divisor used in the calculations is n-ddof, where n represents the number of (non-masked) elements.
  ! By default ddof is zero, i.e. variance and standard deviations are population and not sample moments,
  ! i.e. they are divided by n and not (n-1).

  ! Literature
  !   Moments (incl. mean, stddev, etc.) - Chapter 14 of
  !       WH Press, SA Teukolsky, WT Vetterling, BP Flannery,
  !           Numerical Recipes in Fortran 90 - The Art of Parallel Scientific Computing, 2nd Edition
  !           Volume 2 of Fortran Numerical Recipes, Cambridge University Press, UK, 1996
  !   Central moments and error variances
  !       LH Benedict & RD Gould, Towards better uncertainty estimates for turbulence statistics,
  !           Experiments in Fluids 22, 129-136, 1996

  ! Written Nov 2011, Matthias Cuntz
  !         Modified, Matthias Cuntz, Dec 2011 - mod. correlation, covariance
  !         Modified by M. Schroen, Sep 2015, average/mean for single value
  !         Modified, Matthias Cuntz, May 2016 - ddof

  ! License
  ! -------
  ! This file is part of the JAMS Fortran package, distributed under the MIT License.
  !
  ! Copyright (c) 2011-2016 Matthias Cuntz - mc (at) macu (dot) de
  !
  ! Permission is hereby granted, free of charge, to any person obtaining a copy
  ! of this software and associated documentation files (the "Software"), to deal
  ! in the Software without restriction, including without limitation the rights
  ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  ! copies of the Software, and to permit persons to whom the Software is
  ! furnished to do so, subject to the following conditions:
  !
  ! The above copyright notice and this permission notice shall be included in all
  ! copies or substantial portions of the Software.
  !
  ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
  ! SOFTWARE.

  USE mo_kind, ONLY: i4, sp, dp

  IMPLICIT NONE

  PUBLIC :: absdev                        ! Mean absolute deviation from mean of an array
  PUBLIC :: average                       ! 1st moment of an array (same as mean)
  PUBLIC :: central_moment                ! Arbitrary central moment of an array
  PUBLIC :: central_moment_var            ! Central moment error variance
  PUBLIC :: correlation                   ! Correlation between two arrays
  PUBLIC :: covariance                    ! Covariance between two arrays
  PUBLIC :: kurtosis                      ! 4th moment of an array
  PUBLIC :: mean                          ! 1st moment of an array
  PUBLIC :: mixed_central_moment          ! Arbitrary mixed central moment
  PUBLIC :: mixed_central_moment_var      ! Arbitrary mixed central moment error variance
  PUBLIC :: moment                        ! 1st to 4th moments of an array
  PUBLIC :: skewness                      ! 3rd moment of an array
  PUBLIC :: stddev                        ! Sqrt of 2nd moment of an array
  PUBLIC :: variance                      ! 2nd moment of an array

  ! ------------------------------------------------------------------

  !     NAME
  !         absdev

  !     PURPOSE
  !         Calculates the mean absolute deviations from the mean
  !             absdev = sum(abs(x-mean(x)))/(n-ddof)
  !
  !         If an optinal mask is given, the calculations are over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = absdev(dat, mask=mask, ddof=ddof)

  !     INTENT(IN)
  !         real(sp/dp) :: dat(:)     1D-array with input numbers

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: absdev     mean absolute deviations from average

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(dat).
  !                                   If present, only those locations in vec corresponding to the true values in mask are used.
  !         integer(i4) :: ddof       Delta Degrees of Freedom. The divisor used in calculations is n-ddof,
  !                                   where n represents the number of (non-masked) elements. By default ddof is zero.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec = (/ 1., 2, 3., -999., 5., 6. /)
  !         m   = absdev(vec, mask=(vec >= 0.))
  !         -> see also example in test directory

  !     LITERATURE
  !         Press WH, Teukolsky SA, Vetterling WT, & Flannery BP - Numerical Recipes in Fortran 90 -
  !             The Art of Parallel Scientific Computing, 2nd Edition, Volume 2 of Fortran Numerical Recipes,
  !             Cambridge University Press, UK, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE absdev
     MODULE PROCEDURE absdev_sp, absdev_dp
  END INTERFACE absdev

  ! ------------------------------------------------------------------

  !     NAME
  !         average

  !     PURPOSE
  !         Calculates the average value of a vector, i.e. the first moment of a series of numbers:
  !             average = sum(x)/n
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = average(dat, mask=mask)

  !     INTENT(IN)
  !         real(sp/dp) :: dat(:)     1D-array with input numbers

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: average    average of all elements in dat

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(dat).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec = (/ 1., 2, 3., -999., 5., 6. /)
  !         m   = average(vec, mask=(vec >= 0.))
  !         -> see also example in test directory

  !     LITERATURE
  !         Press WH, Teukolsky SA, Vetterling WT, & Flannery BP - Numerical Recipes in Fortran 90 -
  !             The Art of Parallel Scientific Computing, 2nd Edition, Volume 2 of Fortran Numerical Recipes,
  !             Cambridge University Press, UK, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE average
     MODULE PROCEDURE average_sp, average_dp
  END INTERFACE average

  ! ------------------------------------------------------------------

  !     NAME
  !         central_moment

  !     PURPOSE
  !         Calculates the central moment of a vector, i.e. the r-central moment of a series of numbers:
  !             central_moment = sum((x-mean(x))**r)/(n-ddof)
  !         Note that the variance is the second central moment: variance(x) = central_moment(x,2)
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = central_moment(x, r, mask=mask, ddof=ddof)

  !     INTENT(IN)
  !         real(sp/dp) :: dat(:)     1D-array with input numbers
  !         integer(i4) :: r          order of the central moment, i.e. r=2 is variance

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: central_moment    r-th central moment of elements in dat

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(dat).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.
  !         integer(i4) :: ddof       Delta Degrees of Freedom. The divisor used in calculations is n-ddof,
  !                                   where n represents the number of (non-masked) elements. By default ddof is zero.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec = (/ 1., 2, 3., -999., 5., 6. /)
  !         m   = central_moment(vec, 2, mask=(vec >= 0.))
  !         -> see also example in test directory

  !     LITERATURE
  !         LH Benedict & RD Gould, Towards better uncertainty estimates for turbulence statistics,
  !             Experiments in Fluids 22, 129-136, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE central_moment
     MODULE PROCEDURE central_moment_sp, central_moment_dp
  END INTERFACE central_moment

  ! ------------------------------------------------------------------

  !     NAME
  !         central_moment_var

  !     PURPOSE
  !         Calculates the sampling variance of the central moment of a vector.
  !         central_moment_var is something like the "error variance" of the r-th order central moment sampling statistic.
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = central_moment_var(x, r, nin=nin, mask=mask, ddof=ddof)

  !     INTENT(IN)
  !         real(sp/dp) :: dat(:)     1D-array with input numbers
  !         integer(i4) :: r          order of the central moment, i.e. r=2 is variance

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: central_moment_var    sampling variance of r-th central moment of elements in dat

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(dat).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.
  !         integer(i4) :: ddof       Delta Degrees of Freedom. The divisor used in calculations is n-ddof,
  !                                   where n represents the number of (non-masked) elements. By default ddof is zero.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec = (/ 1., 2, 3., -999., 5., 6. /)
  !         m   = central_moment(vec, 2, mask=(vec >= 0.))
  !         em  = central_moment_var(vec, 2, mask=(vec >= 0.))
  !         -> see also example in test directory

  !     LITERATURE
  !         LH Benedict & RD Gould, Towards better uncertainty estimates for turbulence statistics,
  !             Experiments in Fluids 22, 129-136, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE central_moment_var
     MODULE PROCEDURE central_moment_var_sp, central_moment_var_dp
  END INTERFACE central_moment_var

  ! ------------------------------------------------------------------

  !     NAME
  !         correlation

  !     PURPOSE
  !         Calculates the correlation between two input vectors, i.e. the covariance divided by the standard deviations:
  !             correlation = (sum((x-mean(x))*(y-mean(y)))/(n-ddof)) / (stddev(x)*stddev(y))
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = correlation(x, y, mask=mask, ddof=ddof)

  !     INTENT(IN)
  !         real(sp/dp) :: x(:)     First 1D-array with input numbers
  !         real(sp/dp) :: y(:)     Second 1D-array with input numbers

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: correlation    correlation between x and y

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(x).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.
  !         integer(i4) :: ddof       Delta Degrees of Freedom. The divisor used in calculations is n-ddof,
  !                                   where n represents the number of (non-masked) elements. By default ddof is zero.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec1 = (/ 1., 2, 3., -999., 5., 6. /)
  !         vec2 = (/ 1.3, 2.7, 3.9, 5.1, 6., 8. /)
  !         m   = correlation(vec1, vec2, mask=((vec1 >= 0.) .and. (vec2 >= 0.)))
  !         -> see also example in test directory

  !     LITERATURE
  !         Press WH, Teukolsky SA, Vetterling WT, & Flannery BP - Numerical Recipes in Fortran 90 -
  !             The Art of Parallel Scientific Computing, 2nd Edition, Volume 2 of Fortran Numerical Recipes,
  !             Cambridge University Press, UK, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  !         Modified, MC, Dec 2011 - covariance as <(x-<x>)(y-<y>)> instead of <xy>-<x><y>
  INTERFACE correlation
     MODULE PROCEDURE correlation_sp, correlation_dp
  END INTERFACE correlation

  ! ------------------------------------------------------------------

  !     NAME
  !         covariance

  !     PURPOSE
  !         Calculates the covariance between two input vectors:
  !             covariance = sum((x-mean(x))*(y-mean(y)))/n
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = covariance(x, y, mask=mask)

  !     INTENT(IN)
  !         real(sp/dp) :: x(:)     First 1D-array with input numbers
  !         real(sp/dp) :: y(:)     Second 1D-array with input numbers

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: covariance    covariance between x and y

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(x).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec1 = (/ 1., 2, 3., -999., 5., 6. /)
  !         vec2 = (/ 1.3, 2.7, 3.9, 5.1, 6., 8. /)
  !         m   = covariance(vec1, vec2, mask=((vec1 >= 0.) .and. (vec2 >= 0.)))
  !         -> see also example in test directory

  !     LITERATURE
  !         Press WH, Teukolsky SA, Vetterling WT, & Flannery BP - Numerical Recipes in Fortran 90 -
  !             The Art of Parallel Scientific Computing, 2nd Edition, Volume 2 of Fortran Numerical Recipes,
  !             Cambridge University Press, UK, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  !         Modified, MC, Dec 2011 - covariance as <(x-<x>)(y-<y>)> instead of <xy>-<x><y>
  INTERFACE covariance
     MODULE PROCEDURE covariance_sp, covariance_dp
  END INTERFACE covariance

  ! ------------------------------------------------------------------

  !     NAME
  !         kurtosis

  !     PURPOSE
  !         Calculates the kurtosis of a vector, also called excess kurtosis:
  !             kurtosis = central_moment(x,4) / variance(x)**2 - 3
  !                      = sum(((x-mean(x))/stddev(x))**4)/n - 3
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = kurtosis(dat, mask=mask)

  !     INTENT(IN)
  !         real(sp/dp) :: dat(:)     1D-array with input numbers

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: kurtosis    kurtosis of all elements in dat

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(dat).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec = (/ 1., 2, 3., -999., 5., 6. /)
  !         m   = kurtosis(vec, mask=(vec >= 0.))
  !         -> see also example in test directory

  !     LITERATURE
  !         Press WH, Teukolsky SA, Vetterling WT, & Flannery BP - Numerical Recipes in Fortran 90 -
  !             The Art of Parallel Scientific Computing, 2nd Edition, Volume 2 of Fortran Numerical Recipes,
  !             Cambridge University Press, UK, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE kurtosis
     MODULE PROCEDURE kurtosis_sp, kurtosis_dp
  END INTERFACE kurtosis

  ! ------------------------------------------------------------------

  !     NAME
  !         mean

  !     PURPOSE
  !         Calculates the average value of a vector, i.e. the first moment of a series of numbers:
  !             mean = sum(x)/n
  !
  !         If an optinal mask is given, the mean is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = mean(dat, mask=mask)

  !     INTENT(IN)
  !         real(sp/dp) :: dat(:)     1D-array with input numbers

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: mean       average of all elements in dat

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(dat).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec = (/ 1., 2, 3., -999., 5., 6. /)
  !         m   = mean(vec, mask=(vec >= 0.))
  !         -> see also example in test directory

  !     LITERATURE
  !         Press WH, Teukolsky SA, Vetterling WT, & Flannery BP - Numerical Recipes in Fortran 90 -
  !             The Art of Parallel Scientific Computing, 2nd Edition, Volume 2 of Fortran Numerical Recipes,
  !             Cambridge University Press, UK, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE mean
     MODULE PROCEDURE mean_sp, mean_dp
  END INTERFACE mean

  ! ------------------------------------------------------------------

  !     NAME
  !         mixed_central_moment

  !     PURPOSE
  !         Calculates the r,s-th mixed central moment between two vectors:
  !             mixed_central_moment = sum((x-mean(x))**r * (y-mean(y))**s)/(n-ddof)
  !         Note that covariace(x,y) = mixed_central_moment(x,y,1,1)
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = mixed_central_moment(x, y, r, s, mask=mask, ddof=ddof)

  !     INTENT(IN)
  !         real(sp/dp) :: x(:)       First 1D-array
  !         real(sp/dp) :: y(:)       Second 1D-array
  !         integer(i4) :: r          order of x
  !         integer(i4) :: r          order of y

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: mixed_central_moment    r,s-th mixed central moment between x and y

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(x).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.
  !         integer(i4) :: ddof       Delta Degrees of Freedom. The divisor used in calculations is n-ddof,
  !                                   where n represents the number of (non-masked) elements. By default ddof is zero.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec1 = (/ 1., 2, 3., -999., 5., 6. /)
  !         vec2 = (/ 1.3, 2.7, 3.9, 5.1, 6., 8. /)
  !         m   = mixed_central_moment(vec1, vec2, 2, 2, mask=((vec1 >= 0.) .and. (vec2 >= 0.)))
  !         -> see also example in test directory

  !     LITERATURE
  !         LH Benedict & RD Gould, Towards better uncertainty estimates for turbulence statistics,
  !             Experiments in Fluids 22, 129-136, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE mixed_central_moment
     MODULE PROCEDURE mixed_central_moment_sp, mixed_central_moment_dp
  END INTERFACE mixed_central_moment

  ! ------------------------------------------------------------------

  !     NAME
  !         mixed_central_moment_var

  !     PURPOSE
  !         Calculates the sample variance of r,s-th mixed central moment between two vectors.
  !         mixed_central_moment_var is something like the "error variance" of
  !         the r,s-th order mixed central moment sampling statistic.
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = mixed_central_moment_var(x, y, r, s, mask=mask, ddof=ddof)

  !     INTENT(IN)
  !         real(sp/dp) :: x(:)       First 1D-array
  !         real(sp/dp) :: y(:)       Second 1D-array
  !         integer(i4) :: r          order of x
  !         integer(i4) :: r          order of y

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: mixed_central_moment_var    sampling variance of r,s-th mixed central moment between x and y

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(x).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.
  !         integer(i4) :: ddof       Delta Degrees of Freedom. The divisor used in calculations is n-ddof,
  !                                   where n represents the number of (non-masked) elements. By default ddof is zero.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec1 = (/ 1., 2, 3., -999., 5., 6. /)
  !         vec2 = (/ 1.3, 2.7, 3.9, 5.1, 6., 8. /)
  !         m    = mixed_central_moment(vec1, vec2, 2, 2, mask=((vec1 >= 0.) .and. (vec2 >= 0.)))
  !         em   = mixed_central_moment_var(vec1, vec2, 2, 2, mask=((vec1 >= 0.) .and. (vec2 >= 0.)))
  !         -> see also example in test directory

  !     LITERATURE
  !         LH Benedict & RD Gould, Towards better uncertainty estimates for turbulence statistics,
  !             Experiments in Fluids 22, 129-136, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE mixed_central_moment_var
     MODULE PROCEDURE mixed_central_moment_var_sp, mixed_central_moment_var_dp
  END INTERFACE mixed_central_moment_var

  ! ------------------------------------------------------------------

  !     NAME
  !         moment

  !     PURPOSE
  !         Calculates the first four sample moments of a vector, i.e. mean, variance, skewness, and kurtosis,
  !         as well as standard deviation and mean absolute devation.
  !            mean = sum(x)/n
  !            variance = sum((x-mean(x))**2)/(n-ddof)
  !            skewness = sum(((x-mean(x))/stddev(x))**3)/n
  !            kurtosis = sum(((x-mean(x))/stddev(x))**4)/n - 3
  !            stddev   = sqrt(variance)
  !            absdev   = sum(abs(x-mean(x)))/(n-ddof)
  !
  !         All output is optional.
  !         If an optinal mask is given, the calculations are over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         call moment(dat, average=average, variance=variance, skewness=skewness, kurtosis=kurtosis, &
  !                     mean=mean, stddev=stddev, absdev=absdev, mask=mask, ddof=ddof)

  !     INTENT(IN)
  !         real(sp/dp) :: dat(:)     1D-array with input numbers

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         None

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(dat).
  !                                   If present, only those locations in vec corresponding to the true values in mask are used.
  !         integer(i4) :: ddof       Delta Degrees of Freedom. The divisor used in calculations is n-ddof,
  !                                   where n represents the number of (non-masked) elements. By default ddof is zero.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         real(sp/dp) :: average    average of input vector
  !         real(sp/dp) :: variance   sample variance of input vector
  !         real(sp/dp) :: skewness   skewness of input vector
  !         real(sp/dp) :: kurtosis   excess kurtosis of input vector
  !         real(sp/dp) :: mean       same as average
  !         real(sp/dp) :: stddev     square root of variance
  !         real(sp/dp) :: absdev     mean absolute deviations from average

  !     RESTRICTIONS
  !         Input values must be floating points. Inpt and all optional outputs must have same kind.

  !     EXAMPLE
  !         vec = (/ 1., 2, 3., -999., 5., 6. /)
  !         call moment(vec, mask=(vec >= 0.), mean=m, stddev=s)
  !         -> see also example in test directory

  !     LITERATURE
  !         Press WH, Teukolsky SA, Vetterling WT, & Flannery BP - Numerical Recipes in Fortran 90 -
  !             The Art of Parallel Scientific Computing, 2nd Edition, Volume 2 of Fortran Numerical Recipes,
  !             Cambridge University Press, UK, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE moment
     MODULE PROCEDURE moment_sp, moment_dp
  END INTERFACE moment

  ! ------------------------------------------------------------------

  !     NAME
  !         skewness

  !     PURPOSE
  !         Calculates the skewness of a vector, i.e. the third standardised moment:
  !             skewness = sum(((x-mean(x))/stddev(x))**3)/n
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = skewness(dat, mask=mask)

  !     INTENT(IN)
  !         real(sp/dp) :: dat(:)     1D-array with input numbers

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: skewness    skewness of all elements in dat

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(dat).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec = (/ 1., 2, 3., -999., 5., 6. /)
  !         m   = skewness(vec, mask=(vec >= 0.))
  !         -> see also example in test directory

  !     LITERATURE
  !         Press WH, Teukolsky SA, Vetterling WT, & Flannery BP - Numerical Recipes in Fortran 90 -
  !             The Art of Parallel Scientific Computing, 2nd Edition, Volume 2 of Fortran Numerical Recipes,
  !             Cambridge University Press, UK, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE skewness
     MODULE PROCEDURE skewness_sp, skewness_dp
  END INTERFACE skewness

  ! ------------------------------------------------------------------

  !     NAME
  !         stddev

  !     PURPOSE
  !         Calculates the sample standard deviation of a vector, i.e. the square root of the second moment
  !             stddev = sqrt(sum((x-mean(x))**2)/(n-ddof))
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = stddev(dat, mask=mask, ddof=ddof)

  !     INTENT(IN)
  !         real(sp/dp) :: dat(:)     1D-array with input numbers

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: stddev     sample standard deviation of all elements in dat

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(dat).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.
  !         integer(i4) :: ddof       Delta Degrees of Freedom. The divisor used in calculations is n-ddof,
  !                                   where n represents the number of (non-masked) elements. By default ddof is zero.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec = (/ 1., 2, 3., -999., 5., 6. /)
  !         m   = stddev(vec, mask=(vec >= 0.))
  !         -> see also example in test directory

  !     LITERATURE
  !         Press WH, Teukolsky SA, Vetterling WT, & Flannery BP - Numerical Recipes in Fortran 90 -
  !             The Art of Parallel Scientific Computing, 2nd Edition, Volume 2 of Fortran Numerical Recipes,
  !             Cambridge University Press, UK, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE stddev
     MODULE PROCEDURE stddev_sp, stddev_dp
  END INTERFACE stddev

  ! ------------------------------------------------------------------

  !     NAME
  !         variance

  !     PURPOSE
  !         Calculates the sample variance of a vector, i.e. the second moment
  !             variance = sum((x-mean(x))**2)/(n-ddof)
  !
  !         If an optinal mask is given, the average is only over those locations that correspond to true values in the mask.
  !         x can be single or double precision. The result will have the same numerical precision.

  !     CALLING SEQUENCE
  !         out = variance(dat, mask=mask, ddof=ddof)

  !     INTENT(IN)
  !         real(sp/dp) :: dat(:)     1D-array with input numbers

  !     INTENT(INOUT)
  !         None

  !     INTENT(OUT)
  !         real(sp/dp) :: variance    sample variance of all elements in dat

  !     INTENT(IN), OPTIONAL
  !         logical :: mask(:)        1D-array of logical values with size(dat).
  !                                   If present, only those locations in dat corresponding to the true values in mask are used.
  !         integer(i4) :: ddof       Delta Degrees of Freedom. The divisor used in calculations is n-ddof,
  !                                   where n represents the number of (non-masked) elements. By default ddof is zero.

  !     INTENT(INOUT), OPTIONAL
  !         None

  !     INTENT(OUT), OPTIONAL
  !         None

  !     RESTRICTIONS
  !         Input values must be floating points.

  !     EXAMPLE
  !         vec = (/ 1., 2, 3., -999., 5., 6. /)
  !         m   = variance(vec, mask=(vec >= 0.))
  !         -> see also example in test directory

  !     LITERATURE
  !         Press WH, Teukolsky SA, Vetterling WT, & Flannery BP - Numerical Recipes in Fortran 90 -
  !             The Art of Parallel Scientific Computing, 2nd Edition, Volume 2 of Fortran Numerical Recipes,
  !             Cambridge University Press, UK, 1996

  !     HISTORY
  !         Written,  Matthias Cuntz, Nov 2011
  INTERFACE variance
     MODULE PROCEDURE variance_sp, variance_dp
  END INTERFACE variance

  ! ------------------------------------------------------------------

  PRIVATE

  ! ------------------------------------------------------------------

CONTAINS

  ! ------------------------------------------------------------------

  FUNCTION absdev_dp(dat, mask, ddof)

    IMPLICIT NONE

    REAL(dp), DIMENSION(:),           INTENT(IN) :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN) :: ddof
    REAL(dp)                                     :: absdev_dp

    REAL(dp) :: n

    REAL(dp) :: ave
    LOGICAL, DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error absdev_dp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(dat),dp)
    endif
    if (present(ddof)) n = n-real(ddof,dp)
    if (n < 1.0_dp) stop 'absdev_dp: n-ddof must be at least 1'

    ! Average
    ave  = sum(dat(:), mask=maske)/n
    ! Sum of absolute deviation
    absdev_dp = sum(abs(dat(:)-ave), mask=maske)/n

  END FUNCTION absdev_dp

  FUNCTION absdev_sp(dat, mask, ddof)

    IMPLICIT NONE

    REAL(sp), DIMENSION(:),           INTENT(IN) :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN) :: ddof
    REAL(sp)                                     :: absdev_sp

    REAL(sp) :: n

    REAL(sp) :: ave
    LOGICAL, DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error absdev_sp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(dat),sp)
    endif
    if (present(ddof)) n = n-real(ddof,sp)
    if (n < 1.0_sp) stop 'absdev_sp: n-ddof must be at least 1'

    ! Average
    ave  = sum(dat(:), mask=maske)/n
    ! Sum of absolute deviation
    absdev_sp = sum(abs(dat(:)-ave), mask=maske)/n

  END FUNCTION absdev_sp

  ! ------------------------------------------------------------------

  FUNCTION average_dp(dat, mask)

    IMPLICIT NONE

    REAL(dp), DIMENSION(:),           INTENT(IN)  :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN)  :: mask
    REAL(dp)                                      :: average_dp

    REAL(dp) :: n
    LOGICAL, DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error average_dp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(dat),dp)
    endif

    ! Average
    average_dp  = sum(dat(:), mask=maske)/n

  END FUNCTION average_dp

  FUNCTION average_sp(dat, mask)

    IMPLICIT NONE

    REAL(sp), DIMENSION(:),           INTENT(IN)  :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN)  :: mask
    REAL(sp)                                      :: average_sp

    REAL(sp) :: n
    LOGICAL, DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error average_sp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(dat),sp)
    endif

    ! Average
    average_sp  = sum(dat(:), mask=maske)/n

  END FUNCTION average_sp

  ! ------------------------------------------------------------------

  FUNCTION central_moment_dp(x, r, mask, ddof)

    IMPLICIT NONE

    REAL(dp),    DIMENSION(:),           INTENT(IN) :: x
    INTEGER(i4),                         INTENT(IN) :: r
    LOGICAL,     DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),               OPTIONAL, INTENT(IN) :: ddof
    REAL(dp)                                        :: central_moment_dp

    REAL(dp)                    :: n, mx
    LOGICAL, DIMENSION(size(x)) :: maske

    if (r < 0) then
       central_moment_dp = 0.0_dp
       return
    endif
    if (r == 0) then
       central_moment_dp = 1.0_dp
       return
    endif

    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error central_moment_dp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(x),dp)
    endif
    if (present(ddof)) n = n-real(ddof,dp)
    if (n < 1.0_dp) stop 'central_moment_dp: n-ddof must be at least 1'

    ! average
    mx = sum(x, mask=maske) / n
    ! central moment
    central_moment_dp = sum((x-mx)**r, mask=maske) / n

  END FUNCTION central_moment_dp

  FUNCTION central_moment_sp(x, r, mask, ddof)

    IMPLICIT NONE

    REAL(sp),    DIMENSION(:),           INTENT(IN) :: x
    INTEGER(i4),                         INTENT(IN) :: r
    LOGICAL,     DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),               OPTIONAL, INTENT(IN) :: ddof
    REAL(sp)                                        :: central_moment_sp

    REAL(sp) :: n, mx
    LOGICAL, DIMENSION(size(x)) :: maske

    if (r < 0) then
       central_moment_sp = 0.0_sp
       return
    endif
    if (r == 0) then
       central_moment_sp = 1.0_sp
       return
    endif

    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error central_moment_sp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(x),sp)
    endif
    if (present(ddof)) n = n-real(ddof,sp)
    if (n < 1.0_sp) stop 'central_moment_sp: n-ddof must be at least 1'

    ! average
    mx = sum(x, mask=maske) / n
    ! central moment
    central_moment_sp = sum((x-mx)**r, mask=maske) / n

  END FUNCTION central_moment_sp

  ! ------------------------------------------------------------------

  FUNCTION central_moment_var_dp(x, r, mask, ddof)

    IMPLICIT NONE

    REAL(dp),    DIMENSION(:),           INTENT(IN) :: x
    INTEGER(i4),                         INTENT(IN) :: r
    LOGICAL,     DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),               OPTIONAL, INTENT(IN) :: ddof
    REAL(dp)                                        :: central_moment_var_dp

    REAL(dp) :: n, rr, u2r, ur, urm1, urp1, u2
    LOGICAL, DIMENSION(size(x)) :: maske

    if (r <= 1) then
       central_moment_var_dp = 0.0_dp
       return
    endif

    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error central_moment_var_dp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(x),dp)
    endif
    if (present(ddof)) n = n-real(ddof,dp)
    if (n < 1.0_dp) stop 'central_moment_var_dp: n-ddof must be at least 1'

    u2r  = central_moment(x, 2*r, mask=maske, ddof=ddof)
    ur   = central_moment(x, r,   mask=maske, ddof=ddof)
    urm1 = central_moment(x, r-1, mask=maske, ddof=ddof)
    u2   = central_moment(x, 2,   mask=maske, ddof=ddof)
    urp1 = central_moment(x, r+1, mask=maske, ddof=ddof)
    rr   = real(r,dp)
    central_moment_var_dp = (u2r - ur*ur + rr*rr*urm1*urm1*u2 - 2.0_dp*rr*urp1*urm1) / n

  END FUNCTION central_moment_var_dp

  FUNCTION central_moment_var_sp(x, r, mask, ddof)

    IMPLICIT NONE

    REAL(sp),    DIMENSION(:),           INTENT(IN) :: x
    INTEGER(i4),                         INTENT(IN) :: r
    LOGICAL,     DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),               OPTIONAL, INTENT(IN) :: ddof
    REAL(sp)                                        :: central_moment_var_sp

    REAL(sp) :: n, rr, u2r, ur, urm1, urp1, u2
    LOGICAL, DIMENSION(size(x)) :: maske

    if (r <= 1) then
       central_moment_var_sp = 0.0_sp
       return
    endif

    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error central_moment_var_sp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(x),sp)
    endif
    if (present(ddof)) n = n-real(ddof,sp)
    if (n < 1.0_sp) stop 'central_moment_var_sp: n-ddof must be at least 1'

    u2r  = central_moment(x, 2*r, mask=maske, ddof=ddof)
    ur   = central_moment(x, r,   mask=maske, ddof=ddof)
    urm1 = central_moment(x, r-1, mask=maske, ddof=ddof)
    u2   = central_moment(x, 2,   mask=maske, ddof=ddof)
    urp1 = central_moment(x, r+1, mask=maske, ddof=ddof)
    rr   = real(r,sp)
    central_moment_var_sp = (u2r - ur*ur + rr*rr*urm1*urm1*u2 - 2.0_sp*rr*urp1*urm1) / n

  END FUNCTION central_moment_var_sp

  ! ------------------------------------------------------------------

  FUNCTION correlation_dp(x, y, mask, ddof)

    IMPLICIT NONE

    REAL(dp), DIMENSION(:),           INTENT(IN) :: x
    REAL(dp), DIMENSION(:),           INTENT(IN) :: y
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN) :: ddof
    REAL(dp)                                     :: correlation_dp

    REAL(dp)    :: n
    REAL(dp)    :: mx, my
    REAL(dp)    :: sx, sy, covar
    LOGICAL, DIMENSION(size(x)) :: maske

    if (size(x) .ne. size(y)) stop 'Error correlation_dp: size(x) .ne. size(y)'
    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error correlation_dp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(x),dp)
    endif
    if (present(ddof)) n = n-real(ddof,dp)
    if (n < 1.0_dp) stop 'correlation_dp: n-ddof must be at least 1'

    ! Mean and Stddev of x and y
    call moment(x, mx, stddev=sx, mask=maske, ddof=ddof)
    call moment(y, my, stddev=sy, mask=maske, ddof=ddof)
    covar = sum((x-mx)*(y-my), mask=maske) / n
    ! correlation
    correlation_dp  = covar / (sx*sy)

  END FUNCTION correlation_dp

  FUNCTION correlation_sp(x, y, mask, ddof)

    IMPLICIT NONE

    REAL(sp), DIMENSION(:),           INTENT(IN) :: x
    REAL(sp), DIMENSION(:),           INTENT(IN) :: y
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN) :: ddof
    REAL(sp)                                     :: correlation_sp

    REAL(sp)    :: n
    REAL(sp)    :: mx, my
    REAL(sp)    :: sx, sy, covar
    LOGICAL, DIMENSION(size(x)) :: maske

    if (size(x) .ne. size(y)) stop 'Error correlation_sp: size(x) .ne. size(y)'
    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error correlation_sp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(x),sp)
    endif
    if (present(ddof)) n = n-real(ddof,sp)
    if (n < 1.0_sp) stop 'correlation_sp: n-ddof must be at least 1'

    ! Mean and Stddev of x and y
    call moment(x, mx, stddev=sx, mask=maske, ddof=ddof)
    call moment(y, my, stddev=sy, mask=maske, ddof=ddof)
    covar = sum((x-mx)*(y-my), mask=maske) / n
    ! correlation
    correlation_sp  = covar / (sx*sy)

  END FUNCTION correlation_sp

  ! ------------------------------------------------------------------

  FUNCTION covariance_dp(x, y, mask, ddof)

    IMPLICIT NONE

    REAL(dp), DIMENSION(:),           INTENT(IN) :: x
    REAL(dp), DIMENSION(:),           INTENT(IN) :: y
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN) :: ddof
    REAL(dp)                                     :: covariance_dp

    REAL(dp)    :: n
    REAL(dp)    :: mx, my
    LOGICAL, DIMENSION(size(x)) :: maske

    if (size(x) .ne. size(y)) stop 'Error covariance_dp: size(x) .ne. size(y)'
    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error covariance_dp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(x),dp)
    endif
    if (present(ddof)) n = n-real(ddof,dp)
    if (n < 1.0_dp) stop 'covariance_dp: n-ddof must be at least 1'

    ! Mean of x and y
    mx = mean(x, mask=maske)
    my = mean(y, mask=maske)
    covariance_dp = sum((x-mx)*(y-my), mask=maske) / n

  END FUNCTION covariance_dp

  FUNCTION covariance_sp(x, y, mask, ddof)

    IMPLICIT NONE

    REAL(sp), DIMENSION(:),           INTENT(IN) :: x
    REAL(sp), DIMENSION(:),           INTENT(IN) :: y
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN) :: ddof
    REAL(sp)                                     :: covariance_sp

    REAL(sp)    :: n
    REAL(sp)    :: mx, my
    LOGICAL, DIMENSION(size(x)) :: maske

    if (size(x) .ne. size(y)) stop 'Error covariance_sp: size(x) .ne. size(y)'
    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error covariance_sp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(x),sp)
    endif
    if (present(ddof)) n = n-real(ddof,sp)
    if (n < 1.0_sp) stop 'covariance_sp: n-ddof must be at least 1'

    ! Mean of x and y
    mx = mean(x, mask=maske)
    my = mean(y, mask=maske)
    covariance_sp = sum((x-mx)*(y-my), mask=maske) / n

  END FUNCTION covariance_sp

  ! ------------------------------------------------------------------

  FUNCTION kurtosis_dp(dat, mask)

    IMPLICIT NONE

    REAL(dp), DIMENSION(:),           INTENT(IN)  :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN)  :: mask
    REAL(dp)                                      :: kurtosis_dp

    REAL(dp) :: n

    REAL(dp) :: ep, ave, var
    REAL(dp), DIMENSION(size(dat)) :: p, s
    LOGICAL,  DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error kurtosis_dp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(dat),dp)
    endif
    if (n < 2.0_dp) stop 'kurtosis_dp: n must be at least 2'

    ! Average
    ave  = sum(dat(:), mask=maske)/n
    s(:) = dat(:)-ave
    ! Variance / Standard deviation
    ep   = sum(s(:), mask=maske)
    p(:) = s(:)*s(:)
    var = sum(p(:), mask=maske)
    var = (var-ep*ep/n)/(n-1.0_dp)
    if (abs(var) < tiny(0.0_dp)) stop 'kurtosis_dp: no kurtosis when zero variance'
    ! Kurtosis
    p(:) = p(:)*s(:)*s(:)
    kurtosis_dp = sum(p(:), mask=maske)
    kurtosis_dp = kurtosis_dp/(n*var*var) - 3.0_dp

  END FUNCTION kurtosis_dp

  FUNCTION kurtosis_sp(dat, mask)

    IMPLICIT NONE

    REAL(sp), DIMENSION(:),           INTENT(IN)  :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN)  :: mask
    REAL(sp)                                      :: kurtosis_sp

    REAL(sp) :: n

    REAL(sp) :: ep, ave, var
    REAL(sp), DIMENSION(size(dat)) :: p, s
    LOGICAL,  DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error kurtosis_sp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(dat),sp)
    endif
    if (n < 2.0_sp) stop 'kurtosis_sp: n must be at least 2'

    ! Average
    ave  = sum(dat(:), mask=maske)/n
    s(:) = dat(:)-ave
    ! Variance / Standard deviation
    ep   = sum(s(:), mask=maske)
    p(:) = s(:)*s(:)
    var = sum(p(:), mask=maske)
    var = (var-ep*ep/n)/(n-1.0_sp)
    if (abs(var) < tiny(0.0_sp)) stop 'kurtosis_sp: no kurtosis when zero variance'
    ! Kurtosis
    p(:) = p(:)*s(:)*s(:)
    kurtosis_sp = sum(p(:), mask=maske)
    kurtosis_sp = kurtosis_sp/(n*var*var) - 3.0_sp

  END FUNCTION kurtosis_sp

  ! ------------------------------------------------------------------

  FUNCTION mean_dp(dat, mask)

    IMPLICIT NONE

    REAL(dp), DIMENSION(:),           INTENT(IN)  :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN)  :: mask
    REAL(dp)                                      :: mean_dp

    REAL(dp) :: n

    LOGICAL, DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error mean_dp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(dat),dp)
    endif

    ! Mean
    mean_dp  = sum(dat(:), mask=maske)/n

  END FUNCTION mean_dp

  FUNCTION mean_sp(dat, mask)

    IMPLICIT NONE

    REAL(sp), DIMENSION(:),           INTENT(IN)  :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN)  :: mask
    REAL(sp)                                      :: mean_sp

    REAL(sp) :: n

    LOGICAL, DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error mean_sp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(dat),sp)
    endif

    ! Mean
    mean_sp  = sum(dat(:), mask=maske)/n

  END FUNCTION mean_sp

  ! ------------------------------------------------------------------

  FUNCTION mixed_central_moment_dp(x, y, r, s, mask, ddof)

    IMPLICIT NONE

    REAL(dp),    DIMENSION(:),           INTENT(IN) :: x
    REAL(dp),    DIMENSION(:),           INTENT(IN) :: y
    INTEGER(i4),                         INTENT(IN) :: r
    INTEGER(i4),                         INTENT(IN) :: s
    LOGICAL,     DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),               OPTIONAL, INTENT(IN) :: ddof
    REAL(dp)                                        :: mixed_central_moment_dp

    REAL(dp)                     :: n, mx, my
    REAL(dp), DIMENSION(size(x)) :: xx, yy
    LOGICAL,  DIMENSION(size(x)) :: maske

    if (r<0 .or. s<0) then
       mixed_central_moment_dp = 0.0_dp
       return
    endif

    if (size(x) .ne. size(y)) stop 'Error mixed_central_moment_dp: size(x) .ne. size(y)'
    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error mixed_central_moment_dp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(x),dp)
    endif
    if (present(ddof)) n = n-real(ddof,dp)
    if (n < 1.0_dp) stop 'mixed_central_moment_dp: n-ddof must be at least 1'

    ! Averages of x and y
    mx = mean(x, mask=maske)
    my = mean(y, mask=maske)
    ! Mixed central moment
    if (r>0) then
       xx = (x-mx)**r
    else
       xx = 1._dp
    endif
    if (s>0) then
       yy = (y-my)**s
    else
       yy = 1._dp
    endif
    mixed_central_moment_dp = sum(xx*yy, mask=maske) / n

  END FUNCTION mixed_central_moment_dp

  FUNCTION mixed_central_moment_sp(x, y, r, s, mask, ddof)

    IMPLICIT NONE

    REAL(sp),    DIMENSION(:),           INTENT(IN) :: x
    REAL(sp),    DIMENSION(:),           INTENT(IN) :: y
    INTEGER(i4),                         INTENT(IN) :: r
    INTEGER(i4),                         INTENT(IN) :: s
    LOGICAL,     DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),               OPTIONAL, INTENT(IN) :: ddof
    REAL(sp)                                        :: mixed_central_moment_sp

    REAL(sp)                     :: n, mx, my
    REAL(sp), DIMENSION(size(x)) :: xx, yy
    LOGICAL,  DIMENSION(size(x)) :: maske

    if (r<0 .or. s<0) then
       mixed_central_moment_sp = 0.0_sp
       return
    endif

    if (size(x) .ne. size(y)) stop 'Error mixed_central_moment_sp: size(x) .ne. size(y)'
    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error mixed_central_moment_sp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(x),sp)
    endif
    if (present(ddof)) n = n-real(ddof,sp)
    if (n < 1.0_sp) stop 'mixed_central_moment_sp: n-ddof must be at least 1'

    ! Averages of x and y
    mx = mean(x, mask=maske)
    my = mean(y, mask=maske)
    ! Mixed central moment
    if (r>0) then
       xx = (x-mx)**r
    else
       xx = 1._sp
    endif
    if (s>0) then
       yy = (y-my)**s
    else
       yy = 1._sp
    endif
    mixed_central_moment_sp = sum(xx*yy, mask=maske) / n

  END FUNCTION mixed_central_moment_sp

  ! ------------------------------------------------------------------

  FUNCTION mixed_central_moment_var_dp(x, y, r, s, mask, ddof)
    ! Error variance of mixed central moment (Benedict & Gould 1996)
    IMPLICIT NONE

    REAL(dp),    DIMENSION(:),           INTENT(IN) :: x
    REAL(dp),    DIMENSION(:),           INTENT(IN) :: y
    INTEGER(i4),                         INTENT(IN) :: r
    INTEGER(i4),                         INTENT(IN) :: s
    LOGICAL,     DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),               OPTIONAL, INTENT(IN) :: ddof
    REAL(dp)                                        :: mixed_central_moment_var_dp

    REAL(dp) :: u2r2s, urs, urm1s, u20, urp1s, ursm1, u02, ursp1, u11
    REAL(dp) :: n, rr, ss
    LOGICAL, DIMENSION(size(x)) :: maske

    if (size(x) .ne. size(y)) stop 'Error mixed_central_moment_var_dp: size(x) .ne. size(y)'
    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error mixed_central_moment_var_dp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(x),dp)
    endif
    if (present(ddof)) n = n-real(ddof,dp)
    if (n < 1.0_dp) stop 'mixed_central_moment_var_dp: n-ddof must be at least 1'

    u2r2s = mixed_central_moment(x, y, 2*r, 2*s, mask=maske, ddof=ddof)
    urs   = mixed_central_moment(x, y, r,   s,   mask=maske, ddof=ddof)
    urm1s = mixed_central_moment(x, y, r-1, s,   mask=maske, ddof=ddof)
    u20   = mixed_central_moment(x, y, 2,   0,   mask=maske, ddof=ddof)
    urp1s = mixed_central_moment(x, y, r+1, s,   mask=maske, ddof=ddof)
    ursm1 = mixed_central_moment(x, y, r,   s-1, mask=maske, ddof=ddof)
    u02   = mixed_central_moment(x, y, 0,   2,   mask=maske, ddof=ddof)
    ursp1 = mixed_central_moment(x, y, r,   s+1, mask=maske, ddof=ddof)
    u11   = mixed_central_moment(x, y, 1,   1,   mask=maske, ddof=ddof)
    rr = real(r,dp)
    ss = real(s,dp)

    mixed_central_moment_var_dp = (u2r2s - urs*urs &
         + rr*rr**u20*urm1s*urm1s + ss*ss*u02*ursm1*ursm1 &
         + 2.0_dp*rr*ss*u11*urm1s*ursm1 &
         - 2.0_dp*rr*urp1s*urm1s - 2.0_dp*ss*ursp1*ursm1) / n

  END FUNCTION mixed_central_moment_var_dp

  FUNCTION mixed_central_moment_var_sp(x, y, r, s, mask, ddof)
    ! Error variance of mixed central moment (Benedict & Gould 1996)
    IMPLICIT NONE

    REAL(sp),    DIMENSION(:),           INTENT(IN) :: x
    REAL(sp),    DIMENSION(:),           INTENT(IN) :: y
    INTEGER(i4),                         INTENT(IN) :: r
    INTEGER(i4),                         INTENT(IN) :: s
    LOGICAL,     DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),               OPTIONAL, INTENT(IN) :: ddof
    REAL(sp)                                        :: mixed_central_moment_var_sp

    REAL(sp) :: u2r2s, urs, urm1s, u20, urp1s, ursm1, u02, ursp1, u11
    REAL(sp) :: n, rr, ss
    LOGICAL, DIMENSION(size(x)) :: maske

    if (size(x) .ne. size(y)) stop 'Error mixed_central_moment_var_sp: size(x) .ne. size(y)'
    if (present(mask)) then
       if (size(mask) .ne. size(x)) stop 'Error mixed_central_moment_var_sp: size(mask) .ne. size(x)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(x),sp)
    endif
    if (present(ddof)) n = n-real(ddof,sp)
    if (n < 1.0_sp) stop 'mixed_central_moment_var_sp: n-ddof must be at least 1'

    u2r2s = mixed_central_moment(x, y, 2*r, 2*s, mask=maske, ddof=ddof)
    urs   = mixed_central_moment(x, y, r,   s,   mask=maske, ddof=ddof)
    urm1s = mixed_central_moment(x, y, r-1, s,   mask=maske, ddof=ddof)
    u20   = mixed_central_moment(x, y, 2,   0,   mask=maske, ddof=ddof)
    urp1s = mixed_central_moment(x, y, r+1, s,   mask=maske, ddof=ddof)
    ursm1 = mixed_central_moment(x, y, r,   s-1, mask=maske, ddof=ddof)
    u02   = mixed_central_moment(x, y, 0,   2,   mask=maske, ddof=ddof)
    ursp1 = mixed_central_moment(x, y, r,   s+1, mask=maske, ddof=ddof)
    u11   = mixed_central_moment(x, y, 1,   1,   mask=maske, ddof=ddof)
    rr = real(r,sp)
    ss = real(s,sp)

    mixed_central_moment_var_sp = (u2r2s - urs*urs &
         + rr*rr**u20*urm1s*urm1s + ss*ss*u02*ursm1*ursm1 &
         + 2.0_sp*rr*ss*u11*urm1s*ursm1 &
         - 2.0_sp*rr*urp1s*urm1s - 2.0_sp*ss*ursp1*ursm1) / n

  END FUNCTION mixed_central_moment_var_sp

  ! ------------------------------------------------------------------

  SUBROUTINE moment_dp(dat, average, variance, skewness, kurtosis, mean, stddev, absdev, mask, ddof)

    IMPLICIT NONE

    REAL(dp), DIMENSION(:),           INTENT(IN)  :: dat
    REAL(dp),               OPTIONAL, INTENT(OUT) :: average
    REAL(dp),               OPTIONAL, INTENT(OUT) :: variance
    REAL(dp),               OPTIONAL, INTENT(OUT) :: skewness
    REAL(dp),               OPTIONAL, INTENT(OUT) :: kurtosis
    REAL(dp),               OPTIONAL, INTENT(OUT) :: mean
    REAL(dp),               OPTIONAL, INTENT(OUT) :: stddev
    REAL(dp),               OPTIONAL, INTENT(OUT) :: absdev
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN)  :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN)  :: ddof

    REAL(dp) :: n, n1

    REAL(dp) :: ep, ave, var
    REAL(dp), DIMENSION(size(dat)) :: p, s
    LOGICAL,  DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error moment_dp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(dat),sp)
    endif
    if (present(ddof)) then
       n1 = n-real(ddof,dp)
    else
       n1 = n
    endif
    if (n1 < 1.0_dp) stop 'moment_dp: n-ddof must be at least 1'

    ! Any optional argument
    if (.not. (present(average) .or. present(variance) .or. present(skewness) .or. &
         present(kurtosis) .or. present(mean) .or. present(stddev) .or. present(absdev))) return
    ! Average
    ave  = sum(dat(:), mask=maske)/n
    if (present(average)) average = ave
    if (present(mean))    mean    = ave
    if (.not. (present(variance) .or. present(skewness) .or. &
         present(kurtosis) .or. present(stddev) .or. present(absdev))) return
    ! Absolute deviation
    s(:) = dat(:)-ave
    if (present(absdev)) absdev = sum(abs(s(:)), mask=maske)/n1
    ! Variance / Standard deviation
    if (.not. (present(variance) .or. present(skewness) .or. &
         present(kurtosis) .or. present(stddev))) return
    ep   = sum(s(:), mask=maske)
    p(:) = s(:)*s(:)
    var = sum(p(:), mask=maske)
    var = (var-ep*ep/n)/n1
    if (present(variance)) variance = var
    ! Standard deviation
    if (present(stddev)) stddev   = sqrt(var)
    if (.not. (present(skewness) .or. present(kurtosis))) return
    ! Skewness
    if (abs(var) < tiny(0.0_dp)) stop 'moment_dp: no skewness or kurtosis when zero variance'
    p(:) = p(:)*s(:)
    if (present(skewness)) then
       skewness = sum(p(:), mask=maske)
       skewness = skewness/(n*stddev*stddev*stddev)
    endif
    ! Kurtosis
    if (present(kurtosis)) then
       p(:) = p(:)*s(:)
       kurtosis = sum(p(:), mask=maske)
       kurtosis = kurtosis/(n*variance*variance) - 3.0_dp
    end if

  END SUBROUTINE moment_dp

  SUBROUTINE moment_sp(dat, average, variance, skewness, kurtosis, mean, stddev, absdev, mask, ddof)

    IMPLICIT NONE

    REAL(sp), DIMENSION(:),           INTENT(IN)  :: dat
    REAL(sp),               OPTIONAL, INTENT(OUT) :: average
    REAL(sp),               OPTIONAL, INTENT(OUT) :: variance
    REAL(sp),               OPTIONAL, INTENT(OUT) :: skewness
    REAL(sp),               OPTIONAL, INTENT(OUT) :: kurtosis
    REAL(sp),               OPTIONAL, INTENT(OUT) :: mean
    REAL(sp),               OPTIONAL, INTENT(OUT) :: stddev
    REAL(sp),               OPTIONAL, INTENT(OUT) :: absdev
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN)  :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN)  :: ddof

    REAL(sp) :: n, n1

    REAL(sp) :: ep, ave, var
    REAL(sp), DIMENSION(size(dat)) :: p, s
    LOGICAL,  DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error moment_sp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(dat),sp)
    endif
    if (present(ddof)) then
       n1 = n-real(ddof,sp)
    else
       n1 = n
    endif
    if (n1 < 1.0_sp) stop 'moment_sp: n-ddof must be at least 1'

    ! Any optional argument
    if (.not. (present(average) .or. present(variance) .or. present(skewness) .or. &
         present(kurtosis) .or. present(mean) .or. present(stddev) .or. present(absdev))) return
    ! Average
    ave  = sum(dat(:), mask=maske)/n
    if (present(average)) average = ave
    if (present(mean))    mean    = ave
    if (.not. (present(variance) .or. present(skewness) .or. &
         present(kurtosis) .or. present(stddev) .or. present(absdev))) return
    ! Absolute deviation
    s(:) = dat(:)-ave
    if (present(absdev)) absdev = sum(abs(s(:)), mask=maske)/n1
    ! Variance / Standard deviation
    if (.not. (present(variance) .or. present(skewness) .or. &
         present(kurtosis) .or. present(stddev))) return
    ep   = sum(s(:), mask=maske)
    p(:) = s(:)*s(:)
    var = sum(p(:), mask=maske)
    var = (var-ep*ep/n)/n1
    if (present(variance)) variance = var
    ! Standard deviation
    if (present(stddev)) stddev   = sqrt(var)
    if (.not. (present(skewness) .or. present(kurtosis))) return
    ! Skewness
    if (abs(var) < tiny(0.0_sp)) stop 'moment_sp: no skewness or kurtosis when zero variance'
    p(:) = p(:)*s(:)
    if (present(skewness)) then
       skewness = sum(p(:), mask=maske)
       skewness = skewness/(n*stddev*stddev*stddev)
    endif
    ! Kurtosis
    if (present(kurtosis)) then
       p(:) = p(:)*s(:)
       kurtosis = sum(p(:), mask=maske)
       kurtosis = kurtosis/(n*variance*variance) - 3.0_sp
    end if

  END SUBROUTINE moment_sp

  ! ------------------------------------------------------------------

  FUNCTION stddev_dp(dat, mask, ddof)

    IMPLICIT NONE

    REAL(dp), DIMENSION(:),           INTENT(IN) :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN) :: ddof
    REAL(dp)                                     :: stddev_dp

    REAL(dp) :: n, n1

    REAL(dp) :: ep, ave, var
    REAL(dp), DIMENSION(size(dat)) :: p, s
    LOGICAL,  DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error stddev_dp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(dat),dp)
    endif
    if (present(ddof)) then
       n1 = n-real(ddof,dp)
    else
       n1 = n
    endif
    if (n1 < 1.0_dp) stop 'stddev_dp: n-ddof must be at least 1'

    ! Average
    ave  = mean(dat(:), mask=maske)
    s(:) = dat(:)-ave
    ! Variance / Standard deviation
    ep   = sum(s(:), mask=maske)
    p(:) = s(:)*s(:)
    var = sum(p(:), mask=maske)
    var = (var-ep*ep/n)/n1
    stddev_dp = sqrt(var)

  END FUNCTION stddev_dp

  FUNCTION stddev_sp(dat, mask, ddof)

    IMPLICIT NONE

    REAL(sp), DIMENSION(:),           INTENT(IN) :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN) :: ddof
    REAL(sp)                                     :: stddev_sp

    REAL(sp) :: n, n1

    REAL(sp) :: ep, ave, var
    REAL(sp), DIMENSION(size(dat)) :: p, s
    LOGICAL,  DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error stddev_sp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(dat),sp)
    endif
    if (present(ddof)) then
       n1 = n-real(ddof,sp)
    else
       n1 = n
    endif
    if (n1 < 1.0_sp) stop 'stddev_sp: n-ddof must be at least 1'

    ! Average
    ave  = mean(dat(:), mask=maske)
    s(:) = dat(:)-ave
    ! Variance / Standard deviation
    ep   = sum(s(:), mask=maske)
    p(:) = s(:)*s(:)
    var = sum(p(:), mask=maske)
    var = (var-ep*ep/n)/n1
    stddev_sp = sqrt(var)

  END FUNCTION stddev_sp

  ! ------------------------------------------------------------------

  FUNCTION skewness_dp(dat, mask)

    IMPLICIT NONE

    REAL(dp), DIMENSION(:),           INTENT(IN)  :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN)  :: mask
    REAL(dp)                                      :: skewness_dp

    REAL(dp) :: n

    REAL(dp) :: ep, ave, var, stddev
    REAL(dp), DIMENSION(size(dat)) :: p, s
    LOGICAL,  DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error skewness_dp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(dat),dp)
    endif
    if (n < 2.0_dp) stop 'skewness_dp: n must be at least 2'

    ! Average
    ave  = sum(dat(:), mask=maske)/n
    s(:) = dat(:)-ave
    ! Variance / Standard deviation
    ep   = sum(s(:), mask=maske)
    p(:) = s(:)*s(:)
    var = sum(p(:), mask=maske)
    var = (var-ep*ep/n)/(n-1.0_dp)
    stddev = sqrt(var)
    ! Skewness
    if (abs(var) < tiny(0.0_dp)) stop 'skewness_dp: no skewness when zero variance'
    p(:) = p(:)*s(:)
    skewness_dp = sum(p(:), mask=maske)
    skewness_dp = skewness_dp/(n*stddev*stddev*stddev)

  END FUNCTION skewness_dp

  FUNCTION skewness_sp(dat, mask)

    IMPLICIT NONE

    REAL(sp), DIMENSION(:),           INTENT(IN)  :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN)  :: mask
    REAL(sp)                                      :: skewness_sp

    REAL(sp) :: n

    REAL(sp) :: ep, ave, var, stddev
    REAL(sp), DIMENSION(size(dat)) :: p, s
    LOGICAL,  DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error skewness_sp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(dat),sp)
    endif
    if (n < 2.0_sp) stop 'skewness_sp: n must be at least 2'

    ! Average
    ave  = sum(dat(:), mask=maske)/n
    s(:) = dat(:)-ave
    ! Variance / Standard deviation
    ep   = sum(s(:), mask=maske)
    p(:) = s(:)*s(:)
    var = sum(p(:), mask=maske)
    var = (var-ep*ep/n)/(n-1.0_sp)
    stddev = sqrt(var)
    ! Skewness
    if (abs(var) < tiny(0.0_sp)) stop 'skewness_sp: no skewness when zero variance'
    p(:) = p(:)*s(:)
    skewness_sp = sum(p(:), mask=maske)
    skewness_sp = skewness_sp/(n*stddev*stddev*stddev)

  END FUNCTION skewness_sp

  ! ------------------------------------------------------------------

  FUNCTION variance_dp(dat, mask, ddof)

    IMPLICIT NONE

    REAL(dp), DIMENSION(:),           INTENT(IN) :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN) :: ddof
    REAL(dp)                                     :: variance_dp

    REAL(dp) :: n, n1

    REAL(dp) :: ep, ave, var
    REAL(dp), DIMENSION(size(dat)) :: p, s
    LOGICAL,  DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error variance_dp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),dp)
    else
       maske(:) = .true.
       n = real(size(dat),dp)
    endif
    if (present(ddof)) then
       n1 = n-real(ddof,dp)
    else
       n1 = n
    endif
    if (n1 < 1.0_dp) stop 'variance_dp: n-ddof must be at least 1'

    ! Average
    ave  = mean(dat(:), mask=maske)
    s(:) = dat(:)-ave
    ! Variance / Standard deviation
    ep   = sum(s(:), mask=maske)
    p(:) = s(:)*s(:)
    var = sum(p(:), mask=maske)
    variance_dp = (var-ep*ep/n)/n1

  END FUNCTION variance_dp

  FUNCTION variance_sp(dat, mask, ddof)

    IMPLICIT NONE

    REAL(sp), DIMENSION(:),           INTENT(IN) :: dat
    LOGICAL,  DIMENSION(:), OPTIONAL, INTENT(IN) :: mask
    INTEGER(i4),            OPTIONAL, INTENT(IN) :: ddof
    REAL(sp)                                     :: variance_sp

    REAL(sp) :: n, n1

    REAL(sp) :: ep, ave, var
    REAL(sp), DIMENSION(size(dat)) :: p, s
    LOGICAL,  DIMENSION(size(dat)) :: maske

    if (present(mask)) then
       if (size(mask) .ne. size(dat)) stop 'Error variance_sp: size(mask) .ne. size(dat)'
       maske = mask
       n = real(count(maske),sp)
    else
       maske(:) = .true.
       n = real(size(dat),sp)
    endif
    if (present(ddof)) then
       n1 = n-real(ddof,sp)
    else
       n1 = n
    endif
    if (n1 < 1.0_sp) stop 'variance_sp: n-ddof must be at least 1'

    ! Average
    ave  = mean(dat(:), mask=maske)
    s(:) = dat(:)-ave
    ! Variance / Standard deviation
    ep   = sum(s(:), mask=maske)
    p(:) = s(:)*s(:)
    var = sum(p(:), mask=maske)
    variance_sp = (var-ep*ep/n)/n1

  END FUNCTION variance_sp

  ! ------------------------------------------------------------------

END MODULE mo_moment


!========================================================================
!
!                          T o m o f a s t - x
!                        -----------------------
!
!           Authors: Vitaliy Ogarko, Jeremie Giraud, Roland Martin.
!
!               (c) 2021 The University of Western Australia.
!
! The full text of the license is available in file "LICENSE".
!
!========================================================================

!===============================================================================
! Contains analytical solutions to 3D Laplace's equation in cylinder.
!
! Author: Vitaliy Ogarko, UWA, CET, Australia, 2015-2016.
!===============================================================================
module laplace

  use global_typedefs
  use trootj

  implicit none

  private

  public :: solution1
  public :: solution2

contains

!===============================================================================
! Reference: M. A. Pinsky, Partial differential equations, Example 3.5.1.
! TODO: add the reference for type=3 general solution.
!===============================================================================
subroutine solution1(nr,ntheta,nz,r,z,u,imax,kmax,type)
  integer, intent(in) :: nr,ntheta,nz,imax,kmax,type
  real(kind=CUSTOM_REAL), intent(in) :: r(0:2*nr+1)
  real(kind=CUSTOM_REAL), intent(in) :: z(0:nz+1)

  real(kind=CUSTOM_REAL), intent(out) :: u(0:nr+1,0:ntheta+1,0:nz+1)

  integer :: i,j,k,n
  real(kind=CUSTOM_REAL) :: radius, Rmax, L, coef, An

  u(:,:,:) = 0.d0

  ! Radius at which we have set the BC's u=1.
  Rmax = r(2*imax-1)

  ! Height at which we have set the BC's u=0.
  L = z(kmax)

  do k=0,kmax
    do j=0,ntheta+1
      do i=0,imax
        if (i == 0) then
          radius = 0.d0
        else
          radius = r(2*i-1)
        endif

        ! Without guards.
        if (type == 1) then
          ! Only odd n-values for series calculation are used.
          do n=1,100,2
            coef = dble(n)*PI/L
            u(i,j,k) = u(i,j,k) + sin(coef*z(k)) * BESSI0(coef*radius) / (dble(n)*BESSI0(coef*Rmax))
          enddo
          u(i,j,k) = u(i,j,k)*4.d0/PI

        ! With guards.
        else if (type == 2) then
          ! Only odd n-values for series calculation are used.
          do n=1,100,2
            coef = dble(n)*PI/L
            u(i,j,k) = u(i,j,k) + sin(coef*z(k)) * BESSI0(coef*radius) / (dble(n)*BESSI0(coef*Rmax)) * &
                                  (cos(dble(n)*PI/4.d0) - cos(3.d0*dble(n)*PI/4.d0))
          enddo
          u(i,j,k) = u(i,j,k)*2.d0/PI

        ! With gradual increase and decrease: Ta(z) = 4z/L(1-z/L)
        else if (type == 3) then
          ! Only odd n-values for series calculation are used.
          do n=1,100,2
            ! Partial An coefficient, excluding a constant factor (4L/PI^3)
            An = - (PI*dble(n)*sin(PI*dble(n)) + 2.d0*cos(PI*dble(n)) - 2.d0) / dble(n**3)

            coef = dble(n)*PI/L
            u(i,j,k) = u(i,j,k) + An * sin(coef*z(k)) * BESSI0(coef*radius) / BESSI0(coef*Rmax)
          enddo
          u(i,j,k) = u(i,j,k)*8.d0/PI**3
        endif

        ! This is analytically correct, since sin(n*PI)=0, but numerically it is not exactly zero.
        if (k == kmax) u(i,j,k) = 0.d0
      enddo
    enddo
  enddo

end subroutine solution1

!======================================================================================
! Reference: M. A. Pinsky, Partial differential equations, Example 3.5.2.
! Note there is a mistake in the book in the last equations, a term with z is missing.
!======================================================================================
subroutine solution2(nr,ntheta,nz,r,z,u,imax,kmax)
  integer, intent(in) :: nr,ntheta,nz,imax,kmax
  real(kind=CUSTOM_REAL), intent(in) :: r(0:2*nr+1)
  real(kind=CUSTOM_REAL), intent(in) :: z(0:nz+1)

  real(kind=CUSTOM_REAL), intent(out) :: u(0:nr+1,0:ntheta+1,0:nz+1)

  integer :: i,j,k,n
  real(kind=CUSTOM_REAL) :: radius, Rmax, L

  integer, parameter :: NK = 50
  INTEGER IER(NK)
  REAL(KIND=8) JZERO(NK)

  u(:,:,:) = 0.d0

  ! Radius at i=imax (where we have set the BC's u=0).
  Rmax = r(2*imax-1)

  ! Height at which we have set the BC's u=1.
  L = z(kmax)

  ! Calculate the roots of Bessel's function.
  call ROOTJ(0,NK,JZERO,IER)

  do n=1,NK
    if (IER(n) /= 0) then
      print *, "ERROR with Bessel function roots calculation!"
      stop
    endif
  enddo

  do k=0,kmax
    do j=0,ntheta+1
      do i=0,imax
        if (i == 0) then
          radius = 0.d0
        else
          radius = r(2*i-1)
        endif

        do n=1,NK
          u(i,j,k) = u(i,j,k) + BESSJ0(radius*JZERO(n)/Rmax) * sinh(JZERO(n)*z(k)/Rmax) / &
                                (JZERO(n) * BESSJ1(JZERO(n)) * sinh(JZERO(n)*L/Rmax))
        enddo

        u(i,j,k) = u(i,j,k)*2.d0

        ! This is analytically correct, since BESSJ0(JZERO(n))=0, but numerically it is not exactly zero.
        if (i == imax) u(i,j,k) = 0.d0
      enddo
    enddo
  enddo

end subroutine solution2

end module laplace


module asflowf_constants
    use asflowf_kinds, only : dp

    implicit none
    real(kind=dp), parameter :: bohr_to_angstrom = 0.529177249
    real(kind=dp), parameter :: pi = 3.141592653
    real(kind=dp), parameter :: ry_to_ev = 13.6056923
    real(kind=dp), parameter :: ha_to_ev = 27.211324570273

end module asflowf_constants


          program demo_selected_int_kind
          implicit none
            integer,parameter :: k5 = selected_int_kind(5)
            integer,parameter :: k15 = selected_int_kind(15)
            integer(kind=k5) :: i5
            integer(kind=k15) :: i15

            print *, huge(i5), huge(i15)

            ! the following inequalities are always true
            print *, huge(i5) >= 10_k5**5-1
            print *, huge(i15) >= 10_k15**15-1
          end program demo_selected_int_kind


program backward
    implicit none
    integer :: i, N
    real :: x, h
    real, external :: f

    h = 0.1
    N = 1. / h

    ! backward Euler method for f(x,t) = -100x + 100t + 101
    x = 1.01
    write(*,*)0., x
    do i=1,N
        x = (x + h * (100. * i * h + 101.)) / (1. + 100. * h)
        write(*,*)i * h, x
    end do

end program


FUNCTION chi2nc(x, f, theta) RESULT(fn_val)

! Code converted using TO_F90 by Alan Miller
! Date: 2000-06-16  Time: 00:34:40

! ALGORITHM AS 275 APPL.STATIST. (1992), VOL.41, NO.2

! Computes the noncentral chi-square distribution function with positive
! real degrees of freedom f and nonnegative noncentrality parameter theta

IMPLICIT NONE
INTEGER, PARAMETER    :: dp = SELECTED_REAL_KIND(12, 60)

REAL (dp), INTENT(IN)  :: x
REAL (dp), INTENT(IN)  :: f
REAL (dp), INTENT(IN)  :: theta
REAL (dp)              :: fn_val

! Local variables

INTEGER    :: ifault
LOGICAL    :: flag
REAL (dp)  :: lam, n, u, v, x2, f2, t, term, bound

! EXTERNAL alogam

INTEGER, PARAMETER    :: itrmax = 50
REAL (dp), PARAMETER  :: errmax = 1.0E-12, zero = 0.0_dp, one = 1.0_dp,  &
                         two = 2.0_dp

fn_val = x
ifault = 2
IF (f <= zero .OR. theta < zero) GO TO 999
ifault = 3
IF (x < zero) GO TO 999
ifault = 0
IF (x == zero) RETURN
lam = theta / two

!       Evaluate the first term

n = one
u = EXP(-lam)
v = u
x2 = x / two
f2 = f / two
t = x2 ** f2 * EXP(-x2) / EXP(lngamma(f2 + one))
term = v * t
fn_val = term

!       Check if (f+2n) is greater than x

flag = .false.
10 IF (f + two * n - x <= zero) GO TO 30

!       Find the error bound and check for convergence

flag = .true.
20 bound = t * x / (f + two * n - x)
IF (bound > errmax .AND. INT(n) <= itrmax) GO TO 30
IF (bound > errmax) ifault = 1
GO TO 999

!       Evaluate the next term of the expansion and then the partial sum

30 u = u * lam / n
v = v + u
t = t * x / (f + two * n)
term = v * t
fn_val = fn_val + term
n = n + one
IF (flag) GO TO 20
GO TO 10

999 WRITE(*, *) 'Error in CHI2NC, IFAULT = ', ifault
RETURN

CONTAINS

FUNCTION lngamma(z) RESULT(lanczos)

!  Uses Lanczos-type approximation to ln(gamma) for z > 0.
!  Reference:
!       Lanczos, C. 'A precision approximation of the gamma
!               function', J. SIAM Numer. Anal., B, 1, 86-96, 1964.
!  Accuracy: About 14 significant digits except for small regions
!            in the vicinity of 1 and 2.

!  Programmer: Alan Miller
!              1 Creswick Street, Brighton, Vic. 3187, Australia
!  Latest revision - 14 October 1996

REAL (dp), INTENT(IN)  :: z
REAL (dp)              :: lanczos

! Local variables

REAL (dp), PARAMETER   :: a(9) = (/   &
                          0.9999999999995183_dp, 676.5203681218835_dp, &
                          -1259.139216722289_dp, 771.3234287757674_dp, &
                          -176.6150291498386_dp, 12.50734324009056_dp, &
                          -0.1385710331296526_dp, 0.9934937113930748D-05, &
                          0.1659470187408462D-06 /),  &
                          lnsqrt2pi = 0.9189385332046727_dp, half = 0.5_dp, &
                          sixpt5 = 6.5_dp, seven = 7.0_dp
INTEGER    :: j
REAL (dp)  :: tmp

IF (z <= zero) THEN
  WRITE(*, *) 'Error: zero or -ve argument for lngamma'
  RETURN
END IF

lanczos = zero
tmp = z + seven
DO j = 9, 2, -1
  lanczos = lanczos + a(j)/tmp
  tmp = tmp - one
END DO
lanczos = lanczos + a(1)
lanczos = LOG(lanczos) + lnsqrt2pi - (z + sixpt5) + (z - half)*LOG(z + sixpt5)
RETURN

END FUNCTION lngamma

END FUNCTION chi2nc


!------------------------------------------------------------------------------
module m_constants
!------------------------------------------------------------------------------
!
! physical constants
!
real grav    ! gravitational acceleration
real sqrtg   ! square root of grav
real gsq     ! square of grav
real nu      ! kinematic viscosity of water
!
real d_water ! density of water
real d_air   ! density of air
!
! mathematical constants
!
real pi     ! circular constant, 3.1415...
real pi2    ! 2*pi
real pih    ! pi/2
real dera   ! conversion from degrees to radians
real rade   ! conversion from radians to degrees
real expmin ! min argument for exp. function to avoid underflow
real expmax ! max argument for exp. function to avoid overflow
real sqrt2  ! square root of 2 ~ 1.41
!
contains
!
!------------------------------------------------------------------------------
subroutine init_constants
!------------------------------------------------------------------------------
!
pi   = 4.*atan(1.)
pi2  = 2.*pi
pih  = 0.5*pi
dera = pi/180.
rade = 180./pi
!
expmin = -20.
expmax =  20.
!
!  physical constants
!
grav    = 9.81
sqrtg   = sqrt(grav)
gsq     = grav*grav
nu      = 1.e-6
d_air   = 1.2
d_water = 1027
!
end subroutine
!
end module


	FUNCTION PR_TMWB  ( tmpk, rmix, pres )
C************************************************************************
C* PR_TMWB								*
C*									*
C* This function computes wet bulb temperature from the temperature,	*
C* mixing ratio, and pressure.  The result is obtained by solving	*
C* for the temperature at which saturation occurs when the latent	*
C* heat required to vaporize the water is provided by a cooling of	*
C* the air.  The equation representing the process is			*
C*									*
C*	( TMPK - TMWB ) * CP - ( Rsat (TMWB) - RMIX ) * LVAP = 0	*
C*									*
C* This implicit equation is solved by Newton's method, since the	*
C* saturation mixing ratio Rsat is a transcendental function of		*
C* TMWB.								*
C*									*
C* The expressions for the heat of vaporization (LVAP) and saturation	*
C* vapor pressure are equations (2) and (10) from Bolton (MWR, 1980).	*
C*									*
C* REAL PR_TMWB  ( TMPK, RMIX, PRES )					*
C*									*
C* Input parameters:							*
C*	TMPK		REAL		Temperature (K)			*
C*	RMIX		REAL		Mixing ratio (g/kg)		*
C*	PRES		REAL    	Pressure (mb)			*
C*									*
C* Output parameters:							*
C*	PR_TMWB		REAL		Wet bulb temperature (K)	*
C**									*
C* Log:									*
C* K. Brill/NMC		 4/94						*
C* S. Jacobs/NMC	 4/94	Changed input RMIX from	kg/kg to g/kg	*
C* G. Krueger/EAI        4/96	Replaced C->K constant with PR_TMKC 	*
C* T. Lee/GSC		11/96	Changed constant 			*
C* S. Jacobs/NCEP	 8/97	Changed latent heat calc to use PR_LHVP	*
C* T. Lee/GSC		 8/97	Set TMWB <= temp; Simplify computation	*
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
C*
	PARAMETER  	( A = 6.112, B = 17.67, C = 243.5, EPSI = .622 )
	PARAMETER  	( G = B * C )
	PARAMETER  	( ERRMAX = .001 )
C*
	LOGICAL		convrg
C*
	INCLUDE		'ERMISS.FNC'
C------------------------------------------------------------------------
C*      Check for missing values.
C
	IF  ( ERMISS ( tmpk ) .or. ERMISS ( rmix ) .or. ERMISS ( pres )
     +       .or.  ( pres .le. 0. ) )  THEN
	    PR_TMWB = RMISSD
	  ELSE
C
C*	    Change temperature to degrees Celsius.
C
	    tmp = PR_TMKC (tmpk)
C
C*	    Compute the latent heat of vaporization.
C
	    lvap = PR_LHVP ( tmp )
C
C*	    Compute the specific heat of moist air.
C
	    rmix = rmix / 1000.
	    cp = 1005.7 * ( 1. + .887 * rmix )
C
C*	    Compute L / cp.
C
	    rlocp = lvap / cp
C
C*	    Do Newton iteration.
C
	    iter = 0
	    twb = tmp
	    convrg = .false.
	    DO WHILE ( iter .le. 50 .and. .not. convrg )
		iter = iter + 1
		bt = B * twb
		tpc = twb + C
		d = ( pres / A ) * EXP ( (-bt) / tpc )
		dm1 = d - 1.
		f = ( tmp - twb ) - rlocp * ( EPSI / dm1 - rmix )
		df = (-G)  / ( tpc * tpc )
		df = d * df * rlocp * EPSI / ( dm1 * dm1 ) - 1.
		cor = f / df
		twb = twb - cor
		IF ( ABS ( cor ) .le. ERRMAX ) convrg = .true.
	    END DO
C*
	    IF ( .not. convrg ) THEN
		PR_TMWB = RMISSD
	      ELSE
		twk     = PR_TMCK (twb)
		IF  ( twk .gt. tmpk )  twk = tmpk
		PR_TMWB = twk
	    END IF
	END IF
C*
	RETURN
	END