File: RELATIVE:/../../../mfix.git/model/des/neighbour.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: NEIGHBOUR                                              C
4     !  Purpose: DES - Neighbors search;
5     !           N-Square,
6     !           Quadtree(2D)/Octree(3D)  (use at own risk)
7     !           Cell linked
8     !                                                                      C
9     !  Author: Jay Boyalakuntla                           Date: 12-Jun-04  C
10     !  Reviewer: Sreekanth Pannala                        Date: 09-Nov-06  C
11     !  Reviewer: Rahul Garg                               Date: 01-Aug-07  C
12     !                                                                      C
13     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
14     
15           SUBROUTINE NEIGHBOUR
16     
17     !-----------------------------------------------
18     ! Modules
19     !-----------------------------------------------
20           USE param1
21           USE discretelement
22           use desgrid
23           Use des_thermo
24           IMPLICIT NONE
25     !-----------------------------------------------
26     ! Local variables
27     !-----------------------------------------------
28     
29     INTEGER :: cc,ll,cc_start,cc_end,cc_start_old,cc_end_old,cc_old
30     LOGICAL :: found
31     
32     !-----------------------------------------------
33     ! Reset PPOS and NEIGHBOURS back to initialized values
34           PPOS(:,:) = DES_POS_NEW(:,:)
35           neighbor_index_old(:) = neighbor_index(:)
36     
37     !$omp parallel do default(none) private(cc) &
38     !$omp shared(neighbors, neighbors_old, pft_neighbor, pft_neighbor_old)
39           do cc=1, size(neighbors)
40              neighbors_old(cc) = neighbors(cc)
41              pft_neighbor_old(:,cc) = pft_neighbor(:,cc)
42           enddo
43     !$omp end parallel do
44     
45           NEIGHBOR_INDEX(:) = 0
46     
47           IF (DES_NEIGHBOR_SEARCH.EQ.1) THEN
48              CALL NSQUARE
49           ELSEIF (DES_NEIGHBOR_SEARCH.EQ.4) THEN
50               CALL DESGRID_NEIGH_BUILD
51           ENDIF
52     
53     !$omp parallel do default(none)                                         &
54     !$omp private(cc,ll,found,cc_start,cc_end,cc_start_old,cc_end_old)      &
55     !$omp shared(max_pip,neighbors,neighbor_index,neighbor_index_old,       &
56     !$omp    neighbors_old, pft_neighbor,pft_neighbor_old,neigh_max)
57           do ll = 1, max_pip
58     
59              CC_START = 1
60              IF (LL.gt.1) CC_START = NEIGHBOR_INDEX(LL-1)
61              CC_END   = NEIGHBOR_INDEX(LL)
62     
63              CC_START_OLD = 1
64              IF (LL.gt.1) CC_START_OLD = NEIGHBOR_INDEX_OLD(LL-1)
65              CC_END_OLD   = NEIGHBOR_INDEX_OLD(LL)
66     
67              DO CC = CC_START, CC_END-1
68                 found = .false.
69                 DO CC_OLD = CC_START_OLD, CC_END_OLD-1
70                    if (neighbors(cc) .eq. neighbors_old(cc_old)) then
71                       pft_neighbor(:,cc) = pft_neighbor_old(:,cc_old)
72                       found = .true.
73                       exit
74                    endif
75                 enddo
76     
77                 if (.not.found) pft_neighbor(:,cc) = 0.0
78              enddo
79           enddo
80     !$omp end parallel do
81     
82     ! resetting do_nsearch to false here since neighbor search will have
83     ! just been invoked
84           DO_NSEARCH = .FALSE.
85     
86           RETURN
87           END SUBROUTINE NEIGHBOUR
88