Return to combinaisons.F90 CVS log

Up to [local] / rpl / src

En route pour la 4.1.16.

    1: !===============================================================================
    2: ! RPL/2 (R) version 4.1.16
    3: ! Copyright (C) 1989-2013 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 combinaison C(n,k)
   26: !===============================================================================
   27: ! Entrées :
   28: !   integer*8 N
   29: !   integer*8 K
   30: !-------------------------------------------------------------------------------
   31: ! Sortie :
   32: !   real*8 donnant C(N, K)
   33: !-------------------------------------------------------------------------------
   34: ! Effets de bord : néant
   35: !===============================================================================
   36: 
   37: subroutine F90COMBINAISON(N, K, RESULTAT) bind(C, name='f90combinaison')
   38:     use iso_c_binding
   39:     implicit none
   40: 
   41:     integer(rpl_integer8), intent(in) ::        K
   42:     integer(rpl_integer8), intent(in) ::        N
   43: 
   44:     real(rpl_real8), intent(out) ::             RESULTAT
   45: 
   46:     real(rpl_real8)                             GAMMA_LN1
   47:     real(rpl_real8)                             GAMMA_LN2
   48:     real(rpl_real8)                             GAMMA_LN3
   49: 
   50:     interface
   51:         subroutine F90GAMMALN(X, RESULTAT, SIGNE, ERREUR)
   52:             use iso_c_binding
   53:             implicit none
   54:             real(rpl_real8), intent(in) ::                      X
   55:             integer(rpl_integer8), intent(out), optional ::     ERREUR
   56:             real(rpl_real8), intent(out) ::                     RESULTAT
   57:             real(rpl_real8), intent(out), optional ::           SIGNE
   58:         end subroutine
   59:     end interface
   60: 
   61:     call F90GAMMALN(dble(N + 1), GAMMA_LN1)
   62:     call F90GAMMALN(dble(K + 1), GAMMA_LN2)
   63:     call F90GAMMALN(dble(N - K + 1), GAMMA_LN3)
   64: 
   65:     RESULTAT = exp(GAMMA_LN1 - GAMMA_LN2 - GAMMA_LN3)
   66:       
   67:     return
   68: end subroutine
   69: 
   70: 
   71: !===============================================================================
   72: ! Fonction renvoyant la valeur de l'arrangement A(n,k)
   73: !===============================================================================
   74: ! Entrées :
   75: !   integer*8 N
   76: !   integer*8 K
   77: !-------------------------------------------------------------------------------
   78: ! Sortie :
   79: !   real*8 donnant A(N, K)
   80: !-------------------------------------------------------------------------------
   81: ! Effets de bord : néant
   82: !===============================================================================
   83: 
   84: subroutine F90ARRANGEMENT(N, K, RESULTAT) bind(C, name='f90arrangement')
   85:     use iso_c_binding
   86:     implicit none
   87: 
   88:     integer(rpl_integer8), intent(in) ::            K
   89:     integer(rpl_integer8), intent(in) ::            N
   90: 
   91:     real(rpl_real8), intent(out) ::                 RESULTAT
   92:     
   93:     real(rpl_real8)                                 GAMMA_LN1
   94:     real(rpl_real8)                                 GAMMA_LN2
   95: 
   96:     interface
   97:         subroutine F90GAMMALN(X, RESULTAT, SIGNE, ERREUR)
   98:             use iso_c_binding
   99:             implicit none
  100:             real(rpl_real8), intent(in) ::                      X
  101:             integer(rpl_integer8), intent(out), optional ::     ERREUR
  102:             real(rpl_real8), intent(out) ::                     RESULTAT
  103:             real(rpl_real8), intent(out), optional ::           SIGNE
  104:         end subroutine
  105:     end interface
  106: 
  107:     call F90GAMMALN(dble(N + 1), GAMMA_LN1)
  108:     call F90GAMMALN(dble(N - K + 1), GAMMA_LN2)
  109: 
  110:     RESULTAT = exp(GAMMA_LN1 - GAMMA_LN2)
  111:     
  112:     return
  113: end subroutine
  114: 
  115: ! vim: ts=4