Skip to content

Commit 645f2cf

Browse files
wilfonbawilfonba
committed
fix boundary_common on Frontier
1 parent 5cf0fef commit 645f2cf

File tree

2 files changed

+85
-92
lines changed

2 files changed

+85
-92
lines changed

‎src/common/m_boundary_common.fpp‎

Lines changed: 82 additions & 89 deletions
Original file line numberDiff line numberDiff line change
@@ -93,18 +93,23 @@ contains
9393
do k = 0, n
9494
select case (int(bc_type(1, -1)%sf(0, k, l)))
9595
case (BC_CHAR_SUP_OUTFLOW:BC_GHOST_EXTRAP)
96-
call s_ghost_cell_extrapolation(q_prim_vf, pb, mv, 1, -1, k, l)
96+
call s_ghost_cell_extrapolation(q_prim_vf, 1, -1, k, l)
9797
case (BC_REFLECTIVE)
98-
call s_symmetry(q_prim_vf, pb, mv, 1, -1, k, l)
98+
call s_symmetry(q_prim_vf, 1, -1, k, l, pb, mv)
9999
case (BC_PERIODIC)
100-
call s_periodic(q_prim_vf, pb, mv, 1, -1, k, l)
100+
call s_periodic(q_prim_vf, 1, -1, k, l, pb, mv)
101101
case (BC_SLIP_WALL)
102-
call s_slip_wall(q_prim_vf, pb, mv, 1, -1, k, l)
102+
call s_slip_wall(q_prim_vf, 1, -1, k, l)
103103
case (BC_NO_SLIP_WALL)
104-
call s_no_slip_wall(q_prim_vf, pb, mv, 1, -1, k, l)
104+
call s_no_slip_wall(q_prim_vf, 1, -1, k, l)
105105
case (BC_DIRICHLET)
106-
call s_dirichlet(q_prim_vf, pb, mv, 1, -1, k, l)
106+
call s_dirichlet(q_prim_vf, 1, -1, k, l)
107107
end select
108+
109+
if (qbmm .and. (.not. polytropic) .and. &
110+
(bc_type(1, -1)%sf(0, k, l) <= BC_GHOST_EXTRAP)) then
111+
call s_qbmm_extrapolation(1, -1, k, l, pb, mv)
112+
end if
108113
end do
109114
end do
110115
end if
@@ -117,18 +122,23 @@ contains
117122
do k = 0, n
118123
select case (int(bc_type(1, 1)%sf(0, k, l)))
119124
case (BC_CHAR_SUP_OUTFLOW:BC_GHOST_EXTRAP) ! Ghost-cell extrap. BC at end
120-
call s_ghost_cell_extrapolation(q_prim_vf, pb, mv, 1, 1, k, l)
125+
call s_ghost_cell_extrapolation(q_prim_vf, 1, 1, k, l)
121126
case (BC_REFLECTIVE)
122-
call s_symmetry(q_prim_vf, pb, mv, 1, 1, k, l)
127+
call s_symmetry(q_prim_vf, 1, 1, k, l, pb, mv)
123128
case (BC_PERIODIC)
124-
call s_periodic(q_prim_vf, pb, mv, 1, 1, k, l)
129+
call s_periodic(q_prim_vf, 1, 1, k, l, pb, mv)
125130
case (BC_SLIP_WALL)
126-
call s_slip_wall(q_prim_vf, pb, mv, 1, 1, k, l)
131+
call s_slip_wall(q_prim_vf, 1, 1, k, l)
127132
case (BC_NO_SLIP_WALL)
128-
call s_no_slip_wall(q_prim_vf, pb, mv, 1, 1, k, l)
133+
call s_no_slip_wall(q_prim_vf, 1, 1, k, l)
129134
case (BC_DIRICHLET)
130-
call s_dirichlet(q_prim_vf, pb, mv, 1, 1, k, l)
135+
call s_dirichlet(q_prim_vf, 1, 1, k, l)
131136
end select
137+
138+
if (qbmm .and. (.not. polytropic) .and. &
139+
(bc_type(1, 1)%sf(0, k, l) <= BC_GHOST_EXTRAP)) then
140+
call s_qbmm_extrapolation(1, 1, k, l, pb, mv)
141+
end if
132142
end do
133143
end do
134144
end if
@@ -145,20 +155,26 @@ contains
145155
do k = -buff_size, m + buff_size
146156
select case (int(bc_type(2, -1)%sf(k, 0, l)))
147157
case (BC_CHAR_SUP_OUTFLOW:BC_GHOST_EXTRAP)
148-
call s_ghost_cell_extrapolation(q_prim_vf, pb, mv, 2, -1, k, l)
158+
call s_ghost_cell_extrapolation(q_prim_vf, 2, -1, k, l)
149159
case (BC_AXIS)
150-
call s_axis(q_prim_vf, pb, mv, 2, -1, k, l)
160+
call s_axis(q_prim_vf, 2, -1, k, l, pb, mv)
151161
case (BC_REFLECTIVE)
152-
call s_symmetry(q_prim_vf, pb, mv, 2, -1, k, l)
162+
call s_symmetry(q_prim_vf, 2, -1, k, l, pb, mv)
153163
case (BC_PERIODIC)
154-
call s_periodic(q_prim_vf, pb, mv, 2, -1, k, l)
164+
call s_periodic(q_prim_vf, 2, -1, k, l, pb, mv)
155165
case (BC_SLIP_WALL)
156-
call s_slip_wall(q_prim_vf, pb, mv, 2, -1, k, l)
166+
call s_slip_wall(q_prim_vf, 2, -1, k, l)
157167
case (BC_NO_SLIP_WALL)
158-
call s_no_slip_wall(q_prim_vf, pb, mv, 2, -1, k, l)
168+
call s_no_slip_wall(q_prim_vf, 2, -1, k, l)
159169
case (BC_DIRICHLET)
160-
call s_dirichlet(q_prim_vf, pb, mv, 2, -1, k, l)
170+
call s_dirichlet(q_prim_vf, 2, -1, k, l)
161171
end select
172+
173+
if (qbmm .and. (.not. polytropic) .and. &
174+
(bc_type(2, -1)%sf(0, k, l) <= BC_GHOST_EXTRAP) .and. &
175+
(bc_type(2, -1)%sf(0, k, l) /= BC_AXIS)) then
176+
call s_qbmm_extrapolation(2, -1, k, l, pb, mv)
177+
end if
162178
end do
163179
end do
164180
end if
@@ -171,18 +187,23 @@ contains
171187
do k = -buff_size, m + buff_size
172188
select case (int(bc_type(2, 1)%sf(k, 0, l)))
173189
case (BC_CHAR_SUP_OUTFLOW:BC_GHOST_EXTRAP)
174-
call s_ghost_cell_extrapolation(q_prim_vf, pb, mv, 2, 1, k, l)
190+
call s_ghost_cell_extrapolation(q_prim_vf, 2, 1, k, l)
175191
case (BC_REFLECTIVE)
176-
call s_symmetry(q_prim_vf, pb, mv, 2, 1, k, l)
192+
call s_symmetry(q_prim_vf, 2, 1, k, l, pb, mv)
177193
case (BC_PERIODIC)
178-
call s_periodic(q_prim_vf, pb, mv, 2, 1, k, l)
194+
call s_periodic(q_prim_vf, 2, 1, k, l, pb, mv)
179195
case (BC_SLIP_WALL)
180-
call s_slip_wall(q_prim_vf, pb, mv, 2, 1, k, l)
196+
call s_slip_wall(q_prim_vf, 2, 1, k, l)
181197
case (BC_NO_SLIP_WALL)
182-
call s_no_slip_wall(q_prim_vf, pb, mv, 2, 1, k, l)
198+
call s_no_slip_wall(q_prim_vf, 2, 1, k, l)
183199
case (BC_DIRICHLET)
184-
call s_dirichlet(q_prim_vf, pb, mv, 2, 1, k, l)
200+
call s_dirichlet(q_prim_vf, 2, 1, k, l)
185201
end select
202+
203+
if (qbmm .and. (.not. polytropic) .and. &
204+
(bc_type(2, 1)%sf(0, k, l) <= BC_GHOST_EXTRAP)) then
205+
call s_qbmm_extrapolation(2, 1, k, l, pb, mv)
206+
end if
186207
end do
187208
end do
188209
end if
@@ -199,18 +220,23 @@ contains
199220
do k = -buff_size, m + buff_size
200221
select case (int(bc_type(3, -1)%sf(k, l, 0)))
201222
case (BC_CHAR_SUP_OUTFLOW:BC_GHOST_EXTRAP)
202-
call s_ghost_cell_extrapolation(q_prim_vf, pb, mv, 3, -1, k, l)
223+
call s_ghost_cell_extrapolation(q_prim_vf, 3, -1, k, l)
203224
case (BC_REFLECTIVE)
204-
call s_symmetry(q_prim_vf, pb, mv, 3, -1, k, l)
225+
call s_symmetry(q_prim_vf, 3, -1, k, l, pb, mv)
205226
case (BC_PERIODIC)
206-
call s_periodic(q_prim_vf, pb, mv, 3, -1, k, l)
227+
call s_periodic(q_prim_vf, 3, -1, k, l, pb, mv)
207228
case (BC_SLIP_WALL)
208-
call s_slip_wall(q_prim_vf, pb, mv, 3, -1, k, l)
229+
call s_slip_wall(q_prim_vf, 3, -1, k, l)
209230
case (BC_NO_SLIP_WALL)
210-
call s_no_slip_wall(q_prim_vf, pb, mv, 3, -1, k, l)
231+
call s_no_slip_wall(q_prim_vf, 3, -1, k, l)
211232
case (BC_DIRICHLET)
212-
call s_dirichlet(q_prim_vf, pb, mv, 3, -1, k, l)
233+
call s_dirichlet(q_prim_vf, 3, -1, k, l)
213234
end select
235+
236+
if (qbmm .and. (.not. polytropic) .and. &
237+
(bc_type(3, -1)%sf(0, k, l) <= BC_GHOST_EXTRAP)) then
238+
call s_qbmm_extrapolation(3, -1, k, l, pb, mv)
239+
end if
214240
end do
215241
end do
216242
end if
@@ -223,44 +249,42 @@ contains
223249
do k = -buff_size, m + buff_size
224250
select case (int(bc_type(3, 1)%sf(k, l, 0)))
225251
case (BC_CHAR_SUP_OUTFLOW:BC_GHOST_EXTRAP)
226-
call s_ghost_cell_extrapolation(q_prim_vf, pb, mv, 3, 1, k, l)
252+
call s_ghost_cell_extrapolation(q_prim_vf, 3, 1, k, l)
227253
case (BC_REFLECTIVE)
228-
call s_symmetry(q_prim_vf, pb, mv, 3, 1, k, l)
254+
call s_symmetry(q_prim_vf, 3, 1, k, l, pb, mv)
229255
case (BC_PERIODIC)
230-
call s_periodic(q_prim_vf, pb, mv, 3, 1, k, l)
256+
call s_periodic(q_prim_vf, 3, 1, k, l, pb, mv)
231257
case (BC_SlIP_WALL)
232-
call s_slip_wall(q_prim_vf, pb, mv, 3, 1, k, l)
258+
call s_slip_wall(q_prim_vf, 3, 1, k, l)
233259
case (BC_NO_SLIP_WALL)
234-
call s_no_slip_wall(q_prim_vf, pb, mv, 3, 1, k, l)
260+
call s_no_slip_wall(q_prim_vf, 3, 1, k, l)
235261
case (BC_DIRICHLET)
236-
call s_dirichlet(q_prim_vf, pb, mv, 3, 1, k, l)
262+
call s_dirichlet(q_prim_vf, 3, 1, k, l)
237263
end select
264+
265+
if (qbmm .and. (.not. polytropic) .and. &
266+
(bc_type(3, 1)%sf(0, k, l) <= BC_GHOST_EXTRAP)) then
267+
call s_qbmm_extrapolation(3, 1, k, l, pb, mv)
268+
end if
238269
end do
239270
end do
240271
end if
241272
! END: Population of Buffers in z-direction
242273

