Annotation of rpl/src/combinaisons.F90, revision 1.1
1.1 ! bertrand 1: !===============================================================================
! 2: ! RPL/2 (R) version 4.0.9
! 3: ! Copyright (C) 1989-2010 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
CVSweb interface <joel.bertrand@systella.fr>