Return to distributions.F90 CVS log

Up to [local] / rpl / src

Mise à jour du copyright.

    1: !===============================================================================
    2: ! RPL/2 (R) version 4.1.36
    3: ! Copyright (C) 1989-2025 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