Return to combinaisons.F90 CVS log

Up to [local] / rpl / src

Correction d'une réinitialisation sauvage de la pile des variables par niveau
dans la copie de la structure de description du processus. Cela corrige
la fonction SPAWN qui échouait sur un segmentation fault car la pile des
variables par niveau était vide alors même que l'arbre des variables contenait
bien les variables. Passage à la prerelease 2.

    1: !===============================================================================
    2: ! RPL/2 (R) version 4.1.0.prerelease.2
    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: 
   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