Skip to content

Commit 91fbe3c

Browse files
author
Anand
committed
Add tests for LF Riemann Solver + AI suggestions
1 parent 0dba2f2 commit 91fbe3c

28 files changed

+2099
-87
lines changed

‎src/post_process/m_checker.fpp‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -113,17 +113,18 @@ contains
113113

114114
!> Checks constraints on fft_wrt
115115
impure subroutine s_check_inputs_fft
116-
integer :: num_procs_x, num_procs_y, num_procs_z
116+
integer :: num_procs_y, num_procs_z
117117

118118
@:PROHIBIT(fft_wrt .and. (n == 0 .or. p == 0), "FFT WRT only in 3D")
119119
@:PROHIBIT(fft_wrt .and. cyl_coord, "FFT WRT incompatible with cylindrical coordinates")
120120
@:PROHIBIT(fft_wrt .and. (MOD(m_glb+1,2) == 1 .or. MOD(n_glb+1,2) == 1 .or. MOD(p_glb+1,2) == 1), "FFT WRT requires global dimensions divisible by 2")
121-
num_procs_x = (m_glb + 1)/(m + 1)
121+
@:PROHIBIT(fft_wrt .and. MOD(n_glb+1,n+1) /= 0, "FFT WRT requires n_glb to be divisble by num_procs_y")
122+
@:PROHIBIT(fft_wrt .and. MOD(p_glb+1,p+1) /= 0, "FFT WRT requires p_glb to be divisble by num_procs_z")
122123
num_procs_y = (n_glb + 1)/(n + 1)
123124
num_procs_z = (p_glb + 1)/(p + 1)
124-
@:PROHIBIT(fft_wrt .and. (MOD(m_glb+1,num_procs_y) /= 0 .or. MOD(m_glb+1,num_procs_z) /= 0), "FFT WRT requires m_glb to be divisble by num_procs_y and num_procs_z")
125-
@:PROHIBIT(fft_wrt .and. (MOD(n_glb+1,num_procs_y) /= 0 .or. MOD(n_glb+1,num_procs_z) /= 0), "FFT WRT requires n_glb to be divisble by num_procs_y and num_procs_z")
126-
@:PROHIBIT(fft_wrt .and. (MOD(p_glb+1,num_procs_y) /= 0 .or. MOD(p_glb+1,num_procs_z) /= 0), "FFT WRT requires p_glb to be divisble by num_procs_y and num_procs_z")
125+
@:PROHIBIT(fft_wrt .and. MOD(m_glb+1,num_procs_y) /= 0, "FFT WRT requires m_glb to be divisble by num_procs_y")
126+
@:PROHIBIT(fft_wrt .and. MOD(n_glb+1,num_procs_z) /= 0, "FFT WRT requires n_glb to be divisble by num_procs_z")
127+
@:PROHIBIT(fft_wrt .and. (bc_x%beg < -1 .or. bc_y%beg < -1 .or. bc_z%beg < -1 .or. bc_x%end < -1 .or. bc_y%end < -1 .or. bc_z%end < -1), "FFT WRT requires periodic BCs")
127128
end subroutine s_check_inputs_fft
128129

129130
!> Checks constraints on Q-criterion parameters

‎src/post_process/m_start_up.fpp‎

Lines changed: 94 additions & 74 deletions
Original file line numberDiff line numberDiff line change
@@ -462,8 +462,8 @@ contains
462462
do k = 1, Nyloc2
463463
do j = 1, Nxloc
464464

465-
j_glb = j + proc_coords(2)*Nxloc
466-
k_glb = k + proc_coords(3)*Nyloc2
465+
j_glb = j + cart3d_coords(2)*Nxloc
466+
k_glb = k + cart3d_coords(3)*Nyloc2
467467
l_glb = l
468468

469469
if (j_glb >= (m_glb + 1)/2) then
@@ -864,6 +864,78 @@ contains
864864

865865
end subroutine s_save_data
866866

