module m

  implicit none
  integer, parameter :: dp = 8

!###############################################################################

  type, abstract :: base_t
  contains
    procedure(base_start), deferred, pass :: start
  end type

!###############################################################################

  type, abstract, extends(base_t) :: child_t
    real(kind=dp) :: s1 = 1.0d0
    real(kind=dp) :: s2 = 2.0d0
    real(kind=dp) :: s3 = 3.0d0
    real(kind=dp) :: s4 = 4.0d0
    integer :: n1 = 0
    integer :: n2 = 1
    integer :: n3 = 2
    integer :: n4 = 2
    integer :: nthreads = 1
    real(kind=dp), pointer :: f1(:) => null()
    real(kind=dp), allocatable :: f2(:,:)
    real(kind=dp), allocatable :: f3(:,:,:)
    real(kind=dp), allocatable :: d1(:)
    real(kind=dp), pointer :: d2(:,:) => null()
  contains
    procedure :: start => child_t_start
    procedure :: child_t_start
  end type

  type, extends(child_t) :: child_1_t
  contains
    procedure :: start => child_1_t_start
  end type

  type, extends(child_t) :: child_2_t
  contains
    procedure :: start => child_2_t_start
  end type

!###############################################################################

  abstract interface

    subroutine base_start(this, ldim, nthreads)
      import :: base_t
      implicit none
      class(base_t), target, intent(inout) :: this
      integer, intent(in) :: ldim
      integer, intent(in) :: nthreads
    end subroutine

  end interface

!###############################################################################

contains

  subroutine child_t_start(this, ldim, nthreads)
    implicit none
    class(child_t), target, intent(inout) :: this
    integer, intent(in) :: ldim
    integer, intent(in) :: nthreads
    integer :: nsh

    this%nthreads = nthreads

    nsh = ldim

    print *, 'allocated(d1)=', allocated(this%d1)
    print *, 'ubound(d1)=', ubound(this%d1)

    if (allocated(this%d1)) then
        deallocate(this%d1)
    end if

    allocate(this%d1(nsh*(nsh+1)/2), source=0.0d0)

  end subroutine

!###############################################################################

  subroutine child_1_t_start(this, ldim, nthreads)
    implicit none
    class(child_1_t), target, intent(inout) :: this
    integer, intent(in) :: ldim
    integer, intent(in) :: nthreads

    this%n2 = ldim
    this%n3 = 1

    call this%child_t_start(ldim, nthreads)

  end subroutine

!###############################################################################

  subroutine child_2_t_start(this, ldim, nthreads)
    implicit none
    class(child_2_t), target, intent(inout) :: this
    integer, intent(in) :: ldim
    integer, intent(in) :: nthreads

    this%n2 = ldim
    this%n3 = 2

    call this%child_t_start(ldim, nthreads)

  end subroutine


!###############################################################################

  subroutine test_sub(dat)

    class(base_t), intent(inout) :: dat
    integer :: nthreads
    integer :: ldim

    ldim = 10
    nthreads = 1

    call dat%start(ldim,nthreads)

  end subroutine
end module

program test
  use m
  implicit none
  class(child_t), allocatable :: dat
  real(kind=dp), allocatable, target :: two_d_array(:,:)
  integer :: i

  allocate(two_d_array(100,1), source=100.0d0)

  print *, 'enter i:'
  read(*,*) i

  select case (i)
  case (0)
      write(*,*) '1 branch'
!      allocate(child_1_t :: dat)
      dat = child_1_t(n1=5, n3=1, d2=two_d_array)
  case default
      write(*,*) '2 branch'
!      allocate(child_2_t :: dat)
      dat = child_2_t(n2=10, n3=2, d2=two_d_array)
  end select

  call test_sub(dat)

end program
