Return to combinaisons.F90 CVS log

Up to [local] / rpl / src

Ajout des premiers bouts de rplcas.

    1: !===============================================================================
    2: ! RPL/2 (R) version 4.1.0.prerelease.0
    3: ! Copyright (C) 1989-2011 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: <<<<<<< 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: !===============================================================================
   40: 
   41: 
   42: #include "rplftypes-conv.inc"
   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