diff options
author | schnetter <schnetter@0f96c2a6-8d4f-0410-8182-94f2e8281398> | 2008-10-10 16:22:36 +0000 |
---|---|---|
committer | schnetter <schnetter@0f96c2a6-8d4f-0410-8182-94f2e8281398> | 2008-10-10 16:22:36 +0000 |
commit | 5eeb2401d99c2458960db1d6a25527f9c5f07a78 (patch) | |
tree | dd5712ef14e29b48e09b92da2f9924e990c1e9d3 /src | |
parent | dd9e8d6928f79c2b3abad885a9d68c1ea436c744 (diff) |
git-svn-id: http://svn.aei.mpg.de/numrel/AEIThorns/GSLFortran/trunk@2 0f96c2a6-8d4f-0410-8182-94f2e8281398
Diffstat (limited to 'src')
-rw-r--r-- | src/gsl_sf_erf.c | 118 | ||||
-rw-r--r-- | src/gsl_sf_result.c | 3 | ||||
-rw-r--r-- | src/m_gsl_sf_erf.F90 | 110 | ||||
-rw-r--r-- | src/m_gsl_sf_result.F90 | 9 | ||||
-rw-r--r-- | src/make.code.defn | 10 |
5 files changed, 250 insertions, 0 deletions
diff --git a/src/gsl_sf_erf.c b/src/gsl_sf_erf.c new file mode 100644 index 0000000..1b38a76 --- /dev/null +++ b/src/gsl_sf_erf.c @@ -0,0 +1,118 @@ +#include <gsl/gsl_sf_erf.h> + +#include "cctk.h" + + + +/* Complementary Error Function + * erfc(x) := 2/Sqrt[Pi] Integrate[Exp[-t^2], {t,x,Infinity}] + * + * exceptions: none + */ +int CCTK_FCALL +CCTK_FNAME(gsl_sf_erfc_e) (double const * restrict const x, + gsl_sf_result * restrict const result) +{ + return gsl_sf_erfc_e (* x, result); +} + +double CCTK_FCALL +CCTK_FNAME(gsl_sf_erfc) (double const * restrict const x) +{ + return gsl_sf_erfc (* x); +} + + +/* Log Complementary Error Function + * + * exceptions: none + */ +int CCTK_FCALL +CCTK_FNAME(gsl_sf_log_erfc_e) (double const * restrict const x, + gsl_sf_result * restrict const result) +{ + return gsl_sf_log_erfc_e (* x, result); +} + +double CCTK_FCALL +CCTK_FNAME(gsl_sf_log_erfc) (double const * restrict const x) +{ + return gsl_sf_log_erfc (* x); +} + + +/* Error Function + * erf(x) := 2/Sqrt[Pi] Integrate[Exp[-t^2], {t,0,x}] + * + * exceptions: none + */ +int CCTK_FCALL +CCTK_FNAME(gsl_sf_erf_e) (double const * restrict const x, + gsl_sf_result * restrict const result) +{ + return gsl_sf_erf_e (* x, result); +} + +double CCTK_FCALL +CCTK_FNAME(gsl_sf_erf) (double const * restrict const x) +{ + return gsl_sf_erf (* x); +} + + +/* Probability functions: + * Z(x) : Abramowitz+Stegun 26.2.1 + * Q(x) : Abramowitz+Stegun 26.2.3 + * + * exceptions: none + */ +int CCTK_FCALL +CCTK_FNAME(gsl_sf_erf_Z_e) (double const * restrict const x, + gsl_sf_result * restrict const result) +{ + return gsl_sf_erf_Z_e (* x, result); +} + +int CCTK_FCALL +CCTK_FNAME(gsl_sf_erf_Q_e) (double const * restrict const x, + gsl_sf_result * restrict const result) +{ + return gsl_sf_erf_Q_e (* x, result); +} + +double CCTK_FCALL +CCTK_FNAME(gsl_sf_erf_Z) (double const * restrict const x) +{ + return gsl_sf_erf_Z (* x); +} + +double CCTK_FCALL +CCTK_FNAME(gsl_sf_erf_Q) (double const * restrict const x) +{ + return gsl_sf_erf_Q (* x); +} + + +#if 0 +/* Does not exist in older versions of GSL*/ + +/* Hazard function, also known as the inverse Mill's ratio. + * + * H(x) := Z(x)/Q(x) + * = Sqrt[2/Pi] Exp[-x^2 / 2] / Erfc[x/Sqrt[2]] + * + * exceptions: GSL_EUNDRFLW + */ +int CCTK_FCALL +CCTK_FNAME(gsl_sf_hazard_e) (double const * restrict const x, + gsl_sf_result * restrict const result) +{ + return gsl_sf_hazard_e (* x, result); +} + +double CCTK_FCALL +CCTK_FNAME(gsl_sf_hazard) (double const * restrict const x) +{ + return gsl_sf_hazard (* x); +} +#endif diff --git a/src/gsl_sf_result.c b/src/gsl_sf_result.c new file mode 100644 index 0000000..8237970 --- /dev/null +++ b/src/gsl_sf_result.c @@ -0,0 +1,3 @@ +#include <gsl/gsl_sf_result.h> + +#include "cctk.h" diff --git a/src/m_gsl_sf_erf.F90 b/src/m_gsl_sf_erf.F90 new file mode 100644 index 0000000..d9e670a --- /dev/null +++ b/src/m_gsl_sf_erf.F90 @@ -0,0 +1,110 @@ +module m_gsl_sf_erf + implicit none + + interface + + ! Complementary Error Function + ! erfc(x) := 2/Sqrt[Pi] Integrate[Exp[-t^2], {t,x,Infinity}] + ! + ! exceptions: none + integer function gsl_sf_erfc_e (x, result) + use m_gsl_sf_result + implicit none + double precision x + type(gsl_sf_result) result + end function gsl_sf_erfc_e + + double precision function gsl_sf_erfc (x) + implicit none + double precision x + end function gsl_sf_erfc + + + ! Log Complementary Error Function + ! + ! exceptions: none + integer function gsl_sf_log_erfc_e (x, result) + use m_gsl_sf_result + implicit none + double precision x + type(gsl_sf_result) result + end function gsl_sf_log_erfc_e + + double precision function gsl_sf_log_erfc (x) + implicit none + double precision x + end function gsl_sf_log_erfc + + + ! Error Function + ! erf(x) := 2/Sqrt[Pi] Integrate[Exp[-t^2], {t,0,x}] + ! + ! exceptions: none + integer function gsl_sf_erf_e (x, result) + use m_gsl_sf_result + implicit none + double precision x + type(gsl_sf_result) result + end function gsl_sf_erf_e + + double precision function gsl_sf_erf (x) + implicit none + double precision x + end function gsl_sf_erf + + + ! Probability functions: + ! Z(x) : Abramowitz+Stegun 26.2.1 + ! Q(x) : Abramowitz+Stegun 26.2.3 + ! + ! exceptions: none + integer function gsl_sf_erf_Z_e (x, result) + use m_gsl_sf_result + implicit none + double precision x + type(gsl_sf_result) result + end function gsl_sf_erf_Z_e + + integer function gsl_sf_erf_Q_e (x, result) + use m_gsl_sf_result + implicit none + double precision x + type(gsl_sf_result) result + end function gsl_sf_erf_Q_e + + double precision function gsl_sf_erf_Z (x) + implicit none + double precision x + end function gsl_sf_erf_Z + + double precision function gsl_sf_erf_Q (x) + implicit none + double precision x + end function gsl_sf_erf_Q + + +#if 0 + /* Does not exist in older versions of GSL*/ + + ! Hazard function, also known as the inverse Mill's ratio. + ! + ! H(x) := Z(x)/Q(x) + ! = Sqrt[2/Pi] Exp[-x^2 / 2] / Erfc[x/Sqrt[2]] + ! + ! exceptions: GSL_EUNDRFLW + integer function gsl_sf_hazard_e (x, result) + use m_gsl_sf_result + implicit none + double precision x + type(gsl_sf_result) result + end function gsl_sf_hazard_e + + double precision function gsl_sf_hazard (x) + implicit none + double precision x + end function gsl_sf_hazard +#endif + + end interface + +end module m_gsl_sf_erf diff --git a/src/m_gsl_sf_result.F90 b/src/m_gsl_sf_result.F90 new file mode 100644 index 0000000..7f6f8e9 --- /dev/null +++ b/src/m_gsl_sf_result.F90 @@ -0,0 +1,9 @@ +module m_gsl_sf_result + implicit none + + type gsl_sf_result + double precision val + double precision err + end type gsl_sf_result + +end module m_gsl_sf_result diff --git a/src/make.code.defn b/src/make.code.defn new file mode 100644 index 0000000..54e2075 --- /dev/null +++ b/src/make.code.defn @@ -0,0 +1,10 @@ +# Main make.code.defn file for thorn GSLFortran + +# Source files in this directory +SRCS = m_gsl_sf_erf.F90 \ + m_gsl_sf_result.F90 \ + gsl_sf_erf.c \ + gsl_sf_result.c + +# Subdirectories containing source files +SUBDIRS = |