subroutine propagate(lp,level,base_grid,base,finest_level,g)
use adaptive
real, dimension(:,:,:) :: base_grid
real, dimension(:,:,:,:,:), target :: g
type(ADAPTIVE_MESH), pointer :: base
integer     :: level,finest_level
type(LEVEL_INFO), dimension(maxlevel) :: lp

real, dimension(2,mxf,myf) :: gridpointer1
type(ADAPTIVE_MESH), pointer :: grid1,grid2,sibling,parent

!HPF$ PROCESSORS P(PX,PY)
!HPF$ DISTRIBUTE *(*,BLOCK,BLOCK) onto *P :: base_grid
!HPF$ DISTRIBUTE (*,BLOCK,BLOCK) onto P :: gridpointer1
!HPF$ DISTRIBUTE (*,*,*,BLOCK,BLOCK) onto *P :: g

INTERFACE
  subroutine update(a,t,dr,nx,ny)
  use parameters
  real, dimension(:,:,:) :: a
  real t
  integer nx,ny
  real, dimension(0:2) :: dr
!HPF$ PROCESSORS P(PX,PY)
!HPF$ DISTRIBUTE *(*,BLOCK,BLOCK) onto *P :: a
  end subroutine update

  subroutine injection(lev,grid,base_grid,g)
  use parameters
  use adaptive
  real,dimension(:,:,:) :: base_grid
  real,dimension(:,:,:,:,:), target :: g
  integer :: lev
  type(ADAPTIVE_MESH),pointer :: grid
!HPF$ PROCESSORS P(PX,PY)
!HPF$ DISTRIBUTE *(*,BLOCK,BLOCK) onto *P :: base_grid
!HPF$ DISTRIBUTE *(*,*,*,BLOCK,BLOCK) onto *P :: g
  end subroutine injection

END INTERFACE

write(6,*) 'PROPAGATE at level',level

if(.not.associated(base)) then
write(6,*) '???'
stop
endif


do istep=1,2
write(6,*) 'step',istep,' on level',level

! do one step on the current level 
! update all grids on the current level, from 1 to curmax
!   write(6,*) lp%curmax

!   (level == 1)

lev=1
write(6,*) 'call update base grid'
write(6,*) 't,dr',base%t,lp(lev)%dr
 call update(base_grid,base%t,lp(lev)%dr,base%nr(1),base%nr(2))
!write(6,*) 'base grid updated' 

! if there are finer levels, update them ...

if(finest_level>1) then

     lev=2
     grid1=>lp(lev)%head
!write(6,*) 'grid associated'

!     gridpointer=>g(lev,grid%grid_id,:,:,:)
!     gridpointer1=g(lev,grid1%grid_id,:,:,:)
     DO WHILE (associated(grid1))
write(6,*) 'call update: level',lev
     call update(g(lev,grid1%grid_id,:,:,:),grid1%t,lp(lev)%dr, &
                           grid1%nr(1),grid1%nr(2))
if(finest_level==3) then
   lev=3
   grid2=>lp(lev)%head
!   gridpointer1=g(lev,grid2%grid_id,:,:,:)
   DO WHILE(associated(grid2))
     write(6,*) 'call update: level',lev
     call update(g(lev,grid2%grid_id,:,:,:),grid2%t,lp(lev)%dr, &
                                 grid2%nr(1),grid2%nr(2))
     call update(g(lev,grid2%grid_id,:,:,:),grid2%t,lp(lev)%dr, &
                                 grid2%nr(1),grid2%nr(2))
!     write(6,*) 'INJECT in level3:before',g(2,1,2,5,5)
     call injection(lev,grid2,base_grid,g)
!     write(6,*) 'INJECT in level3:after',g(2,1,2,5,5)
     grid2=>grid2%sibling
   ENDDO
   lev=2
endif
       call injection(lev,grid1,base_grid,g)
write(6,*) 'call update: level',lev
     call update(g(lev,grid1%grid_id,:,:,:),grid1%t,lp(lev)%dr, &
                                  grid1%nr(1),grid1%nr(2))
if(finest_level==3) then
   lev=3
   grid2=>lp(lev)%head
   gridpointer1=g(lev,grid2%grid_id,:,:,:)
   DO WHILE(associated(grid2))
     write(6,*) 'call update: level',lev
     call update(g(lev,grid2%grid_id,:,:,:),grid2%t,lp(lev)%dr, &
                                 grid2%nr(1),grid2%nr(2))
     call update(g(lev,grid2%grid_id,:,:,:),grid2%t,lp(lev)%dr, &
                                 grid2%nr(1),grid2%nr(2))
!     write(6,*) 'INJECT in level3:before',g(2,1,2,5,5)
     call injection(lev,grid2,base_grid,g)
!     write(6,*) 'INJECT in level3:after',g(2,1,2,5,5)
     grid2=>grid2%sibling
   ENDDO
   lev=2
endif
!       write(6,*) 'INJECT in level2: before',base_grid(2,5,5)
       call injection(lev,grid1,base_grid,g)
!       write(6,*) 'INJECT in level2: after',base_grid(2,5,5)
!       call update(g(lev,grid%grid_id,:,:,:),grid%t,lp(lev)%dr)
!       call update(g(lev,grid%grid_id,:,:,:),grid%t,lp(lev)%dr)
       grid1=>grid1%sibling
     ENDDO ! WHILE
     lev=1

endif !finest_level==2

enddo

return
end

