Community
cancel
Showing results for
Did you mean:
Highlighted
Beginner
6 Views

Passing type bounded procedure to Quadpack

Greetings,

I'd like to pass a type bounded procedure to Quadpack's qagpi integrator. Is there a way I could do that? The following code generates a SIGSEGV... so I'm doing this very wrong.

Any help would be much appreciated.

Thanks!

module A

use B
use C

implicit none

type L
real                           :: vs
integer                        :: itermax

contains

procedure                      :: a1=>A1
procedure                      :: b1=>B1
procedure                      :: c1=>C1
procedure                      :: d1=>D1
procedure                      :: e1=>E1
procedure                      :: intgrd=>integrand
end type L

real function D1 ( this, r)
class(L)   , intent(in) :: this
real (kind = 4)  ,intent(inout) :: r
! Do something
D1 = somevalue
return
end function D1

real function E1 ( this, r)
class(L)   , intent(in) :: this
real (kind = 4)  ,intent(inout) :: r
! Do something
E1 = somevalue
return
end function E1

real function integrand(this, r)
class(L)   , intent(in) :: this
real (kind = 4)  ,intent(inout) :: r
real                            :: x, y

x = this% D1(r)
y= this% E1(r)
integrand = x * (y**2) / r

return
end function integrand

real function A1(this, r)
class(L)    , intent(in) :: this
real (kind = 4)     , intent(in) :: r
real (kind = 4)                  :: a
real ( kind = 4 )                :: abserr
real ( kind = 4 )    , parameter :: epsabs = 0.0E+00
real ( kind = 4 )    , parameter :: epsrel = 1E-06
integer ( kind = 4 )             :: ier
integer ( kind = 4 ) , parameter :: inf = 1
integer ( kind = 4 )             :: neval
real ( kind = 4 )    , parameter :: r4_pi = 3.141592653589793E+00
real ( kind = 4 )                :: result

a = real ( r, 4 )
call qagi ( this% intgrd,
&            a, inf, epsabs, epsrel,
&            result,
&            abserr,
&            neval,
&            ier)

A1 = - result
return
end function A1
end module A
Tags (1)