Paste from function pointer at 2021-11-09 09:31:08I want to paste
module func_mod
implicit none
abstract interface
function func_1d(x)result(y)
real(kind=8),intent(in)::x
real(kind=8)::y
end function func_1d
end interface
type func_ptr
procedure(func_1d),pointer,nopass:: ptr
end type func_ptr
contains
!! simpson integral
function Simpson(func,x0,x1,n)result(f1)
procedure(func_1d)::func
real(8)::f1
integer,intent(in),optional::n
real(8),intent(in)::x0,x1
integer::n1
real(8)::delta,x
integer::i
if(present(n))then
n1=n
else
n1=20
end if
f1=0.d0
delta=(x1-x0)/n1
x=x0-delta/2
do i=1,n1
x=x+delta
f1=f1+4.d0*func(x)
end do
x=x0
do i=1,n1-1
x=x+delta
f1=f1+2.d0*func(x)
end do
f1=f1+(func(x0)+func(x1))
f1=f1*delta/6
end function
end module func_mod
program main
use func_mod
implicit none
type(func_ptr)::a(3)
procedure(func_1d)::power2
procedure(func_1d)::sinpi
procedure(func_1d)::cospi
integer::i
a(1)%ptr=>power2
a(2)%ptr=>sinpi
a(3)%ptr=>cospi
do i=1,3
write(*,*)simpson(a(i)%ptr,0.d0,1.d0,20)
end do
end program main
function power2(x)result(y)
implicit none
real(kind=8),intent(in)::x
real(kind=8)::y
y = x*x
end function power2
function sinpi(x)result(y)
implicit none
real(kind=8),intent(in)::x
real(kind=8)::y
y = sin(3.141592653589793d0*x)
end function sinpi
function cospi(x)result(y)
implicit none
real(kind=8),intent(in)::x
real(kind=8)::y
y = cos(3.141592653589793d0*x)
end function cospi