      module mesh     
      use bh02
      use types

      contains
      
      subroutine allocate_grid(grid,grid_name,gmin,gmax,gd)
      type(GF3TL), pointer        ::  grid 
      character(256),target       ::  grid_name
      real(SP), dimension(3)          ::  gmin,gmax,gd 
      real(SP) temp1,temp2,temp3
      
      integer(I4B) nx,ny,nz

      INTERFACE
      subroutine initialize_coordinates(x,y,z,nx,ny,nz,dx,dy,dz,x0,y0,z0)
      use types
      real(SP), dimension(:)  :: x,y,z
!      real(SP), dimension(3) :: gmin,gd
      real(SP)                :: dx,dy,dz
      real(SP)                :: x0,y0,z0
      integer(I4B)            :: nx,ny,nz
      end subroutine initialize_coordinates


      END INTERFACE

write(*,*) 'allocate_grid: gmin : ',gmin
write(*,*) 'allocate_grid: gmax : ',gmax
write(*,*) 'allocate_grid: gd   : ',gd
      nx=int((gmax(1)-gmin(1)+gd(1))/gd(1) + 0.5)
if(maxdim>1) then
      ny=int((gmax(2)-gmin(2)+gd(2))/gd(2) + 0.5)
else
      ny=1
endif
 
if(maxdim>2)  then
    nz=int((gmax(3)-gmin(3)+gd(3))/gd(3) + 0.5)
else
    nz=1
endif
      dx = gd(1)
      dy = gd(2)
      dz = gd(3)  
      call allocate_GF3TL(grid,grid_name)
!      write(6,*) 'calling allocate_GF3'
      call allocate_GF3(grid,nx,ny,nz)
!      write(6,*) 'calling allocate_coordinates'
      call allocate_coordinates(grid,nx,ny,nz)
!      write(6,*) 'calling initialize_coordinates'
      call initialize_coordinates(grid%c(1)%coord,grid%c(2)%coord,&
        grid%c(3)%coord,nx,ny,nz,dx,dy,dz,gmin(1),gmin(2),gmin(3))

!write(62,*) grid%c(1)%coord, grid%c(2)%coord, grid%c(3)%coord 
!       write(6,*) 'end allocate_grid'
      return
      end subroutine allocate_grid 

      subroutine allocate_GF3TL(grid,grid_name)
      type(GF3TL), pointer        ::  grid 
      character(256),target       :: grid_name

      allocate(grid,stat=ierr)
      if(ierr>0) then
       write(6,*) 'allocate_GF3TL(1): not enough memeory'
       stop
      endif 
      grid % name = trim(grid_name)
      grid % n_gfcn = n_gfcn
      allocate(grid % gfcn(n_gfcn),stat=ierr)
      if(ierr>0) then
       write(6,*) 'allocate_GF3TL(2): not enough memeory'
       stop
      endif 
      allocate(grid % c(3),stat=ierr)
      if(ierr>0) then
         write(6,*) 'allocate_GF3TL(2.5): not enough memory'
         stop
      endif

      do i = 1, grid % n_gfcn
         grid % gfcn(i) % n_t = ntlev(i)
         allocate(grid % gfcn(i) % t(ntlev(i)),stat=ierr)
         if(ierr>0) then
         write(6,*) 'allocate_GF3TL(3): not enough memeory'
         stop
         endif 

         allocate(grid % gfcn(i) % tlev(ntlev(i)),stat=ierr)
         if(ierr>0) then
         write(6,*) 'allocate_GF3TL(4): not enough memeory'
         stop
        endif 

      enddo 
      return
      end subroutine allocate_GF3TL

      subroutine allocate_GF3(grid,nx,ny,nz) 
      type(GF3TL), pointer ::  grid 
      integer(I4B) nx,ny,nz

       do i = 1, n_gfcn
        do j= 1, grid % gfcn(i) % n_t  
          grid % gfcn(i) % tlev(j) % name => gnames(i) 
          allocate(grid % gfcn(i) % tlev(j) % ddim(3),stat=ierr)
          if(ierr>0) then
          write(6,*) 'allocate_GF3(1): not enough memeory'
          stop
          endif 

          grid % gfcn(i) % tlev(j) % ddim = (/nx,ny,nz/)
          allocate(grid % gfcn(i) % tlev(j) % data(nx,ny,nz),stat=ierr)
          if(ierr>0) then
          write(6,*) 'allocate_GF3(2): not enough memeory'
          stop
          endif 
          grid%gfcn(i)%tlev(j)%data=0


       enddo  
      enddo  
      return
      end subroutine allocate_GF3

      subroutine allocate_coordinates(grid,nx,ny,nz)
      type(GF3TL), pointer ::  grid 
      integer(I4B) nx,ny,nz

      type(COORDS), pointer :: x,y,z

      allocate(x,stat=ierr)
      if(ierr>0) then
       write(6,*) 'allocate_coordinates(1): not enough memeory'
       stop
      endif 

      x%n_coord=nx
