![]() ![]() | ![]() |
Passage de la branche 4.1 en branche stable.
1: !=============================================================================== 2: ! RPL/2 (R) version 4.1.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: 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