Return to fonctions_speciales.F90 CVS log

Up to [local] / rpl / src

Annotation of rpl/src/fonctions_speciales.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 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