
!**********************************************************************************************************************************!
!*****************************  Useful routines for generating and initializing computational cells  ******************************!
!**********************************************************************************************************************************!


!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE gbem_cell_init
!----------------------------------------------------------------------------------------------------------------------------------!	

!===purpose===! 

!**********************************************************************************************************************************!
!*************************************  Initialization of the computational parallelepiped  ***************************************!
!************************  Determine computational cells containing boundary nodes, i.e., non-empty cells  ************************!
!**********************************************************************************************************************************!

!*** Developer: Sylvain Nintcheu Fata
!*** Version:   V.1.1
!*** Released:  Jun 14, 2012

 
USE KINDS
USE LNLST,    ONLY: ilst         ! ilst == derived type: Singly Linked List Structure
USE SRF_GEOM, ONLY: nbnd         ! nbnd == Total number of boundary nodes
USE SRF_GEOM, ONLY: bnd          ! bnd(:,k) == Cartesian coordinates of the k-th boundary node
USE CELL_ARP, ONLY: ncx,ncy,ncz  ! ncx,ncy,ncz == Total number of cells in the computational box in the x,y,z-coordinate
				 ! directions respectively
USE CELL_ARP, ONLY: ncell,ncwnd  ! ncell == Total number of cells in the homogeneous computational box: ncell = ncx*ncy*ncz
				 ! ncwnd == Number of computional Cells containing boundary nodes <==> number of non-empty cells
USE CELL_ARP, ONLY: cwnd,cell    ! cwnd(k) == Global index of the k-th non-empty cell
			         ! cell(k) == Structure containing information about the k-th cell