867+
subroutine s_mpi_transpose_x2y
868+
complex(c_double_complex), allocatable :: sendbuf(:), recvbuf(:)
869+
integer :: dest_rank, src_rank
870+
integer :: i, j, k, l
871+
872+
allocate (sendbuf(Nx*Nyloc*Nzloc))
873+
allocate (recvbuf(Nx*Nyloc*Nzloc))
874+
875+
do dest_rank = 0, num_procs_y - 1
876+
do l = 1, Nzloc
877+
do k = 1, Nyloc
878+
do j = 1, Nxloc
879+
sendbuf(j + (k - 1)*Nxloc + (l - 1)*Nxloc*Nyloc + dest_rank*Nxloc*Nyloc*Nzloc) = data_cmplx(j + dest_rank*Nxloc, k, l)
880+
end do
881+
end do
882+
end do
883+
end do
884+
885+
call MPI_Alltoall(sendbuf, Nxloc*Nyloc*Nzloc, MPI_C_DOUBLE_COMPLEX, &
886+
recvbuf, Nxloc*Nyloc*Nzloc, MPI_C_DOUBLE_COMPLEX, MPI_COMM_CART12, ierr)
887+
888+
do src_rank = 0, num_procs_y - 1
889+
do l = 1, Nzloc
890+
do k = 1, Nyloc
891+
do j = 1, Nxloc
892+
data_cmplx_y(j, k + src_rank*Nyloc, l) = recvbuf(j + (k - 1)*Nxloc + (l - 1)*Nxloc*Nyloc + src_rank*Nxloc*Nyloc*Nzloc)
893+
end do
894+
end do
895+
end do
896+
end do
897+
898+
deallocate (sendbuf)
899+
deallocate (recvbuf)
900+
901+
end subroutine s_mpi_transpose_x2y
902+
903+
subroutine s_mpi_transpose_y2z
904+
complex(c_double_complex), allocatable :: sendbuf(:), recvbuf(:)
905+
integer :: dest_rank, src_rank
906+
integer :: j, k, l
907+
908+
allocate (sendbuf(Ny*Nxloc*Nzloc))
909+
allocate (recvbuf(Ny*Nxloc*Nzloc))
910+
911+
do dest_rank = 0, num_procs_z - 1
912+
do l = 1, Nzloc
913+
do j = 1, Nxloc
914+
do k = 1, Nyloc2
915+
sendbuf(k + (j - 1)*Nyloc2 + (l - 1)*(Nyloc2*Nxloc) + dest_rank*Nyloc2*Nxloc*Nzloc) = data_cmplx_y(j, k + dest_rank*Nyloc2, l)
916+
end do
917+
end do
918+
end do
919+
end do
920+
921+
call MPI_Alltoall(sendbuf, Nyloc2*Nxloc*Nzloc, MPI_C_DOUBLE_COMPLEX, &
922+
recvbuf, Nyloc2*Nxloc*Nzloc, MPI_C_DOUBLE_COMPLEX, MPI_COMM_CART13, ierr)
923+
924+
do src_rank = 0, num_procs_z - 1
925+
do l = 1, Nzloc
926+
do j = 1, Nxloc
927+
do k = 1, Nyloc2
928+
data_cmplx_z(j, k, l + src_rank*Nzloc) = recvbuf(k + (j - 1)*Nyloc2 + (l - 1)*(Nyloc2*Nxloc) + src_rank*Nyloc2*Nxloc*Nzloc)
929+
end do
930+
end do
931+
end do
932+
end do
933+
934+
deallocate (sendbuf)
935+
deallocate (recvbuf)
936+
937+
end subroutine s_mpi_transpose_y2z
938+
867939
impure subroutine s_initialize_modules
868940
! Computation of parameters, allocation procedures, and/or any other tasks
869941
! needed to properly setup the modules
@@ -1029,78 +1101,6 @@ contains
10291101

10301102
end subroutine s_mpi_FFT_fwd
10311103