!      write(6,*) 'nx', nx
      allocate(x % coord(nx),stat=ierr)      
      if(ierr>0) then
       write(6,*) 'allocate_coordinates(2): not enough memeory'
       stop
      endif 
      allocate(y,stat=ierr)
      if(ierr>0) then
       write(6,*) 'allocate_coordinates(3): not enough memeory'
       stop
      endif 

      y%n_coord=ny
      allocate(y % coord(ny),stat=ierr)
      if(ierr>0) then
       write(6,*) 'allocate_coordinates(4): not enough memeory'
       stop
      endif 
      
      allocate(z,stat=ierr)
      if(ierr>0) then
       write(6,*) 'allocate_coordinates(5): not enough memeory'
       stop
      endif 

      z%n_coord=nz
      allocate(z % coord(nz),stat=ierr)
      if(ierr>0) then
       write(6,*) 'allocate_coordinates(6): not enough memeory'
       stop
      endif 
      
      
!       do i=1,grid%n_gfcn
!        do j=1,grid%gfcn(i)%n_t
!         grid % gfcn(i) % tlev(j) % c(1) = x
!         grid % gfcn(i) % tlev(j) % c(2) = y
!         grid % gfcn(i) % tlev(j) % c(3) = z
!        end do
!       end do

      grid%c(1) = x 
      grid%c(2) = y 
      grid%c(3) = z 

       return
      end subroutine allocate_coordinates

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      subroutine deallocateGF3TL(struct) 
      type(GF3TL), pointer ::  struct 
      integer(I4B) n_t,n,igfcn,i_t,i
      type(COORDS), pointer :: x

!  DEALLOCATE COORDINATES

      do i=1,3
         x => struct%c(i)
         deallocate(x%coord)
         deallocate(x)
      enddo

!  DEALLOCATE GF3

      n=struct%n_gfcn
      do igfcn=1,n
        n_t=struct%gfcn(igfcn)%n_t
        do i_t=1,n_t
           deallocate(struct%gfcn(igfcn)%tlev(i_t)%data)
           deallocate(struct%gfcn(igfcn)%tlev(i_t)%ddim)
        enddo
      enddo

!  DEALLOCATE GF3TL

      do igfcn=1,n
        deallocate(struct%gfcn(igfcn)%tlev)
        deallocate(struct%gfcn(igfcn)%t)
      enddo
      deallocate(struct%c)
      deallocate(struct%gfcn)
      deallocate(struct)
      nullify(struct)

      return
      end subroutine deallocateGF3TL

      subroutine copyGF3TL(struct,copy)
      type(GF3TL), pointer ::  struct,copy 
      integer(I4B) n_gfcn,ndim,n_t
     
      ndim=3
      n_gfcn=struct%n_gfcn

      allocate(copy,stat=ierr)
      if(ierr>0) then
       write(6,*) 'copyGF3TL(1): not enough memeory'
       stop
      endif 

      copy%name = struct%name
      copy%n_gfcn=struct%n_gfcn
      allocate(copy%gfcn(n_gfcn),stat=ierr)
      if(ierr>0) then
       write(6,*) 'copyGF3TL(2): not enough memeory'
       stop
      endif 

      do i=1, n_gfcn 
         copy%gfcn(i)%n_t = struct%gfcn(i)%n_t
         n_t=struct%gfcn(i)%n_t
         allocate(copy % gfcn(i) % t(n_t),stat=ierr)
         if(ierr>0) then
         write(6,*) 'copyGF3TL(2): not enough memory'
         stop
         endif 

         allocate(copy % gfcn(i) % tlev(n_t),stat=ierr)
         if(ierr>0) then
         write(6,*) 'copyGF3TL(3): not enough memeory'
         stop
         endif 


         do j=1,copy%gfcn(i)%n_t
            copy%gfcn(i)%t(j)=struct%gfcn(i)%t(j)
         enddo
       enddo


       do i = 1, n_gfcn
        do j= 1, copy % gfcn(i) % n_t
          copy % gfcn(i) % tlev(j) % name => &
          struct % gfcn(i) % tlev(j) % name  
          allocate(copy % gfcn(i) % tlev(j) % ddim(ndim),stat=ierr)
          if(ierr>0) then
          write(6,*) 'copyGF3TL(4): not enough memeory'
          stop
          endif 

          copy % gfcn(i) % tlev(j) % ddim = &
          struct % gfcn(i) % tlev(j) % ddim
          nx=struct%gfcn(i)%tlev(j)%ddim(1)
          ny=struct%gfcn(i)%tlev(j)%ddim(2)
          nz=struct%gfcn(i)%tlev(j)%ddim(3)
          allocate(copy % gfcn(i) % tlev(j) % & 
                                          data(nx,ny,nz),stat=ierr)
          if(ierr>0) then
          write(6,*) 'copyGF3TL(5): not enough memeory'
          stop
          endif 

          copy % gfcn(i) % tlev(j) % data = &
          struct % gfcn(i) % tlev(j) % data

          allocate(copy  % c(3),stat=ierr)
          if(ierr>0) then
          write(6,*) 'copyGF3TL(6): not enough memeory'
          stop
          endif 
              
       enddo  
      enddo  
      copy % c = struct % c
      return 
      end subroutine copyGF3TL

      subroutine vGF3TL(struct)
      type(GF3TL) struct