IMPLICIT NONE

 integer(kind=k9) :: i1,i2,i3,j,k,l1,l2,l3,cell_count,mxy,alloc_st
 type(ilst), pointer :: ptr ! ptr == temporary pointer to an element of the list referenced to by ptr_list
 real(kind=dp), parameter :: tol = 1.0E-14_dp
 real(kind=dp) :: xmin,xmax,ymin,ymax,zmin,zmax
 real(kind=dp) :: diam_box ! diam_box == Diameter of the computational box
 real(kind=dp) :: cell_length_x,cell_length_y,cell_length_z
 real(kind=dp) :: cell_side_l(3) ! cell_side_l(i) == Left-end of the current cell segment in the i-th coordinate direction
 real(kind=dp) :: cell_side_r(3) ! cell_side_r(i) == Right-end of the current cell segment in the i-th coordinate direction
 real(kind=dp) :: epsbx,epsby,epsbz ! epsbx,epsby,epsbz = Small pertubations of the computational Box in x-,y-,and z-coordinate directions
 real(kind=dp), external :: sqr_dist_pt_box ! sqr_dist_pt_box == SQUARE DISTANCE between a POINT and an AXIS-PARALLEL BOX in 3D space



    xmin = minval(bnd(1,:)); xmax = maxval(bnd(1,:))
    ymin = minval(bnd(2,:)); ymax = maxval(bnd(2,:))
    zmin = minval(bnd(3,:)); zmax = maxval(bnd(3,:))

    epsbx = xmax-xmin; epsby = ymax-ymin; epsbz = zmax-zmin
    diam_box = dsqrt(epsbx*epsbx + epsby*epsby + epsbz*epsbz) ! diam_box == Diameter of the computational box
    diam_box = 1000.0_dp*diam_box ! diam_box == 1000 times the actual diameter of the computational box
    epsbx = epsbx/diam_box; epsby = epsby/diam_box; epsbz = epsbz/diam_box
    
    xmin = xmin - epsbx; xmax = xmax + epsbx
    ymin = ymin - epsby; ymax = ymax + epsby
    zmin = zmin - epsbz; zmax = zmax + epsbz

    cell_length_x = (xmax-xmin)/real(ncx,dp) ! cell_length_x == Length of a single cell in the x-coordinate direction
    cell_length_y = (ymax-ymin)/real(ncy,dp) ! cell_length_y == Length of a single cell in the y-coordinate direction
    cell_length_z = (zmax-zmin)/real(ncz,dp) ! cell_length_z == Length of a single cell in the z-coordinate direction
    
    mxy = ncx*ncy
    ncell = mxy*ncz ! ncell == Total number of cells in the homogeneous computational box: ncell = ncx*ncy*ncz
    
    allocate(cell(ncell),STAT=alloc_st)
    if ( alloc_st /= 0 ) then  ! If cell is not successfully allocated
       write(*,*)'gbem_cell_init: Allocate array "cell" failed with Status=',alloc_st
       stop
    endif

    loop0: do k=1,ncell
       cell(k)%nnc = 0 ! cell(k)%nnc == Number of boundary nodes in the k-th cell
       nullify(cell(k)%ptr_list) ! Empty list
    enddo loop0
    
    cell_side_r(1) = xmin; cell_side_r(2) = ymin; cell_side_r(3) = zmin ! Collapsing cell
    loop1a: do i3=1,ncz ! Loop over all cells in the 3-rd coordinate direction (z-direction)
       cell_side_l(3) = cell_side_r(3)
       cell_side_r(3) = cell_side_l(3) + cell_length_z
       l3 = mxy*(i3-1)
       loop1b: do i2=1,ncy ! Loop over all cells in the 2-nd coordinate direction (y-direction)
     	  cell_side_l(2) = cell_side_r(2)
	  cell_side_r(2) = cell_side_l(2) + cell_length_y
	  l2 = ncx*(i2-1)
          loop1c: do i1=1,ncx ! Loop over all cells in the 1-st coordinate direction (x-direction)
	     cell_side_l(1) = cell_side_r(1)
	     cell_side_r(1) = cell_side_l(1) + cell_length_x
	     l1 = l3+l2+i1 ! l1 == Linear index of the current computational cell
	      ! cell(l1)%bbox == Bounding Box of the current cell
	      cell(l1)%bbox(1,1) = cell_side_l(1); cell(l1)%bbox(2,1) = cell_side_r(1) ! Bounding box in the x-direction
	      cell(l1)%bbox(1,2) = cell_side_l(2); cell(l1)%bbox(2,2) = cell_side_r(2) ! Bounding box in the y-direction
	      cell(l1)%bbox(1,3) = cell_side_l(3); cell(l1)%bbox(2,3) = cell_side_r(3) ! Bounding box in the z-direction

   	      if (i1 == ncx) then
	         cell_side_r(1) = xmin ! Collapsing cell in the 1-st coordinate direction
	         if (i2 == ncy) cell_side_r(2) = ymin ! Collapsing cell in the 2-nd coordinate direction
	      endif
          enddo loop1c
       enddo loop1b
    enddo loop1a

    loop2a: do k=1,nbnd ! Loop over all boundary nodes: k == Global index of the k-th boundary node
       loop2b: do l1=1,ncell ! Loop over all cells in the computational parallelepiped
       ! bnd(:,k) == Cartesian coordinates of the k-th boundary node
	  if (sqr_dist_pt_box(bnd(:,k),cell(l1)%bbox) < tol) then ! If bnd(:,k) falls in the current cell, then
	  							  ! sqr_dist_pt_box(bnd(:,k),cell(l1)%bbox) = 0.0
								  ! Tolerance "tol" is used to resolve the situation
	     call add_elt_in_cell(l1,k)                           ! when bnd(:,k) falls on a corner, edge or side of
	     exit						  ! the current cell. This call add_elt_in_cell(l1,k)
								  ! adds boundary node k into a cell with index l1
	  endif
       enddo loop2b
    enddo loop2a

