module adaptive

use parameters
type ADAPTIVE_MESH
integer :: level
integer :: grid_id
type(ADAPTIVE_MESH), pointer :: neighbor
type(ADAPTIVE_MESH), pointer :: sibling
type(ADAPTIVE_MESH), pointer :: parent
type(ADAPTIVE_MESH), pointer :: child
real, dimension(2) :: rmin
real, dimension(2) :: rmax
integer, dimension(2) :: nr 
real t
end type ADAPTIVE_MESH

type LEVEL_INFO
type(ADAPTIVE_MESH),pointer :: head
integer                     :: curmax
real                        :: threshold
real,dimension(0:2)         :: dr
end type LEVEL_INFO

contains

subroutine deallocate_FINE_LEVELS(level,finest_level,lp)
integer :: level,finest_level
type(LEVEL_INFO),dimension(maxlevel) :: lp

integer ilev,igrid,ngrids
type(ADAPTIVE_MESH),pointer :: grid1,grid2

if(finest_level-level<1) return
do ilev=level+1,finest_level
   ngirds=lp(ilev)%curmax
   grid1=>lp(ilev)%head
   do igrid=1,ngrids
       grid2=>grid1%sibling
       deallocate(grid1)
       grid1=>grid2
   enddo
   lp(ilev)%curmax=0
   nullify(lp(ilev)%head)
enddo

!now nullify childern links
ngrids=lp(level)%curmax
grid1=>lp(level)%head
do i=1,ngrids
   nullify(grid1%child)
   grid1=>grid1%sibling
enddo

finest_level=level
return
end subroutine deallocate_FINE_LEVELS 



subroutine allocate_LEVEL_INFO(lp)
type(LEVEL_INFO),dimension(maxlevel) :: lp

do i=1,maxlevel
nullify(lp(i)%head)
lp(i)%curmax=0
lp(i)%dr(1)=dx/(rho**(i-1))
lp(i)%dr(2)=dy/(rho**(i-1))
lp(i)%dr(0)=lp(i)%dr(1)*dtbydr
write(6,*) i,lp(i)%dr
enddo

lp(1)%threshold=0.5
lp(2)%threshold=0.7
!lp(3)%threshold=0.8
!lp(4)%threshold=100.0
!lp(5)%threshold=100.0

return
end subroutine allocate_LEVEL_INFO

subroutine allocate_ADAPTIVE_MESH(lp,level,parent,mesh,t,rmin,rmax,nr)
type(LEVEL_INFO), dimension(maxlevel) :: lp
integer level
type(ADAPTIVE_MESH), pointer  :: parent, mesh
real, dimension(2) :: rmin,rmax
integer, dimension(2) :: nr
real, dimension(0:2) :: dr

type(ADAPTIVE_MESH), pointer :: work

nullify(work)

allocate(mesh)
mesh%parent=>parent
nullify(mesh%child)
nullify(mesh%neighbor)
nullify(mesh%sibling)
mesh%t=t
mesh%rmin=rmin
mesh%rmax=rmax
mesh%nr=nr
mesh%level=level 

if(associated(parent)) then
  if(associated(parent%child)) then 
     work=>parent%child

     DO WHILE (associated(work))
     if(.not.associated(work%sibling)) then
         work%sibling=>mesh
         mesh%grid_id=work%grid_id+1
         work=>work%sibling%sibling
     else
         work=>work%sibling
     endif
     ENDDO
  else   
     parent%child=>mesh
     mesh%grid_id=1
  endif
else    
  nullify(mesh%parent)
  mesh%grid_id=1
  if(level <> 1) write(6,*) 'WARNING: (1) orfant grid'
endif
lp(level)%curmax=mesh%grid_id
!write(6,*) 'end of allocate:',lp%curmax
if(.not.associated(lp(level)%head)) lp(level)%head=>mesh
return 
end subroutine allocate_ADAPTIVE_MESH

end module adaptive













