From 7a4ff1cb42a88cb30225896b645c1174c1f8e3d1 Mon Sep 17 00:00:00 2001
From: Wojtek Kosior <kwojtus@protonmail.com>
Date: Fri, 21 Jun 2019 12:17:56 +0200
Subject: initial commit - check that function pointers really work

---
 src/quadratures.f90 | 41 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)
 create mode 100644 src/quadratures.f90

(limited to 'src')

diff --git a/src/quadratures.f90 b/src/quadratures.f90
new file mode 100644
index 0000000..9e6bd38
--- /dev/null
+++ b/src/quadratures.f90
@@ -0,0 +1,41 @@
+PROGRAM quadratures
+
+  INTERFACE
+     FUNCTION integrate(ibeg, iend, myfun, p) result(value)
+       IMPLICIT none
+       ! beginning of integration interval
+       real(kind=8), intent(in) :: ibeg
+       ! ending of integration interval
+       real(kind=8), intent(in) :: iend
+       ! function to be integrated
+       procedure(funint) :: myfun
+       ! polynomial order
+       integer(kind=4), intent(in) :: p
+       ! result of integration
+       real(kind=8) :: value
+     END FUNCTION integrate
+  END INTERFACE
+  
+  INTERFACE
+     FUNCTION funint(x) result(y)
+       IMPLICIT none
+       real(kind=8), intent(in) :: x
+       real(kind=8) :: y
+     END FUNCTION funint
+  END INTERFACE
+
+  procedure(funint), pointer :: ptr
+
+  ptr => my_exp
+
+  write(*,*) my_exp(2.0_8)
+  
+CONTAINS
+
+  FUNCTION my_exp(x) result(y)
+    real(kind=8), intent(in) :: x
+    real(kind=8) :: y
+    y = exp(x)
+  END FUNCTION my_exp
+  
+END PROGRAM quadratures
-- 
cgit v1.2.3