!*** Initialization of non-empty cells
    cell_count = 0 ! cell_count == Number of cell with boundary nodes, i.e., non-empty cells
    loop5: do k=1,ncell ! Loop over all cells in the computational parallelepiped
       if (cell(k)%nnc /= 0) then ! if the k-th cell is not empty
          cell_count = cell_count + 1
          allocate(cell(k)%nd_id(cell(k)%nnc),STAT=alloc_st)
	  if ( alloc_st /= 0 ) then ! If cell(k)%nd_id is not successfully allocated
	     write(*,*)'gbem_cell_init: Allocate array "cell(k)%nd_id" failed k=',k,'with Status=',alloc_st
	     stop
	  endif
	  
	   loop6: do j=cell(k)%nnc,1,-1 ! Loop over all boundary nodes in the k-th non-empty cell
              ptr => cell(k)%ptr_list
               cell(k)%nd_id(j) = ptr%id
               cell(k)%ptr_list => ptr%next  
              deallocate(ptr)
           enddo loop6
       endif ! if the k-th cell is not empty
    enddo loop5
!*** End Initialization of non-empty cells
    
    ncwnd = cell_count ! ncwnd == Number of cells with boundary nodes, i.e., non-empty cells

    allocate(cwnd(ncwnd),STAT=alloc_st)
    if ( alloc_st /= 0 ) then  ! If cwnd is not successfully allocated
       write(*,*)'gbem_cell_init: Allocate array "cwnd" failed with Status=',alloc_st
       stop
    endif
   
    cell_count = 0
    loop7: do k=1,ncell
       if (cell(k)%nnc /= 0) then ! if the k-th cell is not empty
          cell_count = cell_count + 1
          cwnd(cell_count) = k
       endif ! if the k-th cell is not empty
    enddo loop7

!----------------------------------------------------------------------------------------------------------------------------------! 
END SUBROUTINE gbem_cell_init
!----------------------------------------------------------------------------------------------------------------------------------!	


!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE gbem_cell_neighbor
!----------------------------------------------------------------------------------------------------------------------------------!	

!===purpose===! 

!**********************************************************************************************************************************!
!************************************************  Find "Near-neighboring" cells  *************************************************!
!**********************************************************************************************************************************!

!*** Developer: Sylvain Nintcheu Fata
!*** Version:   V.1.1
!*** Released:  Jun 14, 2012

 
USE KINDS
USE LNLST,    ONLY: ilst       ! ilst == derived type: Singly Linked List Structure
USE CELL_ARP, ONLY: ncwnd      ! ncwnd == Number of computional Cells containing boundary nodes <==> number of non-empty cells
USE CELL_ARP, ONLY: nbfac      ! nbfac == Factor characterizing the near-neighboring region of a giving cell
USE CELL_ARP, ONLY: cwnd,cell  ! cwnd(k) == Global index of the k-th non-empty cell
			       ! cell(k) == Structure containing information about the k-th cell


