1: !===============================================================================
2: ! RPL/2 (R) version 4.1.32
3: ! Copyright (C) 1989-2020 Dr. BERTRAND Joël
4: !
5: ! This file is part of RPL/2.
6: !
7: ! RPL/2 is free software; you can redistribute it and/or modify it
8: ! under the terms of the CeCILL V2 License as published by the french
9: ! CEA, CNRS and INRIA.
10: !
11: ! RPL/2 is distributed in the hope that it will be useful, but WITHOUT
12: ! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13: ! FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
14: ! for more details.
15: !
16: ! You should have received a copy of the CeCILL License
17: ! along with RPL/2. If not, write to info@cecill.info.
18: !===============================================================================
19:
20:
21: #include "rplftypes-conv.inc"
22:
23:
24: !===============================================================================
25: ! Fonction renvoyant la valeur de la distribution X² à v degrés de liberté
26: ! cumulée à droite
27: !===============================================================================
28: ! Entrées :
29: ! real*8 X2 : valeur de la variable X²
30: ! integer*4 NU : nombre de degrés de liberté
31: !-------------------------------------------------------------------------------
32: ! Sortie :
33: ! real*8 donnant la probabilité P(X < X2)
34: !-------------------------------------------------------------------------------
35: ! Effets de bord : néant
36: !===============================================================================
37:
38: subroutine F90X2CD(X2, NU, RESULTAT) bind(C, name='f90x2cd')
39: use iso_c_binding
40: implicit none
41:
42: integer(rpl_integer8), intent(in) :: NU
43:
44: real(rpl_real8), intent(out) :: RESULTAT
45: real(rpl_real8), intent(in) :: X2
46:
47: interface
48: real(c_double) function gsl_cdf_chisq_Q(X2, NU) &
49: bind(C, name='gsl_cdf_chisq_Q')
50: use iso_c_binding
51: implicit none
52: real(c_double), intent(in), value :: NU
53: real(c_double), intent(in), value :: X2
54: end function
55: end interface
56:
57: RESULTAT = gsl_cdf_chisq_Q(X2, dble(NU))
58:
59: return
60: end subroutine
61:
62:
63: !===============================================================================
64: ! Fonction renvoyant la valeur de la distribution F à v1 et v2 degrés de liberté
65: ! cumulée à droite
66: !===============================================================================
67: ! Entrées :
68: ! real*8 F : valeur de la variable
69: ! integer*4 NU1 : nombre de degrés de liberté
70: ! integer*4 NU2 : nombre de degrés de liberté
71: !-------------------------------------------------------------------------------
72: ! Sortie :
73: ! real*8 donnant la probabilité P(X < F)
74: !-------------------------------------------------------------------------------
75: ! Effets de bord : néant
76: !===============================================================================
77:
78: subroutine F90FCD(F, NU1, NU2, RESULTAT) bind(C, name='f90fcd')
79: use iso_c_binding
80: implicit none
81:
82: integer(rpl_integer8), intent(in) :: NU1
83: integer(rpl_integer8), intent(in) :: NU2
84:
85: real(rpl_real8), intent(in) :: F
86: real(rpl_real8), intent(out) :: RESULTAT
87:
88: interface
89: real(c_double) function gsl_cdf_fdist_Q(F, NU1, NU2) &
90: bind(C, name='gsl_cdf_fdist_Q')
91: use iso_c_binding
92: implicit none
93: real(c_double), intent(in), value :: NU1
94: real(c_double), intent(in), value :: NU2
95: real(c_double), intent(in), value :: F
96: end function
97: end interface
98:
99: RESULTAT = gsl_cdf_fdist_Q(F, dble(NU1), dble(NU2))
100:
101: return
102: end subroutine
103:
104:
105: !===============================================================================
106: ! Fonction renvoyant la valeur de la distribution du t de Student
107: ! cumulée à droite
108: !===============================================================================
109: ! Entrées :
110: ! real*8 T : point de calcul
111: ! real*8 N : nombre de degrés de liberté
112: !-------------------------------------------------------------------------------
113: ! Sortie :
114: ! real*8 donnant la probabilité P(X < T)
115: !-------------------------------------------------------------------------------
116: ! Effets de bord : néant
117: !===============================================================================
118:
119: subroutine F90TCD(T, NU, RESULTAT) bind(C, name='f90tcd')
120: use iso_c_binding
121: implicit none
122:
123: integer(rpl_integer8), intent(in) :: NU
124:
125: real(rpl_real8), intent(out) :: RESULTAT
126: real(rpl_real8), intent(in) :: T
127:
128: interface
129: real(c_double) function gsl_cdf_tdist_Q(T, NU) &
130: bind(C, name='gsl_cdf_tdist_Q')
131: use iso_c_binding
132: implicit none
133: real(rpl_real8), intent(in), value :: NU
134: real(rpl_real8), intent(in), value :: T
135: end function
136: end interface
137:
138: RESULTAT = gsl_cdf_tdist_Q(T, dble(NU))
139:
140: return
141: end subroutine
142:
143:
144: !===============================================================================
145: ! Fonction renvoyant la valeur de la distribution normale cumulée à droite
146: !===============================================================================
147: ! Entrées :
148: ! real*8 X : point de calcul
149: ! real*8 MOYENNE et VARIANCE de la distribution
150: !-------------------------------------------------------------------------------
151: ! Sortie :
152: ! real*8 donnant la probabilité P(R < X)
153: !-------------------------------------------------------------------------------
154: ! Effets de bord : néant
155: !===============================================================================
156:
157: subroutine F90GAUSSCD(X, MOYENNE, VARIANCE, RESULTAT) bind(C, name='f90gausscd')
158: use iso_c_binding
159: implicit none
160:
161: real(rpl_real8), intent(in) :: MOYENNE
162: real(rpl_real8), intent(in) :: VARIANCE
163: real(rpl_real8), intent(in) :: X
164:
165: real(rpl_real8), intent(out) :: RESULTAT
166:
167: real(rpl_real8) Z
168:
169: interface
170: real(c_double) function gsl_cdf_ugaussian_Q(Z) &
171: bind(C, name='gsl_cdf_ugaussian_Q')
172: use iso_c_binding
173: implicit none
174: real(c_double), intent(in), value :: Z
175: end function
176: end interface
177:
178: Z = (X - MOYENNE) / sqrt(VARIANCE)
179: RESULTAT = gsl_cdf_ugaussian_Q(Z)
180:
181: return
182: end subroutine
183:
184: ! vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to distributions.F90 CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src