Return to combinaisons.F90 CVS log

Up to [local] / rpl / src

Annotation of rpl/src/combinaisons.F90, revision 1.19

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