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>