243274
end subroutine s_populate_variables_buffers
244275

245-
subroutine s_ghost_cell_extrapolation(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l)
276+
subroutine s_ghost_cell_extrapolation(q_prim_vf, bc_dir, bc_loc, k, l)
246277
#ifdef _CRAYFTN
247278
!DIR$ INLINEALWAYS s_ghost_cell_extrapolation
248279
#else
249280
!$acc routine seq
250281
#endif
251282
type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
252-
real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
253283
integer, intent(in) :: bc_dir, bc_loc
254284
integer, intent(in) :: k, l
255285

256286
integer :: j, q, i
257287

258-
#ifndef MFC_POST_PROCESS
259-
if (qbmm .and. .not. polytropic) then
260-
call s_qbmm_extrapolation(pb, mv, bc_dir, bc_loc, k, l)
261-
end if
262-
#endif
263-
264288
if (bc_dir == 1) then !< x-direction
265289
if (bc_loc == -1) then !bc_x%beg
266290
do i = 1, sys_size
@@ -313,14 +337,10 @@ contains
313337

314338
end subroutine s_ghost_cell_extrapolation
315339

316-
subroutine s_symmetry(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l)
317-
#ifdef _CRAYFTN
318-
!DIR$ INLINEALWAYS s_symmetry
319-
#else
340+
subroutine s_symmetry(q_prim_vf, bc_dir, bc_loc, k, l, pb, mv)
320341
!$acc routine seq
321-
#endif
322342
type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
323-
real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
343+
real(wp), optional, dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
324344
integer, intent(in) :: bc_dir, bc_loc
325345
integer, intent(in) :: k, l
326346

