Return to combinaisons.F90 CVS log

Up to [local] / rpl / src

Modification du copyright.

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