Annotation of rpl/src/combinaisons.F90, revision 1.18
1.1 bertrand 1: !===============================================================================
1.17 bertrand 2: ! RPL/2 (R) version 4.1.0.prerelease.0
1.15 bertrand 3: ! Copyright (C) 1989-2011 Dr. BERTRAND Joël
1.1 bertrand 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: !===============================================================================
1.18 ! bertrand 19: <<<<<<< combinaisons.F90
! 20: ! RPL/2 (R) version 4.1.0.prerelease.0
! 21: =======
! 22: ! RPL/2 (R) version 4.0.23
! 23: >>>>>>> 1.16.2.2
! 24: ! Copyright (C) 1989-2011 Dr. BERTRAND Joël
! 25: !
! 26: ! This file is part of RPL/2.
! 27: !
! 28: ! RPL/2 is free software; you can redistribute it and/or modify it
! 29: ! under the terms of the CeCILL V2 License as published by the french
! 30: ! CEA, CNRS and INRIA.
! 31: !
! 32: ! RPL/2 is distributed in the hope that it will be useful, but WITHOUT
! 33: ! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
! 34: ! FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
! 35: ! for more details.
! 36: !
! 37: ! You should have received a copy of the CeCILL License
! 38: ! along with RPL/2. If not, write to info@cecill.info.
! 39: !===============================================================================
1.1 bertrand 40:
41:
1.11 bertrand 42: #include "rplftypes-conv.inc"
1.1 bertrand 43:
44:
45: !===============================================================================
46: ! Fonction renvoyant la valeur de la combinaison C(n,k)
47: !===============================================================================
48: ! Entrées :
49: ! integer*8 N
50: ! integer*8 K
51: !-------------------------------------------------------------------------------
52: ! Sortie :
53: ! real*8 donnant C(N, K)
54: !-------------------------------------------------------------------------------
55: ! Effets de bord : néant
56: !===============================================================================
57:
58: subroutine F90COMBINAISON(N, K, RESULTAT) bind(C, name='f90combinaison')
59: use iso_c_binding
60: implicit none
61:
62: integer(rpl_integer8), intent(in) :: K
63: integer(rpl_integer8), intent(in) :: N
64:
65: real(rpl_real8), intent(out) :: RESULTAT
66:
67: real(rpl_real8) GAMMA_LN1
68: real(rpl_real8) GAMMA_LN2
69: real(rpl_real8) GAMMA_LN3
70:
71: interface
72: subroutine F90GAMMALN(X, RESULTAT, SIGNE, ERREUR)
73: use iso_c_binding
74: implicit none
75: real(rpl_real8), intent(in) :: X
76: integer(rpl_integer8), intent(out), optional :: ERREUR
77: real(rpl_real8), intent(out) :: RESULTAT
78: real(rpl_real8), intent(out), optional :: SIGNE
79: end subroutine
80: end interface
81:
82: call F90GAMMALN(dble(N + 1), GAMMA_LN1)
83: call F90GAMMALN(dble(K + 1), GAMMA_LN2)
84: call F90GAMMALN(dble(N - K + 1), GAMMA_LN3)
85:
86: RESULTAT = exp(GAMMA_LN1 - GAMMA_LN2 - GAMMA_LN3)
87:
88: return
89: end subroutine
90:
91:
92: !===============================================================================
93: ! Fonction renvoyant la valeur de l'arrangement A(n,k)
94: !===============================================================================
95: ! Entrées :
96: ! integer*8 N
97: ! integer*8 K
98: !-------------------------------------------------------------------------------
99: ! Sortie :
100: ! real*8 donnant A(N, K)
101: !-------------------------------------------------------------------------------
102: ! Effets de bord : néant
103: !===============================================================================
104:
105: subroutine F90ARRANGEMENT(N, K, RESULTAT) bind(C, name='f90arrangement')
106: use iso_c_binding
107: implicit none
108:
109: integer(rpl_integer8), intent(in) :: K
110: integer(rpl_integer8), intent(in) :: N
111:
112: real(rpl_real8), intent(out) :: RESULTAT
113:
114: real(rpl_real8) GAMMA_LN1
115: real(rpl_real8) GAMMA_LN2
116:
117: interface
118: subroutine F90GAMMALN(X, RESULTAT, SIGNE, ERREUR)
119: use iso_c_binding
120: implicit none
121: real(rpl_real8), intent(in) :: X
122: integer(rpl_integer8), intent(out), optional :: ERREUR
123: real(rpl_real8), intent(out) :: RESULTAT
124: real(rpl_real8), intent(out), optional :: SIGNE
125: end subroutine
126: end interface
127:
128: call F90GAMMALN(dble(N + 1), GAMMA_LN1)
129: call F90GAMMALN(dble(N - K + 1), GAMMA_LN2)
130:
131: RESULTAT = exp(GAMMA_LN1 - GAMMA_LN2)
132:
133: return
134: end subroutine
135:
136: ! vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>