IMPLICIT NONE

 integer(kind=k9) :: i,j,ii,alloc_st
 real   (kind=dp) :: cnt_cl(3),z(3),dist,z_c(3)
 real   (kind=dp) :: hlf_cl_len(3) ! hlf_cl_len(i) == Half-Length of a cell in the i-th axis direction
 real   (kind=dp) :: r_nbor ! r_nbor == nbfac*(D/2), D = diameter of a cell

 type pt_ilst 
  type(ilst), pointer :: p
 end type pt_ilst
 type(pt_ilst), pointer :: ptr_list(:) ! ptr_list(k)%p == pointer to the list of near-neighboring cells to the k-th cell
 type(ilst), pointer :: ptr1, ptr2 ! ptr1, ptr2 == temporary pointers to an element of the list referenced to by ptr_list



    allocate(ptr_list(ncwnd),STAT=alloc_st)
    if ( alloc_st /= 0 ) then  ! If ptr_list is not successfully allocated
       write(*,*)'gbem_cell_neighbor: Allocate array "ptr_list" failed with Status=',alloc_st
       stop
    endif

    loop0: do i=1,ncwnd ! Loop over all non-empty cells
       nullify(ptr_list(i)%p) ! Empty list for every non-empty cell
       cell(cwnd(i))%nnnc = 1 ! cell(cwnd(i))%nnnc == Number of near-neighboring cells to the i-th cell 
                              ! A cell is a near-neighbor to itself
    enddo loop0

    ! hlf_cl_len(1) == Half-Length of the 1st non-empty cell in the x-coordinate (or 1st-axis) direction
    hlf_cl_len(1) = 0.5_dp*(cell(cwnd(1))%bbox(2,1)-cell(cwnd(1))%bbox(1,1))
    
    ! hlf_cl_len(2) == Half-Length of the 1st non-empty cell in the y-coordinate (or 2nd-axis) direction
    hlf_cl_len(2) = 0.5_dp*(cell(cwnd(1))%bbox(2,2)-cell(cwnd(1))%bbox(1,2))
    
    ! hlf_cl_len(3) == Half-Length of the 1st non-empty cell in the z-coordinate (or 3rd-axis) direction
    hlf_cl_len(3) = 0.5_dp*(cell(cwnd(1))%bbox(2,3)-cell(cwnd(1))%bbox(1,3))
    
    r_nbor = nbfac*dsqrt(hlf_cl_len(1)*hlf_cl_len(1) + hlf_cl_len(2)*hlf_cl_len(2) + hlf_cl_len(3)*hlf_cl_len(3))

    loop1a: do i=1,ncwnd-1 ! Loop over all non-empty cells
       loop1b: do ii=1,3 ! Loop over the coordinate directions
	  cnt_cl(ii) = cell(cwnd(i))%bbox(1,ii) + hlf_cl_len(ii) ! cnt_cl == Center of the i-th cell
       enddo loop1b

         loop1c: do j=i+1,ncwnd ! Loop over the remaining non-empty cells
	       loop1d: do ii=1,3 ! Loop over the coordinate directions
	            z(ii) = cell(cwnd(j))%bbox(1,ii) + hlf_cl_len(ii) ! z == Center of the j-th cell
		    z_c(ii) = z(ii)-cnt_cl(ii)
	       enddo loop1d
	       dist = dsqrt(z_c(1)*z_c(1) + z_c(2)*z_c(2) + z_c(3)*z_c(3)) ! dist == Distance between the centers

!*** Near-neighboring region of the i-th cell is characterized by a Ball centered at cnt_cl with radius r_nbor
	       if ( dist < r_nbor) then ! If the Center of the j-th cell is in the Near-neighboring region of the i-th cell
	          cell(cwnd(i))%nnnc = cell(cwnd(i))%nnnc + 1; cell(cwnd(j))%nnnc = cell(cwnd(j))%nnnc + 1
                   allocate(ptr1,ptr2,STAT=alloc_st)
                    if(alloc_st /=0) then
		       write(*,*)'gbem_cell_neighbor: Allocate nodes for the list of near-neighbors failed with Status=',alloc_st
		       stop
		    endif
                      ptr1%id = cwnd(j) ! Adding an element to a linked list of the i-th cell
                      ptr1%next => ptr_list(i)%p; ptr_list(i)%p => ptr1
                      ptr2%id = cwnd(i) ! Adding an element to a linked list of the j-th cell
                      ptr2%next => ptr_list(j)%p; ptr_list(j)%p => ptr2
	       endif
         enddo loop1c
    enddo loop1a

!*** Read (to a usual dynamic array) and delete a linked list associated to a cell
    loop2a: do i=1,ncwnd ! Loop over all non-empty cells
      allocate(cell(cwnd(i))%nbor(cell(cwnd(i))%nnnc),STAT=alloc_st)
      if ( alloc_st /= 0 ) then  ! If cell(cwnd(i))%nbor is not successfully allocated
         write(*,*)'cell_neighbor: Allocate array "cell(cwnd(i))%nbor" failed with Status=',alloc_st
         stop
      endif
        ! cell(i)%nbor(k) == Global index of the k-th near-neighbor to the i-th cell

        loop2b: do j=cell(cwnd(i))%nnnc,2,-1 ! Loop over the near-neighboring cells to the i-th cell
           ptr1 => ptr_list(i)%p
           cell(cwnd(i))%nbor(j) = ptr1%id
           ptr_list(i)%p => ptr1%next  
           deallocate(ptr1)
        enddo loop2b
      cell(cwnd(i))%nbor(1) = cwnd(i) ! Adding the i-th cell to the array of its neighbor, since a cell is near-neighbor to itself
    enddo loop2a
    deallocate(ptr_list)

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE gbem_cell_neighbor
!----------------------------------------------------------------------------------------------------------------------------------!	


