![]() ![]() | ![]() |
Passage de la branche 4.1 en branche stable.
1: !=============================================================================== 2: ! RPL/2 (R) version 4.1.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: 20: 21: #include "rplftypes-conv.inc" 22: 23: 24: !=============================================================================== 25: ! Fonction renvoyant le logarithme népérien de la fonction GAMMA(X). 26: ! Le logarithme de GAMMA est bien plus facile à calculer que la fonction 27: ! GAMMA. 28: !=============================================================================== 29: 30: subroutine F90GAMMALN(X, RESULTAT, SIGNE, ERREUR) 31: use iso_c_binding 32: implicit none 33: 34: integer(rpl_integer8), intent(out), optional :: ERREUR 35: integer(rpl_integer8) ERREUR_GAMMA 36: 37: real(rpl_real8), intent(in) :: X 38: real(rpl_real8), intent(out) :: RESULTAT 39: real(rpl_real8), intent(out), optional :: SIGNE 40: real(rpl_real8) SIGNE_GAMMA 41: 42: type, bind(C) :: GSL_SF_RESULT 43: real(c_double) VALEUR 44: real(c_double) ERREUR 45: end type 46: 47: type(GSL_SF_RESULT) STRUCT_RESULTAT 48: 49: interface 50: integer(c_int) function gsl_sf_lngamma_sgn_e(X, & 51: RESULTAT, SIGNE) bind(C, name='gsl_sf_lngamma_sgn_e') 52: use iso_c_binding 53: import :: GSL_SF_RESULT 54: implicit none 55: real(c_double), intent(in), value :: X 56: type(GSL_SF_RESULT), intent(out) :: RESULTAT 57: real(c_double), intent(out) :: SIGNE 58: end function 59: end interface 60: 61: ERREUR_GAMMA = gsl_sf_lngamma_sgn_e(X, STRUCT_RESULTAT, & 62: SIGNE_GAMMA) 63: RESULTAT = STRUCT_RESULTAT%VALEUR 64: 65: if (present(SIGNE)) then 66: SIGNE = SIGNE_GAMMA 67: end if 68: 69: if (present(ERREUR)) then 70: ERREUR = ERREUR_GAMMA 71: end if 72: 73: return 74: end subroutine 75: 76: ! vim: ts=4