![]() ![]() | ![]() |
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 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