Skip to content

Commit b2603ce

Browse files
Dimitrios AdamDimitrios Adam
Dimitrios Adam
authored and
Dimitrios Adam
committed
Revert m_mpi_common.fpp to state in 924f1e4 
1 parent f9de5de commit b2603ce

1 file changed

Lines changed: 67 additions & 121 deletions

File tree

‎src/common/m_mpi_common.fpp‎

Lines changed: 67 additions & 121 deletions
Original file line numberDiff line numberDiff line change
@@ -59,8 +59,6 @@ contains
5959
6060
if (qbmm .and. .not. polytropic) then
6161
v_size = sys_size + 2*nb*4
62-
else if (chemistry) then
63-
v_size = sys_size + 1
6462
else
6563
v_size = sys_size
6664
end if
@@ -126,11 +124,15 @@ contains
126124
127125
!! @param q_cons_vf Conservative variables
128126
!! @param ib_markers track if a cell is within the immersed boundary
127+
!! @param levelset closest distance from every cell to the IB
128+
!! @param levelset_norm normalized vector from every cell to the closest point to the IB
129129
!! @param beta Eulerian void fraction from lagrangian bubbles
130-
impure subroutine s_initialize_mpi_data(q_cons_vf, ib_markers, beta)
130+
impure subroutine s_initialize_mpi_data(q_cons_vf, ib_markers, levelset, levelset_norm, beta)
131131
132132
type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
133133
type(integer_field), optional, intent(in) :: ib_markers
134+
type(levelset_field), optional, intent(IN) :: levelset
135+
type(levelset_norm_field), optional, intent(IN) :: levelset_norm
134136
type(scalar_field), intent(in), optional :: beta
135137
136138
integer, dimension(num_dims) :: sizes_glb, sizes_loc
@@ -201,13 +203,73 @@ contains
201203
end if
202204
#endif
203205
204-
#ifndef MFC_PRE_PROCESS
205206
if (present(ib_markers)) then
207+
208+
#ifdef MFC_PRE_PROCESS
209+
MPI_IO_IB_DATA%var%sf => ib_markers%sf
210+
MPI_IO_levelset_DATA%var%sf => levelset%sf
211+
MPI_IO_levelsetnorm_DATA%var%sf => levelset_norm%sf
212+
#else
206213
MPI_IO_IB_DATA%var%sf => ib_markers%sf(0:m, 0:n, 0:p)
207214
215+
#ifndef MFC_POST_PROCESS
216+
MPI_IO_levelset_DATA%var%sf => levelset%sf(0:m, 0:n, 0:p, 1:num_ibs)
217+
MPI_IO_levelsetnorm_DATA%var%sf => levelset_norm%sf(0:m, 0:n, 0:p, 1:num_ibs, 1:3)
218+
#endif
219+
220+
#endif
208221
call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_glb, sizes_loc, start_idx, &
209222
MPI_ORDER_FORTRAN, MPI_INTEGER, MPI_IO_IB_DATA%view, ierr)
210223
call MPI_TYPE_COMMIT(MPI_IO_IB_DATA%view, ierr)
224+
225+
#ifndef MFC_POST_PROCESS
226+
call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_glb, sizes_loc, start_idx, &
227+
MPI_ORDER_FORTRAN, mpi_p, MPI_IO_levelset_DATA%view, ierr)
228+
call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_glb, sizes_loc, start_idx, &
229+
MPI_ORDER_FORTRAN, mpi_p, MPI_IO_levelsetnorm_DATA%view, ierr)
230+
231+
call MPI_TYPE_COMMIT(MPI_IO_levelset_DATA%view, ierr)
232+
call MPI_TYPE_COMMIT(MPI_IO_levelsetnorm_DATA%view, ierr)
233+
#endif
234+
end if
235+
236+
#ifndef MFC_POST_PROCESS
237+
if (present(ib_markers)) then
238+
do j = 1, num_ibs
239+
if (patch_ib(j)%c > 0) then
240+
241+
#ifdef MFC_PRE_PROCESS
242+
allocate (MPI_IO_airfoil_IB_DATA%var(1:2*Np))
243+
#endif
244+
245+
airfoil_glb(1) = 3*Np*num_procs
246+
airfoil_loc(1) = 3*Np
247+
airfoil_start(1) = 3*proc_rank*Np
248+
249+
#ifdef MFC_PRE_PROCESS
250+
do i = 1, Np
251+
MPI_IO_airfoil_IB_DATA%var(i)%x = airfoil_grid_l(i)%x
252+
MPI_IO_airfoil_IB_DATA%var(i)%y = airfoil_grid_l(i)%y
253+
end do
254+
#endif
255+
256+
call MPI_TYPE_CREATE_SUBARRAY(1, airfoil_glb, airfoil_loc, airfoil_start, &
257+
MPI_ORDER_FORTRAN, mpi_p, MPI_IO_airfoil_IB_DATA%view(1), ierr)
258+
call MPI_TYPE_COMMIT(MPI_IO_airfoil_IB_DATA%view(1), ierr)
259+
260+
#ifdef MFC_PRE_PROCESS
261+
do i = 1, Np
262+
MPI_IO_airfoil_IB_DATA%var(Np + i)%x = airfoil_grid_u(i)%x
263+
MPI_IO_airfoil_IB_DATA%var(Np + i)%y = airfoil_grid_u(i)%y
264+
end do
265+
#endif
266+
call MPI_TYPE_CREATE_SUBARRAY(1, airfoil_glb, airfoil_loc, airfoil_start, &
267+
MPI_ORDER_FORTRAN, mpi_p, MPI_IO_airfoil_IB_DATA%view(2), ierr)
268+
call MPI_TYPE_COMMIT(MPI_IO_airfoil_IB_DATA%view(2), ierr)
269+
270+
end if
271+
end do
272+
211273
end if
212274
#endif
213275
@@ -643,11 +705,10 @@ contains
643705
mpi_dir, &
644706
pbc_loc, &
645707
nVar, &
646-
pb_in, mv_in, q_T_sf)
708+
pb_in, mv_in)
647709
648710
type(scalar_field), dimension(1:), intent(inout) :: q_comm
649711
real(stp), optional, dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb_in, mv_in
650-
type(scalar_field), optional, intent(inout) :: q_T_sf
651712
integer, intent(in) :: mpi_dir, pbc_loc, nVar
652713
653714
integer :: i, j, k, l, r, q !< Generic loop iterators
@@ -677,13 +738,6 @@ contains
677738
buff_size*v_size*(m + 2*buff_size + 1)*(p + 1), &
678739
buff_size*v_size*(m + 2*buff_size + 1)*(n + 2*buff_size + 1) &
679740
/)
680-
else if (chemistry) then
681-
v_size = nVar + 1
682-
buffer_counts = (/ &
683-
buff_size*v_size*(n + 1)*(p + 1), &
684-
buff_size*v_size*(m + 2*buff_size + 1)*(p + 1), &
685-
buff_size*v_size*(m + 2*buff_size + 1)*(n + 2*buff_size + 1) &
686-
/)
687741
else
688742
v_size = nVar
689743
buffer_counts = (/ &
@@ -742,21 +796,6 @@ contains
742796
end do
743797
$:END_GPU_PARALLEL_LOOP()
744798
745-
if (chemistry) then
746-
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
747-
do l = 0, p
748-
do k = 0, n
749-
do j = 0, buff_size - 1
750-
! (v_size - 1) puts T at the end of the cell's buffer chunk
751-
r = (v_size - 1) + v_size* &
752-
(j + buff_size*(k + (n + 1)*l))
753-
buff_send(r) = real(q_T_sf%sf(j + pack_offset, k, l), kind=wp)
754-
end do
755-
end do
756-
end do
757-
$:END_GPU_PARALLEL_LOOP()
758-
end if
759-
760799
if (qbmm_comm) then
761800
$:GPU_PARALLEL_LOOP(collapse=4,private='[r]')
762801
do l = 0, p
@@ -806,21 +845,6 @@ contains
806845
end do
807846
$:END_GPU_PARALLEL_LOOP()
808847
809-
if (chemistry) then
810-
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
811-
do l = 0, p
812-
do k = 0, buff_size - 1
813-
do j = -buff_size, m + buff_size
814-
r = nVar + v_size* &
815-
((j + buff_size) + (m + 2*buff_size + 1)* &
816-
(k + buff_size*l))
817-
buff_send(r) = real(q_T_sf%sf(j, k + pack_offset, l), kind=wp)
818-
end do
819-
end do
820-
end do
821-
$:END_GPU_PARALLEL_LOOP()
822-
end if
823-
824848
if (qbmm_comm) then
825849
$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
826850
do i = nVar + 1, nVar + 4
@@ -872,21 +896,6 @@ contains
872896
end do
873897
$:END_GPU_PARALLEL_LOOP()
874898
875-
if (chemistry) then
876-
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
877-
do l = 0, buff_size - 1
878-
do k = -buff_size, n + buff_size
879-
do j = -buff_size, m + buff_size
880-
r = nVar + v_size* &
881-
((j + buff_size) + (m + 2*buff_size + 1)* &
882-
((k + buff_size) + (n + 2*buff_size + 1)*l))
883-
buff_send(r) = real(q_T_sf%sf(j, k, l + pack_offset), kind=wp)
884-
end do
885-
end do
886-
end do
887-
$:END_GPU_PARALLEL_LOOP()
888-
end if
889-
890899
if (qbmm_comm) then
891900
$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
892901
do i = nVar + 1, nVar + 4
@@ -995,26 +1004,6 @@ contains
9951004
end do
9961005
$:END_GPU_PARALLEL_LOOP()
9971006
998-
if (chemistry) then
999-
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
1000-
do l = 0, p
1001-
do k = 0, n
1002-
do j = -buff_size, -1
1003-
r = nVar + v_size* &
1004-
(j + buff_size*((k + 1) + (n + 1)*l))
1005-
q_T_sf%sf(j + unpack_offset, k, l) = real(buff_recv(r), kind=stp)
1006-
#if defined(__INTEL_COMPILER)
1007-
if (ieee_is_nan(q_T_sf%sf(j, k, l))) then
1008-
print *, "Error", j, k, l, i
1009-
error stop "NaN(s) in recv"
1010-
end if
1011-
#endif
1012-
end do
1013-
end do
1014-
end do
1015-
$:END_GPU_PARALLEL_LOOP()
1016-
end if
1017-
10181007
if (qbmm_comm) then
10191008
$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
10201009
do l = 0, p
@@ -1070,27 +1059,6 @@ contains
10701059
end do
10711060
$:END_GPU_PARALLEL_LOOP()
10721061
1073-
if (chemistry) then
1074-
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
1075-
do l = 0, p
1076-
do k = -buff_size, -1
1077-
do j = -buff_size, m + buff_size
1078-
r = nVar + v_size* &
1079-
((j + buff_size) + (m + 2*buff_size + 1)* &
1080-
((k + buff_size) + buff_size*l))
1081-
q_T_sf%sf(j, k + unpack_offset, l) = real(buff_recv(r), kind=stp)
1082-
#if defined(__INTEL_COMPILER)
1083-
if (ieee_is_nan(q_T_sf%sf(j, k, l))) then
1084-
print *, "Error", j, k, l, i
1085-
error stop "NaN(s) in recv"
1086-
end if
1087-
#endif
1088-
end do
1089-
end do
1090-
end do
1091-
$:END_GPU_PARALLEL_LOOP()
1092-
end if
1093-
10941062
if (qbmm_comm) then
10951063
$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
10961064
do i = nVar + 1, nVar + 4
@@ -1150,28 +1118,6 @@ contains
11501118
end do
11511119
$:END_GPU_PARALLEL_LOOP()
11521120
1153-
if (chemistry) then
1154-
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
1155-
do l = -buff_size, -1
1156-
do k = -buff_size, n + buff_size
1157-
do j = -buff_size, m + buff_size
1158-
r = nVar + v_size* &
1159-
((j + buff_size) + (m + 2*buff_size + 1)* &
1160-
((k + buff_size) + (n + 2*buff_size + 1)* &
1161-
(l + buff_size)))
1162-
q_T_sf%sf(j, k, l + unpack_offset) = real(buff_recv(r), kind=stp)
1163-
#if defined(__INTEL_COMPILER)
1164-
if (ieee_is_nan(q_T_sf%sf(j, k, l))) then
1165-
print *, "Error", j, k, l, i
1166-
error stop "NaN(s) in recv"
1167-
end if
1168-
#endif
1169-
end do
1170-
end do
1171-
end do
1172-
$:END_GPU_PARALLEL_LOOP()
1173-
end if
1174-
11751121
if (qbmm_comm) then
11761122
$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
11771123
do i = nVar + 1, nVar + 4

0 commit comments

Comments
 (0)