subroutine propagate(lp,crsstp,finlev)
      use types
      use amr
      type(LEVEL_INFO),dimension(maxlev) :: lp     
      integer(I4B) crsstp
    
      integer(I4B), parameter :: stacksize = 1000
      integer(I4B) steps,curlev,finlev
      integer(I4B), dimension(stacksize) :: stack
      real(SP)   xmaxim
      integer(I4B), dimension(3):: imaxim  
 

      INTERFACE 
       subroutine timestep(lp,level)
       use types
       use amr
       type(LEVEL_INFO),dimension(maxlev) :: lp     
       integer(I4B) level     
       end subroutine timestep

       subroutine regrid(lp,curlev,finlev)
       use types
       use amr
       type(LEVEL_INFO), dimension(maxlev) :: lp
       integer(I4B) curlev,finlev
       logical first
       end subroutine regrid
       
      END INTERFACE

      finlev =1
      maxsteps=1

      curlev=crslev
      stack(1)=curlev
      stack(2)=crsstp
      top=2

      if(AVS) then
      write(11,1001) lp(1)%ml%gnr(1),lp(1)%ml%gnr(2)
      write(11,1002) lp(1)%ml%grid%gfcn(AMPL)%tlev(1)%data
      if(associated(lp(2)%ml)) then
         write(12,1001) lp(2)%ml%gnr(1),lp(2)%ml%gnr(2)
         write(12,1002) lp(2)%ml%grid%gfcn(AMPL)%tlev(1)%data
      endif
      endif 

if(verbose) then
write(66,*) 'start computation...'
write(66,*) 'base grid extend'
write(66,*) 'min:',lp(1)%ml%grmin
write(66,*) 'max:',lp(1)%ml%grmax
write(66,*) 'size',lp(1)%ml%gnr
write(66,*) 'time',lp(1)%ml%grid%gfcn(1)%t(1)
write(66,*) 'fine levels dr/dt'
write(66,*) 'value for y= 2 & 4'
write(66,*) lp(1)%ml%grid%gfcn(1)%tlev(1)%data(30,1:2,1)
do i=1,maxlev
write(66,*) i,' dr',lp(i)%ldr,lp(i)%ldt
enddo            
endif

DO WHILE(top.gt.0)
   curlev=stack(top-1)
   steps =stack(top)

if(verbose) then
write(66,*) '========================================='
write(66,*) 'STEPS',steps,' on level',curlev
endif
       
   if(steps.gt.0) then

if(verbose) then
write(66,*) 'regrid time?'
endif

    IF(curlev.lt.maxlev .AND. lp(curlev)%lsteps > 0) THEN
       IF(MOD(lp(curlev)%lsteps,lp(curlev)%lrgint)==0) THEN
          IF(curlev==crslev) THEN

if(verbose) then
write(66,*) 'regrid crslev'
endif
            call regrid(lp,curlev,finlev)


          ELSE ! (i.e. fine level)

           IF(MOD(lp(curlev-1)%lsteps-1,lp(curlev-1)%lrgint) <> 0 &
                   .OR.      &
                 int(abs(lp(curlev-1)%ml%grid%gfcn(1)%t(1) - &
                 lp(curlev-1)%ldt -  &
                 lp(curlev)%ml%grid%gfcn(1)%t(1))/lp(curlev)%ldt) <> 0) &
                   THEN
if(verbose) then
 write(66,*) 'regrid at level',curlev
endif
               call regrid(lp,curlev,finlev)
           ENDIF 
          ENDIF  
       ENDIF      

if(verbose) then
do iii=1,maxlev
  if(associated(lp(iii)%ml)) then
     write(66,*) 'level',iii,' exists'
     write(66,*) lp(iii)%ml%grmin
     write(66,*) lp(iii)%ml%grmax
  else
     write(66,*) 'level',iii,' does not'
  endif
enddo       
endif

     ENDIF  

         stack(top-1)=curlev
         stack(top)=-steps

         call timestep(lp,curlev)