@@ -577,14 +597,10 @@ contains
577597

578598
end subroutine s_symmetry
579599

580-
subroutine s_periodic(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l)
581-
#ifdef _CRAYFTN
582-
!DIR$ INLINEALWAYS s_periodic
583-
#else
600+
subroutine s_periodic(q_prim_vf, bc_dir, bc_loc, k, l, pb, mv)
584601
!$acc routine seq
585-
#endif
586602
type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
587-
real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
603+
real(wp), optional, dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
588604
integer, intent(in) :: bc_dir, bc_loc
589605
integer, intent(in) :: k, l
590606

@@ -720,14 +736,10 @@ contains
720736

721737
end subroutine s_periodic
722738

723-
subroutine s_axis(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l)
724-
#ifdef _CRAYFTN
725-
!DIR$ INLINEALWAYS s_axis
726-
#else
739+
subroutine s_axis(q_prim_vf, bc_dir, bc_loc, k, l, pb, mv)
727740
!$acc routine seq
728-
#endif
729741
type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
730-
real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
742+
real(wp), optional, dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
731743
integer, intent(in) :: bc_dir, bc_loc
732744
integer, intent(in) :: k, l
733745

@@ -784,25 +796,18 @@ contains
784796

785797
end subroutine s_axis
786798

787-
subroutine s_slip_wall(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l)
799+
subroutine s_slip_wall(q_prim_vf, bc_dir, bc_loc, k, l)
788800
#ifdef _CRAYFTN
789801
!DIR$ INLINEALWAYS s_slip_wall
790802
#else
791803
!$acc routine seq
792804
#endif
793805
type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
794-
real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
795806
integer, intent(in) :: bc_dir, bc_loc
796807
integer, intent(in) :: k, l
797808

