       subroutine regrid(lp,curlev,finlev,first)
       use amr
       type(LEVEL_INFO), dimension(maxlev) :: lp
       integer curlev,finlev
       logical first
       
       interface

       subroutine flag_candidates(lp,curlev,finlev)
       use amr
       type(LEVEL_INFO), dimension(maxlev) :: lp
       integer curlev,finlev   
       end subroutine flag_candidates

       subroutine rgrid2(lp,curlev,finlev)
       use amr
       type(LEVEL_INFO), dimension(maxlev) :: lp
       integer curlev,finlev
       end subroutine rgrid2

       end interface

       if(curlev.eq.maxlev) then
          write(6,*) 'REGRID: should not be calling routine',
     &    ' at finest allowable level'
          write(6,*) curlev,maxlev
          stop
          return
       endif

       write(6,*) ' -------- START REGRIDDING ------------' 

       call clear_cluster_structure(lp)
       write(6,*) 'BEFORE FLAG:',lp%ldt
       call flag_candidates(lp,curlev,finlev)
       write(6,*) 'AFTER FLAG',lp%ldt 

       call rgrid2(lp,curlev,finlev)
       write(6,*) 'AFTER RGRD2',lp%ldt
       write(6,*) ' -------- END REGRIDDING --------------'

       return
       end


       subroutine flag_candidates(lp,curlev,finlev)
       use amr
       type(LEVEL_INFO), dimension(maxlev) :: lp
       integer curlev,finlev

       type(ADAPTIVE_MESH), pointer :: p
       type(CLUSTERS),pointer       :: cp,clp,clpnew
       real,dimension(3)            :: cmin,cmax

!       variables needed for clustering routine        
       integer, dimension(1) :: npatches
       integer patchno,startpt
       integer, dimension(:), pointer :: patches
       integer, dimension(1,1,1)      :: n1,n2,n3,dim,level
 
       INTERFACE
       subroutine ctrest(lp,lev,p)
       use amr
       type(LEVEL_INFO), dimension(maxlev) :: lp
       integer lev
       type(GF3TL), pointer :: p
       end subroutine ctrest 
        
       subroutine isolate_clusters(lp,lev)
       use amr
       type(LEVEL_INFO),dimension(maxlev) :: lp
       integer lev
       end subroutine isolate_clusters

       subroutine merge_clusters(lp,lev)
       use amr
       type(LEVEL_INFO),dimension(maxlev) :: lp
       integer lev
       end subroutine merge_clusters

       END INTERFACE

       nullify(p)

!      estimate truncation error on each grid
!      from the finest level to the current one

       do   lev=min(finlev,maxlev-1),curlev, -1
!            write(6,*) 'flag candidates on level=',lev
            p=>lp(lev)%ml
            DO WHILE(associated(p))
!             write(6,*) 'call ctrest',lev,tremax
             call ctrest(lp,lev,p%grid)

c       write(6,*) 'make record --------------------->'
        IF(AVS) then 
        write(12,1001) lp(1)%ml%gnr
        write(12,1002) lp(1)%ml%grid%gfcn(ESTRE)%tlev(1)%data
        ENDIF

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


             WHERE(abs(p%grid%gfcn(ESTRE)%tlev(1)%data).ge.tremax)
             p%grid%gfcn(ESTRE)%tlev(1)%data=1.0d0
             ELSEWHERE
             p%grid%gfcn(ESTRE)%tlev(1)%data=0.0
             ENDWHERE

!           do iik=1,32
!           do iij=1,32
!           write(6,333) int(p%grid%gfcn(ESTRE)%tlev(1)%data(1:32,iij,iik))
!           enddo
!           write(6,*) ' '
!           enddo   

 333   format(32(I2))

!          write(6,*) 'any?'
           if(ALL(p%grid%gfcn(ESTRE)%tlev(1)%data<0.5)) then
            write(6,*) 'nothing to regrid!!!!'
            return
           endif 
!          write(6,*) 'continue'

!        ------------------------------------------------------------------   
!        ISOLATE CLUSTERS
!        ------------------------------------------------------------------
         npatches=0
         dim=3
         n1=p%gnr(1)
         n2=p%gnr(2)
         n3=p%gnr(3)
         level=lev
!   NOTE:     temporily, we allow for max 10 clusters (10*6)
         allocate(patches(60))
         patches=0
!         write(6,*) n1,n2,n3,level,'call cluster'
         call cluster(dim,n1,n2,n3,int(p%grid%gfcn(ESTRE)%tlev(1)%data),
     &   npatches,patches,level)

         write(6,*) 'RETURN FROM CLUSTER',lev
!         write(6,*) 'patches associated?',associated(patches)
         write(6,*) '# patches', npatches
!         if(associated(patches)) then
!            write(6,*) size(patches)
!            write(6,*) patches
!         else
!            write(6,*) 'patches not associated!'
!            stop 
!         endif


!     ---------------------------------------------------------------- 
!     CREATE CLUSTER STRUCTURE AT THIS LEVEL
!     ----------------------------------------------------------------
         
      if(npatches(1)>0) then
      do patchno = 1, npatches(1)
      if(lev.lt.maxlev) then

