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