From 5eeb2401d99c2458960db1d6a25527f9c5f07a78 Mon Sep 17 00:00:00 2001
From: schnetter <schnetter@0f96c2a6-8d4f-0410-8182-94f2e8281398>
Date: Fri, 10 Oct 2008 16:22:36 +0000
Subject: Import new thorn GSLFortran, containing Fortran wrappers for some GSL
 functions.

git-svn-id: http://svn.aei.mpg.de/numrel/AEIThorns/GSLFortran/trunk@2 0f96c2a6-8d4f-0410-8182-94f2e8281398
---
 src/gsl_sf_erf.c        | 118 ++++++++++++++++++++++++++++++++++++++++++++++++
 src/gsl_sf_result.c     |   3 ++
 src/m_gsl_sf_erf.F90    | 110 ++++++++++++++++++++++++++++++++++++++++++++
 src/m_gsl_sf_result.F90 |   9 ++++
 src/make.code.defn      |  10 ++++
 5 files changed, 250 insertions(+)
 create mode 100644 src/gsl_sf_erf.c
 create mode 100644 src/gsl_sf_result.c
 create mode 100644 src/m_gsl_sf_erf.F90
 create mode 100644 src/m_gsl_sf_result.F90
 create mode 100644 src/make.code.defn

(limited to 'src')

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 = 
-- 
cgit v1.2.3