798809
integer :: j, q, i
799810

800-
#ifndef MFC_POST_PROCESS
801-
if (qbmm .and. .not. polytropic) then
802-
call s_qbmm_extrapolation(pb, mv, bc_dir, bc_loc, k, l)
803-
end if
804-
#endif
805-
806811
if (bc_dir == 1) then !< x-direction
807812
if (bc_loc == -1) then !< bc_x%beg
808813
do i = 1, sys_size
@@ -885,25 +890,18 @@ contains
885890

886891
end subroutine s_slip_wall
887892

888-
subroutine s_no_slip_wall(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l)
893+
subroutine s_no_slip_wall(q_prim_vf, bc_dir, bc_loc, k, l)
889894
#ifdef _CRAYFTN
890895
!DIR$ INLINEALWAYS s_no_slip_wall
891896
#else
892897
!$acc routine seq
893898
#endif
894899
type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
895-
real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
896900
integer, intent(in) :: bc_dir, bc_loc
897901
integer, intent(in) :: k, l
898902

899903
integer :: j, q, i
900904

901-
#ifndef MFC_POST_PROCESS
902-
if (qbmm .and. .not. polytropic) then
903-
call s_qbmm_extrapolation(pb, mv, bc_dir, bc_loc, k, l)
904-
end if
905-
#endif
906-
907905
if (bc_dir == 1) then !< x-direction
908906
if (bc_loc == -1) then !< bc_x%beg
909907
do i = 1, sys_size
@@ -1022,14 +1020,13 @@ contains
10221020

