extract_array Module Subroutine

  module subroutine extract_array(this, output)
    !! Extract the array
    implicit none

    ! Arguments
    class(array_type), intent(in) :: this
    !! Instance of the array type
    real(real32), dimension(..), allocatable, intent(out) :: output
    !! Output array

    ! Local variables
    integer :: rank_output
    !! Rank of output array
    character(len=10) :: rank_str
    !! String for rank


    if(.not.this%allocated .or. .not.allocated(this%val))then
       call print_warning("Trying to extract from unallocated array")
       return
    end if
    select rank(output)
    rank(1)
       rank_output = 1
       output = reshape(this%val, [ product(this%shape) * size(this%val,2) ])
    rank(2)
       rank_output = 2
       output = this%val
    rank default
       rank_output = -1
       select rank(output)
       rank(3)
          rank_output = 3
          output = reshape( &
               this%val, &
               [ &
                    this%shape(1), &
                    this%shape(2), &
                    size(this%val,2) &
               ] &
          )
       rank(4)
          rank_output = 4
          output = reshape( &
               this%val, &
               [ &
                    this%shape(1), &
                    this%shape(2), &
                    this%shape(3), &
                    size(this%val,2) &
               ] &
          )
       rank(5)
          rank_output = 5
          output = reshape( &
               this%val, &
               [ &
                    this%shape(1), &
                    this%shape(2), &
                    this%shape(3), &
                    this%shape(4), &
                    size(this%val,2) &
               ] &
          )
       end select
    end select

    if(rank_output.eq.-1)then
       write(*,*) "Error: Unable to extract array with rank greater than 5"
       return
    elseif(rank_output .ne. size(this%shape,1) + 1)then
       write(rank_str,'(I0)') rank_output
       call print_warning( &
            "Output data rank mismatch, expected rank "//trim(adjustl(rank_str)) &
       )
       return
    end if

  end subroutine extract_array