Return to combinaisons.F90 CVS log

Up to [local] / rpl / src

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

1.1       bertrand    1: !===============================================================================
1.36    ! bertrand    2: ! RPL/2 (R) version 4.1.9
1.32      bertrand    3: ! Copyright (C) 1989-2012 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: !===============================================================================
                     19: 
                     20: 
1.11      bertrand   21: #include "rplftypes-conv.inc"
1.1       bertrand   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