10231021
end subroutine s_no_slip_wall
10241022

1025-
subroutine s_dirichlet(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l)
1023+
subroutine s_dirichlet(q_prim_vf, bc_dir, bc_loc, k, l)
10261024
#ifdef _CRAYFTN
10271025
!DIR$ INLINEALWAYS s_dirichlet
10281026
#else
10291027
!$acc routine seq
10301028
#endif
10311029
type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf
1032-
real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
10331030
integer, intent(in) :: bc_dir, bc_loc
10341031
integer, intent(in) :: k, l
10351032

@@ -1086,18 +1083,14 @@ contains
10861083
end if
10871084
end if
10881085
#else
1089-
call s_ghost_cell_extrapolation(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l)
1086+
call s_ghost_cell_extrapolation(q_prim_vf, bc_dir, bc_loc, k, l)
10901087
#endif
10911088

10921089
end subroutine s_dirichlet
10931090

1094-
subroutine s_qbmm_extrapolation(pb, mv, bc_dir, bc_loc, k, l)
1095-
#ifdef _CRAYFTN
1096-
!DIR$ INLINEALWAYS s_qbmm_extrapolation
1097-
#else
1091+
subroutine s_qbmm_extrapolation(bc_dir, bc_loc, k, l, pb, mv)
10981092
!$acc routine seq
1099-
#endif
1100-
real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
1093+
real(wp), optional, dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv
11011094
integer, intent(in) :: bc_dir, bc_loc
11021095
integer, intent(in) :: k, l
11031096

@@ -1969,7 +1962,7 @@ contains
19691962
end if
19701963

19711964
! Populating the cell-boundary and center locations buffer at bc_z%end
1972-
do i = 1, buff_size
1965+
do i = 1, offset_z%end
19731966
z_cb(p + i) = z_cb(p + (i - 1)) + dz(p + i)
19741967
end do
19751968

‎toolchain/modules‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -48,9 +48,9 @@ p-gpu nvhpc/24.5 hpcx/2.19-cuda cuda/12.1.1
4848
p-gpu MFC_CUDA_CC=70,75,80,89,90 NVHPC_CUDA_HOME=$CUDA_HOME CC=nvc CXX=nvc++ FC=nvfortran
4949

5050
f OLCF Frontier
51-
f-all cce/18.0.0 cpe/24.07 rocm/6.1.3 cray-mpich/8.1.28
52-
f-all cray-fftw cray-hdf5 cray-python omniperf
53-
f-gpu craype-accel-amd-gfx90a
51+
f-all cpe/25.03 rocm/6.3.1
52+
f-all cray-fftw cray-hdf5 cray-python
53+
f-gpu craype-accel-amd-gfx90a rocprofiler-compute/3.0.0
5454

5555
d NCSA Delta
5656
d-all python/3.11.6

0 commit comments

Comments
 (0)