program main_p

  implicit none

  integer, parameter :: n = 10
  integer, parameter :: m = 5

  integer, parameter :: b = 3
  integer, parameter :: t = n+b-1
  
  integer, parameter :: l = 4
  integer, parameter :: u = 7
  integer, parameter :: s = 3
  integer, parameter :: e = (u-l)/s+1
  
  call test_f()
  call test_s()
  call test_p()
  call test_a()
  stop

contains

  subroutine test_f()
    integer, target :: x(n,n)
    integer, target :: y(b:t)
    integer         :: i
    
    x = reshape([(i, i=1,n*n)], [n,n])
    y = x(:,m)
    call sub_s(x(:,m), y, 1, n, n)
    call sub_s(y, x(:,m), b, t, n)
    return
  end subroutine test_f
  
  subroutine test_s()
    integer, target :: x(n,n)
    integer, target :: v(e)
    integer         :: i
    
    x = reshape([(i, i=1,n*n)], [n,n])
    v = x(l:u:s,m)
    call sub_s(v, v, 1, e, e)
    call sub_s(x(l:u:s,m), v, 1, e, e)
    call sub_s(v, x(l:u:s,m), 1, e, e)
    return
  end subroutine test_s
  
  subroutine test_p()
    integer,  target :: x(n,n)
    integer, pointer :: p(:)
    integer          :: v(e)
    integer          :: i
    
    x = reshape([(i, i=1,n*n)], [n,n])
    v = x(l:u:s,m)
    p => x(:,m)
    call sub_s(p(l:u:s), v, 1, e, e)
    p => x(l:u:s,m)
    call sub_s(p, v, 1, e, e)
    p(l:) => x(l:u:s,m)
    call sub_s(p, v, l, e+l-1, e)
    p(l:l+e-1) => x(l:u:s,m)
    call sub_s(p, v, l, e+l-1, e)
    allocate(p(n))
    p(:) = x(:,m)
    call sub_s(p(l:u:s), v, 1, e, e)
    deallocate(p)
    allocate(p(e))
    p(:) = x(l:u:s,m)
    call sub_s(p, v, 1, e, e)
    deallocate(p)
    allocate(p(l:l+e-1))
    p(:) = x(l:u:s,m)
    call sub_s(p, v, l, e+l-1, e)
    deallocate(p)
    allocate(p(l:l+e-1))
    p(l:) = x(l:u:s,m)
    call sub_s(p, v, l, e+l-1, e)
    deallocate(p)
    allocate(p(l:l+e-1))
    p(l:l+e-1) = x(l:u:s,m)
    call sub_s(p, v, l, e+l-1, e)
    deallocate(p)
    return
  end subroutine test_p
  
  subroutine test_a()
    integer                      :: x(n,n)
    integer, allocatable, target :: a(:)
    integer                      :: v(e)
    integer                      :: i
    
    x = reshape([(i, i=1,n*n)], [n,n])
    v = x(l:u:s,m)
    a = x(:,m)
    call sub_s(a(l:u:s), v, 1, e, e)
    deallocate(a)
    allocate(a(n))
    a(:) = x(:,m)
    call sub_s(a(l:u:s), v, 1, e, e)
    deallocate(a)
    a = x(l:u:s,m)
    call sub_s(a, v, 1, e, e)
    deallocate(a)
    allocate(a(e))
    a(:) = x(l:u:s,m)
    call sub_s(a, v, 1, e, e)
    deallocate(a)
    allocate(a(l:l+e-1))
    a(:) = x(l:u:s,m)
    call sub_s(a, v, l, e+l-1, e)
    deallocate(a)
    allocate(a(l:l+e-1))
    a(l:) = x(l:u:s,m)
    call sub_s(a, v, l, e+l-1, e)
    deallocate(a)
    allocate(a(l:l+e-1))
    a(l:l+e-1) = x(l:u:s,m)
    call sub_s(a, v, l, e+l-1, e)
    deallocate(a)
    return
  end subroutine test_a

  subroutine  sub_s(a, b, l, u, e)
    integer, pointer, intent(in) :: a(:)
    integer,          intent(in) :: b(:)
    integer,          intent(in) :: l
    integer,          intent(in) :: u
    integer,          intent(in) :: e

    integer :: i

    if(lbound(a,dim=1)/=l) stop 1001
    if(ubound(a,dim=1)/=u) stop 1002
    if(any(shape(a)/=[e])) stop 1003
    if(size(a, dim=1)/=e)  stop 1004
    if(size(a)/=size(b))   stop 1005
    do i = l, u
      if(a(i)/=b(i-l+1)) stop 1006
    end do
  end subroutine sub_s

end program main_p