!===============================================================================
! RPL/2 (R) version 4.1.0.prerelease.4
! Copyright (C) 1989-2011 Dr. BERTRAND Joël
!
! This file is part of RPL/2.
!
! RPL/2 is free software; you can redistribute it and/or modify it
! under the terms of the CeCILL V2 License as published by the french
! CEA, CNRS and INRIA.
!
! RPL/2 is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
! FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
! for more details.
!
! You should have received a copy of the CeCILL License
! along with RPL/2. If not, write to info@cecill.info.
!===============================================================================


#include "rplftypes-conv.inc"


!===============================================================================
! Fonction renvoyant la valeur de la distribution X² à v degrés de liberté
! cumulée à droite
!===============================================================================
! Entrées :
!	real*8 X2    : valeur de la variable X²
!	integer*4 NU : nombre de degrés de liberté
!-------------------------------------------------------------------------------
! Sortie :
!	real*8 donnant la probabilité P(X < X2)
!-------------------------------------------------------------------------------
! Effets de bord : néant
!===============================================================================

subroutine F90X2CD(X2, NU, RESULTAT) bind(C, name='f90x2cd')
	use iso_c_binding
	implicit none

	integer(rpl_integer8), intent(in) ::	NU
	
	real(rpl_real8), intent(out) ::			RESULTAT
	real(rpl_real8), intent(in) ::			X2

	interface
		real(c_double) function gsl_cdf_chisq_Q(X2, NU) &
				bind(C, name='gsl_cdf_chisq_Q')
			use iso_c_binding
			implicit none
	  		real(c_double), intent(in), value	 ::	NU
	  		real(c_double), intent(in), value	 ::	X2
	  	end function
	end interface

    RESULTAT = gsl_cdf_chisq_Q(X2, dble(NU))

	return
end subroutine


!===============================================================================
! Fonction renvoyant la valeur de la distribution F à v1 et v2 degrés de liberté
! cumulée à droite
!===============================================================================
! Entrées :
!	real*8 F      : valeur de la variable
!	integer*4 NU1 : nombre de degrés de liberté
!	integer*4 NU2 : nombre de degrés de liberté
!-------------------------------------------------------------------------------
! Sortie :
!	real*8 donnant la probabilité P(X < F)
!-------------------------------------------------------------------------------
! Effets de bord : néant
!===============================================================================

subroutine F90FCD(F, NU1, NU2, RESULTAT) bind(C, name='f90fcd')
	use iso_c_binding
	implicit none

	integer(rpl_integer8), intent(in) :: 	NU1
	integer(rpl_integer8), intent(in) :: 	NU2

	real(rpl_real8), intent(in) ::			F
	real(rpl_real8), intent(out) ::			RESULTAT

	interface
		real(c_double) function gsl_cdf_fdist_Q(F, NU1, NU2) &
				bind(C, name='gsl_cdf_fdist_Q')
			use iso_c_binding
			implicit none
	  		real(c_double), intent(in), value	 ::	NU1
	  		real(c_double), intent(in), value	 ::	NU2
	  		real(c_double), intent(in), value	 ::	F
	  	end function
	end interface

	RESULTAT = gsl_cdf_fdist_Q(F, dble(NU1), dble(NU2))

	return
end subroutine


!===============================================================================
! Fonction renvoyant la valeur de la distribution du t de Student
! cumulée à droite
!===============================================================================
! Entrées :
!	real*8 T : point de calcul
!	real*8 N : nombre de degrés de liberté
!-------------------------------------------------------------------------------
! Sortie :
!	real*8 donnant la probabilité P(X < T)
!-------------------------------------------------------------------------------
! Effets de bord : néant
!===============================================================================

subroutine F90TCD(T, NU, RESULTAT) bind(C, name='f90tcd')
	use iso_c_binding
	implicit none

	integer(rpl_integer8), intent(in) ::		NU

	real(rpl_real8), intent(out) ::				RESULTAT
	real(rpl_real8), intent(in) ::				T

	interface
		real(c_double) function gsl_cdf_tdist_Q(T, NU) &
				bind(C, name='gsl_cdf_tdist_Q')
			use iso_c_binding
			implicit none
	  		real(rpl_real8), intent(in), value	::	NU
	  		real(rpl_real8), intent(in), value	::	T
	  	end function
	end interface

	RESULTAT = gsl_cdf_tdist_Q(T, dble(NU))

	return
end subroutine


!===============================================================================
! Fonction renvoyant la valeur de la distribution normale cumulée à droite
!===============================================================================
! Entrées :
!	real*8 X : point de calcul
!	real*8 MOYENNE et VARIANCE de la distribution
!-------------------------------------------------------------------------------
! Sortie :
!	real*8 donnant la probabilité P(R < X)
!-------------------------------------------------------------------------------
! Effets de bord : néant
!===============================================================================

subroutine F90GAUSSCD(X, MOYENNE, VARIANCE, RESULTAT) bind(C, name='f90gausscd')
	use iso_c_binding
	implicit none

	real(rpl_real8), intent(in) ::		MOYENNE
	real(rpl_real8), intent(in) ::		VARIANCE
	real(rpl_real8), intent(in) ::		X

	real(rpl_real8), intent(out) ::		RESULTAT

	real(rpl_real8)						Z

	interface
		real(c_double) function gsl_cdf_ugaussian_Q(Z) &
				bind(C, name='gsl_cdf_ugaussian_Q')
			use iso_c_binding
			implicit none
	  		real(c_double), intent(in), value ::	Z
	  	end function
	end interface

	Z = (X - MOYENNE) / sqrt(VARIANCE)
	RESULTAT = gsl_cdf_ugaussian_Q(Z)

	return
end subroutine

! vim: ts=4