initial commit - check that function pointers really work

1 files changed, 41 insertions, 0 deletions

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