if(curlev==1) write(63,*) lp(1)%ml%grid%gfcn(AMPL)%tlev(1)%data(5,:,1),'---'
if(curlev==2) write(62,*) lp(2)%ml%grid%gfcn(AMPL)%tlev(1)%data(5,:,1),'---'


        IF(AVS) then 
        write(11,1001) lp(1)%ml%gnr(1),lp(1)%ml%gnr(2)
        write(11,1002) lp(1)%ml%grid%gfcn(AMPL)%tlev(1)%data
      if(associated(lp(2)%ml)) then
         write(12,1001) lp(2)%ml%gnr(1),lp(2)%ml%gnr(2)
         write(12,1002) lp(2)%ml%grid%gfcn(AMPL)%tlev(1)%data
      endif
        ENDIF

 1001 Format(3I5)
 1002 Format(E15.6)   

        SELECT CASE(curlev)
          CASE(1) 
          write(6,*) ' ------------------------------------------------'
          write(6,*) lp(curlev)%ml%grid%gfcn(1)%t(1),'***', &
          crsstp-steps+1
          CASE(2) 
          write(6,*) lp(curlev)%ml%grid%gfcn(1)%t(1),'   ***', &
          int(lp(curlev)%rcxshp)-steps+1
          CASE(3) 
          write(6,*) lp(curlev)%ml%grid%gfcn(1)%t(1),'      ***', &
          int(lp(curlev)%rcxshp)-steps+1
          CASE(4)
          write(6,*) lp(curlev)%ml%grid%gfcn(1)%t(1),'         ***',& 
         int(lp(curlev)%rcxshp)-steps+1
          CASE(5) 
          write(6,*) lp(curlev)%ml%grid%gfcn(1)%t(1),'             ***', &
         int(lp(curlev)%rcxshp)-steps+1
          CASE DEFAULT 
          write(6,*) lp(curlev)%ml%grid%gfcn(1)%t(1),'even finer', &
         int(lp(curlev)%rcxshp)-steps+1
        END SELECT
       
         if(curlev.lt.finlev) then
           if(top+2.gt.stacksize) then
            write(6,*) 'stacksize exceeded: emergency stop'
            stop
           endif
           stack(top+1)=curlev+1
          stack(top+2)=int(lp(curlev+1)%rcxshp)
          top=top+2
         endif 

       else
 
         steps=abs(steps)-1       
         IF(steps.gt.0) then
             stack(top-1)=curlev
             stack(top)  =steps   
         ELSE
             top=top-2
             IF (curlev.gt.crslev) THEN
              call linject(lp(curlev)%ml,curlev,int(lp(curlev)%rcxshp))
             ENDIF
         ENDIF
       endif
      ENDDO

      return
      end

      subroutine timestep(lp,level)
       use types
      use amr
      type(LEVEL_INFO),dimension(maxlev) :: lp     
      integer(I4B) level     

      type(ADAPTIVE_MESH), pointer :: p 


      INTERFACE
      subroutine grid_step(grid,dt,dr,nr,gflb,gfrb)
      use types
      use amr
      type(GF3TL), pointer :: grid
      real(SP)                dt
      real(SP), dimension(3) :: dr
      integer(I4B), dimension(3):: nr,gflb,gfrb
      end subroutine grid_step
      END INTERFACE


!     for each grid at this level perform one temporal step
      p=>lp(level)%ml
      if(.not.associated(p)) then
         write(6,*) 'timestep should not be called, level',level
         stop
      endif

      DO WHILE(associated(p))

if(verbose) then
write(6,*) 'grid extend'
write(6,*) 'min:',p%grmin
write(6,*) 'max:',p%grmax
write(6,*) 'size',p%gnr
write(6,*) 'next grid at the same level:',associated(p%neighbor)
endif

       call grid_step(p%grid,lp(level)%ldt,lp(level)%ldr,p%gnr,p%gflb, &
      p%gfrb)
       p=>p%neighbor
      END DO

      lp(level)%lsteps=lp(level)%lsteps+1 

      return
      end





































