neighbour.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: NEIGHBOUR                                              C
!  Purpose: DES - Neighbors search;
!           N-Square,
!           Quadtree(2D)/Octree(3D)  (use at own risk)
!           Cell linked
!                                                                      C
!  Author: Jay Boyalakuntla                           Date: 12-Jun-04  C
!  Reviewer: Sreekanth Pannala                        Date: 09-Nov-06  C
!  Reviewer: Rahul Garg                               Date: 01-Aug-07  C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C

      SUBROUTINE neighbour

!-----------------------------------------------
! Modules
!-----------------------------------------------
      USE param1
      USE discretelement
      use desgrid
      Use des_thermo
      IMPLICIT NONE
!-----------------------------------------------
! Local variables
!-----------------------------------------------

INTEGER :: cc,ll,cc_start,cc_end,cc_start_old,cc_end_old,cc_old
LOGICAL :: found

!-----------------------------------------------
! Reset PPOS and NEIGHBOURS back to initialized values
      ppos(:,:) = des_pos_new(:,:)
      neighbor_index_old(:) = neighbor_index(:)

!$omp parallel do default(none) private(cc) &
!$omp shared(neighbors, neighbors_old, pft_neighbor, pft_neighbor_old)
      do cc=1, size(neighbors)
         neighbors_old(cc) = neighbors(cc)
         pft_neighbor_old(:,cc) = pft_neighbor(:,cc)
      enddo
!$omp end parallel do

      neighbor_index(:) = 0

      IF (des_neighbor_search.EQ.1) THEN
         CALL nsquare
      ELSEIF (des_neighbor_search.EQ.4) THEN
          CALL desgrid_neigh_build
      ENDIF

!$omp parallel do default(none)                                         &
!$omp private(cc,ll,found,cc_start,cc_end,cc_start_old,cc_end_old)      &
!$omp shared(max_pip,neighbors,neighbor_index,neighbor_index_old,       &
!$omp    neighbors_old, pft_neighbor,pft_neighbor_old)
      do ll = 1, max_pip

         cc_start = 1
         IF (ll.gt.1) cc_start = neighbor_index(ll-1)
         cc_end   = neighbor_index(ll)

         cc_start_old = 1
         IF (ll.gt.1) cc_start_old = neighbor_index_old(ll-1)
         cc_end_old   = neighbor_index_old(ll)

         DO cc = cc_start, cc_end-1
            found = .false.
            DO cc_old = cc_start_old, cc_end_old-1
               if (neighbors(cc) .eq. neighbors_old(cc_old)) then
                  pft_neighbor(:,cc) = pft_neighbor_old(:,cc_old)
                  found = .true.
                  exit
               endif
            enddo

            if (.not.found) pft_neighbor(:,cc) = 0.0
         enddo
      enddo
!$omp end parallel do

! resetting do_nsearch to false here since neighbor search will have
! just been invoked
      do_nsearch = .false.

      RETURN
      END SUBROUTINE neighbour