program main
use adaptive

type(ADAPTIVE_MESH), pointer :: parent,base,grid
real, dimension(2) :: rmin 
real, dimension(2) :: rmax 
integer, dimension(2) :: nr 
real, dimension(0:2) :: dr 
integer :: level

real, dimension(:,:,:), target, allocatable :: base_grid
real, dimension(:), allocatable :: base_coordx,base_coordy
real, dimension(:,:,:,:,:), target, allocatable :: g
! grid function (level,grid_id, time_level,x,y) 
real, dimension(:,:,:), allocatable :: coordx,coordy
integer finest_level
type(LEVEL_INFO),dimension(maxlevel) :: lp
real t

!HPF$ PROCESSORS P(PX,PY)
!HPF$ DISTRIBUTE base_grid(*,BLOCK,BLOCK) onto P
!HPF$ ALIGN base_coordx(:) with base_grid(*,:,*)
!HPF$ ALIGN base_coordy(:) with base_grid(*,*,:)
!HPF$ DISTRIBUTE (*,*,*,BLOCK,BLOCK) onto P :: g
!HPF$ ALIGN coordx(*,*,:) with base_grid(*,:,*)
!HPF$ ALIGN coordy(*,*,:) with base_grid(*,*,:)
!HPF$ DISTRIBUTE t1(BLOCK)
!HPF$ DISTRIBUTE t2(BLOCK)

INTERFACE
extrinsic(hpf_local) subroutine timer(return_time, initial_time)
real, dimension(:), intent(in)  :: initial_time
real, dimension(:), intent(out) :: return_time
!HPF$ DISTRIBUTE *(block) :: initial_time
!HPF$ ALIGN return_time with initial_time
end subroutine timer

subroutine propagate(lp,level,base_grid,base,finest_level,g)
use adaptive
use parameters
real, dimension(:,:,:) :: base_grid
real, dimension(:,:,:,:,:) :: g
type(ADAPTIVE_MESH), pointer :: base
integer     :: level,finest_level
type(LEVEL_INFO), dimension(maxlevel) :: lp
!HPF$ PROCESSORS P(PX,PY)
!HPF$ DISTRIBUTE *(*,BLOCK,BLOCK) onto *P :: base_grid
!HPF$ DISTRIBUTE *(*,*,*,BLOCK,BLOCK) onto *P :: g
end subroutine propagate

subroutine regrid(base,base_grid,grid,g,level,finest_level,lp, &
                    base_coordx,base_coordy,coordx,coordy)
use adaptive
use parameters
type(ADAPTIVE_MESH),pointer    :: base,grid
real,dimension(:,:,:)          :: base_grid
real, dimension(:) :: base_coordx,base_coordy
real,dimension(:,:,:,:,:),target :: g
real, dimension(:,:,:) :: coordx,coordy
integer level,finest_level
type(LEVEL_INFO), dimension(maxlevel) :: lp
!HPF$ PROCESSORS P(PX,PY)
!HPF$ DISTRIBUTE *(*,BLOCK,BLOCK) onto *P :: base_grid
!HPF$ DISTRIBUTE *(*,*,*,BLOCK,BLOCK) onto *P :: g
!HPF$ ALIGN base_coordx(:) with base_grid(*,:,*)
!HPF$ ALIGN base_coordy(:) with base_grid(*,*,:)
!HPF$ ALIGN coordx(*,*,:)  with base_grid(*,:,*)
!HPF$ ALIGN coordy(*,*,:)  with base_grid(*,*,:)
end subroutine regrid

END INTERFACE

call timer(t2,t1)
call allocate_LEVEL_INFO(lp)
nullify(base)
!allocate base_grid
nullify(parent)
rmin=(/1.0,1.0/)
rmax=(/100.0,100.0/)
nr=(/mx,my/)
level=1
t=0
call allocate_ADAPTIVE_MESH(lp,level,parent,base,t,rmin,rmax,nr)
allocate(base_grid(2,mx,my))
allocate(base_coordx(mx))
allocate(base_coordy(my))

! initialize base grid
 base_grid(1:2,:,:)= 0
! initialize base coordinates
 forall(i=1:mx) base_coordx(i) = i
 forall(j=1:my) base_coordy(j) = j

! allocate memory for fine grids
allocate(g(maxlevel,ngrds,2,mxf,myf))
! allocate memory for coordinates
allocate(coordx(maxlevel,ngrds,mxf))
allocate(coordy(maxlevel,ngrds,myf))
level=1
finest_level=1

do i=1,18
write(6,*) '------------------------------------------'
write(6,*) 'coarse step no',i
! ================ regridding =====================================
!time for regridding?
if(mod(i,2)==1) then
   call regrid(base,base_grid,grid,g,level,finest_level,lp, &
                  base_coordx,base_coordy,coordx,coordy)
!if(finest_level>2) stop
endif  
! ====================================================================
call propagate(lp,level,base_grid,base,finest_level,g) 
enddo

call timer(t1,t2)
print *,'time',t1,' seconds'

stop
end


extrinsic(hpf_local) subroutine timer(return_time, initial_time)
real, dimension(:), intent(in)  :: initial_time
real, dimension(:), intent(out) :: return_time

return_time(lbound(return_time, 1)) =     &
    secnds(initial_time(lbound(initial_time, 1)))

end

