Return to combinaisons.F90 CVS log

Up to [local] / rpl / src

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

1.1       bertrand    1: !===============================================================================
1.62    ! bertrand    2: ! RPL/2 (R) version 4.1.29
        !             3: ! Copyright (C) 1989-2018 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.61      bertrand   21: #define _RPL_COMPLEX_
1.11      bertrand   22: #include "rplftypes-conv.inc"
1.1       bertrand   23: 
                     24: 
                     25: !===============================================================================
                     26: ! Fonction renvoyant la valeur de la combinaison C(n,k)
                     27: !===============================================================================
                     28: ! Entrées :
                     29: !  integer*8 N
                     30: !  integer*8 K
                     31: !-------------------------------------------------------------------------------
                     32: ! Sortie :
                     33: !  real*8 donnant C(N, K)
                     34: !-------------------------------------------------------------------------------
                     35: ! Effets de bord : néant
                     36: !===============================================================================
                     37: 
                     38: subroutine F90COMBINAISON(N, K, RESULTAT) bind(C, name='f90combinaison')
                     39:    use iso_c_binding
                     40:    implicit none
                     41: 
                     42:    integer(rpl_integer8), intent(in) ::        K
                     43:    integer(rpl_integer8), intent(in) ::        N
                     44: 
                     45:    real(rpl_real8), intent(out) ::             RESULTAT
                     46: 
                     47:    real(rpl_real8)                             GAMMA_LN1
                     48:    real(rpl_real8)                             GAMMA_LN2
                     49:    real(rpl_real8)                             GAMMA_LN3
                     50: 
                     51:    interface
                     52:        subroutine F90GAMMALN(X, RESULTAT, SIGNE, ERREUR)
                     53:            use iso_c_binding
                     54:            implicit none
                     55:            real(rpl_real8), intent(in) ::                      X
                     56:            integer(rpl_integer8), intent(out), optional ::     ERREUR
                     57:            real(rpl_real8), intent(out) ::                     RESULTAT
                     58:            real(rpl_real8), intent(out), optional ::           SIGNE
                     59:        end subroutine
                     60:    end interface
                     61: 
                     62:    call F90GAMMALN(dble(N + 1), GAMMA_LN1)
                     63:    call F90GAMMALN(dble(K + 1), GAMMA_LN2)
                     64:    call F90GAMMALN(dble(N - K + 1), GAMMA_LN3)
                     65: 
                     66:    RESULTAT = exp(GAMMA_LN1 - GAMMA_LN2 - GAMMA_LN3)
                     67:      
                     68:    return
                     69: end subroutine
                     70: 
                     71: 
                     72: !===============================================================================
                     73: ! Fonction renvoyant la valeur de l'arrangement A(n,k)
                     74: !===============================================================================
                     75: ! Entrées :
                     76: !  integer*8 N
                     77: !  integer*8 K
                     78: !-------------------------------------------------------------------------------
                     79: ! Sortie :
                     80: !  real*8 donnant A(N, K)
                     81: !-------------------------------------------------------------------------------
                     82: ! Effets de bord : néant
                     83: !===============================================================================
                     84: 
                     85: subroutine F90ARRANGEMENT(N, K, RESULTAT) bind(C, name='f90arrangement')
                     86:    use iso_c_binding
                     87:    implicit none
                     88: 
                     89:    integer(rpl_integer8), intent(in) ::            K
                     90:    integer(rpl_integer8), intent(in) ::            N
                     91: 
                     92:    real(rpl_real8), intent(out) ::                 RESULTAT
                     93:    
                     94:    real(rpl_real8)                                 GAMMA_LN1
                     95:    real(rpl_real8)                                 GAMMA_LN2
                     96: 
                     97:    interface
                     98:        subroutine F90GAMMALN(X, RESULTAT, SIGNE, ERREUR)
                     99:            use iso_c_binding
                    100:            implicit none
                    101:            real(rpl_real8), intent(in) ::                      X
                    102:            integer(rpl_integer8), intent(out), optional ::     ERREUR
                    103:            real(rpl_real8), intent(out) ::                     RESULTAT
                    104:            real(rpl_real8), intent(out), optional ::           SIGNE
                    105:        end subroutine
                    106:    end interface
                    107: 
                    108:    call F90GAMMALN(dble(N + 1), GAMMA_LN1)
                    109:    call F90GAMMALN(dble(N - K + 1), GAMMA_LN2)
                    110: 
                    111:    RESULTAT = exp(GAMMA_LN1 - GAMMA_LN2)
                    112:    
                    113:    return
                    114: end subroutine
                    115: 
                    116: ! vim: ts=4