program main
use adaptive

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

real, dimension(:,:,:), target, allocatable :: base_grid
real, dimension(:,:,:,:,:), target, allocatable :: g
! grid function (level,grid_id, time_level,x,y) 
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$ DISTRIBUTE (*,*,*,BLOCK,BLOCK) onto P :: g
!HPF$ ALIGN g(*,*,:,:,:) 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,g,level,finest_level,lp)
use adaptive
use parameters
type(ADAPTIVE_MESH),pointer      :: base
real,dimension(:,:,:)            :: base_grid
real,dimension(:,:,:,:,:),target :: g
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 (*,*,:,:,:) WITH *base_grid(:,:,:) :: g
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))

! initialize base grid
 base_grid(1:2,:,:)= 0

! allocate memory for fine grids
allocate(g(maxlevel,ngrds,2,mxf,myf))
 g=0

level=1
finest_level=1

!        write(12,1004) level
!        write(12,1000) lp(1)%dr(1),base%rmin(1),base%rmax(1), &
!                       base%rmin(2),base%rmax(2) 
!        write(12,1001) mx,my
!        write(12,1002) base_grid(1,:,:)

do i=1,50
write(6,*) '------------------------------------------'
write(6,*) 'coarse step no',i
! ================ regridding =====================================
!time for regridding?
if(mod(i,2)==1 .and. level < maxlevel) then
   call regrid(base,base_grid,g,level,finest_level,lp)
endif  
! ====================================================================
call propagate(lp,level,base_grid,base,finest_level,g) 

!        IF(AVS) then
!        write(12,1004) level
!        write(12,1000) lp(1)%dr(1),base%rmin(1),base%rmax(1), &
!                       base%rmin(2),base%rmax(2) 
!        write(12,1001) mx,my
!        write(12,*) int(base%rmin(1)),int(base%rmax(1)),lp(1)%dr(1)
!        write(12,1002) base_grid(1,:,:)
!        ENDIF

 1000 Format(5E10.5)
 1001 Format(2I5)
 1002 Format(E15.6)   
 1004 Format(I2)

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




