Declaring or creating an object of abstract type is not permitted. The rationale is that one might invoke what appears to be a type-bound procedure that isn’t actually available.
I have a code for nonlinear least squares that uses both forward and reverse (coroutine) communication.
A clean way to organize the code would be to use a polymorphic argument with an abstract base type. The type would have bindings for procedures to compute the function and Jacobian, factor the Jacobian, calculate the Newton move and gradient, and various other calculations for Aitken acceleration, Levenberg-Marquardt stabilization, etc. The desideratum whether to use forward or reverse communication for a particular computation would be whether the relevant procedure is deferred.
The alternative is to use default NULL() procedure pointer components.
If instantiating objects of abstract type were permitted, it would be necessary to add a DEFERRED intrinsic function to determine whether a type-bound procedure could be invoked. An alternative to allowing objects of abstract type would be to remove the constraint that reqiures a type with a deferred binding to have the ABSTRACT attribute.
One cannot start with a base type that has no bindings and then extend it to provide the bindings because the code cannot invoke the bindings using objects of the base type. One could provide bindings to “dummy” routines that do nothing in the base type and use EXTENDS_TYPE_OF .and. .not. SAME_TYPE_AS to determine whether to use forward or reverse communication. This is uglier than a simple DEFERRED intrinsic function. It’s also not as reliable because one might have extended the type and not overridden the type-bound procedures with ones that actually do something useful. Of course, one could include a collection of flags in the type to indicate whether to use forward or reverse communication for each action, but this is even more ugly and unreliable.
Here’s a simple example of a quadrature code, illustrating only the reverse-communication case (because the forward case is obvious). The quadrature code would be simpler and clearer as a coroutine. Coroutines and iterators were briefly on the table for 2008. A nonlinear parameter estimation code would be much more complicated.
module Quadrature_m
implicit NONE
public
integer, parameter :: RK = kind(0.0d0)
type, abstract :: Quadrature_t
real(rk) :: A, B ! Bounds
real(rk) :: Tolerance ! How accurately to compute the integral
real(rk) :: Integral ! Estimate of the integral
real(rk) :: Error ! Estimate of error in the integral
integer :: Status = 0 ! 0 => Compute the integrand
! 1 => Error <= Tolerance
! 2 => Error > Tolerance
integer :: What = 0 ! What am I doing? 0 => Starting.
real(rk) :: F ! Value of the integrand
real(rk) :: X ! Value of the independent variable
! More components to represent the internal state of the
! Quadrature "coroutine" ...
contains
procedure, deferred :: Integrand
end type Quadrature_t
contains
subroutine Quadrature ( State )
class(quadrature_t), intent(inout) :: State
!...
do
select case ( state%what )
case ( 0 ) ! Set up to start the computation
state%what = 1
case ( 1 ) ! Request a value of the integrand
state%what = 2
if ( deferred(state%integrand) ) then
return
else
state%f = integrand ( state%x )
end if
case ( 2 ) ! Accumulate the estimate of the integral
! ...
state%what = 1
end select
end do
end subroutine Quadrature
real(rk) function Integrand ( X )
real(rk), intent(in) :: X
end function Integrand
end module Quadrature_m
program Foo
use Quadrature_m
type(quadrature_t) :: State
state%what = 0 ! Tell the code we're starting
do
call quadrature ( state )
if ( state%status /= 0 ) exit
state%f = my_integrand ( state%x )
end do
print *, 'Integral = ', state%integral, ' +/- ', state%error
end program Foo