!        ----------------------------------------------------------------
!        TRANSLATE ARRAY INDICES INTO COORDINATES
!        ----------------------------------------------------------------
         startpt=1+(patchno-1)*6

         i1=patches(startpt)
         i2=i1+patches(startpt+3)
!         write(6,*) 'x:', i1,i2
         cmin(1)=p%grid%gfcn(ESTRE)%tlev(1)%c(1)%coord(i1)
         cmax(1)=p%grid%gfcn(ESTRE)%tlev(1)%c(1)%coord(i2)

         i1=patches(startpt+1)
         i2=i1+patches(startpt+4)
!         write(6,*) 'y:', i1,i2
         cmin(2)=p%grid%gfcn(ESTRE)%tlev(1)%c(2)%coord(i1)
         cmax(2)=p%grid%gfcn(ESTRE)%tlev(1)%c(2)%coord(i2)

         i1=patches(startpt+2)
         i2=i1+patches(startpt+5)
!         write(6,*) 'z:', i1,i2
         cmin(3)=p%grid%gfcn(ESTRE)%tlev(1)%c(3)%coord(i1)
         cmax(3)=p%grid%gfcn(ESTRE)%tlev(1)%c(3)%coord(i2)

!         write(6,*) 'cmin', cmin
!         write(6,*) 'cmax', cmax


       allocate(clpnew)
       nullify(clpnew%clnext)
       nullify(clpnew%clprnt)
       clpnew%clrmin=cmin   
       clpnew%clrmax=cmax   
       clpnew%clprnt=>p
       if(associated(clp)) then
         clp%clnext=>clpnew
       else
         lp(lev+1)%clhead=>clpnew
       endif
       clp=>clpnew
      else
        write(6,*) 'isolate clusters: maximum levels exceeded'
      endif
      enddo !patchno          
      endif !npatches>0

         p=>p%neighbor
         ENDDO !process nest grid at this level

!       write(6,*) '---isolate---'
!!!     OBSOLETE:      call isolate_clusters(lp,lev)
! LATER:       call merge_clusters(lp,lev)
       write(6,*) 'CLUSTERING: -done with level',lev,'-----------------'
       enddo   !goto level lev-1

       return
       end


       subroutine rgrid2(lp,curlev,finlev)
       use amr
       type(LEVEL_INFO), dimension(maxlev) :: lp
       integer curlev,finlev

       type(ADAPTIVE_MESH),pointer :: parent,child,head,current,old
       type(CLUSTERS),pointer       :: clp
       character(200)              :: chname = 'child'  
       integer g 

!      ------------------------------------------------------- 
!      DETERMINE NEW FINEST LEVEL OF REFINEMENT 
!      -------------------------------------------------------

       finlev=curlev
       do lev = curlev + 1, maxlev
          if(associated(lp(lev)%clhead)) finlev = lev
       enddo

!       write(6,*) 'REGRID 2: finest level=',finlev

!      make copy of the current structire
!      not needed any more 

       IF(curlev+1.le.finlev) THEN       
       do lev=curlev+1,finlev 

       nullify(child)
       nullify(head)
       nullify(parent)
       nullify(current)

       clp=>lp(lev)%clhead
 
       DO WHILE(associated(clp))

          call find_parent(lp(lev-1)%ml,parent,clp%clrmin,clp%clrmax)
          if(.not.associated(parent)) then
             write(6,*) 'regrid: parent not found'
             stop
          endif

           call initialize_grid(child,lev,chname,clp%clrmin(1),
     &     clp%clrmin(2),clp%clrmin(3),clp%clrmax(1),clp%clrmax(2),
     &     clp%clrmax(3),lp(lev)%ldr)

         
          child%parent=>parent 
!!          nullify(child%neighbor)
!!          nullify(child%sibiling)
!!          nullify(child%child)

          is=int(lp(lev)%rcxshp)
          write(6,*) 'CALL INTIALIZE DAT',lp%ldt
          call initialize_data(child,parent,lp(lev)%ml,lp(lev)%ldr,
     &    lp(lev-1)%ldr,lp(lev)%ldt,is)
          write(6,*) 'RETURN FROM INTIALIZE DATA:',lp%ldt

          child%parent=>parent
          if(associated(current)) then
             if(parent%g == current%parent%g) then
                current%sibiling=>child
             endif
          endif

          if(associated(head)) then             
             current%neighbor=>child
             current=>current%neighbor           
             nullify(current%neighbor)
          else
             head=>child
             current=>child
          endif 

          clp=>clp%clnext

         ENDDO

        current=>lp(lev)%ml
        DO WHILE(associated(current))
         old=>current%neighbor
         call deallocateGF3TL(current%grid)
         g=get_g(current%g)
         deallocate(current)
         current=>old
        ENDDO

        lp(lev)%ml=>head
        ENDDO 

       ENDIF

       write(6,*) ' existing levels after regridding'
       do i=1,maxlev
       if(associated(lp(i)%ml)) write(6,*) 'ml level',i
       enddo
!       write(6,*) 'end of regrid2'

       return 
       end subroutine rgrid2