!----------------------------------------------------------------------------------------------------------------------------------! 
FUNCTION sqr_dist_pt_box(x,box)
!----------------------------------------------------------------------------------------------------------------------------------!	

!===purpose===! 


!**********************************************************************************************************************************!
!*****************************  Return the SQUARE DISTANCE between a POINT and an AXIS-PARALLEL BOX  ******************************!
!**********************************************************************************************************************************!

!*** Developer: Sylvain Nintcheu Fata, Oak Ridge National Laboratory
!*** Version:   V.1.0
!*** Released:  Apr 21, 2011


USE KINDS


IMPLICIT NONE

 real   (kind=dp), intent(in) :: x(3) ! x == Arbitrary Point in 3D space
 real   (kind=dp), intent(in) :: box(2,3) ! box == Axis-parallel box
                                          ! [box(1,i),box(2,i)] = Segment forming the box in the i-th axis direction
 real   (kind=dp)             :: sqr_dist_pt_box ! sqr_dist_pt_box == SQUARE DISTANCE between a POINT and an AXIS-PARALLEL BOX
 real   (kind=dp)             :: dx,dy,dz ! dx = Distance in the x-coordinate direction
 					  ! dy = Distance in the y-coordinate direction
					  ! dz = Distance in the z-coordinate direction



    dx = max(box(1,1) - x(1), x(1) - box(2,1), 0.0_dp)
    dy = max(box(1,2) - x(2), x(2) - box(2,2), 0.0_dp)
    dz = max(box(1,3) - x(3), x(3) - box(2,3), 0.0_dp)
    sqr_dist_pt_box = dx*dx + dy*dy + dz*dz

!----------------------------------------------------------------------------------------------------------------------------------! 
END FUNCTION sqr_dist_pt_box
!----------------------------------------------------------------------------------------------------------------------------------!	


!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE add_elt_in_cell(Cell_id, elt_id)
!----------------------------------------------------------------------------------------------------------------------------------!	

!===purpose===! 

!**********************************************************************************************************************************!
!***************  Add a single element with global index elt_id in a computational cell with global index Cell_id  ****************!
!**********************************************************************************************************************************!

!*** Developer: Sylvain Nintcheu Fata, Oak Ridge National Laboratory
!*** Version:   V.1.0
!*** Released:  Apr 21, 2011

 
USE KINDS
USE LNLST,    ONLY: ilst ! ilst == derived type: Singly Linked List Structure
USE CELL_ARP, ONLY: cell ! cell(k) == Structure containing information about the k-th cell


IMPLICIT NONE

 integer(kind=k9), intent(in) :: Cell_id
 integer(kind=k9), intent(in) :: elt_id

 type(ilst), pointer :: ptr ! ptr == temporary pointer to an element of the list referenced to by cell(Cell_id)%ptr_list
 integer(kind=k9) :: alloc_st


    cell(Cell_id)%nnc = cell(Cell_id)%nnc + 1
    allocate(ptr,STAT=alloc_st)
    if(alloc_st /=0) then
       write(*,*)'add_elt_in_cell: Allocate a node for the cell list failed with Status=',alloc_st
       stop
    endif
    ptr%id = elt_id ! Adding an element to a linked list
    ptr%next => cell(Cell_id)%ptr_list; cell(Cell_id)%ptr_list => ptr

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE add_elt_in_cell
!----------------------------------------------------------------------------------------------------------------------------------!	
