File: /nfs/home/0/users/jenkins/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,dd,ii,jj,iii,jjj,ddd
30     
31     !-----------------------------------------------
32     ! Reset PPOS and NEIGHBOURS back to initialized values
33           PPOS(:,:) = DES_POS_NEW(:,:)
34     
35     !$omp parallel do default(none) private(cc) &
36     !$omp             shared(pair_num,pairs_old,pairs,pv_pair_old,pv_pair,pfn_pair_old,pfn_pair,pft_pair_old,pft_pair)
37           do cc= 1, pair_num
38              pairs_old(:,cc) = pairs(:,cc)
39              pv_pair_old(cc) = pv_pair(cc)
40              pfn_pair_old(:,cc) = pfn_pair(:,cc)
41              pft_pair_old(:,cc) = pft_pair(:,cc)
42           end do
43     !$omp end parallel do
44     
45           old_pair_num = pair_num
46           pair_num = 0
47     
48           IF (DES_NEIGHBOR_SEARCH.EQ.1) THEN
49              CALL NSQUARE
50           ELSEIF (DES_NEIGHBOR_SEARCH.EQ.4) THEN
51               CALL DESGRID_NEIGH_BUILD
52           ENDIF
53     
54           dd = 1
55           iii = pairs_old(1,dd)
56           jjj = pairs_old(2,dd)
57     
58     !$omp parallel do default(none) private(cc,ii,jj,iii,jjj,ddd) &
59     !$omp          shared(pair_num,pairs,pairs_old,pv_pair,pfn_pair,pft_pair,pfn_pair_old,pft_pair_old,pv_pair_old,old_pair_num) &
60     !$omp          firstprivate(dd)
61     
62           do cc = 1, pair_num
63              ii = pairs(1,cc)
64              jj = pairs(2,cc)
65     
66              iii = pairs_old(1,dd)
67              jjj = pairs_old(2,dd)
68     
69              do while (dd .le. old_pair_num .and. (iii < ii))
70                 dd = dd + 1
71                 iii = pairs_old(1,dd)
72                 jjj = pairs_old(2,dd)
73              enddo
74     
75              ddd = dd
76              do while (ddd .le. old_pair_num .and. iii.eq.ii .and. jjj.ne.jj )
77                 ddd = ddd + 1
78                 iii = pairs_old(1,ddd)
79                 jjj = pairs_old(2,ddd)
80              enddo
81     
82              if (ii.eq.iii .and. jj.eq.jjj) then
83                 pv_pair(cc) = pv_pair_old(ddd)
84                 pfn_pair(:,cc) = pfn_pair_old(:,ddd)
85                 pft_pair(:,cc) = pft_pair_old(:,ddd)
86              else
87                 pv_pair(cc) = .false.
88                 pfn_pair(:,cc) = 0.0
89                 pft_pair(:,cc) = 0.0
90              endif
91     
92           enddo
93     !$omp end parallel do
94     
95     ! resetting do_nsearch to false here since neighbor search will have
96     ! just been invoked
97           DO_NSEARCH = .FALSE.
98     
99           RETURN
100           END SUBROUTINE NEIGHBOUR
101