allocate_array Module Subroutine

  module subroutine allocate_array(this, array_shape, source)
    !! Allocate array
    implicit none

    ! Arguments
    class(array_type), intent(inout), target :: this
    !! Instance of the array type
    integer, dimension(:), intent(in), optional :: array_shape
    !! Shape of the array
    class(*), dimension(..), intent(in), optional :: source
    !! Source array

    if(allocated(this%val).or.this%allocated)then
       call stop_program("Trying to allocate already allocated array values")
       return
    end if
    if(present(array_shape))then
       allocate(this%val( &
            product(array_shape(1:size(array_shape)-1)),  &
            array_shape(size(array_shape)) &
       ))
       this%shape = [ array_shape(1:size(array_shape)-1) ]
    end if
    if(present(source))then
       select rank(source)
       rank(0)
          select type(source)
          type is (real(real32))
             if(.not.present(array_shape))then
                call stop_program('Source shape not provided')
                return
             end if
             this%val(:,:) = source
          type is (array_type)
             if(present(array_shape))then
                if(any(array_shape.ne.shape(source%val)))then
                   call stop_program('Source shape does not match array shape')
                   return
                end if
             end if
             this = source
             !  this%val_ptr( &
             !       1:source%shape(1), &
             !       1:size(source%val, dim=2) &
             !  ) => this%val
          class default
             call stop_program('Incompatible source type for rank 0')
             return
          end select
       rank(2)
          select type(source)
          type is (real(real32))
             if(present(array_shape))then
                if(any(array_shape.ne.shape(source)))then
                   call stop_program('Source shape does not match array shape')
                   return
                end if
             end if
             this%val = source
             !  this%val_ptr( &
             !       1:size(source, dim=1), &
             !       1:size(source, dim=2) &
             !  ) => this%val
          class default
             call stop_program('Incompatible source type for rank 2')
             return
          end select
       rank default
          call stop_program('Unrecognised source rank')
          return
       end select
    end if
    if(.not.present(source).and..not.present(array_shape))then
       call stop_program('No shape or source provided')
       return
    end if
    this%rank = 1
    this%allocated = .true.
    !  this%val_ptr(1:size(this%val, dim=1), 1:size(this%val, dim=2)) => this%val
    if(.not.allocated(this%shape)) this%shape = [ size(this%val, dim=1) ]
    this%size = product(this%shape)


  end subroutine allocate_array