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) :: gridpointer
type(ADAPTIVE_MESH), pointer :: grid,child,sibling,parent

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

INTERFACE
  subroutine update(a,t,dr,nx,ny,level)
  use parameters
  real, dimension(:,:,:) :: a
  real t
  integer nx,ny,level
  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


!=====================================================================
! TWO STEPS ON BASE LEVEL
!=====================================================================
do istep=1,2

   lev=1
   call update(base_grid,base%t,lp(lev)%dr,base%nr(1),base%nr(2),lev)

!       for AVS
        write(12,1001) mx,my
        write(12,1004) lev
        write(12,*) int(base%rmin(1)),int(base%rmin(2)),lp(1)%dr(1)
        write(12,1002) base_grid(1,:,:)
!       end for AVS 
!    ============================================
!    if there are finer levels, update them ...
!    ============================================

     if(finest_level==2) then

     lev=2
     grid=>lp(lev)%head

!     gridpointer=>g(lev,grid%grid_id,:,:,:)  gridpointer is an array!
     gridpointer=g(lev,grid%grid_id,:,:,:)

     !--------------------------------------------
     ! for all grids at level 2      
     !-------------------------------------------- 

     DO WHILE (associated(grid))

       write(6,*) 'TEST:',grid%nr
       call update(gridpointer,grid%t,lp(lev)%dr,grid%nr(1),grid%nr(2),lev)
       call update(gridpointer,grid%t,lp(lev)%dr,grid%nr(1),grid%nr(2),lev)

!       for AVS
        write(13,1001) grid%nr(1),grid%nr(2)
        write(13,1004) lev
        write(13,*) int(grid%rmin(1)),int(grid%rmin(2)),lp(2)%dr(1)
        write(13,1002) gridpointer(2,1:grid%nr(1),1:grid%nr(2))
!       end for AVS

       write(6,*) 'SSS:',int(grid%rmin(2)),int(grid%rmax(2)),lp(2)%dr(1)
       write(6,*) 'SSS:',grid%nr(1),grid%nr(2)

       call injection(lev,grid,base_grid,g)
       grid=>grid%sibling

     ENDDO ! WHILE


     else  !there is no level 2 grids; make dummy record for AVS

        lev=2
        write(13,1001) mxf/2,myf/2
        write(13,1004) lev
        ix=1
        iy=1
        write(13,*) ix,iy,lp(2)%dr(1)
        g(2,1,1,:,:)=-0.95
        write(13,1002) g(2,1,1,1:mxf/2,1:myf/2)

     endif !finest_level==2

enddo !two steps on the base level


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


return 
end








