Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
SUBROUTINE flashBlockToFlyCell(bnd_box_min, bnd_box_max, blockCells)
USE fly_h
INCLUDE 'mpif.h'
real, dimension(ndim) :: bnd_box_min, bnd_box_max
real(kind=8), dimension(nZones(1), nZones(2), nZones(3)) :: blockCells
#ifdef FLASH
real :: blockSize, boxSize, cellVolume
real, dimension(ndim) :: blockCenter
real(KIND=8), dimension(ndim) :: bodyPosition
real, dimension(ndim) :: cellSize
real(KIND=8), dimension(ndim) :: pl, pcl, pcl_par
integer, dimension(ndim) :: cellIndex
integer :: sub_temp1, blockLevel
integer(KIND=4) :: par_temp1
integer :: i, j, k,ind_pe
integer, dimension(ndim) :: nindex
INTEGER(KIND=MPI_ADDRESS_KIND) :: startIndex
INTEGER(KIND=4), DIMENSION(nsubcell) :: isub !,sub_app
DATA nindex/4,2,1/
!================================================================================
boxSize = size_level(1)
blockSize = bnd_box_max(1) - bnd_box_min(1)
blockCenter = bnd_box_min + (blockSize / 2)
cellSize = blockSize / nZones
blockLevel=0
DO i=1,nmax_level
IF(boxSize.gt.blockSize) THEN
blockLevel=blockLevel+1
boxSize=boxSize/2.0
ELSE
EXIT
ENDIF
ENDDO
par_temp1 = root
DO i = 1, blockLevel
i_sh = par_temp1 - nbodsmax
IF(POW2) THEN
ind_pe = IAND((i_sh - 1), npes - 1)
ind_loc = ISHFT((i_sh - 1), -lpes) + 1
ELSE
ind_pe = MOD((i_sh - 1), npes)
ind_loc =((i_sh - 1)/ npes) + 1
ENDIF
IF(ind_pe.EQ.me) THEN
pcl(1:ndim) = pos_cell(1:ndim, ind_loc)
isub(1:nsubcell) = subp(1:nsubcell, ind_loc)
ELSE
startIndex = (((ind_loc - 1) * ndim) + 1) - 1
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, &
ind_pe, 0, win_pos_cell, ierror)
CALL MPI_GET(pcl(1), ndim, MPI_REAL8, ind_pe, &
startIndex, ndim, MPI_REAL8, win_pos_cell, ierror)
CALL MPI_WIN_UNLOCK(ind_pe, win_pos_cell, ierror)
startIndex = (((ind_loc - 1) * nsubcell) + 1) - 1
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, &
ind_pe, 0, win_subp, ierror)
CALL MPI_GET(isub(1), nsubcell, MPI_INTEGER4, ind_pe, &
startIndex, nsubcell, MPI_INTEGER4, win_subp, ierror)
CALL MPI_WIN_UNLOCK(ind_pe, win_subp, ierror)
ENDIF
pl(1:3) = blockCenter(1:3)
! write(100+me,*)"p1 ME=",me," par_temp1 =",par_temp1," pcl =",pcl, &
! " pl =",pl," ind_pe=", ind_pe ," ind_loc=",ind_loc," startIndex=",startIndex
! call flush(uterm)
sub_temp1 = 1
DO k = 1, ndim
IF(pl(k).GE.pcl(k)) sub_temp1 = sub_temp1 + nindex(k)
ENDDO
! write(100+me,*)"p2 ME=",me," sub_temp1 =",sub_temp1," isub_temp1=",isub(sub_temp1)
! call flush(uterm)
IF(isub(sub_temp1).GT.nbodsmax) THEN
par_temp1 = isub(sub_temp1)
ELSEIF(isub(sub_temp1).EQ.0) THEN
!no bodies in the block
blockCells = 0.0
RETURN
ELSE
!one body in the block
i_sh = isub(sub_temp1)
ind_pe = (i_sh-1)/ max_pr
ind_loc = i_sh - (max_pr * ind_pe)
IF(ind_pe.EQ.me) THEN
bodyPosition(1:3) = pos(1:3, ind_loc)
ELSE
startIndex = (((ind_loc - 1) * ndim) + 1) - 1
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, ind_pe, 0, &
win_pos, ierror)
CALL MPI_GET(bodyPosition(1), ndim, MPI_REAL8, ind_pe, &
startIndex, ndim, MPI_REAL8, win_pos, ierror)
CALL MPI_WIN_UNLOCK(ind_pe, win_pos, ierror)
ENDIF
IF(bodyPosition(3).GE.bnd_box_min(3).AND.bodyPosition(3).LT.bnd_box_max(3)) THEN
IF(bodyPosition(2).GE.bnd_box_min(2).AND.bodyPosition(2).LT.bnd_box_max(2)) THEN
IF(bodyPosition(1).GE.bnd_box_min(1).AND.bodyPosition(1).LT.bnd_box_max(1)) THEN
cellIndex = (bodyPosition - bnd_box_min)/cellSize + 1
blockCells(cellIndex(1), cellIndex(2), cellIndex(3)) = &
blockCells(cellIndex(1), cellIndex(2), cellIndex(3)) + 1
ENDIF
ENDIF
ENDIF
RETURN
ENDIF
ENDDO
! write(100+me,*)"ME=",me," par_temp1 =",par_temp1," pcl =",pcl, &
! " pl =",pl
! call flush(uterm)
CALL findParticlesInCell(par_temp1, bnd_box_min, bnd_box_max, &
blockCells)
! write(100+me,*)"ME=",me," esco da flashBlockToFlyCell"
! call flush(uterm)
! STOP
#endif
RETURN
END