!     verify structure GF3TL  

      write(6,*) '======= new structure ======'
      write(6,*) 'name: ',trim(struct%name)
      write(6,*) 'number of grid functions:',struct%n_gfcn
      if(struct%n_gfcn.le.0) stop
      do i=1,struct%n_gfcn
       write(6,*) '--> gfcn',i,' time levels:',struct%gfcn(i)%n_t
       do j=1,struct%gfcn(i)%n_t
       write(6,*) '    tl',j,' timeid:',struct%gfcn(i)%t(j)
       write(6,*) '       gfnc name:',trim(struct%gfcn(i)%tlev(j)%name)
       write(6,*) '       gfnc ddim:',struct%gfcn(i)%tlev(j)%ddim
       write(6,*) '       coordinates'
!       if(.not.associated(struct%gfcn(i)%tlev(j)%c(1)%coord)) then
!           write(6,*) '     coordinates not initialized !!!!'
!           cycle
!       else
!           write(6,*) 'nr=',struct%gfcn(i)%tlev(j)%c(1)%n_coord
!           write(6,*) struct%gfcn(i)%tlev(j)%c(1)%coord(1:4)
!       endif
       enddo
      enddo
      write(6,*) '===end of new structure ==='
      return
      end subroutine vGF3TL
      
!  ***********************************************************************

      subroutine coarsecopyGF3TL(finegrid,coarsegrid)
      type(GF3TL), pointer ::  finegrid,coarsegrid
!      integer(I4B) n_gfcn,ndim,n_t
      integer(I4B) ngfcn,nt
     
!      ndim=3
      ngfcn=finegrid%n_gfcn
!      write(6,*) 'start coarsecopy',ngfcn

      allocate(coarsegrid,stat=ierr)
      if(ierr>0) then
       write(6,*) 'coarsecopyGF3TL(1): not enough memory'
       stop
      endif 

!      write(6,*) 'grid allocated'
      coarsegrid%name = 'temporary coarse grid'
      coarsegrid%n_gfcn=finegrid%n_gfcn
      allocate(coarsegrid%gfcn(ngfcn),stat=ierr)
      if(ierr>0) then
       write(6,*) 'coarsecopyGF3TL(2): not enough memory'
       stop
      endif 

      do i=1, ngfcn 
         coarsegrid%gfcn(i)%n_t = finegrid%gfcn(i)%n_t
         n_t=finegrid%gfcn(i)%n_t
         allocate(coarsegrid % gfcn(i) % t(n_t),stat=ierr)
         if(ierr>0) then
         write(6,*) 'coarsecopyGF3TL(3): not enough memory'
         stop
         endif 

         allocate(coarsegrid % gfcn(i) % tlev(n_t),stat=ierr)
         if(ierr>0) then
         write(6,*) 'coarsecopyGF3TL(4): not enough memory'
         stop
         endif 


         do j=1,coarsegrid%gfcn(i)%n_t
            coarsegrid%gfcn(i)%t(j)=finegrid%gfcn(i)%t(j)
         enddo
       enddo

       do i = 1, ngfcn
        do j= 1, coarsegrid % gfcn(i) % n_t
          coarsegrid % gfcn(i) % tlev(j) % name => &
          finegrid % gfcn(i) % tlev(j) % name  
          allocate(coarsegrid%gfcn(i)%tlev(j)%ddim(3),stat=ierr)
          if(ierr>0) then
          write(6,*) 'coarsecopyGF3TL(5): not enough memory'
          stop
          endif 

          do k=1,3
             coarsegrid % gfcn(i) % tlev(j) % ddim(k) = &
             (finegrid % gfcn(i) % tlev(j) % ddim(k) + 1)/2
          enddo

          nx=coarsegrid%gfcn(i)%tlev(j)%ddim(1)
          ny=coarsegrid%gfcn(i)%tlev(j)%ddim(2)
          nz=coarsegrid%gfcn(i)%tlev(j)%ddim(3)

          allocate(coarsegrid % gfcn(i) % tlev(j) % &
                                         data(nx,ny,nz),stat=ierr)
          if(ierr>0) then
          write(6,*) 'coarsecopyGF3TL(6): not enough memory'
          stop
          endif 

          do ii=1,nx
          do jj=1,ny
          do kk=1,nz

             coarsegrid % gfcn(i) % tlev(j) % data (ii,jj,kk) = &
            finegrid % gfcn(i) % tlev(j) % data(2*ii-1,2*jj-1,2*kk-1)
           
          enddo
          enddo
          enddo
        

!         *************************************************************
!         MUST FIX UP 
!         *************************************************************
          allocate(coarsegrid % c(3),stat=ierr)
          if(ierr>0) then
          write(6,*) 'copyGF3TL(7): not enough memory'
          stop
          endif 
              
       enddo  
      enddo  
      coarsegrid % c = finegrid  % c
      return 
      end subroutine coarsecopyGF3TL

      end module mesh