1032-
subroutine s_mpi_transpose_x2y
1033-
complex(c_double_complex), allocatable :: sendbuf(:), recvbuf(:)
1034-
integer :: dest_rank, src_rank
1035-
integer :: i, j, k, l
1036-
1037-
allocate (sendbuf(Nx*Nyloc*Nzloc))
1038-
allocate (recvbuf(Nx*Nyloc*Nzloc))
1039-
1040-
do dest_rank = 0, num_procs_y - 1
1041-
do l = 1, Nzloc
1042-
do k = 1, Nyloc
1043-
do j = 1, Nxloc
1044-
sendbuf(j + (k - 1)*Nxloc + (l - 1)*Nxloc*Nyloc + dest_rank*Nxloc*Nyloc*Nzloc) = data_cmplx(j + dest_rank*Nxloc, k, l)
1045-
end do
1046-
end do
1047-
end do
1048-
end do
1049-
1050-
call MPI_Alltoall(sendbuf, Nxloc*Nyloc*Nzloc, MPI_DOUBLE_COMPLEX, &
1051-
recvbuf, Nxloc*Nyloc*Nzloc, MPI_DOUBLE_COMPLEX, MPI_COMM_CART12, ierr)
1052-
1053-
do src_rank = 0, num_procs_y - 1
1054-
do l = 1, Nzloc
1055-
do k = 1, Nyloc
1056-
do j = 1, Nxloc
1057-
data_cmplx_y(j, k + src_rank*Nyloc, l) = recvbuf(j + (k - 1)*Nxloc + (l - 1)*Nxloc*Nyloc + src_rank*Nxloc*Nyloc*Nzloc)
1058-
end do
1059-
end do
1060-
end do
1061-
end do
1062-
1063-
deallocate (sendbuf)
1064-
deallocate (recvbuf)
1065-
1066-
end subroutine s_mpi_transpose_x2y
1067-
1068-
subroutine s_mpi_transpose_y2z
1069-
complex(c_double_complex), allocatable :: sendbuf(:), recvbuf(:)
1070-
integer :: dest_rank, src_rank
1071-
integer :: j, k, l
1072-
1073-
allocate (sendbuf(Ny*Nxloc*Nzloc))
1074-
allocate (recvbuf(Ny*Nxloc*Nzloc))
1075-
1076-
do dest_rank = 0, num_procs_z - 1
1077-
do l = 1, Nzloc
1078-
do j = 1, Nxloc
1079-
do k = 1, Nyloc2
1080-
sendbuf(k + (j - 1)*Nyloc2 + (l - 1)*(Nyloc2*Nxloc) + dest_rank*Nyloc2*Nxloc*Nzloc) = data_cmplx_y(j, k + dest_rank*Nyloc2, l)
1081-
end do
1082-
end do
1083-
end do
1084-
end do
1085-
1086-
call MPI_Alltoall(sendbuf, Nyloc2*Nxloc*Nzloc, MPI_DOUBLE_COMPLEX, &
1087-
recvbuf, Nyloc2*Nxloc*Nzloc, MPI_DOUBLE_COMPLEX, MPI_COMM_CART13, ierr)
1088-
1089-
do src_rank = 0, num_procs_z - 1
1090-
do l = 1, Nzloc
1091-
do j = 1, Nxloc
1092-
do k = 1, Nyloc2
1093-
data_cmplx_z(j, k, l + src_rank*Nzloc) = recvbuf(k + (j - 1)*Nyloc2 + (l - 1)*(Nyloc2*Nxloc) + src_rank*Nyloc2*Nxloc*Nzloc)
1094-
end do
1095-
end do
1096-
end do
1097-
end do
1098-
1099-
deallocate (sendbuf)
1100-
deallocate (recvbuf)
1101-
1102-
end subroutine s_mpi_transpose_y2z
1103-
11041104
impure subroutine s_initialize_mpi_domain
11051105
! Initialization of the MPI environment
11061106
call s_mpi_initialize()
@@ -1136,6 +1136,26 @@ contains
11361136
! call s_close_energy_data_file()
11371137
! end if
11381138

1139+
if (fft_wrt) then
1140+
if (c_associated(fwd_plan_x)) call fftw_destroy_plan(fwd_plan_x)
1141+
if (c_associated(fwd_plan_y)) call fftw_destroy_plan(fwd_plan_y)
1142+
if (c_associated(fwd_plan_z)) call fftw_destroy_plan(fwd_plan_z)
1143+
if (allocated(data_in)) deallocate (data_in)
1144+
if (allocated(data_out)) deallocate (data_out)
1145+
if (allocated(data_cmplx)) deallocate (data_cmplx)
1146+
if (allocated(data_cmplx_y)) deallocate (data_cmplx_y)
1147+
if (allocated(data_cmplx_z)) deallocate (data_cmplx_z)
1148+
if (allocated(En_real)) deallocate (En_real)
1149+
if (allocated(En)) deallocate (En)
1150+
call fftw_cleanup()
1151+
end if
1152+
1153+
if (fft_wrt) then
1154+
if (MPI_COMM_CART12 /= MPI_COMM_NULL) call MPI_Comm_free(MPI_COMM_CART12, ierr)
1155+
if (MPI_COMM_CART13 /= MPI_COMM_NULL) call MPI_Comm_free(MPI_COMM_CART13, ierr)
1156+
if (MPI_COMM_CART /= MPI_COMM_NULL) call MPI_Comm_free(MPI_COMM_CART, ierr)
1157+
end if
1158+
11391159
! Deallocation procedures for the modules
11401160
call s_finalize_data_output_module()
11411161
call s_finalize_derived_variables_module()

‎src/simulation/m_riemann_solvers.fpp‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1382,6 +1382,9 @@ contains
13821382
s_P = max(s_L, s_R) + max(c_L, c_R)
13831383
s_M = -s_P
13841384

1385+
s_L = s_M
1386+
s_R = s_P
1387+
13851388
! Low Mach correction
13861389
if (low_Mach == 1) then
13871390
@:compute_low_Mach_correction()

‎tests/09DDCC0C/golden-metadata.txt‎

Lines changed: 150 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)