From fba5d635e48acfbe34c9a8042bd52de52115f26f Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Fri, 12 Sep 2025 15:20:56 -0400 Subject: [PATCH 01/43] Added placeholders for where we will be instantiating the imersed boundaries with moving imersed boundary variables --- src/pre_process/m_global_parameters.fpp | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 0eb0cf6c41..a402a122e0 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -538,6 +538,11 @@ contains patch_ib(i)%model_filepath(:) = dflt_char patch_ib(i)%model_spc = num_ray patch_ib(i)%model_threshold = ray_tracing_threshold + + patch_ib%moving_ibm = 0._wp + patch_ib%x_vel = 0._wp + patch_ib%y_vel = 0._wp + patch_ib%z_vel = 0._wp end do ! Fluids physical parameters From 9f846a7f3af48c40780dd9bdf099f80c1b35681d Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Fri, 12 Sep 2025 15:57:26 -0400 Subject: [PATCH 02/43] Moved levelset to common so that it can be called each step for MIBM --- src/{pre_process => common}/m_compute_levelset.fpp | 0 src/common/m_derived_types.fpp | 5 +++++ src/pre_process/m_checker.fpp | 8 +++++++- src/pre_process/m_global_parameters.fpp | 1 + src/simulation/m_ibm.fpp | 2 ++ 5 files changed, 15 insertions(+), 1 deletion(-) rename src/{pre_process => common}/m_compute_levelset.fpp (100%) diff --git a/src/pre_process/m_compute_levelset.fpp b/src/common/m_compute_levelset.fpp similarity index 100% rename from src/pre_process/m_compute_levelset.fpp rename to src/common/m_compute_levelset.fpp diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 38674af615..27023aab6c 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -318,6 +318,11 @@ module m_derived_types real(wp) :: model_threshold !< !! Threshold to turn on smoothen STL patch. + + !! Patch conditions for moving imersed boundaries + integer :: moving_ibm ! 0 for no moving, 1 for moving, 2 for moving on forced path + real(wp) :: x_vel, y_vel, z_vel + end type ib_patch_parameters !> Derived type annexing the physical parameters (PP) of the fluids. These diff --git a/src/pre_process/m_checker.fpp b/src/pre_process/m_checker.fpp index 0001444584..e8993f657a 100644 --- a/src/pre_process/m_checker.fpp +++ b/src/pre_process/m_checker.fpp @@ -254,6 +254,12 @@ contains "Incompatible BC type for boundary condition patch "//trim(iStr)) end do - end subroutine + end subroutine s_check_bc + + impure subroutine s_check_moving_IBM + + + + end subroutine s__check_moving_IBM end module m_checker diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index a402a122e0..c4f30f45f8 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -539,6 +539,7 @@ contains patch_ib(i)%model_spc = num_ray patch_ib(i)%model_threshold = ray_tracing_threshold + ! Variabes to handle moving imersed boundaries, defaulting to no movement patch_ib%moving_ibm = 0._wp patch_ib%x_vel = 0._wp patch_ib%y_vel = 0._wp diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 4d01608120..c906d35c12 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -22,6 +22,8 @@ module m_ibm use m_constants + use m_compute_levelset + implicit none private :: s_compute_image_points, & From d26caa0326d28d080ab2f8d5e9cf6d5721b6456e Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Mon, 15 Sep 2025 09:41:42 -0400 Subject: [PATCH 03/43] Fixed build issue with post_processing --- CMakeLists.txt | 6 ++++++ src/pre_process/m_checker.fpp | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 0b349eb394..52362c67df 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -328,6 +328,12 @@ macro(HANDLE_SOURCES target useCommon) "${CMAKE_BINARY_DIR}/modules/${target}/*.fpp") if (${useCommon}) file(GLOB common_FPPs CONFIGURE_DEPENDS "${common_DIR}/*.fpp") + + # If we're building post_process, exclude m_compute_levelset.fpp + if("${target}" STREQUAL "post_process") + list(FILTER common_FPPs EXCLUDE REGEX ".*/m_compute_levelset\.fpp$") + endif() + list(APPEND ${target}_FPPs ${common_FPPs}) endif() diff --git a/src/pre_process/m_checker.fpp b/src/pre_process/m_checker.fpp index e8993f657a..f5a2177606 100644 --- a/src/pre_process/m_checker.fpp +++ b/src/pre_process/m_checker.fpp @@ -260,6 +260,6 @@ contains - end subroutine s__check_moving_IBM + end subroutine s_check_moving_IBM end module m_checker From b2a546f4dec68d64455370137a0f76d9eaa6d225 Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Mon, 15 Sep 2025 11:01:36 -0400 Subject: [PATCH 04/43] Updated how velocity is stored --- src/common/m_derived_types.fpp | 2 +- src/pre_process/m_global_parameters.fpp | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 27023aab6c..1a8cf2cadb 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -321,7 +321,7 @@ module m_derived_types !! Patch conditions for moving imersed boundaries integer :: moving_ibm ! 0 for no moving, 1 for moving, 2 for moving on forced path - real(wp) :: x_vel, y_vel, z_vel + real(wp), dimension(1:3) :: vel end type ib_patch_parameters diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index c4f30f45f8..722f1f28f7 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -540,10 +540,10 @@ contains patch_ib(i)%model_threshold = ray_tracing_threshold ! Variabes to handle moving imersed boundaries, defaulting to no movement - patch_ib%moving_ibm = 0._wp - patch_ib%x_vel = 0._wp - patch_ib%y_vel = 0._wp - patch_ib%z_vel = 0._wp + patch_ib(i)%moving_ibm = 0 + patch_ib(i)%vel(1) = 0._wp + patch_ib(i)%vel(2) = 0._wp + patch_ib(i)%vel(3) = 0._wp end do ! Fluids physical parameters From 100a9ebd3ae5c18d76590f57190d4ca02a537a8e Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Mon, 15 Sep 2025 11:28:56 -0400 Subject: [PATCH 05/43] Fixed the toolchain? --- toolchain/mfc/run/case_dicts.py | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index 8378d3044d..aaddb22440 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -112,9 +112,13 @@ def analytic(self): for real_attr, ty in [("geometry", ParamType.INT), ("radius", ParamType.REAL), ("theta", ParamType.REAL), ("slip", ParamType.LOG), ("c", ParamType.REAL), ("p", ParamType.REAL), - ("t", ParamType.REAL), ("m", ParamType.REAL)]: + ("t", ParamType.REAL), ("m", ParamType.REAL), + ("moving_ibm", ParamType.INT)]: PRE_PROCESS[f"patch_ib({ib_id})%{real_attr}"] = ty + for vel_id in range(1, 4): + PRE_PROCESS[f"patch_ib({ib_id})%vel({vel_id})"] = ParamType.REAL + for cmp_id, cmp in enumerate(["x", "y", "z"]): cmp_id += 1 PRE_PROCESS[f'patch_ib({ib_id})%{cmp}_centroid'] = ParamType.REAL From 5164d070d90bc763fe8f2c222c4eaf058578c02a Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Mon, 15 Sep 2025 15:54:48 -0400 Subject: [PATCH 06/43] Pushing from local --- src/simulation/p_main.fpp | 1 + 1 file changed, 1 insertion(+) diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 29cb3b8281..2887d319e3 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -53,6 +53,7 @@ program p_main call nvtxStartRange("INIT-GPU-VARS") call s_initialize_gpu_vars() call nvtxEndRange + print *, patch_ib(1)%moving_ibm, patch_ib(1)%vel(1), patch_ib(1)%vel(2), patch_ib(1)%vel(3) ! Setting the time-step iterator to the first time-step if (cfl_dt) then From 343fcdf0830115d0caabdc6414e5c8e751377e68 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Tue, 16 Sep 2025 19:08:01 -0400 Subject: [PATCH 07/43] Added euler'd method to the patch location --- src/simulation/m_ibm.fpp | 31 +++++++++++++++++++++++++++++++ src/simulation/p_main.fpp | 2 +- 2 files changed, 32 insertions(+), 1 deletion(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index c906d35c12..1cb41ebb66 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -862,6 +862,37 @@ contains end subroutine s_interpolate_image_point + !> Subroutine the updates the moving imersed boundary positions + impure subroutine propagate_mibs() + + integer :: i, j + + ! start by using euler's method naiively, but eventually incorporate more sophistocation + do i = 1, num_ibs + if (patch_ib(i)%moving_ibm .eq. 1) then + ! this continues with euler's method, which is obviously not that great and we need to add acceleration + do j = 1, 3 + patch_ib(i)%vel(j) = patch_ib(i)%vel(j) + 0.0 * dt ! TODO :: ADD EXTERNAL FORCES HERE + end do + + patch_ib(i)%x_centroid = patch_ib(i)%x_centroid + patch_ib(i)%vel(1) * dt + patch_ib(i)%x_centroid = patch_ib(i)%y_centroid + patch_ib(i)%vel(2) * dt + patch_ib(i)%x_centroid = patch_ib(i)%z_centroid + patch_ib(i)%vel(3) * dt + end if + end do + + end subroutine propagate_mibs + + impure subroutine recompute_levelset_norms() + + end subroutine recompute_levelset_norms() + + impure subroutine update_mib() + + + + end subroutine update_mib + !> Subroutine to deallocate memory reserved for the IBM module impure subroutine s_finalize_ibm_module() diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 2887d319e3..bd606b34e9 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -53,7 +53,7 @@ program p_main call nvtxStartRange("INIT-GPU-VARS") call s_initialize_gpu_vars() call nvtxEndRange - print *, patch_ib(1)%moving_ibm, patch_ib(1)%vel(1), patch_ib(1)%vel(2), patch_ib(1)%vel(3) + print *, "Printing mibm conditions:", patch_ib(1)%moving_ibm, patch_ib(1)%vel(1), patch_ib(1)%vel(2), patch_ib(1)%vel(3) ! Setting the time-step iterator to the first time-step if (cfl_dt) then From 49ece487950da55a34287ae67791da4a8daa0aee Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Tue, 16 Sep 2025 19:11:04 -0400 Subject: [PATCH 08/43] Fixed and x vs y issue --- src/simulation/m_ibm.fpp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 1cb41ebb66..a6553185bd 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -876,9 +876,10 @@ contains end do patch_ib(i)%x_centroid = patch_ib(i)%x_centroid + patch_ib(i)%vel(1) * dt - patch_ib(i)%x_centroid = patch_ib(i)%y_centroid + patch_ib(i)%vel(2) * dt - patch_ib(i)%x_centroid = patch_ib(i)%z_centroid + patch_ib(i)%vel(3) * dt + patch_ib(i)%y_centroid = patch_ib(i)%y_centroid + patch_ib(i)%vel(2) * dt + patch_ib(i)%z_centroid = patch_ib(i)%z_centroid + patch_ib(i)%vel(3) * dt end if + end do end subroutine propagate_mibs From c103f626247b07f2a955e32be7b3aa354fc0dc76 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Tue, 16 Sep 2025 19:22:55 -0400 Subject: [PATCH 09/43] Performing first test run --- src/simulation/m_ibm.fpp | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index a6553185bd..63b60c571e 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -863,7 +863,7 @@ contains end subroutine s_interpolate_image_point !> Subroutine the updates the moving imersed boundary positions - impure subroutine propagate_mibs() + impure subroutine s_propagate_mibs() integer :: i, j @@ -882,17 +882,21 @@ contains end do - end subroutine propagate_mibs - - impure subroutine recompute_levelset_norms() - - end subroutine recompute_levelset_norms() - - impure subroutine update_mib() + end subroutine s_propagate_mibs + impure subroutine s_update_mib() + integer :: i + + do i = 1, num_ibs + if (patch_ib(i)%moving_ibm .ne. 0) then + call s_propagate_mibs() ! TODO :: THIS IS DONE TERRIBLY WITH EULER METHOD + call s_apply_domain_patches() ! TODO :: VERIFY THAT I AM ALLOWED TO JUST APPLY THEM LIKE THIS + exit + end if + end do - end subroutine update_mib + end subroutine s_update_mib !> Subroutine to deallocate memory reserved for the IBM module impure subroutine s_finalize_ibm_module() From 1c9211ee46abdf3898240abb441b473466e1dfe3 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Tue, 16 Sep 2025 19:39:42 -0400 Subject: [PATCH 10/43] The apply_pathces subroutine did not work and needs simplification for what is applied each loop. Wrote a seaparate function and working on passing everything in --- src/simulation/m_ibm.fpp | 63 ++++++++++++++++++++++++++++----------- src/simulation/p_main.fpp | 2 ++ 2 files changed, 48 insertions(+), 17 deletions(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 63b60c571e..36f8c5a75d 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -863,36 +863,65 @@ contains end subroutine s_interpolate_image_point !> Subroutine the updates the moving imersed boundary positions - impure subroutine s_propagate_mibs() + impure subroutine s_propagate_mib(patch_id) - integer :: i, j + integer, intent(in) :: patch_id + integer :: i ! start by using euler's method naiively, but eventually incorporate more sophistocation - do i = 1, num_ibs - if (patch_ib(i)%moving_ibm .eq. 1) then - ! this continues with euler's method, which is obviously not that great and we need to add acceleration - do j = 1, 3 - patch_ib(i)%vel(j) = patch_ib(i)%vel(j) + 0.0 * dt ! TODO :: ADD EXTERNAL FORCES HERE - end do + if (patch_ib(patch_id)%moving_ibm .eq. 1) then + ! this continues with euler's method, which is obviously not that great and we need to add acceleration + do i = 1, 3 + patch_ib(patch_id)%vel(i) = patch_ib(patch_id)%vel(i) + 0.0 * dt ! TODO :: ADD EXTERNAL FORCES HERE + end do - patch_ib(i)%x_centroid = patch_ib(i)%x_centroid + patch_ib(i)%vel(1) * dt - patch_ib(i)%y_centroid = patch_ib(i)%y_centroid + patch_ib(i)%vel(2) * dt - patch_ib(i)%z_centroid = patch_ib(i)%z_centroid + patch_ib(i)%vel(3) * dt + patch_ib(patch_id)%x_centroid = patch_ib(patch_id)%x_centroid + patch_ib(patch_id)%vel(1) * dt + patch_ib(patch_id)%y_centroid = patch_ib(patch_id)%y_centroid + patch_ib(patch_id)%vel(2) * dt + patch_ib(patch_id)%z_centroid = patch_ib(patch_id)%z_centroid + patch_ib(patch_id)%vel(3) * dt + end if + + + end subroutine s_propagate_mib + + impure subroutine s_update_levelset_norms(patch_id, ib_markers_sf, q_prim_vf, levelset, levelset_norm) + + integer, intent(in) :: patch_id + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + integer, dimension(:, :, :), intent(inout), optional :: ib_markers_sf + type(levelset_field), intent(inout), optional :: levelset !< Levelset determined by models + type(levelset_norm_field), intent(inout), optional :: levelset_norm !< Levelset_norm determined by models + + if (patch_ib(patch_id)%geometry == 2) then + call s_circle(patch_id, ib_markers_sf, q_prim_vf, ib) + call s_circle_levelset(patch_id, levelset, levelset_norm) + elseif (patch_ib(patch_id)%geometry == 3) then + call s_rectangle(patch_id, ib_markers_sf, q_prim_vf, ib) + call s_rectangle_levelset(patch_id, levelset, levelset_norm) + elseif (patch_ib(patch_id)%geometry == 4) then + call s_airfoil(patch_id, ib_markers_sf, q_prim_vf, ib) + call s_airfoil_levelset(patch_id, levelset, levelset_norm) + ! STL+IBM patch + elseif (patch_ib(patch_id)%geometry == 5) then + call s_model(patch_id, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) end if - end do - end subroutine s_propagate_mibs + end subroutine s_update_levelset_norms + + impure subroutine s_update_mib(num_ibs, ib_markers_sf, q_prim_vf, levelset, levelset_norm) - impure subroutine s_update_mib() + integer, intent(in) :: num_ibs + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + integer, dimension(:, :, :), intent(inout), optional :: ib_markers_sf + type(levelset_field), intent(inout), optional :: levelset + type(levelset_norm_field), intent(inout), optional :: levelset_norm integer :: i do i = 1, num_ibs if (patch_ib(i)%moving_ibm .ne. 0) then - call s_propagate_mibs() ! TODO :: THIS IS DONE TERRIBLY WITH EULER METHOD - call s_apply_domain_patches() ! TODO :: VERIFY THAT I AM ALLOWED TO JUST APPLY THEM LIKE THIS - exit + call s_propagate_mib(i) ! TODO :: THIS IS DONE TERRIBLY WITH EULER METHOD + call s_update_levelset_norms(i, ib_markers_sf, q_prim_vf, levelset, levelset_norm) ! TODO :: VERIFY THAT I AM ALLOWED TO JUST APPLY THEM LIKE THIS end if end do diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index bd606b34e9..a2836eebaf 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -75,6 +75,8 @@ program p_main ! Time-stepping Loop do + call s_update_mib() + if (cfl_dt) then if (mytime >= t_stop) then call s_save_performance_metrics(time_avg, time_final, io_time_avg, & From ee4fdcc148e26fc8e636601892f15d7881441592 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Wed, 17 Sep 2025 11:07:02 -0400 Subject: [PATCH 11/43] Fixed linking of common analytic values --- .../include/1dHardcodedIC.fpp | 0 .../include/2dHardcodedIC.fpp | 0 .../include/3dHardcodedIC.fpp | 0 .../include/ExtrusionHardcodedIC.fpp | 0 src/common/include/case.fpp | 1 + src/{pre_process => common}/m_patches.fpp | 0 src/simulation/p_main.fpp | 2 +- toolchain/mfc/case.py | 15 ++++++++++++--- toolchain/mfc/run/run.py | 2 +- 9 files changed, 15 insertions(+), 5 deletions(-) rename src/{pre_process => common}/include/1dHardcodedIC.fpp (100%) rename src/{pre_process => common}/include/2dHardcodedIC.fpp (100%) rename src/{pre_process => common}/include/3dHardcodedIC.fpp (100%) rename src/{pre_process => common}/include/ExtrusionHardcodedIC.fpp (100%) rename src/{pre_process => common}/m_patches.fpp (100%) diff --git a/src/pre_process/include/1dHardcodedIC.fpp b/src/common/include/1dHardcodedIC.fpp similarity index 100% rename from src/pre_process/include/1dHardcodedIC.fpp rename to src/common/include/1dHardcodedIC.fpp diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/common/include/2dHardcodedIC.fpp similarity index 100% rename from src/pre_process/include/2dHardcodedIC.fpp rename to src/common/include/2dHardcodedIC.fpp diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/common/include/3dHardcodedIC.fpp similarity index 100% rename from src/pre_process/include/3dHardcodedIC.fpp rename to src/common/include/3dHardcodedIC.fpp diff --git a/src/pre_process/include/ExtrusionHardcodedIC.fpp b/src/common/include/ExtrusionHardcodedIC.fpp similarity index 100% rename from src/pre_process/include/ExtrusionHardcodedIC.fpp rename to src/common/include/ExtrusionHardcodedIC.fpp diff --git a/src/common/include/case.fpp b/src/common/include/case.fpp index ad2e0b1a94..84d1d2cc14 100644 --- a/src/common/include/case.fpp +++ b/src/common/include/case.fpp @@ -4,4 +4,5 @@ ! For pre-process. #:def analytical() + #:enddef diff --git a/src/pre_process/m_patches.fpp b/src/common/m_patches.fpp similarity index 100% rename from src/pre_process/m_patches.fpp rename to src/common/m_patches.fpp diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index a2836eebaf..4c088b496b 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -75,7 +75,7 @@ program p_main ! Time-stepping Loop do - call s_update_mib() + call s_update_mib(num_ibs, ib_markers%sf, q_prim_vf, levelset, levelset_norm) if (cfl_dt) then if (mytime >= t_stop) then diff --git a/toolchain/mfc/case.py b/toolchain/mfc/case.py index 836811eefa..0aa4f6220e 100644 --- a/toolchain/mfc/case.py +++ b/toolchain/mfc/case.py @@ -7,6 +7,8 @@ from .state import ARG from .run import case_dicts +import pprint + QPVF_IDX_VARS = { 'alpha_rho': 'contxb', 'vel' : 'momxb', 'pres': 'E_idx', 'alpha': 'advxb', 'tau_e': 'stress_idx%beg', 'Y': 'chemxb', @@ -234,7 +236,7 @@ def __get_sim_fpp(self, print: bool) -> str: igr_pres_lim = 1 if self.params.get("igr_pres_lim", 'F') == 'T' else 0 # Throw error if wenoz_q is required but not set - return f"""\ + out = f"""\ #:set MFC_CASE_OPTIMIZATION = {ARG("case_optimization")} #:set recon_type = {recon_type} #:set weno_order = {weno_order} @@ -262,11 +264,14 @@ def __get_sim_fpp(self, print: bool) -> str: #:set viscous = {viscous} """ - return """\ + else: + out = """\ ! This file is purposefully empty. It is only important for builds that make use ! of --case-optimization. """ + return out + f"\n{self.__get_pre_fpp(print)}" + def get_fpp(self, target, print = True) -> str: def _prepend() -> str: return f"""\ @@ -277,10 +282,14 @@ def _default(_) -> str: return "! This file is purposefully empty." result = { - "pre_process" : self.__get_pre_fpp, + "pre_process" : self.__get_pre_fpp, "simulation" : self.__get_sim_fpp, }.get(build.get_target(target).name, _default)(print) + pprint.pprint(build.get_target(target).name) + if build.get_target(target).name == 'common': + raise 0 + return _prepend() + result def __getitem__(self, key: str) -> str: diff --git a/toolchain/mfc/run/run.py b/toolchain/mfc/run/run.py index fb7d528ff9..687e8034ea 100644 --- a/toolchain/mfc/run/run.py +++ b/toolchain/mfc/run/run.py @@ -136,7 +136,7 @@ def __execute_job_script(qsystem: queues.QueueSystem): def run(targets = None, case = None): targets = get_targets(list(REQUIRED_TARGETS) + (targets or ARG("targets"))) case = case or input.load(ARG("input"), ARG("--")) - + build(targets) cons.print("[bold]Run[/bold]") From 819013b66b777877756f31956564bfcaa17dc776 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Wed, 17 Sep 2025 17:17:14 -0400 Subject: [PATCH 12/43] It looks like the icpp patch definitions must be seaparated from the ib patch definitions. This is a precommit before I start separating the two files --- .vscode/settings.json | 2 +- src/{pre_process => common}/m_model.fpp | 0 src/pre_process/m_icpp_patches.fpp | 2308 +++++++++++++++++++++++ toolchain/mfc/case.py | 6 +- 4 files changed, 2311 insertions(+), 5 deletions(-) rename src/{pre_process => common}/m_model.fpp (100%) create mode 100644 src/pre_process/m_icpp_patches.fpp diff --git a/.vscode/settings.json b/.vscode/settings.json index ab9cd6f770..5c880f8ded 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -49,7 +49,7 @@ // Enable ONLY fortls language server "fortran.enableLanguageServer": true, "fortran.languageServer": "fortls", - "fortran.fortls.disabled": false, + "fortran.fortls.disabled": true, "fortran.fortls.path": "fortls", // Try to disable any built-in language features diff --git a/src/pre_process/m_model.fpp b/src/common/m_model.fpp similarity index 100% rename from src/pre_process/m_model.fpp rename to src/common/m_model.fpp diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp new file mode 100644 index 0000000000..071a34d996 --- /dev/null +++ b/src/pre_process/m_icpp_patches.fpp @@ -0,0 +1,2308 @@ +!> +!! @file m_patches.fpp +!! @brief Contains module m_patches + +#:include 'case.fpp' +#:include 'ExtrusionHardcodedIC.fpp' +#:include '1dHardcodedIC.fpp' +#:include '2dHardcodedIC.fpp' +#:include '3dHardcodedIC.fpp' +#:include 'macros.fpp' + +module m_patches + + use m_model ! Subroutine(s) related to STL files + + use m_derived_types ! Definitions of the derived types + + use m_global_parameters !< Definitions of the global parameters + + use m_helper_basic !< Functions to compare floating point numbers + + use m_helper + + use m_compute_levelset ! Subroutines to calculate levelsets for IBs + + use m_mpi_common + + use m_assign_variables + + use m_mpi_common + + implicit none + + private; public :: s_apply_domain_patches + + real(wp) :: x_centroid, y_centroid, z_centroid + real(wp) :: length_x, length_y, length_z + + integer :: smooth_patch_id + real(wp) :: smooth_coeff !< + !! These variables are analogous in both meaning and use to the similarly + !! named components in the ic_patch_parameters type (see m_derived_types.f90 + !! for additional details). They are employed as a means to more concisely + !! perform the actions necessary to lay out a particular patch on the grid. + + real(wp) :: eta !< + !! In the case that smoothing of patch boundaries is enabled and the boundary + !! between two adjacent patches is to be smeared out, this variable's purpose + !! is to act as a pseudo volume fraction to indicate the contribution of each + !! patch toward the composition of a cell's fluid state. + + real(wp) :: cart_x, cart_y, cart_z + real(wp) :: sph_phi !< + !! Variables to be used to hold cell locations in Cartesian coordinates if + !! 3D simulation is using cylindrical coordinates + + type(bounds_info) :: x_boundary, y_boundary, z_boundary !< + !! These variables combine the centroid and length parameters associated with + !! a particular patch to yield the locations of the patch boundaries in the + !! x-, y- and z-coordinate directions. They are used as a means to concisely + !! perform the actions necessary to lay out a particular patch on the grid. + + character(len=5) :: istr ! string to store int to string result for error checking + +contains + + impure subroutine s_apply_domain_patches(patch_id_fp, q_prim_vf, ib_markers_sf, levelset, levelset_norm) + + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + integer, dimension(0:m, 0:m, 0:m), intent(inout) :: patch_id_fp + integer, dimension(:, :, :), intent(inout), optional :: ib_markers_sf + type(levelset_field), intent(inout), optional :: levelset !< Levelset determined by models + type(levelset_norm_field), intent(inout), optional :: levelset_norm !< Levelset_norm determined by models + + integer :: i + + ! 3D Patch Geometries + if (p > 0) then + + do i = 1, num_patches + + if (proc_rank == 0) then + print *, 'Processing patch', i + end if + + !> ICPP Patches + !> @{ + ! Spherical patch + if (patch_icpp(i)%geometry == 8) then + call s_sphere(i, patch_id_fp, q_prim_vf) + ! Cuboidal patch + elseif (patch_icpp(i)%geometry == 9) then + call s_cuboid(i, patch_id_fp, q_prim_vf) + ! Cylindrical patch + elseif (patch_icpp(i)%geometry == 10) then + call s_cylinder(i, patch_id_fp, q_prim_vf) + ! Swept plane patch + elseif (patch_icpp(i)%geometry == 11) then + call s_sweep_plane(i, patch_id_fp, q_prim_vf) + ! Ellipsoidal patch + elseif (patch_icpp(i)%geometry == 12) then + call s_ellipsoid(i, patch_id_fp, q_prim_vf) + ! Spherical harmonic patch + elseif (patch_icpp(i)%geometry == 14) then + call s_spherical_harmonic(i, patch_id_fp, q_prim_vf) + ! 3D Modified circular patch + elseif (patch_icpp(i)%geometry == 19) then + call s_3dvarcircle(i, patch_id_fp, q_prim_vf) + ! 3D STL patch + elseif (patch_icpp(i)%geometry == 21) then + call s_model(i, patch_id_fp, q_prim_vf) + end if + end do + !> @} + + !> IB Patches + !> @{ + ! Spherical patch + do i = 1, num_ibs + if (proc_rank == 0) then + print *, 'Processing 3D ib patch ', i + end if + + if (patch_ib(i)%geometry == 8) then + call s_sphere(i, ib_markers_sf, q_prim_vf, ib) + call s_sphere_levelset(i, levelset, levelset_norm) + elseif (patch_ib(i)%geometry == 9) then + call s_cuboid(i, ib_markers_sf, q_prim_vf, ib) + call s_cuboid_levelset(i, levelset, levelset_norm) + elseif (patch_ib(i)%geometry == 10) then + call s_cylinder(i, ib_markers_sf, q_prim_vf, ib) + call s_cylinder_levelset(i, levelset, levelset_norm) + elseif (patch_ib(i)%geometry == 11) then + call s_3D_airfoil(i, ib_markers_sf, q_prim_vf, ib) + call s_3D_airfoil_levelset(i, levelset, levelset_norm) + ! STL+IBM patch + elseif (patch_ib(i)%geometry == 12) then + call s_model(i, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) + end if + end do + !> @} + + ! 2D Patch Geometries + elseif (n > 0) then + + do i = 1, num_patches + + if (proc_rank == 0) then + print *, 'Processing patch', i + end if + + !> ICPP Patches + !> @{ + ! Circular patch + if (patch_icpp(i)%geometry == 2) then + call s_circle(i, patch_id_fp, q_prim_vf) + ! Rectangular patch + elseif (patch_icpp(i)%geometry == 3) then + call s_rectangle(i, patch_id_fp, q_prim_vf) + ! Swept line patch + elseif (patch_icpp(i)%geometry == 4) then + call s_sweep_line(i, patch_id_fp, q_prim_vf) + ! Elliptical patch + elseif (patch_icpp(i)%geometry == 5) then + call s_ellipse(i, patch_id_fp, q_prim_vf) + ! Unimplemented patch (formerly isentropic vortex) + elseif (patch_icpp(i)%geometry == 6) then + call s_mpi_abort('This used to be the isentropic vortex patch, '// & + 'which no longer exists. See Examples. Exiting.') + ! Spherical Harmonic Patch + elseif (patch_icpp(i)%geometry == 14) then + call s_spherical_harmonic(i, patch_id_fp, q_prim_vf) + ! Spiral patch + elseif (patch_icpp(i)%geometry == 17) then + call s_spiral(i, patch_id_fp, q_prim_vf) + ! Modified circular patch + elseif (patch_icpp(i)%geometry == 18) then + call s_varcircle(i, patch_id_fp, q_prim_vf) + ! TaylorGreen vortex patch + elseif (patch_icpp(i)%geometry == 20) then + call s_2D_TaylorGreen_vortex(i, patch_id_fp, q_prim_vf) + ! STL patch + elseif (patch_icpp(i)%geometry == 21) then + call s_model(i, patch_id_fp, q_prim_vf) + end if + !> @} + end do + + !> IB Patches + !> @{ + do i = 1, num_ibs + if (proc_rank == 0) then + print *, 'Processing 2D ib patch ', i + end if + if (patch_ib(i)%geometry == 2) then + call s_circle(i, ib_markers_sf, q_prim_vf, ib) + call s_circle_levelset(i, levelset, levelset_norm) + elseif (patch_ib(i)%geometry == 3) then + call s_rectangle(i, ib_markers_sf, q_prim_vf, ib) + call s_rectangle_levelset(i, levelset, levelset_norm) + elseif (patch_ib(i)%geometry == 4) then + call s_airfoil(i, ib_markers_sf, q_prim_vf, ib) + call s_airfoil_levelset(i, levelset, levelset_norm) + ! STL+IBM patch + elseif (patch_ib(i)%geometry == 5) then + call s_model(i, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) + end if + end do + !> @} + + ! 1D Patch Geometries + else + + do i = 1, num_patches + + if (proc_rank == 0) then + print *, 'Processing patch', i + end if + + ! Line segment patch + if (patch_icpp(i)%geometry == 1) then + call s_line_segment(i, patch_id_fp, q_prim_vf) + ! 1d analytical + elseif (patch_icpp(i)%geometry == 16) then + call s_1d_bubble_pulse(i, patch_id_fp, q_prim_vf) + end if + end do + + end if + + end subroutine s_apply_domain_patches + + !> The line segment patch is a 1D geometry that may be used, + !! for example, in creating a Riemann problem. The geometry + !! of the patch is well-defined when its centroid and length + !! in the x-coordinate direction are provided. Note that the + !! line segment patch DOES NOT allow for the smearing of its + !! boundaries. + !! @param patch_id patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + subroutine s_line_segment(patch_id, patch_id_fp, q_prim_vf) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + ! Generic loop iterators + integer :: i, j, k + + ! Placeholders for the cell boundary values + real(wp) :: pi_inf, gamma, lit_gamma + @:HardcodedDimensionsExtrusion() + @:Hardcoded1DVariables() + + pi_inf = fluid_pp(1)%pi_inf + gamma = fluid_pp(1)%gamma + lit_gamma = (1._wp + gamma)/gamma + j = 0 + k = 0 + + ! Transferring the line segment's centroid and length information + x_centroid = patch_icpp(patch_id)%x_centroid + length_x = patch_icpp(patch_id)%length_x + + ! Computing the beginning and end x-coordinates of the line segment + ! based on its centroid and length + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + + ! Since the line segment patch does not allow for its boundaries to + ! be smoothed out, the pseudo volume fraction is set to 1 to ensure + ! that only the current patch contributes to the fluid state in the + ! cells that this patch covers. + eta = 1._wp + + ! Checking whether the line segment covers a particular cell in the + ! domain and verifying whether the current patch has the permission + ! to write to that cell. If both queries check out, the primitive + ! variables of the current patch are assigned to this cell. + do i = 0, m + if (x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i) .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, 0, 0))) then + + call s_assign_patch_primitive_variables(patch_id, i, 0, 0, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + + ! check if this should load a hardcoded patch + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded1D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, 0, 0) = patch_id + + end if + end do + @:HardcodedDellacation() + + end subroutine s_line_segment + + !> The spiral patch is a 2D geometry that may be used, The geometry + !! of the patch is well-defined when its centroid and radius + !! are provided. Note that the circular patch DOES allow for + !! the smoothing of its boundary. + !! @param patch_id patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + impure subroutine s_spiral(patch_id, patch_id_fp, q_prim_vf) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + integer :: i, j, k !< Generic loop iterators + real(wp) :: th, thickness, nturns, mya + real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max + @:HardcodedDimensionsExtrusion() + @:Hardcoded2DVariables() + + ! Transferring the circular patch's radius, centroid, smearing patch + ! identity and smearing coefficient information + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + mya = patch_icpp(patch_id)%radius + thickness = patch_icpp(patch_id)%length_x + nturns = patch_icpp(patch_id)%length_y + + ! + logic_grid = 0 + do k = 0, int(m*91*nturns) + th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi + + spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), & + f_r(th, thickness, mya)*cos(th)/)) + spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), & + f_r(th, thickness, mya)*sin(th)/)) + + spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), & + f_r(th, thickness, mya)*cos(th)/)) + spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), & + f_r(th, thickness, mya)*sin(th)/)) + + do j = 0, n; do i = 0, m; + if ((x_cc(i) > spiral_x_min) .and. (x_cc(i) < spiral_x_max) .and. & + (y_cc(j) > spiral_y_min) .and. (y_cc(j) < spiral_y_max)) then + logic_grid(i, j, 0) = 1 + end if + end do; end do + end do + + do j = 0, n + do i = 0, m + if ((logic_grid(i, j, 0) == 1)) then + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded2D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id + end if + end do + end do + @:HardcodedDellacation() + + end subroutine s_spiral + + !> The circular patch is a 2D geometry that may be used, for + !! example, in creating a bubble or a droplet. The geometry + !! of the patch is well-defined when its centroid and radius + !! are provided. Note that the circular patch DOES allow for + !! the smoothing of its boundary. + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + !! @param ib True if this patch is an immersed boundary + subroutine s_circle(patch_id, patch_id_fp, q_prim_vf, ib_flag) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + logical, optional, intent(in) :: ib_flag + + real(wp) :: radius + + integer :: i, j, k !< Generic loop iterators + @:HardcodedDimensionsExtrusion() + @:Hardcoded2DVariables() + + ! Transferring the circular patch's radius, centroid, smearing patch + ! identity and smearing coefficient information + + if (present(ib_flag)) then + x_centroid = patch_ib(patch_id)%x_centroid + y_centroid = patch_ib(patch_id)%y_centroid + radius = patch_ib(patch_id)%radius + else + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + radius = patch_icpp(patch_id)%radius + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff + end if + + ! Initializing the pseudo volume fraction value to 1. The value will + ! be modified as the patch is laid out on the grid, but only in the + ! case that smoothing of the circular patch's boundary is enabled. + eta = 1._wp + + ! Checking whether the circle covers a particular cell in the domain + ! and verifying whether the current patch has permission to write to + ! that cell. If both queries check out, the primitive variables of + ! the current patch are assigned to this cell. + + do j = 0, n + do i = 0, m + + if (.not. present(ib_flag) .and. patch_icpp(patch_id)%smoothen) then + + eta = tanh(smooth_coeff/min(dx, dy)* & + (sqrt((x_cc(i) - x_centroid)**2 & + + (y_cc(j) - y_centroid)**2) & + - radius))*(-0.5_wp) + 0.5_wp + + end if + + if (present(ib_flag) .and. ((x_cc(i) - x_centroid)**2 & + + (y_cc(j) - y_centroid)**2 <= radius**2)) & + then + + patch_id_fp(i, j, 0) = patch_id + else + if (((x_cc(i) - x_centroid)**2 & + + (y_cc(j) - y_centroid)**2 <= radius**2 & + .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & + .or. & + (.not. present(ib_flag) .and. patch_id_fp(i, j, 0) == smooth_patch_id)) & + then + + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded2D() + end if + + end if + end if + end do + end do + @:HardcodedDellacation() + + end subroutine s_circle + + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + !! @param ib True if this patch is an immersed boundary + subroutine s_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + logical, optional, intent(in) :: ib_flag + + real(wp) :: x0, y0, f, x_act, y_act, ca_in, pa, ma, ta, theta + real(wp) :: xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c + integer :: i, j, k + integer :: Np1, Np2 + + if (.not. present(ib_flag)) return + x0 = patch_ib(patch_id)%x_centroid + y0 = patch_ib(patch_id)%y_centroid + ca_in = patch_ib(patch_id)%c + pa = patch_ib(patch_id)%p + ma = patch_ib(patch_id)%m + ta = patch_ib(patch_id)%t + theta = pi*patch_ib(patch_id)%theta/180._wp + + Np1 = int((pa*ca_in/dx)*20) + Np2 = int(((ca_in - pa*ca_in)/dx)*20) + Np = Np1 + Np2 + 1 + + allocate (airfoil_grid_u(1:Np)) + allocate (airfoil_grid_l(1:Np)) + + airfoil_grid_u(1)%x = x0 + airfoil_grid_u(1)%y = y0 + + airfoil_grid_l(1)%x = x0 + airfoil_grid_l(1)%y = y0 + + eta = 1._wp + + do i = 1, Np1 + Np2 - 1 + if (i <= Np1) then + xc = x0 + i*(pa*ca_in/Np1) + xa = (xc - x0)/ca_in + yc = (ma/pa**2)*(2*pa*xa - xa**2) + dycdxc = (2*ma/pa**2)*(pa - xa) + else + xc = x0 + pa*ca_in + (i - Np1)*((ca_in - pa*ca_in)/Np2) + xa = (xc - x0)/ca_in + yc = (ma/(1 - pa)**2)*(1 - 2*pa + 2*pa*xa - xa**2) + dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) + end if + + yt = (5._wp*ta)*(0.2969_wp*xa**0.5_wp - 0.126_wp*xa - 0.3516_wp*xa**2._wp + 0.2843_wp*xa**3 - 0.1015_wp*xa**4) + sin_c = dycdxc/(1 + dycdxc**2)**0.5_wp + cos_c = 1/(1 + dycdxc**2)**0.5_wp + + xu = xa - yt*sin_c + yu = yc + yt*cos_c + + xl = xa + yt*sin_c + yl = yc - yt*cos_c + + xu = xu*ca_in + x0 + yu = yu*ca_in + y0 + + xl = xl*ca_in + x0 + yl = yl*ca_in + y0 + + airfoil_grid_u(i + 1)%x = xu + airfoil_grid_u(i + 1)%y = yu + + airfoil_grid_l(i + 1)%x = xl + airfoil_grid_l(i + 1)%y = yl + + end do + + airfoil_grid_u(Np)%x = x0 + ca_in + airfoil_grid_u(Np)%y = y0 + + airfoil_grid_l(Np)%x = x0 + ca_in + airfoil_grid_l(Np)%y = y0 + + do j = 0, n + do i = 0, m + + if (.not. f_is_default(patch_ib(patch_id)%theta)) then + x_act = (x_cc(i) - x0)*cos(theta) - (y_cc(j) - y0)*sin(theta) + x0 + y_act = (x_cc(i) - x0)*sin(theta) + (y_cc(j) - y0)*cos(theta) + y0 + else + x_act = x_cc(i) + y_act = y_cc(j) + end if + + if (x_act >= x0 .and. x_act <= x0 + ca_in) then + xa = (x_act - x0)/ca_in + if (xa <= pa) then + yc = (ma/pa**2)*(2*pa*xa - xa**2) + dycdxc = (2*ma/pa**2)*(pa - xa) + else + yc = (ma/(1 - pa)**2)*(1 - 2*pa + 2*pa*xa - xa**2) + dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) + end if + if (y_act >= y0) then + k = 1 + do while (airfoil_grid_u(k)%x < x_act) + k = k + 1 + end do + if (f_approx_equal(airfoil_grid_u(k)%x, x_act)) then + if (y_act <= airfoil_grid_u(k)%y) then + !!IB + !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + !eta, q_prim_vf, patch_id_fp) + patch_id_fp(i, j, 0) = patch_id + end if + else + f = (airfoil_grid_u(k)%x - x_act)/(airfoil_grid_u(k)%x - airfoil_grid_u(k - 1)%x) + if (y_act <= ((1._wp - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then + !!IB + !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + !eta, q_prim_vf, patch_id_fp) + patch_id_fp(i, j, 0) = patch_id + end if + end if + else + k = 1 + do while (airfoil_grid_l(k)%x < x_act) + k = k + 1 + end do + if (f_approx_equal(airfoil_grid_l(k)%x, x_act)) then + if (y_act >= airfoil_grid_l(k)%y) then + !!IB + !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + !eta, q_prim_vf, patch_id_fp) + patch_id_fp(i, j, 0) = patch_id + end if + else + f = (airfoil_grid_l(k)%x - x_act)/(airfoil_grid_l(k)%x - airfoil_grid_l(k - 1)%x) + + if (y_act >= ((1._wp - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then + !!IB + !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + !eta, q_prim_vf, patch_id_fp) + patch_id_fp(i, j, 0) = patch_id + end if + end if + end if + end if + end do + end do + + if (.not. f_is_default(patch_ib(patch_id)%theta)) then + do i = 1, Np + airfoil_grid_l(i)%x = (airfoil_grid_l(i)%x - x0)*cos(theta) + (airfoil_grid_l(i)%y - y0)*sin(theta) + x0 + airfoil_grid_l(i)%y = -1._wp*(airfoil_grid_l(i)%x - x0)*sin(theta) + (airfoil_grid_l(i)%y - y0)*cos(theta) + y0 + + airfoil_grid_u(i)%x = (airfoil_grid_u(i)%x - x0)*cos(theta) + (airfoil_grid_u(i)%y - y0)*sin(theta) + x0 + airfoil_grid_u(i)%y = -1._wp*(airfoil_grid_u(i)%x - x0)*sin(theta) + (airfoil_grid_u(i)%y - y0)*cos(theta) + y0 + end do + end if + + end subroutine s_airfoil + + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + !! @param ib True if this patch is an immersed boundary + subroutine s_3D_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + logical, optional, intent(in) :: ib_flag + + real(wp) :: x0, y0, z0, lz, z_max, z_min, f, x_act, y_act, ca_in, pa, ma, ta, theta, xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c + integer :: i, j, k, l + integer :: Np1, Np2 + + if (.not. present(ib_flag)) return + x0 = patch_ib(patch_id)%x_centroid + y0 = patch_ib(patch_id)%y_centroid + z0 = patch_ib(patch_id)%z_centroid + lz = patch_ib(patch_id)%length_z + ca_in = patch_ib(patch_id)%c + pa = patch_ib(patch_id)%p + ma = patch_ib(patch_id)%m + ta = patch_ib(patch_id)%t + theta = pi*patch_ib(patch_id)%theta/180._wp + + Np1 = int((pa*ca_in/dx)*20) + Np2 = int(((ca_in - pa*ca_in)/dx)*20) + Np = Np1 + Np2 + 1 + + allocate (airfoil_grid_u(1:Np)) + allocate (airfoil_grid_l(1:Np)) + + airfoil_grid_u(1)%x = x0 + airfoil_grid_u(1)%y = y0 + + airfoil_grid_l(1)%x = x0 + airfoil_grid_l(1)%y = y0 + + z_max = z0 + lz/2 + z_min = z0 - lz/2 + + eta = 1._wp + + do i = 1, Np1 + Np2 - 1 + if (i <= Np1) then + xc = x0 + i*(pa*ca_in/Np1) + xa = (xc - x0)/ca_in + yc = (ma/pa**2)*(2*pa*xa - xa**2) + dycdxc = (2*ma/pa**2)*(pa - xa) + else + xc = x0 + pa*ca_in + (i - Np1)*((ca_in - pa*ca_in)/Np2) + xa = (xc - x0)/ca_in + yc = (ma/(1 - pa)**2)*(1 - 2*pa + 2*pa*xa - xa**2) + dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) + end if + + yt = (5._wp*ta)*(0.2969_wp*xa**0.5_wp - 0.126_wp*xa - 0.3516_wp*xa**2._wp + 0.2843_wp*xa**3 - 0.1015_wp*xa**4) + sin_c = dycdxc/(1 + dycdxc**2)**0.5_wp + cos_c = 1/(1 + dycdxc**2)**0.5_wp + + xu = xa - yt*sin_c + yu = yc + yt*cos_c + + xl = xa + yt*sin_c + yl = yc - yt*cos_c + + xu = xu*ca_in + x0 + yu = yu*ca_in + y0 + + xl = xl*ca_in + x0 + yl = yl*ca_in + y0 + + airfoil_grid_u(i + 1)%x = xu + airfoil_grid_u(i + 1)%y = yu + + airfoil_grid_l(i + 1)%x = xl + airfoil_grid_l(i + 1)%y = yl + + end do + + airfoil_grid_u(Np)%x = x0 + ca_in + airfoil_grid_u(Np)%y = y0 + + airfoil_grid_l(Np)%x = x0 + ca_in + airfoil_grid_l(Np)%y = y0 + + do l = 0, p + if (z_cc(l) >= z_min .and. z_cc(l) <= z_max) then + do j = 0, n + do i = 0, m + + if (.not. f_is_default(patch_ib(patch_id)%theta)) then + x_act = (x_cc(i) - x0)*cos(theta) - (y_cc(j) - y0)*sin(theta) + x0 + y_act = (x_cc(i) - x0)*sin(theta) + (y_cc(j) - y0)*cos(theta) + y0 + else + x_act = x_cc(i) + y_act = y_cc(j) + end if + + if (x_act >= x0 .and. x_act <= x0 + ca_in) then + xa = (x_act - x0)/ca_in + if (xa <= pa) then + yc = (ma/pa**2)*(2*pa*xa - xa**2) + dycdxc = (2*ma/pa**2)*(pa - xa) + else + yc = (ma/(1 - pa)**2)*(1 - 2*pa + 2*pa*xa - xa**2) + dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) + end if + if (y_act >= y0) then + k = 1 + do while (airfoil_grid_u(k)%x < x_act) + k = k + 1 + end do + if (f_approx_equal(airfoil_grid_u(k)%x, x_act)) then + if (y_act <= airfoil_grid_u(k)%y) then + !!IB + !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + !eta, q_prim_vf, patch_id_fp) + patch_id_fp(i, j, l) = patch_id + end if + else + f = (airfoil_grid_u(k)%x - x_act)/(airfoil_grid_u(k)%x - airfoil_grid_u(k - 1)%x) + if (y_act <= ((1._wp - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then + !!IB + !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + !eta, q_prim_vf, patch_id_fp) + patch_id_fp(i, j, l) = patch_id + end if + end if + else + k = 1 + do while (airfoil_grid_l(k)%x < x_act) + k = k + 1 + end do + if (f_approx_equal(airfoil_grid_l(k)%x, x_act)) then + if (y_act >= airfoil_grid_l(k)%y) then + !!IB + !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + !eta, q_prim_vf, patch_id_fp) + patch_id_fp(i, j, l) = patch_id + end if + else + f = (airfoil_grid_l(k)%x - x_act)/(airfoil_grid_l(k)%x - airfoil_grid_l(k - 1)%x) + + if (y_act >= ((1._wp - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then + !!IB + !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + !eta, q_prim_vf, patch_id_fp) + patch_id_fp(i, j, l) = patch_id + end if + end if + end if + end if + end do + end do + end if + end do + + if (.not. f_is_default(patch_ib(patch_id)%theta)) then + do i = 1, Np + airfoil_grid_l(i)%x = (airfoil_grid_l(i)%x - x0)*cos(theta) + (airfoil_grid_l(i)%y - y0)*sin(theta) + x0 + airfoil_grid_l(i)%y = -1._wp*(airfoil_grid_l(i)%x - x0)*sin(theta) + (airfoil_grid_l(i)%y - y0)*cos(theta) + y0 + + airfoil_grid_u(i)%x = (airfoil_grid_u(i)%x - x0)*cos(theta) + (airfoil_grid_u(i)%y - y0)*sin(theta) + x0 + airfoil_grid_u(i)%y = -1._wp*(airfoil_grid_u(i)%x - x0)*sin(theta) + (airfoil_grid_u(i)%y - y0)*cos(theta) + y0 + end do + end if + + end subroutine s_3D_airfoil + + !> The varcircle patch is a 2D geometry that may be used + !! . It generatres an annulus + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + subroutine s_varcircle(patch_id, patch_id_fp, q_prim_vf) + + ! Patch identifier + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + ! Generic loop iterators + integer :: i, j, k + real(wp) :: radius, myr, thickness + @:HardcodedDimensionsExtrusion() + @:Hardcoded2DVariables() + + ! Transferring the circular patch's radius, centroid, smearing patch + ! identity and smearing coefficient information + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + radius = patch_icpp(patch_id)%radius + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff + thickness = patch_icpp(patch_id)%epsilon + + ! Initializing the pseudo volume fraction value to 1. The value will + ! be modified as the patch is laid out on the grid, but only in the + ! case that smoothing of the circular patch's boundary is enabled. + eta = 1._wp + + ! Checking whether the circle covers a particular cell in the domain + ! and verifying whether the current patch has permission to write to + ! that cell. If both queries check out, the primitive variables of + ! the current patch are assigned to this cell. + do j = 0, n + do i = 0, m + myr = sqrt((x_cc(i) - x_centroid)**2 & + + (y_cc(j) - y_centroid)**2) + + if (myr <= radius + thickness/2._wp .and. & + myr >= radius - thickness/2._wp .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then + + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded2D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id + + q_prim_vf(alf_idx)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1)* & + exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) + end if + + end do + end do + @:HardcodedDellacation() + + end subroutine s_varcircle + + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + subroutine s_3dvarcircle(patch_id, patch_id_fp, q_prim_vf) + + ! Patch identifier + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + ! Generic loop iterators + integer :: i, j, k + real(wp) :: radius, myr, thickness + @:HardcodedDimensionsExtrusion() + @:Hardcoded3DVariables() + + ! Transferring the circular patch's radius, centroid, smearing patch + ! identity and smearing coefficient information + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + z_centroid = patch_icpp(patch_id)%z_centroid + length_z = patch_icpp(patch_id)%length_z + radius = patch_icpp(patch_id)%radius + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff + thickness = patch_icpp(patch_id)%epsilon + + ! Initializing the pseudo volume fraction value to 1. The value will + ! be modified as the patch is laid out on the grid, but only in the + ! case that smoothing of the circular patch's boundary is enabled. + eta = 1._wp + + ! write for all z + + ! Checking whether the circle covers a particular cell in the domain + ! and verifying whether the current patch has permission to write to + ! that cell. If both queries check out, the primitive variables of + ! the current patch are assigned to this cell. + do k = 0, p + do j = 0, n + do i = 0, m + myr = sqrt((x_cc(i) - x_centroid)**2 & + + (y_cc(j) - y_centroid)**2) + + if (myr <= radius + thickness/2._wp .and. & + myr >= radius - thickness/2._wp .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then + + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded3D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id + + q_prim_vf(alf_idx)%sf(i, j, k) = patch_icpp(patch_id)%alpha(1)* & + exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) + end if + + end do + end do + end do + @:HardcodedDellacation() + + end subroutine s_3dvarcircle + + !> The elliptical patch is a 2D geometry. The geometry of + !! the patch is well-defined when its centroid and radii + !! are provided. Note that the elliptical patch DOES allow + !! for the smoothing of its boundary + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + subroutine s_ellipse(patch_id, patch_id_fp, q_prim_vf) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + integer :: i, j, k !< Generic loop operators + real(wp) :: a, b + @:HardcodedDimensionsExtrusion() + @:Hardcoded2DVariables() + + ! Transferring the elliptical patch's radii, centroid, smearing + ! patch identity, and smearing coefficient information + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + a = patch_icpp(patch_id)%radii(1) + b = patch_icpp(patch_id)%radii(2) + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff + + ! Initializing the pseudo volume fraction value to 1. The value + ! be modified as the patch is laid out on the grid, but only in + ! the case that smoothing of the elliptical patch's boundary is + ! enabled. + eta = 1._wp + + ! Checking whether the ellipse covers a particular cell in the + ! domain and verifying whether the current patch has permission + ! to write to that cell. If both queries check out, the primitive + ! variables of the current patch are assigned to this cell. + do j = 0, n + do i = 0, m + + if (patch_icpp(patch_id)%smoothen) then + eta = tanh(smooth_coeff/min(dx, dy)* & + (sqrt(((x_cc(i) - x_centroid)/a)**2 + & + ((y_cc(j) - y_centroid)/b)**2) & + - 1._wp))*(-0.5_wp) + 0.5_wp + end if + + if ((((x_cc(i) - x_centroid)/a)**2 + & + ((y_cc(j) - y_centroid)/b)**2 <= 1._wp & + .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & + .or. & + patch_id_fp(i, j, 0) == smooth_patch_id) & + then + + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded2D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id + end if + end do + end do + @:HardcodedDellacation() + + end subroutine s_ellipse + + !> The ellipsoidal patch is a 3D geometry. The geometry of + !! the patch is well-defined when its centroid and radii + !! are provided. Note that the ellipsoidal patch DOES allow + !! for the smoothing of its boundary + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + subroutine s_ellipsoid(patch_id, patch_id_fp, q_prim_vf) + + ! Patch identifier + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + ! Generic loop iterators + integer :: i, j, k + real(wp) :: a, b, c + @:HardcodedDimensionsExtrusion() + @:Hardcoded3DVariables() + + ! Transferring the ellipsoidal patch's radii, centroid, smearing + ! patch identity, and smearing coefficient information + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + z_centroid = patch_icpp(patch_id)%z_centroid + a = patch_icpp(patch_id)%radii(1) + b = patch_icpp(patch_id)%radii(2) + c = patch_icpp(patch_id)%radii(3) + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff + + ! Initializing the pseudo volume fraction value to 1. The value + ! be modified as the patch is laid out on the grid, but only in + ! the case that smoothing of the ellipsoidal patch's boundary is + ! enabled. + eta = 1._wp + + ! Checking whether the ellipsoid covers a particular cell in the + ! domain and verifying whether the current patch has permission + ! to write to that cell. If both queries check out, the primitive + ! variables of the current patch are assigned to this cell. + do k = 0, p + do j = 0, n + do i = 0, m + + if (grid_geometry == 3) then + call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + else + cart_y = y_cc(j) + cart_z = z_cc(k) + end if + + if (patch_icpp(patch_id)%smoothen) then + eta = tanh(smooth_coeff/min(dx, dy, dz)* & + (sqrt(((x_cc(i) - x_centroid)/a)**2 + & + ((cart_y - y_centroid)/b)**2 + & + ((cart_z - z_centroid)/c)**2) & + - 1._wp))*(-0.5_wp) + 0.5_wp + end if + + if ((((x_cc(i) - x_centroid)/a)**2 + & + ((cart_y - y_centroid)/b)**2 + & + ((cart_z - z_centroid)/c)**2 <= 1._wp & + .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) & + .or. & + patch_id_fp(i, j, k) == smooth_patch_id) & + then + + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded3D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id + end if + end do + end do + end do + @:HardcodedDellacation() + + end subroutine s_ellipsoid + + !> The rectangular patch is a 2D geometry that may be used, + !! for example, in creating a solid boundary, or pre-/post- + !! shock region, in alignment with the axes of the Cartesian + !! coordinate system. The geometry of such a patch is well- + !! defined when its centroid and lengths in the x- and y- + !! coordinate directions are provided. Please note that the + !! rectangular patch DOES NOT allow for the smoothing of its + !! boundaries. + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + !! @param ib True if this patch is an immersed boundary + subroutine s_rectangle(patch_id, patch_id_fp, q_prim_vf, ib_flag) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary + + integer :: i, j, k !< generic loop iterators + real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters + @:HardcodedDimensionsExtrusion() + @:Hardcoded2DVariables() + + pi_inf = fluid_pp(1)%pi_inf + gamma = fluid_pp(1)%gamma + lit_gamma = (1._wp + gamma)/gamma + + ! Transferring the rectangle's centroid and length information + if (present(ib_flag)) then + x_centroid = patch_ib(patch_id)%x_centroid + y_centroid = patch_ib(patch_id)%y_centroid + length_x = patch_ib(patch_id)%length_x + length_y = patch_ib(patch_id)%length_y + else + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + length_x = patch_icpp(patch_id)%length_x + length_y = patch_icpp(patch_id)%length_y + end if + + ! Computing the beginning and the end x- and y-coordinates of the + ! rectangle based on its centroid and lengths + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + y_boundary%beg = y_centroid - 0.5_wp*length_y + y_boundary%end = y_centroid + 0.5_wp*length_y + + ! Since the rectangular patch does not allow for its boundaries to + ! be smoothed out, the pseudo volume fraction is set to 1 to ensure + ! that only the current patch contributes to the fluid state in the + ! cells that this patch covers. + eta = 1._wp + + ! Checking whether the rectangle covers a particular cell in the + ! domain and verifying whether the current patch has the permission + ! to write to that cell. If both queries check out, the primitive + ! variables of the current patch are assigned to this cell. + do j = 0, n + do i = 0, m + if (x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i) .and. & + y_boundary%beg <= y_cc(j) .and. & + y_boundary%end >= y_cc(j)) then + if (present(ib_flag)) then + ! Updating the patch identities bookkeeping variable + patch_id_fp(i, j, 0) = patch_id + else + if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & + then + + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded2D() + end if + + if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then + !zero density, reassign according to Tait EOS + q_prim_vf(1)%sf(i, j, 0) = & + (((q_prim_vf(E_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))* & + rhoref*(1._wp - q_prim_vf(alf_idx)%sf(i, j, 0)) + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id + + end if + end if + end if + end do + end do + @:HardcodedDellacation() + + end subroutine s_rectangle + + !> The swept line patch is a 2D geometry that may be used, + !! for example, in creating a solid boundary, or pre-/post- + !! shock region, at an angle with respect to the axes of the + !! Cartesian coordinate system. The geometry of the patch is + !! well-defined when its centroid and normal vector, aimed + !! in the sweep direction, are provided. Note that the sweep + !! line patch DOES allow the smoothing of its boundary. + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + subroutine s_sweep_line(patch_id, patch_id_fp, q_prim_vf) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + integer :: i, j, k !< Generic loop operators + real(wp) :: a, b, c + @:HardcodedDimensionsExtrusion() + @:Hardcoded3DVariables() + + ! Transferring the centroid information of the line to be swept + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff + + ! Obtaining coefficients of the equation describing the sweep line + a = patch_icpp(patch_id)%normal(1) + b = patch_icpp(patch_id)%normal(2) + c = -a*x_centroid - b*y_centroid + + ! Initializing the pseudo volume fraction value to 1. The value will + ! be modified as the patch is laid out on the grid, but only in the + ! case that smoothing of the sweep line patch's boundary is enabled. + eta = 1._wp + + ! Checking whether the region swept by the line covers a particular + ! cell in the domain and verifying whether the current patch has the + ! permission to write to that cell. If both queries check out, the + ! primitive variables of the current patch are written to this cell. + do j = 0, n + do i = 0, m + + if (patch_icpp(patch_id)%smoothen) then + eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy) & + *(a*x_cc(i) + b*y_cc(j) + c) & + /sqrt(a**2 + b**2)) + end if + + if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp & + .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & + .or. & + patch_id_fp(i, j, 0) == smooth_patch_id) & + then + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded3D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id + end if + + end do + end do + @:HardcodedDellacation() + + end subroutine s_sweep_line + + !> The Taylor Green vortex is 2D decaying vortex that may be used, + !! for example, to verify the effects of viscous attenuation. + !! Geometry of the patch is well-defined when its centroid + !! are provided. + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + subroutine s_2D_TaylorGreen_Vortex(patch_id, patch_id_fp, q_prim_vf) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + integer :: i, j, k !< generic loop iterators + real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters + real(wp) :: L0, U0 !< Taylor Green Vortex parameters + @:HardcodedDimensionsExtrusion() + @:Hardcoded2DVariables() + + pi_inf = fluid_pp(1)%pi_inf + gamma = fluid_pp(1)%gamma + lit_gamma = (1._wp + gamma)/gamma + + ! Transferring the patch's centroid and length information + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + length_x = patch_icpp(patch_id)%length_x + length_y = patch_icpp(patch_id)%length_y + + ! Computing the beginning and the end x- and y-coordinates + ! of the patch based on its centroid and lengths + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + y_boundary%beg = y_centroid - 0.5_wp*length_y + y_boundary%end = y_centroid + 0.5_wp*length_y + + ! Since the patch doesn't allow for its boundaries to be + ! smoothed out, the pseudo volume fraction is set to 1 to + ! ensure that only the current patch contributes to the fluid + ! state in the cells that this patch covers. + eta = 1._wp + ! U0 is the characteristic velocity of the vortex + U0 = patch_icpp(patch_id)%vel(1) + ! L0 is the characteristic length of the vortex + L0 = patch_icpp(patch_id)%vel(2) + ! Checking whether the patch covers a particular cell in the + ! domain and verifying whether the current patch has the + ! permission to write to that cell. If both queries check out, + ! the primitive variables of the current patch are assigned + ! to this cell. + do j = 0, n + do i = 0, m + if (x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i) .and. & + y_boundary%beg <= y_cc(j) .and. & + y_boundary%end >= y_cc(j) .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then + + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded2D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id + + ! Assign Parameters + q_prim_vf(mom_idx%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0) + q_prim_vf(mom_idx%end)%sf(i, j, 0) = -U0*cos(x_cc(i)/L0)*sin(y_cc(j)/L0) + q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(patch_id)%pres + (cos(2*x_cc(i))/L0 + & + cos(2*y_cc(j))/L0)* & + (q_prim_vf(1)%sf(i, j, 0)*U0*U0)/16 + end if + end do + end do + @:HardcodedDellacation() + + end subroutine s_2D_TaylorGreen_Vortex + + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + subroutine s_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf) + ! Description: This patch assigns the primitive variables as analytical + ! functions such that the code can be verified. + + ! Patch identifier + integer, intent(in) :: patch_id + integer, intent(inout), dimension(0:m, 0:n, 0:p) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + ! Generic loop iterators + integer :: i, j, k + ! Placeholders for the cell boundary values + real(wp) :: pi_inf, gamma, lit_gamma + @:HardcodedDimensionsExtrusion() + @:Hardcoded1DVariables() + + pi_inf = fluid_pp(1)%pi_inf + gamma = fluid_pp(1)%gamma + lit_gamma = (1._wp + gamma)/gamma + + ! Transferring the patch's centroid and length information + x_centroid = patch_icpp(patch_id)%x_centroid + length_x = patch_icpp(patch_id)%length_x + + ! Computing the beginning and the end x- and y-coordinates + ! of the patch based on its centroid and lengths + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + + ! Since the patch doesn't allow for its boundaries to be + ! smoothed out, the pseudo volume fraction is set to 1 to + ! ensure that only the current patch contributes to the fluid + ! state in the cells that this patch covers. + eta = 1._wp + + ! Checking whether the line segment covers a particular cell in the + ! domain and verifying whether the current patch has the permission + ! to write to that cell. If both queries check out, the primitive + ! variables of the current patch are assigned to this cell. + do i = 0, m + if (x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i) .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, 0, 0))) then + + call s_assign_patch_primitive_variables(patch_id, i, 0, 0, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded1D() + end if + + end if + end do + @:HardcodedDellacation() + + end subroutine s_1D_bubble_pulse + + !> This patch generates the shape of the spherical harmonics + !! as a perturbation to a perfect sphere + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + subroutine s_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf) + + integer, intent(IN) :: patch_id + integer, intent(INOUT), dimension(0:m, 0:n, 0:p) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + real(wp) :: r, x_p, eps, phi + real(wp), dimension(2:9) :: as, Ps + real(wp) :: radius, x_centroid_local, y_centroid_local, z_centroid_local, eta_local, smooth_coeff_local + logical :: non_axis_sym_in + + integer :: i, j, k !< generic loop iterators + + ! Transferring the patch's centroid and radius information + x_centroid_local = patch_icpp(patch_id)%x_centroid + y_centroid_local = patch_icpp(patch_id)%y_centroid + z_centroid_local = patch_icpp(patch_id)%z_centroid + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff_local = patch_icpp(patch_id)%smooth_coeff + radius = patch_icpp(patch_id)%radius + as(2) = patch_icpp(patch_id)%a(2) + as(3) = patch_icpp(patch_id)%a(3) + as(4) = patch_icpp(patch_id)%a(4) + as(5) = patch_icpp(patch_id)%a(5) + as(6) = patch_icpp(patch_id)%a(6) + as(7) = patch_icpp(patch_id)%a(7) + as(8) = patch_icpp(patch_id)%a(8) + as(9) = patch_icpp(patch_id)%a(9) + non_axis_sym_in = patch_icpp(patch_id)%non_axis_sym + + ! Since the analytical patch does not allow for its boundaries to get + ! smoothed out, the pseudo volume fraction is set to 1 to make sure + ! that only the current patch contributes to the fluid state in the + ! cells that this patch covers. + eta_local = 1._wp + eps = 1.e-32_wp + + ! Checking whether the patch covers a particular cell in the domain + ! and verifying whether the current patch has permission to write to + ! to that cell. If both queries check out, the primitive variables + ! of the current patch are assigned to this cell. + if (p > 0 .and. .not. non_axis_sym_in) then + do k = 0, p + do j = 0, n + do i = 0, m + if (grid_geometry == 3) then + call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + else + cart_y = y_cc(j) + cart_z = z_cc(k) + end if + + r = sqrt((x_cc(i) - x_centroid_local)**2 + (cart_y - y_centroid_local)**2 + (cart_z - z_centroid_local)**2) + eps + if (x_cc(i) - x_centroid_local <= 0) then + x_p = -1._wp*abs(x_cc(i) - x_centroid_local + eps)/r + else + x_p = abs(x_cc(i) - x_centroid_local + eps)/r + end if + + Ps(2) = unassociated_legendre(x_p, 2) + Ps(3) = unassociated_legendre(x_p, 3) + Ps(4) = unassociated_legendre(x_p, 4) + Ps(5) = unassociated_legendre(x_p, 5) + Ps(6) = unassociated_legendre(x_p, 6) + Ps(7) = unassociated_legendre(x_p, 7) + if ((x_cc(i) - x_centroid_local >= 0 & + .and. & + r - as(2)*Ps(2) - as(3)*Ps(3) - as(4)*Ps(4) - as(5)*Ps(5) - as(6)*Ps(6) - as(7)*Ps(7) <= radius & + .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & + (patch_id_fp(i, j, k) == smooth_patch_id)) & + then + if (patch_icpp(patch_id)%smoothen) then + eta_local = tanh(smooth_coeff_local/min(dx, dy, dz)* & + ((r - as(2)*Ps(2) - as(3)*Ps(3) - as(4)*Ps(4) - as(5)*Ps(5) - as(6)*Ps(6) - as(7)*Ps(7)) & + - radius))*(-0.5_wp) + 0.5_wp + end if + + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta_local, q_prim_vf, patch_id_fp) + end if + + end do + end do + end do + + else if (p == 0) then + do j = 0, n + do i = 0, m + + if (non_axis_sym_in) then + phi = atan(((y_cc(j) - y_centroid_local) + eps)/((x_cc(i) - x_centroid_local) + eps)) + r = sqrt((x_cc(i) - x_centroid_local)**2._wp + (y_cc(j) - y_centroid_local)**2._wp) + eps + x_p = (eps)/r + Ps(2) = spherical_harmonic_func(x_p, phi, 2, 2) + Ps(3) = spherical_harmonic_func(x_p, phi, 3, 3) + Ps(4) = spherical_harmonic_func(x_p, phi, 4, 4) + Ps(5) = spherical_harmonic_func(x_p, phi, 5, 5) + Ps(6) = spherical_harmonic_func(x_p, phi, 6, 6) + Ps(7) = spherical_harmonic_func(x_p, phi, 7, 7) + Ps(8) = spherical_harmonic_func(x_p, phi, 8, 8) + Ps(9) = spherical_harmonic_func(x_p, phi, 9, 9) + else + r = sqrt((x_cc(i) - x_centroid_local)**2._wp + (y_cc(j) - y_centroid_local)**2._wp) + eps + x_p = abs(x_cc(i) - x_centroid_local + eps)/r + Ps(2) = unassociated_legendre(x_p, 2) + Ps(3) = unassociated_legendre(x_p, 3) + Ps(4) = unassociated_legendre(x_p, 4) + Ps(5) = unassociated_legendre(x_p, 5) + Ps(6) = unassociated_legendre(x_p, 6) + Ps(7) = unassociated_legendre(x_p, 7) + Ps(8) = unassociated_legendre(x_p, 8) + Ps(9) = unassociated_legendre(x_p, 9) + end if + + if (x_cc(i) - x_centroid_local >= 0 & + .and. & + r - as(2)*Ps(2) - as(3)*Ps(3) - as(4)*Ps(4) - as(5)*Ps(5) - as(6)*Ps(6) - as(7)*Ps(7) - as(8)*Ps(8) - as(9)*Ps(9) <= radius .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & + then + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta_local, q_prim_vf, patch_id_fp) + + elseif (x_cc(i) - x_centroid_local < 0 & + .and. & + r - as(2)*Ps(2) + as(3)*Ps(3) - as(4)*Ps(4) + as(5)*Ps(5) - as(6)*Ps(6) + as(7)*Ps(7) - as(8)*Ps(8) + as(9)*Ps(9) <= radius & + .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & + then + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta_local, q_prim_vf, patch_id_fp) + + end if + end do + end do + end if + + end subroutine s_spherical_harmonic + + !> The spherical patch is a 3D geometry that may be used, + !! for example, in creating a bubble or a droplet. The patch + !! geometry is well-defined when its centroid and radius are + !! provided. Please note that the spherical patch DOES allow + !! for the smoothing of its boundary. + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + !! @param ib True if this patch is an immersed boundary + subroutine s_sphere(patch_id, patch_id_fp, q_prim_vf, ib_flag) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary + + ! Generic loop iterators + integer :: i, j, k + real(wp) :: radius + @:HardcodedDimensionsExtrusion() + @:Hardcoded3DVariables() + + !! Variables to initialize the pressure field that corresponds to the + !! bubble-collapse test case found in Tiwari et al. (2013) + + ! Transferring spherical patch's radius, centroid, smoothing patch + ! identity and smoothing coefficient information + if (present(ib_flag)) then + x_centroid = patch_ib(patch_id)%x_centroid + y_centroid = patch_ib(patch_id)%y_centroid + z_centroid = patch_ib(patch_id)%z_centroid + radius = patch_ib(patch_id)%radius + else + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + z_centroid = patch_icpp(patch_id)%z_centroid + radius = patch_icpp(patch_id)%radius + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff + end if + + ! Initializing the pseudo volume fraction value to 1. The value will + ! be modified as the patch is laid out on the grid, but only in the + ! case that smoothing of the spherical patch's boundary is enabled. + eta = 1._wp + + ! Checking whether the sphere covers a particular cell in the domain + ! and verifying whether the current patch has permission to write to + ! that cell. If both queries check out, the primitive variables of + ! the current patch are assigned to this cell. + do k = 0, p + do j = 0, n + do i = 0, m + + if (grid_geometry == 3) then + call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + else + cart_y = y_cc(j) + cart_z = z_cc(k) + end if + + if (.not. present(ib_flag) .and. patch_icpp(patch_id)%smoothen) then + eta = tanh(smooth_coeff/min(dx, dy, dz)* & + (sqrt((x_cc(i) - x_centroid)**2 & + + (cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2) & + - radius))*(-0.5_wp) + 0.5_wp + end if + + if (present(ib_flag)) then + ! Updating the patch identities bookkeeping variable + if (((x_cc(i) - x_centroid)**2 & + + (cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2)) then + patch_id_fp(i, j, k) = patch_id + end if + else + if ((((x_cc(i) - x_centroid)**2 & + + (cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2) .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & + patch_id_fp(i, j, k) == smooth_patch_id) then + + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded3D() + end if + + end if + end if + end do + end do + end do + @:HardcodedDellacation() + + end subroutine s_sphere + + !> The cuboidal patch is a 3D geometry that may be used, for + !! example, in creating a solid boundary, or pre-/post-shock + !! region, which is aligned with the axes of the Cartesian + !! coordinate system. The geometry of such a patch is well- + !! defined when its centroid and lengths in the x-, y- and + !! z-coordinate directions are provided. Please notice that + !! the cuboidal patch DOES NOT allow for the smearing of its + !! boundaries. + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + subroutine s_cuboid(patch_id, patch_id_fp, q_prim_vf, ib_flag) + + integer, intent(in) :: patch_id + logical, optional, intent(in) :: ib_flag + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + integer :: i, j, k !< Generic loop iterators + @:HardcodedDimensionsExtrusion() + @:Hardcoded3DVariables() + + ! Transferring the cuboid's centroid and length information + if (present(ib_flag)) then + x_centroid = patch_ib(patch_id)%x_centroid + y_centroid = patch_ib(patch_id)%y_centroid + z_centroid = patch_ib(patch_id)%z_centroid + length_x = patch_ib(patch_id)%length_x + length_y = patch_ib(patch_id)%length_y + length_z = patch_ib(patch_id)%length_z + else + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + z_centroid = patch_icpp(patch_id)%z_centroid + length_x = patch_icpp(patch_id)%length_x + length_y = patch_icpp(patch_id)%length_y + length_z = patch_icpp(patch_id)%length_z + end if + + ! Computing the beginning and the end x-, y- and z-coordinates of + ! the cuboid based on its centroid and lengths + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + y_boundary%beg = y_centroid - 0.5_wp*length_y + y_boundary%end = y_centroid + 0.5_wp*length_y + z_boundary%beg = z_centroid - 0.5_wp*length_z + z_boundary%end = z_centroid + 0.5_wp*length_z + + ! Since the cuboidal patch does not allow for its boundaries to get + ! smoothed out, the pseudo volume fraction is set to 1 to make sure + ! that only the current patch contributes to the fluid state in the + ! cells that this patch covers. + eta = 1._wp + + ! Checking whether the cuboid covers a particular cell in the domain + ! and verifying whether the current patch has permission to write to + ! to that cell. If both queries check out, the primitive variables + ! of the current patch are assigned to this cell. + do k = 0, p + do j = 0, n + do i = 0, m + + if (grid_geometry == 3) then + call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + else + cart_y = y_cc(j) + cart_z = z_cc(k) + end if + + if (x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i) .and. & + y_boundary%beg <= cart_y .and. & + y_boundary%end >= cart_y .and. & + z_boundary%beg <= cart_z .and. & + z_boundary%end >= cart_z) then + + if (present(ib_flag)) then + ! Updating the patch identities bookkeeping variable + patch_id_fp(i, j, k) = patch_id + else + if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then + + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded3D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id + + end if + end if + end if + end do + end do + end do + @:HardcodedDellacation() + + end subroutine s_cuboid + + !> The cylindrical patch is a 3D geometry that may be used, + !! for example, in setting up a cylindrical solid boundary + !! confinement, like a blood vessel. The geometry of this + !! patch is well-defined when the centroid, the radius and + !! the length along the cylinder's axis, parallel to the x-, + !! y- or z-coordinate direction, are provided. Please note + !! that the cylindrical patch DOES allow for the smoothing + !! of its lateral boundary. + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Array of primitive variables + !! @param ib True if this patch is an immersed boundary + subroutine s_cylinder(patch_id, patch_id_fp, q_prim_vf, ib_flag) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary + + integer :: i, j, k !< Generic loop iterators + real(wp) :: radius + @:HardcodedDimensionsExtrusion() + @:Hardcoded3DVariables() + + ! Transferring the cylindrical patch's centroid, length, radius, + ! smoothing patch identity and smoothing coefficient information + + if (present(ib_flag)) then + x_centroid = patch_ib(patch_id)%x_centroid + y_centroid = patch_ib(patch_id)%y_centroid + z_centroid = patch_ib(patch_id)%z_centroid + length_x = patch_ib(patch_id)%length_x + length_y = patch_ib(patch_id)%length_y + length_z = patch_ib(patch_id)%length_z + radius = patch_ib(patch_id)%radius + else + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + z_centroid = patch_icpp(patch_id)%z_centroid + length_x = patch_icpp(patch_id)%length_x + length_y = patch_icpp(patch_id)%length_y + length_z = patch_icpp(patch_id)%length_z + radius = patch_icpp(patch_id)%radius + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff + end if + + ! Computing the beginning and the end x-, y- and z-coordinates of + ! the cylinder based on its centroid and lengths + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + y_boundary%beg = y_centroid - 0.5_wp*length_y + y_boundary%end = y_centroid + 0.5_wp*length_y + z_boundary%beg = z_centroid - 0.5_wp*length_z + z_boundary%end = z_centroid + 0.5_wp*length_z + + ! Initializing the pseudo volume fraction value to 1. The value will + ! be modified as the patch is laid out on the grid, but only in the + ! case that smearing of the cylindrical patch's boundary is enabled. + eta = 1._wp + + ! Checking whether the cylinder covers a particular cell in the + ! domain and verifying whether the current patch has the permission + ! to write to that cell. If both queries check out, the primitive + ! variables of the current patch are assigned to this cell. + do k = 0, p + do j = 0, n + do i = 0, m + + if (grid_geometry == 3) then + call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + else + cart_y = y_cc(j) + cart_z = z_cc(k) + end if + + if (.not. present(ib_flag) .and. patch_icpp(patch_id)%smoothen) then + if (.not. f_is_default(length_x)) then + eta = tanh(smooth_coeff/min(dy, dz)* & + (sqrt((cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2) & + - radius))*(-0.5_wp) + 0.5_wp + elseif (.not. f_is_default(length_y)) then + eta = tanh(smooth_coeff/min(dx, dz)* & + (sqrt((x_cc(i) - x_centroid)**2 & + + (cart_z - z_centroid)**2) & + - radius))*(-0.5_wp) + 0.5_wp + else + eta = tanh(smooth_coeff/min(dx, dy)* & + (sqrt((x_cc(i) - x_centroid)**2 & + + (cart_y - y_centroid)**2) & + - radius))*(-0.5_wp) + 0.5_wp + end if + end if + + if (present(ib_flag)) then + if (((.not. f_is_default(length_x) .and. & + (cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2 .and. & + x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i)) & + .or. & + (.not. f_is_default(length_y) .and. & + (x_cc(i) - x_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2 .and. & + y_boundary%beg <= cart_y .and. & + y_boundary%end >= cart_y) & + .or. & + (.not. f_is_default(length_z) .and. & + (x_cc(i) - x_centroid)**2 & + + (cart_y - y_centroid)**2 <= radius**2 .and. & + z_boundary%beg <= cart_z .and. & + z_boundary%end >= cart_z))) then + + ! Updating the patch identities bookkeeping variable + patch_id_fp(i, j, k) = patch_id + end if + + else + if (((.not. f_is_default(length_x) .and. & + (cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2 .and. & + x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i)) & + .or. & + (.not. f_is_default(length_y) .and. & + (x_cc(i) - x_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2 .and. & + y_boundary%beg <= cart_y .and. & + y_boundary%end >= cart_y) & + .or. & + (.not. f_is_default(length_z) .and. & + (x_cc(i) - x_centroid)**2 & + + (cart_y - y_centroid)**2 <= radius**2 .and. & + z_boundary%beg <= cart_z .and. & + z_boundary%end >= cart_z) .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & + patch_id_fp(i, j, k) == smooth_patch_id) then + + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded3D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id + end if + end if + end do + end do + end do + @:HardcodedDellacation() + + end subroutine s_cylinder + + !> The swept plane patch is a 3D geometry that may be used, + !! for example, in creating a solid boundary, or pre-/post- + !! shock region, at an angle with respect to the axes of the + !! Cartesian coordinate system. The geometry of the patch is + !! well-defined when its centroid and normal vector, aimed + !! in the sweep direction, are provided. Note that the sweep + !! plane patch DOES allow the smoothing of its boundary. + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Primitive variables + subroutine s_sweep_plane(patch_id, patch_id_fp, q_prim_vf) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + integer :: i, j, k !< Generic loop iterators + real(wp) :: a, b, c, d + @:HardcodedDimensionsExtrusion() + @:Hardcoded3DVariables() + + ! Transferring the centroid information of the plane to be swept + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + z_centroid = patch_icpp(patch_id)%z_centroid + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff + + ! Obtaining coefficients of the equation describing the sweep plane + a = patch_icpp(patch_id)%normal(1) + b = patch_icpp(patch_id)%normal(2) + c = patch_icpp(patch_id)%normal(3) + d = -a*x_centroid - b*y_centroid - c*z_centroid + + ! Initializing the pseudo volume fraction value to 1. The value will + ! be modified as the patch is laid out on the grid, but only in the + ! case that smearing of the sweep plane patch's boundary is enabled. + eta = 1._wp + + ! Checking whether the region swept by the plane covers a particular + ! cell in the domain and verifying whether the current patch has the + ! permission to write to that cell. If both queries check out, the + ! primitive variables of the current patch are written to this cell. + do k = 0, p + do j = 0, n + do i = 0, m + + if (grid_geometry == 3) then + call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + else + cart_y = y_cc(j) + cart_z = z_cc(k) + end if + + if (patch_icpp(patch_id)%smoothen) then + eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy, dz) & + *(a*x_cc(i) + & + b*cart_y + & + c*cart_z + d) & + /sqrt(a**2 + b**2 + c**2)) + end if + + if ((a*x_cc(i) + b*cart_y + c*cart_z + d >= 0._wp & + .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) & + .or. & + patch_id_fp(i, j, k) == smooth_patch_id) & + then + + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) + + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded3D() + end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id + end if + + end do + end do + end do + @:HardcodedDellacation() + + end subroutine s_sweep_plane + + !> The STL patch is a 2/3D geometry that is imported from an STL file. + !! @param patch_id is the patch identifier + !! @param patch_id_fp Array to track patch ids + !! @param q_prim_vf Primitive variables + !! @param ib True if this patch is an immersed boundary + !! @param STL_levelset STL levelset + !! @param STL_levelset_norm STL levelset normals + subroutine s_model(patch_id, patch_id_fp, q_prim_vf, ib_flag, STL_levelset, STL_levelset_norm) + + integer, intent(in) :: patch_id + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + + ! Variables for IBM+STL + type(levelset_field), optional, intent(inout) :: STL_levelset !< Levelset determined by models + type(levelset_norm_field), optional, intent(inout) :: STL_levelset_norm !< Levelset_norm determined by models + logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary + real(wp) :: normals(1:3) !< Boundary normal buffer + integer :: boundary_vertex_count, boundary_edge_count, total_vertices !< Boundary vertex + real(wp), allocatable, dimension(:, :, :) :: boundary_v !< Boundary vertex buffer + real(wp), allocatable, dimension(:, :) :: interpolated_boundary_v !< Interpolated vertex buffer + real(wp) :: distance !< Levelset distance buffer + logical :: interpolate !< Logical variable to determine whether or not the model should be interpolated + + integer :: i, j, k !< Generic loop iterators + + type(t_bbox) :: bbox, bbox_old + type(t_model) :: model + type(ic_model_parameters) :: params + + real(wp), dimension(1:3) :: point, model_center + + real(wp) :: grid_mm(1:3, 1:2) + + integer :: cell_num + integer :: ncells + + real(wp), dimension(1:4, 1:4) :: transform, transform_n + + if (present(ib_flag) .and. proc_rank == 0) then + print *, " * Reading model: "//trim(patch_ib(patch_id)%model_filepath) + else if (proc_rank == 0) then + print *, " * Reading model: "//trim(patch_icpp(patch_id)%model_filepath) + end if + + if (present(ib_flag)) then + model = f_model_read(patch_ib(patch_id)%model_filepath) + params%scale(:) = patch_ib(patch_id)%model_scale(:) + params%translate(:) = patch_ib(patch_id)%model_translate(:) + params%rotate(:) = patch_ib(patch_id)%model_rotate(:) + params%spc = patch_ib(patch_id)%model_spc + params%threshold = patch_ib(patch_id)%model_threshold + else + model = f_model_read(patch_icpp(patch_id)%model_filepath) + params%scale(:) = patch_icpp(patch_id)%model_scale(:) + params%translate(:) = patch_icpp(patch_id)%model_translate(:) + params%rotate(:) = patch_icpp(patch_id)%model_rotate(:) + params%spc = patch_icpp(patch_id)%model_spc + params%threshold = patch_icpp(patch_id)%model_threshold + end if + + if (proc_rank == 0) then + print *, " * Transforming model." + end if + + ! Get the model center before transforming the model + bbox_old = f_create_bbox(model) + model_center(1:3) = (bbox_old%min(1:3) + bbox_old%max(1:3))/2._wp + + ! Compute the transform matrices for vertices and normals + transform = f_create_transform_matrix(params, model_center) + transform_n = f_create_transform_matrix(params) + + call s_transform_model(model, transform, transform_n) + + ! Recreate the bounding box after transformation + bbox = f_create_bbox(model) + + ! Show the number of vertices in the original STL model + if (proc_rank == 0) then + print *, ' * Number of input model vertices:', 3*model%ntrs + end if + + call f_check_boundary(model, boundary_v, boundary_vertex_count, boundary_edge_count) + + ! Check if the model needs interpolation + if (p > 0) then + call f_check_interpolation_3D(model, (/dx, dy, dz/), interpolate) + else + call f_check_interpolation_2D(boundary_v, boundary_edge_count, (/dx, dy, dz/), interpolate) + end if + + ! Show the number of edges and boundary edges in 2D STL models + if (proc_rank == 0 .and. p == 0) then + print *, ' * Number of 2D model boundary edges:', boundary_edge_count + end if + + ! Interpolate the STL model along the edges (2D) and on triangle facets (3D) + if (interpolate) then + if (proc_rank == 0) then + print *, ' * Interpolating STL vertices.' + end if + + if (p > 0) then + call f_interpolate_3D(model, (/dx, dy, dz/), interpolated_boundary_v, total_vertices) + else + call f_interpolate_2D(boundary_v, boundary_edge_count, (/dx, dy, dz/), interpolated_boundary_v, total_vertices) + end if + + if (proc_rank == 0) then + print *, ' * Total number of interpolated boundary vertices:', total_vertices + end if + end if + + if (proc_rank == 0) then + write (*, "(A, 3(2X, F20.10))") " > Model: Min:", bbox%min(1:3) + write (*, "(A, 3(2X, F20.10))") " > Cen:", (bbox%min(1:3) + bbox%max(1:3))/2._wp + write (*, "(A, 3(2X, F20.10))") " > Max:", bbox%max(1:3) + + !call s_model_write("__out__.stl", model) + !call s_model_write("__out__.obj", model) + + grid_mm(1, :) = (/minval(x_cc) - 0.e5_wp*dx, maxval(x_cc) + 0.e5_wp*dx/) + grid_mm(2, :) = (/minval(y_cc) - 0.e5_wp*dy, maxval(y_cc) + 0.e5_wp*dy/) + + if (p > 0) then + grid_mm(3, :) = (/minval(z_cc) - 0.e5_wp*dz, maxval(z_cc) + 0.e5_wp*dz/) + else + grid_mm(3, :) = (/0._wp, 0._wp/) + end if + + write (*, "(A, 3(2X, F20.10))") " > Domain: Min:", grid_mm(:, 1) + write (*, "(A, 3(2X, F20.10))") " > Cen:", (grid_mm(:, 1) + grid_mm(:, 2))/2._wp + write (*, "(A, 3(2X, F20.10))") " > Max:", grid_mm(:, 2) + end if + + ncells = (m + 1)*(n + 1)*(p + 1) + do i = 0, m; do j = 0, n; do k = 0, p + + cell_num = i*(n + 1)*(p + 1) + j*(p + 1) + (k + 1) + if (proc_rank == 0 .and. mod(cell_num, ncells/100) == 0) then + write (*, "(A, I3, A)", advance="no") & + char(13)//" * Generating grid: ", & + nint(100*real(cell_num)/ncells), "%" + end if + + point = (/x_cc(i), y_cc(j), 0._wp/) + if (p > 0) then + point(3) = z_cc(k) + end if + + if (grid_geometry == 3) then + point = f_convert_cyl_to_cart(point) + end if + + if (present(ib_flag)) then + eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_ib(patch_id)%model_spc) + else + eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_icpp(patch_id)%model_spc) + end if + + if (present(ib_flag)) then + ! Reading STL boundary vertices and compute the levelset and levelset_norm + if (eta > patch_ib(patch_id)%model_threshold) then + patch_id_fp(i, j, k) = patch_id + end if + + ! 3D models + if (p > 0) then + + ! Get the boundary normals and shortest distance between the cell center and the model boundary + call f_distance_normals_3D(model, point, normals, distance) + + ! Get the shortest distance between the cell center and the interpolated model boundary + if (interpolate) then + STL_levelset%sf(i, j, k, patch_id) = f_interpolated_distance(interpolated_boundary_v, & + total_vertices, & + point) + else + STL_levelset%sf(i, j, k, patch_id) = distance + end if + + ! Correct the sign of the levelset + if (patch_id_fp(i, j, k) > 0) then + STL_levelset%sf(i, j, k, patch_id) = -abs(STL_levelset%sf(i, j, k, patch_id)) + end if + + ! Correct the sign of the levelset_norm + if (patch_id_fp(i, j, k) == 0) then + normals(1:3) = -normals(1:3) + end if + + ! Assign the levelset_norm + STL_levelset_norm%sf(i, j, k, patch_id, 1:3) = normals(1:3) + else + ! 2D models + if (interpolate) then + ! Get the shortest distance between the cell center and the model boundary + STL_levelset%sf(i, j, 0, patch_id) = f_interpolated_distance(interpolated_boundary_v, & + total_vertices, & + point) + else + ! Get the shortest distance between the cell center and the interpolated model boundary + STL_levelset%sf(i, j, 0, patch_id) = f_distance(boundary_v, & + boundary_edge_count, & + point) + end if + + ! Correct the sign of the levelset + if (patch_id_fp(i, j, k) > 0) then + STL_levelset%sf(i, j, 0, patch_id) = -abs(STL_levelset%sf(i, j, 0, patch_id)) + end if + + ! Get the boundary normals + call f_normals(boundary_v, & + boundary_edge_count, & + point, & + normals) + + ! Correct the sign of the levelset_norm + if (patch_id_fp(i, j, k) == 0) then + normals(1:3) = -normals(1:3) + end if + + ! Assign the levelset_norm + STL_levelset_norm%sf(i, j, k, patch_id, 1:3) = normals(1:3) + + end if + else + if (patch_icpp(patch_id)%smoothen) then + if (eta > patch_icpp(patch_id)%model_threshold) then + eta = 1._wp + end if + else + if (eta > patch_icpp(patch_id)%model_threshold) then + eta = 1._wp + else + eta = 0._wp + end if + end if + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) + + ! Note: Should probably use *eta* to compute primitive variables + ! if defining them analytically. + @:analytical() + end if + end do; end do; end do + + if (proc_rank == 0) then + print *, "" + print *, " * Cleaning up." + end if + + call s_model_free(model) + + end subroutine s_model + + subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z) + $:GPU_ROUTINE(parallelism='[seq]') + + real(wp), intent(in) :: cyl_y, cyl_z + + cart_y = cyl_y*sin(cyl_z) + cart_z = cyl_y*cos(cyl_z) + + end subroutine s_convert_cylindrical_to_cartesian_coord + + pure function f_convert_cyl_to_cart(cyl) result(cart) + + $:GPU_ROUTINE(parallelism='[seq]') + + real(wp), dimension(1:3), intent(in) :: cyl + real(wp), dimension(1:3) :: cart + + cart = (/cyl(1), & + cyl(2)*sin(cyl(3)), & + cyl(2)*cos(cyl(3))/) + + end function f_convert_cyl_to_cart + + subroutine s_convert_cylindrical_to_spherical_coord(cyl_x, cyl_y) + $:GPU_ROUTINE(parallelism='[seq]') + + real(wp), intent(IN) :: cyl_x, cyl_y + + sph_phi = atan(cyl_y/cyl_x) + + end subroutine s_convert_cylindrical_to_spherical_coord + + !> Archimedes spiral function + !! @param myth Angle + !! @param offset Thickness + !! @param a Starting position + pure elemental function f_r(myth, offset, a) + $:GPU_ROUTINE(parallelism='[seq]') + real(wp), intent(in) :: myth, offset, a + real(wp) :: b + real(wp) :: f_r + + !r(th) = a + b*th + + b = 2._wp*a/(2._wp*pi) + f_r = a + b*myth + offset + end function f_r + +end module m_patches diff --git a/toolchain/mfc/case.py b/toolchain/mfc/case.py index 0aa4f6220e..e7af954d83 100644 --- a/toolchain/mfc/case.py +++ b/toolchain/mfc/case.py @@ -265,11 +265,9 @@ def __get_sim_fpp(self, print: bool) -> str: """ else: - out = """\ -! This file is purposefully empty. It is only important for builds that make use -! of --case-optimization. -""" + out = "" + # We need to also include the pre_processing includes so that common subroutines have access to the @:analytical function return out + f"\n{self.__get_pre_fpp(print)}" def get_fpp(self, target, print = True) -> str: From de5be7cc810b8362430cc943a6dd3b99c8cff627 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Wed, 17 Sep 2025 17:38:56 -0400 Subject: [PATCH 13/43] Initial sweep of variable changes and removing unused immersed boundary patches from the m_ib_patches.fpp file --- .../{m_patches.fpp => m_ib_patches.fpp} | 898 +----------------- src/pre_process/m_icpp_patches.fpp | 131 +-- 2 files changed, 76 insertions(+), 953 deletions(-) rename src/common/{m_patches.fpp => m_ib_patches.fpp} (61%) diff --git a/src/common/m_patches.fpp b/src/common/m_ib_patches.fpp similarity index 61% rename from src/common/m_patches.fpp rename to src/common/m_ib_patches.fpp index 071a34d996..7fec6e018f 100644 --- a/src/common/m_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -25,10 +25,6 @@ module m_patches use m_mpi_common - use m_assign_variables - - use m_mpi_common - implicit none private; public :: s_apply_domain_patches @@ -64,7 +60,7 @@ module m_patches contains - impure subroutine s_apply_domain_patches(patch_id_fp, q_prim_vf, ib_markers_sf, levelset, levelset_norm) + impure subroutine s_apply_ib_patches(patch_id_fp, q_prim_vf, ib_markers_sf, levelset, levelset_norm) type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:m, 0:m), intent(inout) :: patch_id_fp @@ -77,42 +73,6 @@ contains ! 3D Patch Geometries if (p > 0) then - do i = 1, num_patches - - if (proc_rank == 0) then - print *, 'Processing patch', i - end if - - !> ICPP Patches - !> @{ - ! Spherical patch - if (patch_icpp(i)%geometry == 8) then - call s_sphere(i, patch_id_fp, q_prim_vf) - ! Cuboidal patch - elseif (patch_icpp(i)%geometry == 9) then - call s_cuboid(i, patch_id_fp, q_prim_vf) - ! Cylindrical patch - elseif (patch_icpp(i)%geometry == 10) then - call s_cylinder(i, patch_id_fp, q_prim_vf) - ! Swept plane patch - elseif (patch_icpp(i)%geometry == 11) then - call s_sweep_plane(i, patch_id_fp, q_prim_vf) - ! Ellipsoidal patch - elseif (patch_icpp(i)%geometry == 12) then - call s_ellipsoid(i, patch_id_fp, q_prim_vf) - ! Spherical harmonic patch - elseif (patch_icpp(i)%geometry == 14) then - call s_spherical_harmonic(i, patch_id_fp, q_prim_vf) - ! 3D Modified circular patch - elseif (patch_icpp(i)%geometry == 19) then - call s_3dvarcircle(i, patch_id_fp, q_prim_vf) - ! 3D STL patch - elseif (patch_icpp(i)%geometry == 21) then - call s_model(i, patch_id_fp, q_prim_vf) - end if - end do - !> @} - !> IB Patches !> @{ ! Spherical patch @@ -122,20 +82,20 @@ contains end if if (patch_ib(i)%geometry == 8) then - call s_sphere(i, ib_markers_sf, q_prim_vf, ib) - call s_sphere_levelset(i, levelset, levelset_norm) + call s_ib_sphere(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_sphere_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 9) then - call s_cuboid(i, ib_markers_sf, q_prim_vf, ib) - call s_cuboid_levelset(i, levelset, levelset_norm) + call s_ib_cuboid(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_cuboid_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 10) then - call s_cylinder(i, ib_markers_sf, q_prim_vf, ib) - call s_cylinder_levelset(i, levelset, levelset_norm) + call s_ib_cylinder(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_cylinder_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 11) then - call s_3D_airfoil(i, ib_markers_sf, q_prim_vf, ib) - call s_3D_airfoil_levelset(i, levelset, levelset_norm) + call s_ib_3D_airfoil(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_3D_airfoil_levelset(i, levelset, levelset_norm) ! STL+IBM patch elseif (patch_ib(i)%geometry == 12) then - call s_model(i, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) + call s_ib_model(i, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) end if end do !> @} @@ -143,49 +103,6 @@ contains ! 2D Patch Geometries elseif (n > 0) then - do i = 1, num_patches - - if (proc_rank == 0) then - print *, 'Processing patch', i - end if - - !> ICPP Patches - !> @{ - ! Circular patch - if (patch_icpp(i)%geometry == 2) then - call s_circle(i, patch_id_fp, q_prim_vf) - ! Rectangular patch - elseif (patch_icpp(i)%geometry == 3) then - call s_rectangle(i, patch_id_fp, q_prim_vf) - ! Swept line patch - elseif (patch_icpp(i)%geometry == 4) then - call s_sweep_line(i, patch_id_fp, q_prim_vf) - ! Elliptical patch - elseif (patch_icpp(i)%geometry == 5) then - call s_ellipse(i, patch_id_fp, q_prim_vf) - ! Unimplemented patch (formerly isentropic vortex) - elseif (patch_icpp(i)%geometry == 6) then - call s_mpi_abort('This used to be the isentropic vortex patch, '// & - 'which no longer exists. See Examples. Exiting.') - ! Spherical Harmonic Patch - elseif (patch_icpp(i)%geometry == 14) then - call s_spherical_harmonic(i, patch_id_fp, q_prim_vf) - ! Spiral patch - elseif (patch_icpp(i)%geometry == 17) then - call s_spiral(i, patch_id_fp, q_prim_vf) - ! Modified circular patch - elseif (patch_icpp(i)%geometry == 18) then - call s_varcircle(i, patch_id_fp, q_prim_vf) - ! TaylorGreen vortex patch - elseif (patch_icpp(i)%geometry == 20) then - call s_2D_TaylorGreen_vortex(i, patch_id_fp, q_prim_vf) - ! STL patch - elseif (patch_icpp(i)%geometry == 21) then - call s_model(i, patch_id_fp, q_prim_vf) - end if - !> @} - end do - !> IB Patches !> @{ do i = 1, num_ibs @@ -193,184 +110,24 @@ contains print *, 'Processing 2D ib patch ', i end if if (patch_ib(i)%geometry == 2) then - call s_circle(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_circle(i, ib_markers_sf, q_prim_vf, ib) call s_circle_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 3) then - call s_rectangle(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_rectangle(i, ib_markers_sf, q_prim_vf, ib) call s_rectangle_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 4) then - call s_airfoil(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_airfoil(i, ib_markers_sf, q_prim_vf, ib) call s_airfoil_levelset(i, levelset, levelset_norm) ! STL+IBM patch elseif (patch_ib(i)%geometry == 5) then - call s_model(i, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) + call s_ib_model(i, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) end if end do !> @} - ! 1D Patch Geometries - else - - do i = 1, num_patches - - if (proc_rank == 0) then - print *, 'Processing patch', i - end if - - ! Line segment patch - if (patch_icpp(i)%geometry == 1) then - call s_line_segment(i, patch_id_fp, q_prim_vf) - ! 1d analytical - elseif (patch_icpp(i)%geometry == 16) then - call s_1d_bubble_pulse(i, patch_id_fp, q_prim_vf) - end if - end do - end if - end subroutine s_apply_domain_patches - - !> The line segment patch is a 1D geometry that may be used, - !! for example, in creating a Riemann problem. The geometry - !! of the patch is well-defined when its centroid and length - !! in the x-coordinate direction are provided. Note that the - !! line segment patch DOES NOT allow for the smearing of its - !! boundaries. - !! @param patch_id patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - subroutine s_line_segment(patch_id, patch_id_fp, q_prim_vf) - - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - ! Generic loop iterators - integer :: i, j, k - - ! Placeholders for the cell boundary values - real(wp) :: pi_inf, gamma, lit_gamma - @:HardcodedDimensionsExtrusion() - @:Hardcoded1DVariables() - - pi_inf = fluid_pp(1)%pi_inf - gamma = fluid_pp(1)%gamma - lit_gamma = (1._wp + gamma)/gamma - j = 0 - k = 0 - - ! Transferring the line segment's centroid and length information - x_centroid = patch_icpp(patch_id)%x_centroid - length_x = patch_icpp(patch_id)%length_x - - ! Computing the beginning and end x-coordinates of the line segment - ! based on its centroid and length - x_boundary%beg = x_centroid - 0.5_wp*length_x - x_boundary%end = x_centroid + 0.5_wp*length_x - - ! Since the line segment patch does not allow for its boundaries to - ! be smoothed out, the pseudo volume fraction is set to 1 to ensure - ! that only the current patch contributes to the fluid state in the - ! cells that this patch covers. - eta = 1._wp - - ! Checking whether the line segment covers a particular cell in the - ! domain and verifying whether the current patch has the permission - ! to write to that cell. If both queries check out, the primitive - ! variables of the current patch are assigned to this cell. - do i = 0, m - if (x_boundary%beg <= x_cc(i) .and. & - x_boundary%end >= x_cc(i) .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, 0, 0))) then - - call s_assign_patch_primitive_variables(patch_id, i, 0, 0, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - - ! check if this should load a hardcoded patch - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded1D() - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, 0, 0) = patch_id - - end if - end do - @:HardcodedDellacation() - - end subroutine s_line_segment - - !> The spiral patch is a 2D geometry that may be used, The geometry - !! of the patch is well-defined when its centroid and radius - !! are provided. Note that the circular patch DOES allow for - !! the smoothing of its boundary. - !! @param patch_id patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - impure subroutine s_spiral(patch_id, patch_id_fp, q_prim_vf) - - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - integer :: i, j, k !< Generic loop iterators - real(wp) :: th, thickness, nturns, mya - real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max - @:HardcodedDimensionsExtrusion() - @:Hardcoded2DVariables() - - ! Transferring the circular patch's radius, centroid, smearing patch - ! identity and smearing coefficient information - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - mya = patch_icpp(patch_id)%radius - thickness = patch_icpp(patch_id)%length_x - nturns = patch_icpp(patch_id)%length_y - - ! - logic_grid = 0 - do k = 0, int(m*91*nturns) - th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi - - spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), & - f_r(th, thickness, mya)*cos(th)/)) - spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), & - f_r(th, thickness, mya)*sin(th)/)) - - spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), & - f_r(th, thickness, mya)*cos(th)/)) - spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), & - f_r(th, thickness, mya)*sin(th)/)) - - do j = 0, n; do i = 0, m; - if ((x_cc(i) > spiral_x_min) .and. (x_cc(i) < spiral_x_max) .and. & - (y_cc(j) > spiral_y_min) .and. (y_cc(j) < spiral_y_max)) then - logic_grid(i, j, 0) = 1 - end if - end do; end do - end do - - do j = 0, n - do i = 0, m - if ((logic_grid(i, j, 0) == 1)) then - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded2D() - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id - end if - end do - end do - @:HardcodedDellacation() - - end subroutine s_spiral + end subroutine s_apply_ib_patches !> The circular patch is a 2D geometry that may be used, for !! example, in creating a bubble or a droplet. The geometry @@ -381,7 +138,7 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_circle(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_circle(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -459,13 +216,13 @@ contains end do @:HardcodedDellacation() - end subroutine s_circle + end subroutine s_ib_circle !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -622,13 +379,13 @@ contains end do end if - end subroutine s_airfoil + end subroutine s_ib_airfoil !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_3D_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_3D_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -793,143 +550,7 @@ contains end do end if - end subroutine s_3D_airfoil - - !> The varcircle patch is a 2D geometry that may be used - !! . It generatres an annulus - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - subroutine s_varcircle(patch_id, patch_id_fp, q_prim_vf) - - ! Patch identifier - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - ! Generic loop iterators - integer :: i, j, k - real(wp) :: radius, myr, thickness - @:HardcodedDimensionsExtrusion() - @:Hardcoded2DVariables() - - ! Transferring the circular patch's radius, centroid, smearing patch - ! identity and smearing coefficient information - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - radius = patch_icpp(patch_id)%radius - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - thickness = patch_icpp(patch_id)%epsilon - - ! Initializing the pseudo volume fraction value to 1. The value will - ! be modified as the patch is laid out on the grid, but only in the - ! case that smoothing of the circular patch's boundary is enabled. - eta = 1._wp - - ! Checking whether the circle covers a particular cell in the domain - ! and verifying whether the current patch has permission to write to - ! that cell. If both queries check out, the primitive variables of - ! the current patch are assigned to this cell. - do j = 0, n - do i = 0, m - myr = sqrt((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2) - - if (myr <= radius + thickness/2._wp .and. & - myr >= radius - thickness/2._wp .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then - - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded2D() - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id - - q_prim_vf(alf_idx)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1)* & - exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) - end if - - end do - end do - @:HardcodedDellacation() - - end subroutine s_varcircle - - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - subroutine s_3dvarcircle(patch_id, patch_id_fp, q_prim_vf) - - ! Patch identifier - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - ! Generic loop iterators - integer :: i, j, k - real(wp) :: radius, myr, thickness - @:HardcodedDimensionsExtrusion() - @:Hardcoded3DVariables() - - ! Transferring the circular patch's radius, centroid, smearing patch - ! identity and smearing coefficient information - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - z_centroid = patch_icpp(patch_id)%z_centroid - length_z = patch_icpp(patch_id)%length_z - radius = patch_icpp(patch_id)%radius - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - thickness = patch_icpp(patch_id)%epsilon - - ! Initializing the pseudo volume fraction value to 1. The value will - ! be modified as the patch is laid out on the grid, but only in the - ! case that smoothing of the circular patch's boundary is enabled. - eta = 1._wp - - ! write for all z - - ! Checking whether the circle covers a particular cell in the domain - ! and verifying whether the current patch has permission to write to - ! that cell. If both queries check out, the primitive variables of - ! the current patch are assigned to this cell. - do k = 0, p - do j = 0, n - do i = 0, m - myr = sqrt((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2) - - if (myr <= radius + thickness/2._wp .and. & - myr >= radius - thickness/2._wp .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then - - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded3D() - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id - - q_prim_vf(alf_idx)%sf(i, j, k) = patch_icpp(patch_id)%alpha(1)* & - exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) - end if - - end do - end do - end do - @:HardcodedDellacation() - - end subroutine s_3dvarcircle + end subroutine s_ib_3D_airfoil !> The elliptical patch is a 2D geometry. The geometry of !! the patch is well-defined when its centroid and radii @@ -938,7 +559,7 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_ellipse(patch_id, patch_id_fp, q_prim_vf) + subroutine s_ib_ellipse(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1001,7 +622,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_ellipse + end subroutine s_ib_ellipse !> The ellipsoidal patch is a 3D geometry. The geometry of !! the patch is well-defined when its centroid and radii @@ -1010,7 +631,7 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_ellipsoid(patch_id, patch_id_fp, q_prim_vf) + subroutine s_ib_ellipsoid(patch_id, patch_id_fp, q_prim_vf) ! Patch identifier integer, intent(in) :: patch_id @@ -1088,7 +709,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_ellipsoid + end subroutine s_ib_ellipsoid !> The rectangular patch is a 2D geometry that may be used, !! for example, in creating a solid boundary, or pre-/post- @@ -1102,7 +723,7 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_rectangle(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_rectangle(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1187,368 +808,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_rectangle - - !> The swept line patch is a 2D geometry that may be used, - !! for example, in creating a solid boundary, or pre-/post- - !! shock region, at an angle with respect to the axes of the - !! Cartesian coordinate system. The geometry of the patch is - !! well-defined when its centroid and normal vector, aimed - !! in the sweep direction, are provided. Note that the sweep - !! line patch DOES allow the smoothing of its boundary. - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - subroutine s_sweep_line(patch_id, patch_id_fp, q_prim_vf) - - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - integer :: i, j, k !< Generic loop operators - real(wp) :: a, b, c - @:HardcodedDimensionsExtrusion() - @:Hardcoded3DVariables() - - ! Transferring the centroid information of the line to be swept - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - - ! Obtaining coefficients of the equation describing the sweep line - a = patch_icpp(patch_id)%normal(1) - b = patch_icpp(patch_id)%normal(2) - c = -a*x_centroid - b*y_centroid - - ! Initializing the pseudo volume fraction value to 1. The value will - ! be modified as the patch is laid out on the grid, but only in the - ! case that smoothing of the sweep line patch's boundary is enabled. - eta = 1._wp - - ! Checking whether the region swept by the line covers a particular - ! cell in the domain and verifying whether the current patch has the - ! permission to write to that cell. If both queries check out, the - ! primitive variables of the current patch are written to this cell. - do j = 0, n - do i = 0, m - - if (patch_icpp(patch_id)%smoothen) then - eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy) & - *(a*x_cc(i) + b*y_cc(j) + c) & - /sqrt(a**2 + b**2)) - end if - - if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & - .or. & - patch_id_fp(i, j, 0) == smooth_patch_id) & - then - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded3D() - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id - end if - - end do - end do - @:HardcodedDellacation() - - end subroutine s_sweep_line - - !> The Taylor Green vortex is 2D decaying vortex that may be used, - !! for example, to verify the effects of viscous attenuation. - !! Geometry of the patch is well-defined when its centroid - !! are provided. - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - subroutine s_2D_TaylorGreen_Vortex(patch_id, patch_id_fp, q_prim_vf) - - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - integer :: i, j, k !< generic loop iterators - real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters - real(wp) :: L0, U0 !< Taylor Green Vortex parameters - @:HardcodedDimensionsExtrusion() - @:Hardcoded2DVariables() - - pi_inf = fluid_pp(1)%pi_inf - gamma = fluid_pp(1)%gamma - lit_gamma = (1._wp + gamma)/gamma - - ! Transferring the patch's centroid and length information - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - length_x = patch_icpp(patch_id)%length_x - length_y = patch_icpp(patch_id)%length_y - - ! Computing the beginning and the end x- and y-coordinates - ! of the patch based on its centroid and lengths - x_boundary%beg = x_centroid - 0.5_wp*length_x - x_boundary%end = x_centroid + 0.5_wp*length_x - y_boundary%beg = y_centroid - 0.5_wp*length_y - y_boundary%end = y_centroid + 0.5_wp*length_y - - ! Since the patch doesn't allow for its boundaries to be - ! smoothed out, the pseudo volume fraction is set to 1 to - ! ensure that only the current patch contributes to the fluid - ! state in the cells that this patch covers. - eta = 1._wp - ! U0 is the characteristic velocity of the vortex - U0 = patch_icpp(patch_id)%vel(1) - ! L0 is the characteristic length of the vortex - L0 = patch_icpp(patch_id)%vel(2) - ! Checking whether the patch covers a particular cell in the - ! domain and verifying whether the current patch has the - ! permission to write to that cell. If both queries check out, - ! the primitive variables of the current patch are assigned - ! to this cell. - do j = 0, n - do i = 0, m - if (x_boundary%beg <= x_cc(i) .and. & - x_boundary%end >= x_cc(i) .and. & - y_boundary%beg <= y_cc(j) .and. & - y_boundary%end >= y_cc(j) .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then - - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded2D() - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id - - ! Assign Parameters - q_prim_vf(mom_idx%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0) - q_prim_vf(mom_idx%end)%sf(i, j, 0) = -U0*cos(x_cc(i)/L0)*sin(y_cc(j)/L0) - q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(patch_id)%pres + (cos(2*x_cc(i))/L0 + & - cos(2*y_cc(j))/L0)* & - (q_prim_vf(1)%sf(i, j, 0)*U0*U0)/16 - end if - end do - end do - @:HardcodedDellacation() - - end subroutine s_2D_TaylorGreen_Vortex - - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - subroutine s_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf) - ! Description: This patch assigns the primitive variables as analytical - ! functions such that the code can be verified. - - ! Patch identifier - integer, intent(in) :: patch_id - integer, intent(inout), dimension(0:m, 0:n, 0:p) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - ! Generic loop iterators - integer :: i, j, k - ! Placeholders for the cell boundary values - real(wp) :: pi_inf, gamma, lit_gamma - @:HardcodedDimensionsExtrusion() - @:Hardcoded1DVariables() - - pi_inf = fluid_pp(1)%pi_inf - gamma = fluid_pp(1)%gamma - lit_gamma = (1._wp + gamma)/gamma - - ! Transferring the patch's centroid and length information - x_centroid = patch_icpp(patch_id)%x_centroid - length_x = patch_icpp(patch_id)%length_x - - ! Computing the beginning and the end x- and y-coordinates - ! of the patch based on its centroid and lengths - x_boundary%beg = x_centroid - 0.5_wp*length_x - x_boundary%end = x_centroid + 0.5_wp*length_x - - ! Since the patch doesn't allow for its boundaries to be - ! smoothed out, the pseudo volume fraction is set to 1 to - ! ensure that only the current patch contributes to the fluid - ! state in the cells that this patch covers. - eta = 1._wp - - ! Checking whether the line segment covers a particular cell in the - ! domain and verifying whether the current patch has the permission - ! to write to that cell. If both queries check out, the primitive - ! variables of the current patch are assigned to this cell. - do i = 0, m - if (x_boundary%beg <= x_cc(i) .and. & - x_boundary%end >= x_cc(i) .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, 0, 0))) then - - call s_assign_patch_primitive_variables(patch_id, i, 0, 0, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded1D() - end if - - end if - end do - @:HardcodedDellacation() - - end subroutine s_1D_bubble_pulse - - !> This patch generates the shape of the spherical harmonics - !! as a perturbation to a perfect sphere - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - subroutine s_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf) - - integer, intent(IN) :: patch_id - integer, intent(INOUT), dimension(0:m, 0:n, 0:p) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - real(wp) :: r, x_p, eps, phi - real(wp), dimension(2:9) :: as, Ps - real(wp) :: radius, x_centroid_local, y_centroid_local, z_centroid_local, eta_local, smooth_coeff_local - logical :: non_axis_sym_in - - integer :: i, j, k !< generic loop iterators - - ! Transferring the patch's centroid and radius information - x_centroid_local = patch_icpp(patch_id)%x_centroid - y_centroid_local = patch_icpp(patch_id)%y_centroid - z_centroid_local = patch_icpp(patch_id)%z_centroid - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff_local = patch_icpp(patch_id)%smooth_coeff - radius = patch_icpp(patch_id)%radius - as(2) = patch_icpp(patch_id)%a(2) - as(3) = patch_icpp(patch_id)%a(3) - as(4) = patch_icpp(patch_id)%a(4) - as(5) = patch_icpp(patch_id)%a(5) - as(6) = patch_icpp(patch_id)%a(6) - as(7) = patch_icpp(patch_id)%a(7) - as(8) = patch_icpp(patch_id)%a(8) - as(9) = patch_icpp(patch_id)%a(9) - non_axis_sym_in = patch_icpp(patch_id)%non_axis_sym - - ! Since the analytical patch does not allow for its boundaries to get - ! smoothed out, the pseudo volume fraction is set to 1 to make sure - ! that only the current patch contributes to the fluid state in the - ! cells that this patch covers. - eta_local = 1._wp - eps = 1.e-32_wp - - ! Checking whether the patch covers a particular cell in the domain - ! and verifying whether the current patch has permission to write to - ! to that cell. If both queries check out, the primitive variables - ! of the current patch are assigned to this cell. - if (p > 0 .and. .not. non_axis_sym_in) then - do k = 0, p - do j = 0, n - do i = 0, m - if (grid_geometry == 3) then - call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) - else - cart_y = y_cc(j) - cart_z = z_cc(k) - end if - - r = sqrt((x_cc(i) - x_centroid_local)**2 + (cart_y - y_centroid_local)**2 + (cart_z - z_centroid_local)**2) + eps - if (x_cc(i) - x_centroid_local <= 0) then - x_p = -1._wp*abs(x_cc(i) - x_centroid_local + eps)/r - else - x_p = abs(x_cc(i) - x_centroid_local + eps)/r - end if - - Ps(2) = unassociated_legendre(x_p, 2) - Ps(3) = unassociated_legendre(x_p, 3) - Ps(4) = unassociated_legendre(x_p, 4) - Ps(5) = unassociated_legendre(x_p, 5) - Ps(6) = unassociated_legendre(x_p, 6) - Ps(7) = unassociated_legendre(x_p, 7) - if ((x_cc(i) - x_centroid_local >= 0 & - .and. & - r - as(2)*Ps(2) - as(3)*Ps(3) - as(4)*Ps(4) - as(5)*Ps(5) - as(6)*Ps(6) - as(7)*Ps(7) <= radius & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & - (patch_id_fp(i, j, k) == smooth_patch_id)) & - then - if (patch_icpp(patch_id)%smoothen) then - eta_local = tanh(smooth_coeff_local/min(dx, dy, dz)* & - ((r - as(2)*Ps(2) - as(3)*Ps(3) - as(4)*Ps(4) - as(5)*Ps(5) - as(6)*Ps(6) - as(7)*Ps(7)) & - - radius))*(-0.5_wp) + 0.5_wp - end if - - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta_local, q_prim_vf, patch_id_fp) - end if - - end do - end do - end do - - else if (p == 0) then - do j = 0, n - do i = 0, m - - if (non_axis_sym_in) then - phi = atan(((y_cc(j) - y_centroid_local) + eps)/((x_cc(i) - x_centroid_local) + eps)) - r = sqrt((x_cc(i) - x_centroid_local)**2._wp + (y_cc(j) - y_centroid_local)**2._wp) + eps - x_p = (eps)/r - Ps(2) = spherical_harmonic_func(x_p, phi, 2, 2) - Ps(3) = spherical_harmonic_func(x_p, phi, 3, 3) - Ps(4) = spherical_harmonic_func(x_p, phi, 4, 4) - Ps(5) = spherical_harmonic_func(x_p, phi, 5, 5) - Ps(6) = spherical_harmonic_func(x_p, phi, 6, 6) - Ps(7) = spherical_harmonic_func(x_p, phi, 7, 7) - Ps(8) = spherical_harmonic_func(x_p, phi, 8, 8) - Ps(9) = spherical_harmonic_func(x_p, phi, 9, 9) - else - r = sqrt((x_cc(i) - x_centroid_local)**2._wp + (y_cc(j) - y_centroid_local)**2._wp) + eps - x_p = abs(x_cc(i) - x_centroid_local + eps)/r - Ps(2) = unassociated_legendre(x_p, 2) - Ps(3) = unassociated_legendre(x_p, 3) - Ps(4) = unassociated_legendre(x_p, 4) - Ps(5) = unassociated_legendre(x_p, 5) - Ps(6) = unassociated_legendre(x_p, 6) - Ps(7) = unassociated_legendre(x_p, 7) - Ps(8) = unassociated_legendre(x_p, 8) - Ps(9) = unassociated_legendre(x_p, 9) - end if - - if (x_cc(i) - x_centroid_local >= 0 & - .and. & - r - as(2)*Ps(2) - as(3)*Ps(3) - as(4)*Ps(4) - as(5)*Ps(5) - as(6)*Ps(6) - as(7)*Ps(7) - as(8)*Ps(8) - as(9)*Ps(9) <= radius .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & - then - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta_local, q_prim_vf, patch_id_fp) - - elseif (x_cc(i) - x_centroid_local < 0 & - .and. & - r - as(2)*Ps(2) + as(3)*Ps(3) - as(4)*Ps(4) + as(5)*Ps(5) - as(6)*Ps(6) + as(7)*Ps(7) - as(8)*Ps(8) + as(9)*Ps(9) <= radius & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & - then - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta_local, q_prim_vf, patch_id_fp) - - end if - end do - end do - end if - - end subroutine s_spherical_harmonic + end subroutine s_ib_rectangle !> The spherical patch is a 3D geometry that may be used, !! for example, in creating a bubble or a droplet. The patch @@ -1559,7 +819,7 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_sphere(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_sphere(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1648,7 +908,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_sphere + end subroutine s_ib_sphere !> The cuboidal patch is a 3D geometry that may be used, for !! example, in creating a solid boundary, or pre-/post-shock @@ -1661,7 +921,7 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_cuboid(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_cuboid(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id logical, optional, intent(in) :: ib_flag @@ -1751,7 +1011,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_cuboid + end subroutine s_ib_cuboid !> The cylindrical patch is a 3D geometry that may be used, !! for example, in setting up a cylindrical solid boundary @@ -1765,7 +1025,7 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_cylinder(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_cylinder(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1909,95 +1169,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_cylinder - - !> The swept plane patch is a 3D geometry that may be used, - !! for example, in creating a solid boundary, or pre-/post- - !! shock region, at an angle with respect to the axes of the - !! Cartesian coordinate system. The geometry of the patch is - !! well-defined when its centroid and normal vector, aimed - !! in the sweep direction, are provided. Note that the sweep - !! plane patch DOES allow the smoothing of its boundary. - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Primitive variables - subroutine s_sweep_plane(patch_id, patch_id_fp, q_prim_vf) - - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - integer :: i, j, k !< Generic loop iterators - real(wp) :: a, b, c, d - @:HardcodedDimensionsExtrusion() - @:Hardcoded3DVariables() - - ! Transferring the centroid information of the plane to be swept - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - z_centroid = patch_icpp(patch_id)%z_centroid - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - - ! Obtaining coefficients of the equation describing the sweep plane - a = patch_icpp(patch_id)%normal(1) - b = patch_icpp(patch_id)%normal(2) - c = patch_icpp(patch_id)%normal(3) - d = -a*x_centroid - b*y_centroid - c*z_centroid - - ! Initializing the pseudo volume fraction value to 1. The value will - ! be modified as the patch is laid out on the grid, but only in the - ! case that smearing of the sweep plane patch's boundary is enabled. - eta = 1._wp - - ! Checking whether the region swept by the plane covers a particular - ! cell in the domain and verifying whether the current patch has the - ! permission to write to that cell. If both queries check out, the - ! primitive variables of the current patch are written to this cell. - do k = 0, p - do j = 0, n - do i = 0, m - - if (grid_geometry == 3) then - call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) - else - cart_y = y_cc(j) - cart_z = z_cc(k) - end if - - if (patch_icpp(patch_id)%smoothen) then - eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy, dz) & - *(a*x_cc(i) + & - b*cart_y + & - c*cart_z + d) & - /sqrt(a**2 + b**2 + c**2)) - end if - - if ((a*x_cc(i) + b*cart_y + c*cart_z + d >= 0._wp & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) & - .or. & - patch_id_fp(i, j, k) == smooth_patch_id) & - then - - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded3D() - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id - end if - - end do - end do - end do - @:HardcodedDellacation() - - end subroutine s_sweep_plane + end subroutine s_ib_cylinder !> The STL patch is a 2/3D geometry that is imported from an STL file. !! @param patch_id is the patch identifier @@ -2006,7 +1178,7 @@ contains !! @param ib True if this patch is an immersed boundary !! @param STL_levelset STL levelset !! @param STL_levelset_norm STL levelset normals - subroutine s_model(patch_id, patch_id_fp, q_prim_vf, ib_flag, STL_levelset, STL_levelset_norm) + subroutine s_ib_model(patch_id, patch_id_fp, q_prim_vf, ib_flag, STL_levelset, STL_levelset_norm) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -2255,7 +1427,7 @@ contains call s_model_free(model) - end subroutine s_model + end subroutine s_ib_model subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z) $:GPU_ROUTINE(parallelism='[seq]') diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index 071a34d996..cd7895185f 100644 --- a/src/pre_process/m_icpp_patches.fpp +++ b/src/pre_process/m_icpp_patches.fpp @@ -64,7 +64,7 @@ module m_patches contains - impure subroutine s_apply_domain_patches(patch_id_fp, q_prim_vf, ib_markers_sf, levelset, levelset_norm) + impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf, ib_markers_sf, levelset, levelset_norm) type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:m, 0:m), intent(inout) :: patch_id_fp @@ -113,33 +113,6 @@ contains end do !> @} - !> IB Patches - !> @{ - ! Spherical patch - do i = 1, num_ibs - if (proc_rank == 0) then - print *, 'Processing 3D ib patch ', i - end if - - if (patch_ib(i)%geometry == 8) then - call s_sphere(i, ib_markers_sf, q_prim_vf, ib) - call s_sphere_levelset(i, levelset, levelset_norm) - elseif (patch_ib(i)%geometry == 9) then - call s_cuboid(i, ib_markers_sf, q_prim_vf, ib) - call s_cuboid_levelset(i, levelset, levelset_norm) - elseif (patch_ib(i)%geometry == 10) then - call s_cylinder(i, ib_markers_sf, q_prim_vf, ib) - call s_cylinder_levelset(i, levelset, levelset_norm) - elseif (patch_ib(i)%geometry == 11) then - call s_3D_airfoil(i, ib_markers_sf, q_prim_vf, ib) - call s_3D_airfoil_levelset(i, levelset, levelset_norm) - ! STL+IBM patch - elseif (patch_ib(i)%geometry == 12) then - call s_model(i, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) - end if - end do - !> @} - ! 2D Patch Geometries elseif (n > 0) then @@ -186,28 +159,6 @@ contains !> @} end do - !> IB Patches - !> @{ - do i = 1, num_ibs - if (proc_rank == 0) then - print *, 'Processing 2D ib patch ', i - end if - if (patch_ib(i)%geometry == 2) then - call s_circle(i, ib_markers_sf, q_prim_vf, ib) - call s_circle_levelset(i, levelset, levelset_norm) - elseif (patch_ib(i)%geometry == 3) then - call s_rectangle(i, ib_markers_sf, q_prim_vf, ib) - call s_rectangle_levelset(i, levelset, levelset_norm) - elseif (patch_ib(i)%geometry == 4) then - call s_airfoil(i, ib_markers_sf, q_prim_vf, ib) - call s_airfoil_levelset(i, levelset, levelset_norm) - ! STL+IBM patch - elseif (patch_ib(i)%geometry == 5) then - call s_model(i, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) - end if - end do - !> @} - ! 1D Patch Geometries else @@ -219,7 +170,7 @@ contains ! Line segment patch if (patch_icpp(i)%geometry == 1) then - call s_line_segment(i, patch_id_fp, q_prim_vf) + call s_icpp_line_segment(i, patch_id_fp, q_prim_vf) ! 1d analytical elseif (patch_icpp(i)%geometry == 16) then call s_1d_bubble_pulse(i, patch_id_fp, q_prim_vf) @@ -228,7 +179,7 @@ contains end if - end subroutine s_apply_domain_patches + end subroutine s_apply_icpp_patches !> The line segment patch is a 1D geometry that may be used, !! for example, in creating a Riemann problem. The geometry @@ -239,7 +190,7 @@ contains !! @param patch_id patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_line_segment(patch_id, patch_id_fp, q_prim_vf) + subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -300,7 +251,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_line_segment + end subroutine s_icpp_line_segment !> The spiral patch is a 2D geometry that may be used, The geometry !! of the patch is well-defined when its centroid and radius @@ -309,7 +260,7 @@ contains !! @param patch_id patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - impure subroutine s_spiral(patch_id, patch_id_fp, q_prim_vf) + impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -370,7 +321,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_spiral + end subroutine s_icpp_spiral !> The circular patch is a 2D geometry that may be used, for !! example, in creating a bubble or a droplet. The geometry @@ -381,7 +332,7 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_circle(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -459,13 +410,13 @@ contains end do @:HardcodedDellacation() - end subroutine s_circle + end subroutine s_icpp_circle !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -622,13 +573,13 @@ contains end do end if - end subroutine s_airfoil + end subroutine s_icpp_airfoil !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_3D_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_3D_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -793,14 +744,14 @@ contains end do end if - end subroutine s_3D_airfoil + end subroutine s_icpp_3D_airfoil !> The varcircle patch is a 2D geometry that may be used !! . It generatres an annulus !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_varcircle(patch_id, patch_id_fp, q_prim_vf) + subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf) ! Patch identifier integer, intent(in) :: patch_id @@ -859,12 +810,12 @@ contains end do @:HardcodedDellacation() - end subroutine s_varcircle + end subroutine s_icpp_varcircle !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_3dvarcircle(patch_id, patch_id_fp, q_prim_vf) + subroutine s_icpp_3dvarcircle(patch_id, patch_id_fp, q_prim_vf) ! Patch identifier integer, intent(in) :: patch_id @@ -929,7 +880,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_3dvarcircle + end subroutine s_icpp_3dvarcircle !> The elliptical patch is a 2D geometry. The geometry of !! the patch is well-defined when its centroid and radii @@ -938,7 +889,7 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_ellipse(patch_id, patch_id_fp, q_prim_vf) + subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1001,7 +952,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_ellipse + end subroutine s_icpp_ellipse !> The ellipsoidal patch is a 3D geometry. The geometry of !! the patch is well-defined when its centroid and radii @@ -1010,7 +961,7 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_ellipsoid(patch_id, patch_id_fp, q_prim_vf) + subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf) ! Patch identifier integer, intent(in) :: patch_id @@ -1088,7 +1039,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_ellipsoid + end subroutine s_icpp_ellipsoid !> The rectangular patch is a 2D geometry that may be used, !! for example, in creating a solid boundary, or pre-/post- @@ -1102,7 +1053,7 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_rectangle(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1187,7 +1138,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_rectangle + end subroutine s_icpp_rectangle !> The swept line patch is a 2D geometry that may be used, !! for example, in creating a solid boundary, or pre-/post- @@ -1199,7 +1150,7 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_sweep_line(patch_id, patch_id_fp, q_prim_vf) + subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1261,7 +1212,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_sweep_line + end subroutine s_icpp_sweep_line !> The Taylor Green vortex is 2D decaying vortex that may be used, !! for example, to verify the effects of viscous attenuation. @@ -1270,7 +1221,7 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_2D_TaylorGreen_Vortex(patch_id, patch_id_fp, q_prim_vf) + subroutine s_icpp_2D_TaylorGreen_Vortex(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1343,12 +1294,12 @@ contains end do @:HardcodedDellacation() - end subroutine s_2D_TaylorGreen_Vortex + end subroutine s_icpp_2D_TaylorGreen_Vortex !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf) + subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf) ! Description: This patch assigns the primitive variables as analytical ! functions such that the code can be verified. @@ -1404,14 +1355,14 @@ contains end do @:HardcodedDellacation() - end subroutine s_1D_bubble_pulse + end subroutine s_icpp_1D_bubble_pulse !> This patch generates the shape of the spherical harmonics !! as a perturbation to a perfect sphere !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf) + subroutine s_icpp_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf) integer, intent(IN) :: patch_id integer, intent(INOUT), dimension(0:m, 0:n, 0:p) :: patch_id_fp @@ -1548,7 +1499,7 @@ contains end do end if - end subroutine s_spherical_harmonic + end subroutine s_icpp_spherical_harmonic !> The spherical patch is a 3D geometry that may be used, !! for example, in creating a bubble or a droplet. The patch @@ -1559,7 +1510,7 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_sphere(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1648,7 +1599,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_sphere + end subroutine s_icpp_sphere !> The cuboidal patch is a 3D geometry that may be used, for !! example, in creating a solid boundary, or pre-/post-shock @@ -1661,7 +1612,7 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_cuboid(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id logical, optional, intent(in) :: ib_flag @@ -1751,7 +1702,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_cuboid + end subroutine s_icpp_cuboid !> The cylindrical patch is a 3D geometry that may be used, !! for example, in setting up a cylindrical solid boundary @@ -1765,7 +1716,7 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_cylinder(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf, ib_flag) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1909,7 +1860,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_cylinder + end subroutine s_icpp_cylinder !> The swept plane patch is a 3D geometry that may be used, !! for example, in creating a solid boundary, or pre-/post- @@ -1921,7 +1872,7 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Primitive variables - subroutine s_sweep_plane(patch_id, patch_id_fp, q_prim_vf) + subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1997,7 +1948,7 @@ contains end do @:HardcodedDellacation() - end subroutine s_sweep_plane + end subroutine s_icpp_sweep_plane !> The STL patch is a 2/3D geometry that is imported from an STL file. !! @param patch_id is the patch identifier @@ -2006,7 +1957,7 @@ contains !! @param ib True if this patch is an immersed boundary !! @param STL_levelset STL levelset !! @param STL_levelset_norm STL levelset normals - subroutine s_model(patch_id, patch_id_fp, q_prim_vf, ib_flag, STL_levelset, STL_levelset_norm) + subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf, ib_flag, STL_levelset, STL_levelset_norm) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -2255,7 +2206,7 @@ contains call s_model_free(model) - end subroutine s_model + end subroutine s_icpp_model subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z) $:GPU_ROUTINE(parallelism='[seq]') From cbdfa1c71be8ca1a3aa0d28d518c6973d8ee68e0 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Wed, 17 Sep 2025 17:42:02 -0400 Subject: [PATCH 14/43] More renaming in the icpp_patches file --- src/pre_process/m_icpp_patches.fpp | 36 +++++++++++++++--------------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index cd7895185f..363e37ee21 100644 --- a/src/pre_process/m_icpp_patches.fpp +++ b/src/pre_process/m_icpp_patches.fpp @@ -87,28 +87,28 @@ contains !> @{ ! Spherical patch if (patch_icpp(i)%geometry == 8) then - call s_sphere(i, patch_id_fp, q_prim_vf) + call s_icpp_sphere(i, patch_id_fp, q_prim_vf) ! Cuboidal patch elseif (patch_icpp(i)%geometry == 9) then - call s_cuboid(i, patch_id_fp, q_prim_vf) + call s_icpp_cuboid(i, patch_id_fp, q_prim_vf) ! Cylindrical patch elseif (patch_icpp(i)%geometry == 10) then - call s_cylinder(i, patch_id_fp, q_prim_vf) + call s_icpp_cylinder(i, patch_id_fp, q_prim_vf) ! Swept plane patch elseif (patch_icpp(i)%geometry == 11) then - call s_sweep_plane(i, patch_id_fp, q_prim_vf) + call s_icpp_sweep_plane(i, patch_id_fp, q_prim_vf) ! Ellipsoidal patch elseif (patch_icpp(i)%geometry == 12) then - call s_ellipsoid(i, patch_id_fp, q_prim_vf) + call s_icpp_ellipsoid(i, patch_id_fp, q_prim_vf) ! Spherical harmonic patch elseif (patch_icpp(i)%geometry == 14) then - call s_spherical_harmonic(i, patch_id_fp, q_prim_vf) + call s_icpp_spherical_harmonic(i, patch_id_fp, q_prim_vf) ! 3D Modified circular patch elseif (patch_icpp(i)%geometry == 19) then - call s_3dvarcircle(i, patch_id_fp, q_prim_vf) + call s_icpp_3dvarcircle(i, patch_id_fp, q_prim_vf) ! 3D STL patch elseif (patch_icpp(i)%geometry == 21) then - call s_model(i, patch_id_fp, q_prim_vf) + call s_icpp_model(i, patch_id_fp, q_prim_vf) end if end do !> @} @@ -126,35 +126,35 @@ contains !> @{ ! Circular patch if (patch_icpp(i)%geometry == 2) then - call s_circle(i, patch_id_fp, q_prim_vf) + call s_icpp_circle(i, patch_id_fp, q_prim_vf) ! Rectangular patch elseif (patch_icpp(i)%geometry == 3) then - call s_rectangle(i, patch_id_fp, q_prim_vf) + call s_icpp_rectangle(i, patch_id_fp, q_prim_vf) ! Swept line patch elseif (patch_icpp(i)%geometry == 4) then - call s_sweep_line(i, patch_id_fp, q_prim_vf) + call s_icpp_sweep_line(i, patch_id_fp, q_prim_vf) ! Elliptical patch elseif (patch_icpp(i)%geometry == 5) then - call s_ellipse(i, patch_id_fp, q_prim_vf) + call s_icpp_ellipse(i, patch_id_fp, q_prim_vf) ! Unimplemented patch (formerly isentropic vortex) elseif (patch_icpp(i)%geometry == 6) then call s_mpi_abort('This used to be the isentropic vortex patch, '// & 'which no longer exists. See Examples. Exiting.') ! Spherical Harmonic Patch elseif (patch_icpp(i)%geometry == 14) then - call s_spherical_harmonic(i, patch_id_fp, q_prim_vf) + call s_icpp_spherical_harmonic(i, patch_id_fp, q_prim_vf) ! Spiral patch elseif (patch_icpp(i)%geometry == 17) then - call s_spiral(i, patch_id_fp, q_prim_vf) + call s_icpp_spiral(i, patch_id_fp, q_prim_vf) ! Modified circular patch elseif (patch_icpp(i)%geometry == 18) then - call s_varcircle(i, patch_id_fp, q_prim_vf) + call s_icpp_varcircle(i, patch_id_fp, q_prim_vf) ! TaylorGreen vortex patch elseif (patch_icpp(i)%geometry == 20) then - call s_2D_TaylorGreen_vortex(i, patch_id_fp, q_prim_vf) + call s_icpp_2D_TaylorGreen_vortex(i, patch_id_fp, q_prim_vf) ! STL patch elseif (patch_icpp(i)%geometry == 21) then - call s_model(i, patch_id_fp, q_prim_vf) + call s_icpp_model(i, patch_id_fp, q_prim_vf) end if !> @} end do @@ -173,7 +173,7 @@ contains call s_icpp_line_segment(i, patch_id_fp, q_prim_vf) ! 1d analytical elseif (patch_icpp(i)%geometry == 16) then - call s_1d_bubble_pulse(i, patch_id_fp, q_prim_vf) + call s_icpp_1d_bubble_pulse(i, patch_id_fp, q_prim_vf) end if end do From 30c983be97acf8c687c02ab458c3c1e0b894c6e6 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 09:28:12 -0400 Subject: [PATCH 15/43] Did updates to validate the ib cirble patch --- src/common/m_ib_patches.fpp | 72 +++++++++---------------------------- 1 file changed, 16 insertions(+), 56 deletions(-) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index 7fec6e018f..b3deec30f1 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -82,20 +82,20 @@ contains end if if (patch_ib(i)%geometry == 8) then - call s_ib_sphere(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_sphere(i, ib_markers_sf, q_prim_vf) call s_ib_sphere_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 9) then - call s_ib_cuboid(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_cuboid(i, ib_markers_sf, q_prim_vf) call s_ib_cuboid_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 10) then - call s_ib_cylinder(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_cylinder(i, ib_markers_sf, q_prim_vf) call s_ib_cylinder_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 11) then - call s_ib_3D_airfoil(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_3D_airfoil(i, ib_markers_sf, q_prim_vf) call s_ib_3D_airfoil_levelset(i, levelset, levelset_norm) ! STL+IBM patch elseif (patch_ib(i)%geometry == 12) then - call s_ib_model(i, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) + call s_ib_model(i, ib_markers_sf, q_prim_vf, levelset, levelset_norm) end if end do !> @} @@ -110,17 +110,17 @@ contains print *, 'Processing 2D ib patch ', i end if if (patch_ib(i)%geometry == 2) then - call s_ib_circle(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_circle(i, ib_markers_sf, q_prim_vf) call s_circle_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 3) then - call s_ib_rectangle(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_rectangle(i, ib_markers_sf, q_prim_vf) call s_rectangle_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 4) then - call s_ib_airfoil(i, ib_markers_sf, q_prim_vf, ib) + call s_ib_airfoil(i, ib_markers_sf, q_prim_vf) call s_airfoil_levelset(i, levelset, levelset_norm) ! STL+IBM patch elseif (patch_ib(i)%geometry == 5) then - call s_ib_model(i, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) + call s_ib_model(i, ib_markers_sf, q_prim_vf, levelset, levelset_norm) end if end do !> @} @@ -138,33 +138,23 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_circle(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_circle(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag real(wp) :: radius integer :: i, j, k !< Generic loop iterators - @:HardcodedDimensionsExtrusion() - @:Hardcoded2DVariables() ! Transferring the circular patch's radius, centroid, smearing patch ! identity and smearing coefficient information - if (present(ib_flag)) then - x_centroid = patch_ib(patch_id)%x_centroid - y_centroid = patch_ib(patch_id)%y_centroid - radius = patch_ib(patch_id)%radius - else - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - radius = patch_icpp(patch_id)%radius - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - end if + x_centroid = patch_ib(patch_id)%x_centroid + y_centroid = patch_ib(patch_id)%y_centroid + radius = patch_ib(patch_id)%radius + ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the @@ -178,43 +168,13 @@ contains do j = 0, n do i = 0, m - - if (.not. present(ib_flag) .and. patch_icpp(patch_id)%smoothen) then - - eta = tanh(smooth_coeff/min(dx, dy)* & - (sqrt((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2) & - - radius))*(-0.5_wp) + 0.5_wp - - end if - - if (present(ib_flag) .and. ((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2 <= radius**2)) & + if ((x_cc(i) - x_centroid)**2 & + + (y_cc(j) - y_centroid)**2 <= radius**2) & then - patch_id_fp(i, j, 0) = patch_id - else - if (((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2 <= radius**2 & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & - .or. & - (.not. present(ib_flag) .and. patch_id_fp(i, j, 0) == smooth_patch_id)) & - then - - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded2D() - end if - - end if end if end do end do - @:HardcodedDellacation() end subroutine s_ib_circle From 2b4ab8d033dc0eea69663473f04507a6761bd4d2 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 09:47:39 -0400 Subject: [PATCH 16/43] Removed everything through cuboids --- src/common/m_ib_patches.fpp | 315 ++++-------------------------------- 1 file changed, 29 insertions(+), 286 deletions(-) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index b3deec30f1..fbf99b445b 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -166,6 +166,9 @@ contains ! that cell. If both queries check out, the primitive variables of ! the current patch are assigned to this cell. + ! TODO :: THIS SETS PATCH_ID_FP TO HODL THE PATCH ID, BUT WE NEED TO + ! NOW ALSO SEARCH FOR OTHER POINTS TO DELETE THE CURRENT PATCH ID + do j = 0, n do i = 0, m if ((x_cc(i) - x_centroid)**2 & @@ -182,19 +185,17 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_airfoil(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag real(wp) :: x0, y0, f, x_act, y_act, ca_in, pa, ma, ta, theta real(wp) :: xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c integer :: i, j, k integer :: Np1, Np2 - if (.not. present(ib_flag)) return x0 = patch_ib(patch_id)%x_centroid y0 = patch_ib(patch_id)%y_centroid ca_in = patch_ib(patch_id)%c @@ -345,18 +346,16 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_3D_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_3D_airfoil(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag real(wp) :: x0, y0, z0, lz, z_max, z_min, f, x_act, y_act, ca_in, pa, ma, ta, theta, xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c integer :: i, j, k, l integer :: Np1, Np2 - if (.not. present(ib_flag)) return x0 = patch_ib(patch_id)%x_centroid y0 = patch_ib(patch_id)%y_centroid z0 = patch_ib(patch_id)%z_centroid @@ -512,165 +511,6 @@ contains end subroutine s_ib_3D_airfoil - !> The elliptical patch is a 2D geometry. The geometry of - !! the patch is well-defined when its centroid and radii - !! are provided. Note that the elliptical patch DOES allow - !! for the smoothing of its boundary - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - subroutine s_ib_ellipse(patch_id, patch_id_fp, q_prim_vf) - - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - integer :: i, j, k !< Generic loop operators - real(wp) :: a, b - @:HardcodedDimensionsExtrusion() - @:Hardcoded2DVariables() - - ! Transferring the elliptical patch's radii, centroid, smearing - ! patch identity, and smearing coefficient information - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - a = patch_icpp(patch_id)%radii(1) - b = patch_icpp(patch_id)%radii(2) - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - - ! Initializing the pseudo volume fraction value to 1. The value - ! be modified as the patch is laid out on the grid, but only in - ! the case that smoothing of the elliptical patch's boundary is - ! enabled. - eta = 1._wp - - ! Checking whether the ellipse covers a particular cell in the - ! domain and verifying whether the current patch has permission - ! to write to that cell. If both queries check out, the primitive - ! variables of the current patch are assigned to this cell. - do j = 0, n - do i = 0, m - - if (patch_icpp(patch_id)%smoothen) then - eta = tanh(smooth_coeff/min(dx, dy)* & - (sqrt(((x_cc(i) - x_centroid)/a)**2 + & - ((y_cc(j) - y_centroid)/b)**2) & - - 1._wp))*(-0.5_wp) + 0.5_wp - end if - - if ((((x_cc(i) - x_centroid)/a)**2 + & - ((y_cc(j) - y_centroid)/b)**2 <= 1._wp & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & - .or. & - patch_id_fp(i, j, 0) == smooth_patch_id) & - then - - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded2D() - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id - end if - end do - end do - @:HardcodedDellacation() - - end subroutine s_ib_ellipse - - !> The ellipsoidal patch is a 3D geometry. The geometry of - !! the patch is well-defined when its centroid and radii - !! are provided. Note that the ellipsoidal patch DOES allow - !! for the smoothing of its boundary - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - subroutine s_ib_ellipsoid(patch_id, patch_id_fp, q_prim_vf) - - ! Patch identifier - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - - ! Generic loop iterators - integer :: i, j, k - real(wp) :: a, b, c - @:HardcodedDimensionsExtrusion() - @:Hardcoded3DVariables() - - ! Transferring the ellipsoidal patch's radii, centroid, smearing - ! patch identity, and smearing coefficient information - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - z_centroid = patch_icpp(patch_id)%z_centroid - a = patch_icpp(patch_id)%radii(1) - b = patch_icpp(patch_id)%radii(2) - c = patch_icpp(patch_id)%radii(3) - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - - ! Initializing the pseudo volume fraction value to 1. The value - ! be modified as the patch is laid out on the grid, but only in - ! the case that smoothing of the ellipsoidal patch's boundary is - ! enabled. - eta = 1._wp - - ! Checking whether the ellipsoid covers a particular cell in the - ! domain and verifying whether the current patch has permission - ! to write to that cell. If both queries check out, the primitive - ! variables of the current patch are assigned to this cell. - do k = 0, p - do j = 0, n - do i = 0, m - - if (grid_geometry == 3) then - call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) - else - cart_y = y_cc(j) - cart_z = z_cc(k) - end if - - if (patch_icpp(patch_id)%smoothen) then - eta = tanh(smooth_coeff/min(dx, dy, dz)* & - (sqrt(((x_cc(i) - x_centroid)/a)**2 + & - ((cart_y - y_centroid)/b)**2 + & - ((cart_z - z_centroid)/c)**2) & - - 1._wp))*(-0.5_wp) + 0.5_wp - end if - - if ((((x_cc(i) - x_centroid)/a)**2 + & - ((cart_y - y_centroid)/b)**2 + & - ((cart_z - z_centroid)/c)**2 <= 1._wp & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) & - .or. & - patch_id_fp(i, j, k) == smooth_patch_id) & - then - - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded3D() - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id - end if - end do - end do - end do - @:HardcodedDellacation() - - end subroutine s_ib_ellipsoid - !> The rectangular patch is a 2D geometry that may be used, !! for example, in creating a solid boundary, or pre-/post- !! shock region, in alignment with the axes of the Cartesian @@ -683,17 +523,14 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_rectangle(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_rectangle(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary integer :: i, j, k !< generic loop iterators real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters - @:HardcodedDimensionsExtrusion() - @:Hardcoded2DVariables() pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma @@ -735,38 +572,13 @@ contains x_boundary%end >= x_cc(i) .and. & y_boundary%beg <= y_cc(j) .and. & y_boundary%end >= y_cc(j)) then - if (present(ib_flag)) then - ! Updating the patch identities bookkeeping variable - patch_id_fp(i, j, 0) = patch_id - else - if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & - then - - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded2D() - end if - - if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then - !zero density, reassign according to Tait EOS - q_prim_vf(1)%sf(i, j, 0) = & - (((q_prim_vf(E_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))* & - rhoref*(1._wp - q_prim_vf(alf_idx)%sf(i, j, 0)) - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id - end if - end if + ! Updating the patch identities bookkeeping variable + patch_id_fp(i, j, 0) = patch_id + end if end do end do - @:HardcodedDellacation() end subroutine s_ib_rectangle @@ -779,37 +591,26 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_sphere(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_sphere(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary ! Generic loop iterators integer :: i, j, k real(wp) :: radius - @:HardcodedDimensionsExtrusion() - @:Hardcoded3DVariables() !! Variables to initialize the pressure field that corresponds to the !! bubble-collapse test case found in Tiwari et al. (2013) ! Transferring spherical patch's radius, centroid, smoothing patch ! identity and smoothing coefficient information - if (present(ib_flag)) then - x_centroid = patch_ib(patch_id)%x_centroid - y_centroid = patch_ib(patch_id)%y_centroid - z_centroid = patch_ib(patch_id)%z_centroid - radius = patch_ib(patch_id)%radius - else - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - z_centroid = patch_icpp(patch_id)%z_centroid - radius = patch_icpp(patch_id)%radius - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - end if + x_centroid = patch_ib(patch_id)%x_centroid + y_centroid = patch_ib(patch_id)%y_centroid + z_centroid = patch_ib(patch_id)%z_centroid + radius = patch_ib(patch_id)%radius + ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the @@ -823,50 +624,21 @@ contains do k = 0, p do j = 0, n do i = 0, m - if (grid_geometry == 3) then call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) else cart_y = y_cc(j) cart_z = z_cc(k) end if - - if (.not. present(ib_flag) .and. patch_icpp(patch_id)%smoothen) then - eta = tanh(smooth_coeff/min(dx, dy, dz)* & - (sqrt((x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2) & - - radius))*(-0.5_wp) + 0.5_wp - end if - - if (present(ib_flag)) then - ! Updating the patch identities bookkeeping variable - if (((x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2)) then - patch_id_fp(i, j, k) = patch_id - end if - else - if ((((x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2) .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & - patch_id_fp(i, j, k) == smooth_patch_id) then - - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded3D() - end if - - end if + ! Updating the patch identities bookkeeping variable + if (((x_cc(i) - x_centroid)**2 & + + (cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2)) then + patch_id_fp(i, j, k) = patch_id end if end do end do end do - @:HardcodedDellacation() end subroutine s_ib_sphere @@ -881,33 +653,21 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_ib_cuboid(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_cuboid(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id - logical, optional, intent(in) :: ib_flag integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop iterators - @:HardcodedDimensionsExtrusion() - @:Hardcoded3DVariables() ! Transferring the cuboid's centroid and length information - if (present(ib_flag)) then - x_centroid = patch_ib(patch_id)%x_centroid - y_centroid = patch_ib(patch_id)%y_centroid - z_centroid = patch_ib(patch_id)%z_centroid - length_x = patch_ib(patch_id)%length_x - length_y = patch_ib(patch_id)%length_y - length_z = patch_ib(patch_id)%length_z - else - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - z_centroid = patch_icpp(patch_id)%z_centroid - length_x = patch_icpp(patch_id)%length_x - length_y = patch_icpp(patch_id)%length_y - length_z = patch_icpp(patch_id)%length_z - end if + x_centroid = patch_ib(patch_id)%x_centroid + y_centroid = patch_ib(patch_id)%y_centroid + z_centroid = patch_ib(patch_id)%z_centroid + length_x = patch_ib(patch_id)%length_x + length_y = patch_ib(patch_id)%length_y + length_z = patch_ib(patch_id)%length_z ! Computing the beginning and the end x-, y- and z-coordinates of ! the cuboid based on its centroid and lengths @@ -946,25 +706,8 @@ contains z_boundary%beg <= cart_z .and. & z_boundary%end >= cart_z) then - if (present(ib_flag)) then - ! Updating the patch identities bookkeeping variable - patch_id_fp(i, j, k) = patch_id - else - if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then - - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded3D() - end if - - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id - - end if - end if + ! Updating the patch identities bookkeeping variable + patch_id_fp(i, j, k) = patch_id end if end do end do From e1089fa1ba6691b7998e9c91ba630e7be18eb109 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 09:52:52 -0400 Subject: [PATCH 17/43] Finished with IB file --- src/common/m_ib_patches.fpp | 286 ++++++++++++------------------------ 1 file changed, 91 insertions(+), 195 deletions(-) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index fbf99b445b..1f21874637 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -9,7 +9,7 @@ #:include '3dHardcodedIC.fpp' #:include 'macros.fpp' -module m_patches +module m_ib_patches use m_model ! Subroutine(s) related to STL files @@ -728,40 +728,25 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_cylinder(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_ib_cylinder(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary integer :: i, j, k !< Generic loop iterators real(wp) :: radius - @:HardcodedDimensionsExtrusion() - @:Hardcoded3DVariables() ! Transferring the cylindrical patch's centroid, length, radius, ! smoothing patch identity and smoothing coefficient information - if (present(ib_flag)) then - x_centroid = patch_ib(patch_id)%x_centroid - y_centroid = patch_ib(patch_id)%y_centroid - z_centroid = patch_ib(patch_id)%z_centroid - length_x = patch_ib(patch_id)%length_x - length_y = patch_ib(patch_id)%length_y - length_z = patch_ib(patch_id)%length_z - radius = patch_ib(patch_id)%radius - else - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - z_centroid = patch_icpp(patch_id)%z_centroid - length_x = patch_icpp(patch_id)%length_x - length_y = patch_icpp(patch_id)%length_y - length_z = patch_icpp(patch_id)%length_z - radius = patch_icpp(patch_id)%radius - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - end if + x_centroid = patch_ib(patch_id)%x_centroid + y_centroid = patch_ib(patch_id)%y_centroid + z_centroid = patch_ib(patch_id)%z_centroid + length_x = patch_ib(patch_id)%length_x + length_y = patch_ib(patch_id)%length_y + length_z = patch_ib(patch_id)%length_z + radius = patch_ib(patch_id)%radius ! Computing the beginning and the end x-, y- and z-coordinates of ! the cylinder based on its centroid and lengths @@ -792,85 +777,30 @@ contains cart_z = z_cc(k) end if - if (.not. present(ib_flag) .and. patch_icpp(patch_id)%smoothen) then - if (.not. f_is_default(length_x)) then - eta = tanh(smooth_coeff/min(dy, dz)* & - (sqrt((cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2) & - - radius))*(-0.5_wp) + 0.5_wp - elseif (.not. f_is_default(length_y)) then - eta = tanh(smooth_coeff/min(dx, dz)* & - (sqrt((x_cc(i) - x_centroid)**2 & - + (cart_z - z_centroid)**2) & - - radius))*(-0.5_wp) + 0.5_wp - else - eta = tanh(smooth_coeff/min(dx, dy)* & - (sqrt((x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2) & - - radius))*(-0.5_wp) + 0.5_wp - end if - end if - - if (present(ib_flag)) then - if (((.not. f_is_default(length_x) .and. & - (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2 .and. & - x_boundary%beg <= x_cc(i) .and. & - x_boundary%end >= x_cc(i)) & - .or. & - (.not. f_is_default(length_y) .and. & - (x_cc(i) - x_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2 .and. & - y_boundary%beg <= cart_y .and. & - y_boundary%end >= cart_y) & - .or. & - (.not. f_is_default(length_z) .and. & - (x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 <= radius**2 .and. & - z_boundary%beg <= cart_z .and. & - z_boundary%end >= cart_z))) then - - ! Updating the patch identities bookkeeping variable - patch_id_fp(i, j, k) = patch_id - end if - - else - if (((.not. f_is_default(length_x) .and. & - (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2 .and. & - x_boundary%beg <= x_cc(i) .and. & - x_boundary%end >= x_cc(i)) & - .or. & - (.not. f_is_default(length_y) .and. & - (x_cc(i) - x_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2 .and. & - y_boundary%beg <= cart_y .and. & - y_boundary%end >= cart_y) & - .or. & - (.not. f_is_default(length_z) .and. & - (x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 <= radius**2 .and. & - z_boundary%beg <= cart_z .and. & - z_boundary%end >= cart_z) .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & - patch_id_fp(i, j, k) == smooth_patch_id) then - - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded3D() - end if + if (((.not. f_is_default(length_x) .and. & + (cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2 .and. & + x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i)) & + .or. & + (.not. f_is_default(length_y) .and. & + (x_cc(i) - x_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2 .and. & + y_boundary%beg <= cart_y .and. & + y_boundary%end >= cart_y) & + .or. & + (.not. f_is_default(length_z) .and. & + (x_cc(i) - x_centroid)**2 & + + (cart_y - y_centroid)**2 <= radius**2 .and. & + z_boundary%beg <= cart_z .and. & + z_boundary%end >= cart_z))) then - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id - end if + ! Updating the patch identities bookkeeping variable + patch_id_fp(i, j, k) = patch_id end if end do end do end do - @:HardcodedDellacation() end subroutine s_ib_cylinder @@ -881,7 +811,7 @@ contains !! @param ib True if this patch is an immersed boundary !! @param STL_levelset STL levelset !! @param STL_levelset_norm STL levelset normals - subroutine s_ib_model(patch_id, patch_id_fp, q_prim_vf, ib_flag, STL_levelset, STL_levelset_norm) + subroutine s_ib_model(patch_id, patch_id_fp, q_prim_vf, STL_levelset, STL_levelset_norm) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -890,7 +820,6 @@ contains ! Variables for IBM+STL type(levelset_field), optional, intent(inout) :: STL_levelset !< Levelset determined by models type(levelset_norm_field), optional, intent(inout) :: STL_levelset_norm !< Levelset_norm determined by models - logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary real(wp) :: normals(1:3) !< Boundary normal buffer integer :: boundary_vertex_count, boundary_edge_count, total_vertices !< Boundary vertex real(wp), allocatable, dimension(:, :, :) :: boundary_v !< Boundary vertex buffer @@ -913,27 +842,14 @@ contains real(wp), dimension(1:4, 1:4) :: transform, transform_n - if (present(ib_flag) .and. proc_rank == 0) then - print *, " * Reading model: "//trim(patch_ib(patch_id)%model_filepath) - else if (proc_rank == 0) then - print *, " * Reading model: "//trim(patch_icpp(patch_id)%model_filepath) - end if + print *, " * Reading model: "//trim(patch_ib(patch_id)%model_filepath) - if (present(ib_flag)) then - model = f_model_read(patch_ib(patch_id)%model_filepath) - params%scale(:) = patch_ib(patch_id)%model_scale(:) - params%translate(:) = patch_ib(patch_id)%model_translate(:) - params%rotate(:) = patch_ib(patch_id)%model_rotate(:) - params%spc = patch_ib(patch_id)%model_spc - params%threshold = patch_ib(patch_id)%model_threshold - else - model = f_model_read(patch_icpp(patch_id)%model_filepath) - params%scale(:) = patch_icpp(patch_id)%model_scale(:) - params%translate(:) = patch_icpp(patch_id)%model_translate(:) - params%rotate(:) = patch_icpp(patch_id)%model_rotate(:) - params%spc = patch_icpp(patch_id)%model_spc - params%threshold = patch_icpp(patch_id)%model_threshold - end if + model = f_model_read(patch_ib(patch_id)%model_filepath) + params%scale(:) = patch_ib(patch_id)%model_scale(:) + params%translate(:) = patch_ib(patch_id)%model_translate(:) + params%rotate(:) = patch_ib(patch_id)%model_rotate(:) + params%spc = patch_ib(patch_id)%model_spc + params%threshold = patch_ib(patch_id)%model_threshold if (proc_rank == 0) then print *, " * Transforming model." @@ -1035,93 +951,73 @@ contains eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_icpp(patch_id)%model_spc) end if - if (present(ib_flag)) then - ! Reading STL boundary vertices and compute the levelset and levelset_norm - if (eta > patch_ib(patch_id)%model_threshold) then - patch_id_fp(i, j, k) = patch_id - end if + ! Reading STL boundary vertices and compute the levelset and levelset_norm + if (eta > patch_ib(patch_id)%model_threshold) then + patch_id_fp(i, j, k) = patch_id + end if - ! 3D models - if (p > 0) then + ! 3D models + if (p > 0) then - ! Get the boundary normals and shortest distance between the cell center and the model boundary - call f_distance_normals_3D(model, point, normals, distance) + ! Get the boundary normals and shortest distance between the cell center and the model boundary + call f_distance_normals_3D(model, point, normals, distance) - ! Get the shortest distance between the cell center and the interpolated model boundary - if (interpolate) then - STL_levelset%sf(i, j, k, patch_id) = f_interpolated_distance(interpolated_boundary_v, & - total_vertices, & - point) - else - STL_levelset%sf(i, j, k, patch_id) = distance - end if + ! Get the shortest distance between the cell center and the interpolated model boundary + if (interpolate) then + STL_levelset%sf(i, j, k, patch_id) = f_interpolated_distance(interpolated_boundary_v, & + total_vertices, & + point) + else + STL_levelset%sf(i, j, k, patch_id) = distance + end if - ! Correct the sign of the levelset - if (patch_id_fp(i, j, k) > 0) then - STL_levelset%sf(i, j, k, patch_id) = -abs(STL_levelset%sf(i, j, k, patch_id)) - end if + ! Correct the sign of the levelset + if (patch_id_fp(i, j, k) > 0) then + STL_levelset%sf(i, j, k, patch_id) = -abs(STL_levelset%sf(i, j, k, patch_id)) + end if - ! Correct the sign of the levelset_norm - if (patch_id_fp(i, j, k) == 0) then - normals(1:3) = -normals(1:3) - end if + ! Correct the sign of the levelset_norm + if (patch_id_fp(i, j, k) == 0) then + normals(1:3) = -normals(1:3) + end if - ! Assign the levelset_norm - STL_levelset_norm%sf(i, j, k, patch_id, 1:3) = normals(1:3) + ! Assign the levelset_norm + STL_levelset_norm%sf(i, j, k, patch_id, 1:3) = normals(1:3) + else + ! 2D models + if (interpolate) then + ! Get the shortest distance between the cell center and the model boundary + STL_levelset%sf(i, j, 0, patch_id) = f_interpolated_distance(interpolated_boundary_v, & + total_vertices, & + point) else - ! 2D models - if (interpolate) then - ! Get the shortest distance between the cell center and the model boundary - STL_levelset%sf(i, j, 0, patch_id) = f_interpolated_distance(interpolated_boundary_v, & - total_vertices, & - point) - else - ! Get the shortest distance between the cell center and the interpolated model boundary - STL_levelset%sf(i, j, 0, patch_id) = f_distance(boundary_v, & - boundary_edge_count, & - point) - end if - - ! Correct the sign of the levelset - if (patch_id_fp(i, j, k) > 0) then - STL_levelset%sf(i, j, 0, patch_id) = -abs(STL_levelset%sf(i, j, 0, patch_id)) - end if - - ! Get the boundary normals - call f_normals(boundary_v, & - boundary_edge_count, & - point, & - normals) + ! Get the shortest distance between the cell center and the interpolated model boundary + STL_levelset%sf(i, j, 0, patch_id) = f_distance(boundary_v, & + boundary_edge_count, & + point) + end if - ! Correct the sign of the levelset_norm - if (patch_id_fp(i, j, k) == 0) then - normals(1:3) = -normals(1:3) - end if + ! Correct the sign of the levelset + if (patch_id_fp(i, j, k) > 0) then + STL_levelset%sf(i, j, 0, patch_id) = -abs(STL_levelset%sf(i, j, 0, patch_id)) + end if - ! Assign the levelset_norm - STL_levelset_norm%sf(i, j, k, patch_id, 1:3) = normals(1:3) + ! Get the boundary normals + call f_normals(boundary_v, & + boundary_edge_count, & + point, & + normals) + ! Correct the sign of the levelset_norm + if (patch_id_fp(i, j, k) == 0) then + normals(1:3) = -normals(1:3) end if - else - if (patch_icpp(patch_id)%smoothen) then - if (eta > patch_icpp(patch_id)%model_threshold) then - eta = 1._wp - end if - else - if (eta > patch_icpp(patch_id)%model_threshold) then - eta = 1._wp - else - eta = 0._wp - end if - end if - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) - ! Note: Should probably use *eta* to compute primitive variables - ! if defining them analytically. - @:analytical() + ! Assign the levelset_norm + STL_levelset_norm%sf(i, j, k, patch_id, 1:3) = normals(1:3) + end if - end do; end do; end do + end do; end do; end do if (proc_rank == 0) then print *, "" @@ -1180,4 +1076,4 @@ contains f_r = a + b*myth + offset end function f_r -end module m_patches +end module m_ib_patches From 61febc8489c879836b0f5e0ece46a310dd911145 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 10:00:15 -0400 Subject: [PATCH 18/43] More updates to the IB patch file --- src/common/m_ib_patches.fpp | 74 ++++++++---------------------- src/pre_process/m_icpp_patches.fpp | 2 +- 2 files changed, 21 insertions(+), 55 deletions(-) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index 1f21874637..c4d6a190c2 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -60,9 +60,8 @@ module m_ib_patches contains - impure subroutine s_apply_ib_patches(patch_id_fp, q_prim_vf, ib_markers_sf, levelset, levelset_norm) + impure subroutine s_apply_ib_patches(patch_id_fp, ib_markers_sf, levelset, levelset_norm) - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:m, 0:m), intent(inout) :: patch_id_fp integer, dimension(:, :, :), intent(inout), optional :: ib_markers_sf type(levelset_field), intent(inout), optional :: levelset !< Levelset determined by models @@ -82,20 +81,20 @@ contains end if if (patch_ib(i)%geometry == 8) then - call s_ib_sphere(i, ib_markers_sf, q_prim_vf) + call s_ib_sphere(i, ib_markers_sf) call s_ib_sphere_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 9) then - call s_ib_cuboid(i, ib_markers_sf, q_prim_vf) + call s_ib_cuboid(i, ib_markers_sf) call s_ib_cuboid_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 10) then - call s_ib_cylinder(i, ib_markers_sf, q_prim_vf) + call s_ib_cylinder(i, ib_markers_sf) call s_ib_cylinder_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 11) then - call s_ib_3D_airfoil(i, ib_markers_sf, q_prim_vf) + call s_ib_3D_airfoil(i, ib_markers_sf) call s_ib_3D_airfoil_levelset(i, levelset, levelset_norm) ! STL+IBM patch elseif (patch_ib(i)%geometry == 12) then - call s_ib_model(i, ib_markers_sf, q_prim_vf, levelset, levelset_norm) + call s_ib_model(i, ib_markers_sf, levelset, levelset_norm) end if end do !> @} @@ -110,17 +109,17 @@ contains print *, 'Processing 2D ib patch ', i end if if (patch_ib(i)%geometry == 2) then - call s_ib_circle(i, ib_markers_sf, q_prim_vf) + call s_ib_circle(i, ib_markers_sf) call s_circle_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 3) then - call s_ib_rectangle(i, ib_markers_sf, q_prim_vf) + call s_ib_rectangle(i, ib_markers_sf) call s_rectangle_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 4) then - call s_ib_airfoil(i, ib_markers_sf, q_prim_vf) + call s_ib_airfoil(i, ib_markers_sf) call s_airfoil_levelset(i, levelset, levelset_norm) ! STL+IBM patch elseif (patch_ib(i)%geometry == 5) then - call s_ib_model(i, ib_markers_sf, q_prim_vf, levelset, levelset_norm) + call s_ib_model(i, ib_markers_sf, levelset, levelset_norm) end if end do !> @} @@ -136,13 +135,11 @@ contains !! the smoothing of its boundary. !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_circle(patch_id, patch_id_fp, q_prim_vf) + subroutine s_ib_circle(patch_id, patch_id_fp) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf real(wp) :: radius @@ -183,13 +180,11 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_airfoil(patch_id, patch_id_fp, q_prim_vf) + subroutine s_ib_airfoil(patch_id, patch_id_fp) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf real(wp) :: x0, y0, f, x_act, y_act, ca_in, pa, ma, ta, theta real(wp) :: xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c @@ -290,16 +285,12 @@ contains if (f_approx_equal(airfoil_grid_u(k)%x, x_act)) then if (y_act <= airfoil_grid_u(k)%y) then !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) patch_id_fp(i, j, 0) = patch_id end if else f = (airfoil_grid_u(k)%x - x_act)/(airfoil_grid_u(k)%x - airfoil_grid_u(k - 1)%x) if (y_act <= ((1._wp - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) patch_id_fp(i, j, 0) = patch_id end if end if @@ -311,17 +302,13 @@ contains if (f_approx_equal(airfoil_grid_l(k)%x, x_act)) then if (y_act >= airfoil_grid_l(k)%y) then !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) patch_id_fp(i, j, 0) = patch_id end if else f = (airfoil_grid_l(k)%x - x_act)/(airfoil_grid_l(k)%x - airfoil_grid_l(k - 1)%x) if (y_act >= ((1._wp - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then - !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) + !!IB patch_id_fp(i, j, 0) = patch_id end if end if @@ -344,13 +331,11 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_3D_airfoil(patch_id, patch_id_fp, q_prim_vf) + subroutine s_ib_3D_airfoil(patch_id, patch_id_fp) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf real(wp) :: x0, y0, z0, lz, z_max, z_min, f, x_act, y_act, ca_in, pa, ma, ta, theta, xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c integer :: i, j, k, l @@ -457,16 +442,12 @@ contains if (f_approx_equal(airfoil_grid_u(k)%x, x_act)) then if (y_act <= airfoil_grid_u(k)%y) then !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) patch_id_fp(i, j, l) = patch_id end if else f = (airfoil_grid_u(k)%x - x_act)/(airfoil_grid_u(k)%x - airfoil_grid_u(k - 1)%x) if (y_act <= ((1._wp - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) patch_id_fp(i, j, l) = patch_id end if end if @@ -478,17 +459,13 @@ contains if (f_approx_equal(airfoil_grid_l(k)%x, x_act)) then if (y_act >= airfoil_grid_l(k)%y) then !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) patch_id_fp(i, j, l) = patch_id end if else f = (airfoil_grid_l(k)%x - x_act)/(airfoil_grid_l(k)%x - airfoil_grid_l(k - 1)%x) if (y_act >= ((1._wp - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then - !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) + !!IB patch_id_fp(i, j, l) = patch_id end if end if @@ -521,13 +498,11 @@ contains !! boundaries. !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_rectangle(patch_id, patch_id_fp, q_prim_vf) + subroutine s_ib_rectangle(patch_id, patch_id_fp) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< generic loop iterators real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters @@ -589,13 +564,11 @@ contains !! for the smoothing of its boundary. !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_sphere(patch_id, patch_id_fp, q_prim_vf) + subroutine s_ib_sphere(patch_id, patch_id_fp) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf ! Generic loop iterators integer :: i, j, k @@ -652,12 +625,10 @@ contains !! boundaries. !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - subroutine s_ib_cuboid(patch_id, patch_id_fp, q_prim_vf) + subroutine s_ib_cuboid(patch_id, patch_id_fp) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop iterators @@ -712,7 +683,6 @@ contains end do end do end do - @:HardcodedDellacation() end subroutine s_ib_cuboid @@ -726,13 +696,11 @@ contains !! of its lateral boundary. !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_ib_cylinder(patch_id, patch_id_fp, q_prim_vf) + subroutine s_ib_cylinder(patch_id, patch_id_fp) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop iterators real(wp) :: radius @@ -807,15 +775,13 @@ contains !> The STL patch is a 2/3D geometry that is imported from an STL file. !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Primitive variables !! @param ib True if this patch is an immersed boundary !! @param STL_levelset STL levelset !! @param STL_levelset_norm STL levelset normals - subroutine s_ib_model(patch_id, patch_id_fp, q_prim_vf, STL_levelset, STL_levelset_norm) + subroutine s_ib_model(patch_id, patch_id_fp, STL_levelset, STL_levelset_norm) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf ! Variables for IBM+STL type(levelset_field), optional, intent(inout) :: STL_levelset !< Levelset determined by models diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index 363e37ee21..0baf0543d0 100644 --- a/src/pre_process/m_icpp_patches.fpp +++ b/src/pre_process/m_icpp_patches.fpp @@ -9,7 +9,7 @@ #:include '3dHardcodedIC.fpp' #:include 'macros.fpp' -module m_patches +module m_icpp_patches use m_model ! Subroutine(s) related to STL files From 92a8ef87f73c404bee42e9c1837ff5291e9f4b43 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 10:07:55 -0400 Subject: [PATCH 19/43] Made it through the airfoils in icpp --- src/pre_process/m_icpp_patches.fpp | 391 ++--------------------------- 1 file changed, 21 insertions(+), 370 deletions(-) diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index 0baf0543d0..bac67a97ff 100644 --- a/src/pre_process/m_icpp_patches.fpp +++ b/src/pre_process/m_icpp_patches.fpp @@ -64,11 +64,10 @@ module m_icpp_patches contains - impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf, ib_markers_sf, levelset, levelset_norm) + impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf, levelset, levelset_norm) type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:m, 0:m), intent(inout) :: patch_id_fp - integer, dimension(:, :, :), intent(inout), optional :: ib_markers_sf type(levelset_field), intent(inout), optional :: levelset !< Levelset determined by models type(levelset_norm_field), intent(inout), optional :: levelset_norm !< Levelset_norm determined by models @@ -331,13 +330,11 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - !! @param ib True if this patch is an immersed boundary - subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag real(wp) :: radius @@ -348,17 +345,11 @@ contains ! Transferring the circular patch's radius, centroid, smearing patch ! identity and smearing coefficient information - if (present(ib_flag)) then - x_centroid = patch_ib(patch_id)%x_centroid - y_centroid = patch_ib(patch_id)%y_centroid - radius = patch_ib(patch_id)%radius - else - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - radius = patch_icpp(patch_id)%radius - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - end if + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + radius = patch_icpp(patch_id)%radius + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the @@ -373,7 +364,7 @@ contains do j = 0, n do i = 0, m - if (.not. present(ib_flag) .and. patch_icpp(patch_id)%smoothen) then + if (patch_icpp(patch_id)%smoothen) then eta = tanh(smooth_coeff/min(dx, dy)* & (sqrt((x_cc(i) - x_centroid)**2 & @@ -382,29 +373,23 @@ contains end if - if (present(ib_flag) .and. ((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2 <= radius**2)) & - then - patch_id_fp(i, j, 0) = patch_id - else - if (((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2 <= radius**2 & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & - .or. & - (.not. present(ib_flag) .and. patch_id_fp(i, j, 0) == smooth_patch_id)) & - then - - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta, q_prim_vf, patch_id_fp) + if (((x_cc(i) - x_centroid)**2 & + + (y_cc(j) - y_centroid)**2 <= radius**2 & + .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & + .or. & + patch_id_fp(i, j, 0) == smooth_patch_id) & + then - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded2D() - end if + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta, q_prim_vf, patch_id_fp) + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded2D() end if + end if end do end do @@ -412,340 +397,6 @@ contains end subroutine s_icpp_circle - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - !! @param ib True if this patch is an immersed boundary - subroutine s_icpp_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) - - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag - - real(wp) :: x0, y0, f, x_act, y_act, ca_in, pa, ma, ta, theta - real(wp) :: xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c - integer :: i, j, k - integer :: Np1, Np2 - - if (.not. present(ib_flag)) return - x0 = patch_ib(patch_id)%x_centroid - y0 = patch_ib(patch_id)%y_centroid - ca_in = patch_ib(patch_id)%c - pa = patch_ib(patch_id)%p - ma = patch_ib(patch_id)%m - ta = patch_ib(patch_id)%t - theta = pi*patch_ib(patch_id)%theta/180._wp - - Np1 = int((pa*ca_in/dx)*20) - Np2 = int(((ca_in - pa*ca_in)/dx)*20) - Np = Np1 + Np2 + 1 - - allocate (airfoil_grid_u(1:Np)) - allocate (airfoil_grid_l(1:Np)) - - airfoil_grid_u(1)%x = x0 - airfoil_grid_u(1)%y = y0 - - airfoil_grid_l(1)%x = x0 - airfoil_grid_l(1)%y = y0 - - eta = 1._wp - - do i = 1, Np1 + Np2 - 1 - if (i <= Np1) then - xc = x0 + i*(pa*ca_in/Np1) - xa = (xc - x0)/ca_in - yc = (ma/pa**2)*(2*pa*xa - xa**2) - dycdxc = (2*ma/pa**2)*(pa - xa) - else - xc = x0 + pa*ca_in + (i - Np1)*((ca_in - pa*ca_in)/Np2) - xa = (xc - x0)/ca_in - yc = (ma/(1 - pa)**2)*(1 - 2*pa + 2*pa*xa - xa**2) - dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) - end if - - yt = (5._wp*ta)*(0.2969_wp*xa**0.5_wp - 0.126_wp*xa - 0.3516_wp*xa**2._wp + 0.2843_wp*xa**3 - 0.1015_wp*xa**4) - sin_c = dycdxc/(1 + dycdxc**2)**0.5_wp - cos_c = 1/(1 + dycdxc**2)**0.5_wp - - xu = xa - yt*sin_c - yu = yc + yt*cos_c - - xl = xa + yt*sin_c - yl = yc - yt*cos_c - - xu = xu*ca_in + x0 - yu = yu*ca_in + y0 - - xl = xl*ca_in + x0 - yl = yl*ca_in + y0 - - airfoil_grid_u(i + 1)%x = xu - airfoil_grid_u(i + 1)%y = yu - - airfoil_grid_l(i + 1)%x = xl - airfoil_grid_l(i + 1)%y = yl - - end do - - airfoil_grid_u(Np)%x = x0 + ca_in - airfoil_grid_u(Np)%y = y0 - - airfoil_grid_l(Np)%x = x0 + ca_in - airfoil_grid_l(Np)%y = y0 - - do j = 0, n - do i = 0, m - - if (.not. f_is_default(patch_ib(patch_id)%theta)) then - x_act = (x_cc(i) - x0)*cos(theta) - (y_cc(j) - y0)*sin(theta) + x0 - y_act = (x_cc(i) - x0)*sin(theta) + (y_cc(j) - y0)*cos(theta) + y0 - else - x_act = x_cc(i) - y_act = y_cc(j) - end if - - if (x_act >= x0 .and. x_act <= x0 + ca_in) then - xa = (x_act - x0)/ca_in - if (xa <= pa) then - yc = (ma/pa**2)*(2*pa*xa - xa**2) - dycdxc = (2*ma/pa**2)*(pa - xa) - else - yc = (ma/(1 - pa)**2)*(1 - 2*pa + 2*pa*xa - xa**2) - dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) - end if - if (y_act >= y0) then - k = 1 - do while (airfoil_grid_u(k)%x < x_act) - k = k + 1 - end do - if (f_approx_equal(airfoil_grid_u(k)%x, x_act)) then - if (y_act <= airfoil_grid_u(k)%y) then - !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) - patch_id_fp(i, j, 0) = patch_id - end if - else - f = (airfoil_grid_u(k)%x - x_act)/(airfoil_grid_u(k)%x - airfoil_grid_u(k - 1)%x) - if (y_act <= ((1._wp - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then - !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) - patch_id_fp(i, j, 0) = patch_id - end if - end if - else - k = 1 - do while (airfoil_grid_l(k)%x < x_act) - k = k + 1 - end do - if (f_approx_equal(airfoil_grid_l(k)%x, x_act)) then - if (y_act >= airfoil_grid_l(k)%y) then - !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) - patch_id_fp(i, j, 0) = patch_id - end if - else - f = (airfoil_grid_l(k)%x - x_act)/(airfoil_grid_l(k)%x - airfoil_grid_l(k - 1)%x) - - if (y_act >= ((1._wp - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then - !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) - patch_id_fp(i, j, 0) = patch_id - end if - end if - end if - end if - end do - end do - - if (.not. f_is_default(patch_ib(patch_id)%theta)) then - do i = 1, Np - airfoil_grid_l(i)%x = (airfoil_grid_l(i)%x - x0)*cos(theta) + (airfoil_grid_l(i)%y - y0)*sin(theta) + x0 - airfoil_grid_l(i)%y = -1._wp*(airfoil_grid_l(i)%x - x0)*sin(theta) + (airfoil_grid_l(i)%y - y0)*cos(theta) + y0 - - airfoil_grid_u(i)%x = (airfoil_grid_u(i)%x - x0)*cos(theta) + (airfoil_grid_u(i)%y - y0)*sin(theta) + x0 - airfoil_grid_u(i)%y = -1._wp*(airfoil_grid_u(i)%x - x0)*sin(theta) + (airfoil_grid_u(i)%y - y0)*cos(theta) + y0 - end do - end if - - end subroutine s_icpp_airfoil - - !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - !! @param q_prim_vf Array of primitive variables - !! @param ib True if this patch is an immersed boundary - subroutine s_icpp_3D_airfoil(patch_id, patch_id_fp, q_prim_vf, ib_flag) - - integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag - - real(wp) :: x0, y0, z0, lz, z_max, z_min, f, x_act, y_act, ca_in, pa, ma, ta, theta, xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c - integer :: i, j, k, l - integer :: Np1, Np2 - - if (.not. present(ib_flag)) return - x0 = patch_ib(patch_id)%x_centroid - y0 = patch_ib(patch_id)%y_centroid - z0 = patch_ib(patch_id)%z_centroid - lz = patch_ib(patch_id)%length_z - ca_in = patch_ib(patch_id)%c - pa = patch_ib(patch_id)%p - ma = patch_ib(patch_id)%m - ta = patch_ib(patch_id)%t - theta = pi*patch_ib(patch_id)%theta/180._wp - - Np1 = int((pa*ca_in/dx)*20) - Np2 = int(((ca_in - pa*ca_in)/dx)*20) - Np = Np1 + Np2 + 1 - - allocate (airfoil_grid_u(1:Np)) - allocate (airfoil_grid_l(1:Np)) - - airfoil_grid_u(1)%x = x0 - airfoil_grid_u(1)%y = y0 - - airfoil_grid_l(1)%x = x0 - airfoil_grid_l(1)%y = y0 - - z_max = z0 + lz/2 - z_min = z0 - lz/2 - - eta = 1._wp - - do i = 1, Np1 + Np2 - 1 - if (i <= Np1) then - xc = x0 + i*(pa*ca_in/Np1) - xa = (xc - x0)/ca_in - yc = (ma/pa**2)*(2*pa*xa - xa**2) - dycdxc = (2*ma/pa**2)*(pa - xa) - else - xc = x0 + pa*ca_in + (i - Np1)*((ca_in - pa*ca_in)/Np2) - xa = (xc - x0)/ca_in - yc = (ma/(1 - pa)**2)*(1 - 2*pa + 2*pa*xa - xa**2) - dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) - end if - - yt = (5._wp*ta)*(0.2969_wp*xa**0.5_wp - 0.126_wp*xa - 0.3516_wp*xa**2._wp + 0.2843_wp*xa**3 - 0.1015_wp*xa**4) - sin_c = dycdxc/(1 + dycdxc**2)**0.5_wp - cos_c = 1/(1 + dycdxc**2)**0.5_wp - - xu = xa - yt*sin_c - yu = yc + yt*cos_c - - xl = xa + yt*sin_c - yl = yc - yt*cos_c - - xu = xu*ca_in + x0 - yu = yu*ca_in + y0 - - xl = xl*ca_in + x0 - yl = yl*ca_in + y0 - - airfoil_grid_u(i + 1)%x = xu - airfoil_grid_u(i + 1)%y = yu - - airfoil_grid_l(i + 1)%x = xl - airfoil_grid_l(i + 1)%y = yl - - end do - - airfoil_grid_u(Np)%x = x0 + ca_in - airfoil_grid_u(Np)%y = y0 - - airfoil_grid_l(Np)%x = x0 + ca_in - airfoil_grid_l(Np)%y = y0 - - do l = 0, p - if (z_cc(l) >= z_min .and. z_cc(l) <= z_max) then - do j = 0, n - do i = 0, m - - if (.not. f_is_default(patch_ib(patch_id)%theta)) then - x_act = (x_cc(i) - x0)*cos(theta) - (y_cc(j) - y0)*sin(theta) + x0 - y_act = (x_cc(i) - x0)*sin(theta) + (y_cc(j) - y0)*cos(theta) + y0 - else - x_act = x_cc(i) - y_act = y_cc(j) - end if - - if (x_act >= x0 .and. x_act <= x0 + ca_in) then - xa = (x_act - x0)/ca_in - if (xa <= pa) then - yc = (ma/pa**2)*(2*pa*xa - xa**2) - dycdxc = (2*ma/pa**2)*(pa - xa) - else - yc = (ma/(1 - pa)**2)*(1 - 2*pa + 2*pa*xa - xa**2) - dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) - end if - if (y_act >= y0) then - k = 1 - do while (airfoil_grid_u(k)%x < x_act) - k = k + 1 - end do - if (f_approx_equal(airfoil_grid_u(k)%x, x_act)) then - if (y_act <= airfoil_grid_u(k)%y) then - !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) - patch_id_fp(i, j, l) = patch_id - end if - else - f = (airfoil_grid_u(k)%x - x_act)/(airfoil_grid_u(k)%x - airfoil_grid_u(k - 1)%x) - if (y_act <= ((1._wp - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then - !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) - patch_id_fp(i, j, l) = patch_id - end if - end if - else - k = 1 - do while (airfoil_grid_l(k)%x < x_act) - k = k + 1 - end do - if (f_approx_equal(airfoil_grid_l(k)%x, x_act)) then - if (y_act >= airfoil_grid_l(k)%y) then - !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) - patch_id_fp(i, j, l) = patch_id - end if - else - f = (airfoil_grid_l(k)%x - x_act)/(airfoil_grid_l(k)%x - airfoil_grid_l(k - 1)%x) - - if (y_act >= ((1._wp - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then - !!IB - !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - !eta, q_prim_vf, patch_id_fp) - patch_id_fp(i, j, l) = patch_id - end if - end if - end if - end if - end do - end do - end if - end do - - if (.not. f_is_default(patch_ib(patch_id)%theta)) then - do i = 1, Np - airfoil_grid_l(i)%x = (airfoil_grid_l(i)%x - x0)*cos(theta) + (airfoil_grid_l(i)%y - y0)*sin(theta) + x0 - airfoil_grid_l(i)%y = -1._wp*(airfoil_grid_l(i)%x - x0)*sin(theta) + (airfoil_grid_l(i)%y - y0)*cos(theta) + y0 - - airfoil_grid_u(i)%x = (airfoil_grid_u(i)%x - x0)*cos(theta) + (airfoil_grid_u(i)%y - y0)*sin(theta) + x0 - airfoil_grid_u(i)%y = -1._wp*(airfoil_grid_u(i)%x - x0)*sin(theta) + (airfoil_grid_u(i)%y - y0)*cos(theta) + y0 - end do - end if - - end subroutine s_icpp_3D_airfoil - !> The varcircle patch is a 2D geometry that may be used !! . It generatres an annulus !! @param patch_id is the patch identifier From 7e05fd4db4d7291c3807804cd857c07a1d10a90c Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 10:21:10 -0400 Subject: [PATCH 20/43] Finished with ICPP file --- src/pre_process/m_icpp_patches.fpp | 456 ++++++++--------------------- 1 file changed, 119 insertions(+), 337 deletions(-) diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index bac67a97ff..5921fcf2b6 100644 --- a/src/pre_process/m_icpp_patches.fpp +++ b/src/pre_process/m_icpp_patches.fpp @@ -29,6 +29,8 @@ module m_icpp_patches use m_mpi_common + use m_ib_patches + implicit none private; public :: s_apply_domain_patches @@ -703,13 +705,11 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - !! @param ib True if this patch is an immersed boundary - subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary integer :: i, j, k !< generic loop iterators real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters @@ -721,17 +721,10 @@ contains lit_gamma = (1._wp + gamma)/gamma ! Transferring the rectangle's centroid and length information - if (present(ib_flag)) then - x_centroid = patch_ib(patch_id)%x_centroid - y_centroid = patch_ib(patch_id)%y_centroid - length_x = patch_ib(patch_id)%length_x - length_y = patch_ib(patch_id)%length_y - else - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - length_x = patch_icpp(patch_id)%length_x - length_y = patch_icpp(patch_id)%length_y - end if + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + length_x = patch_icpp(patch_id)%length_x + length_y = patch_icpp(patch_id)%length_y ! Computing the beginning and the end x- and y-coordinates of the ! rectangle based on its centroid and lengths @@ -756,33 +749,27 @@ contains x_boundary%end >= x_cc(i) .and. & y_boundary%beg <= y_cc(j) .and. & y_boundary%end >= y_cc(j)) then - if (present(ib_flag)) then - ! Updating the patch identities bookkeeping variable - patch_id_fp(i, j, 0) = patch_id - else - if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & - then - - call s_assign_patch_primitive_variables(patch_id, i, j, 0, & - eta, q_prim_vf, patch_id_fp) - - @:analytical() + if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & + then - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded2D() - end if + call s_assign_patch_primitive_variables(patch_id, i, j, 0, & + eta, q_prim_vf, patch_id_fp) - if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then - !zero density, reassign according to Tait EOS - q_prim_vf(1)%sf(i, j, 0) = & - (((q_prim_vf(E_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))* & - rhoref*(1._wp - q_prim_vf(alf_idx)%sf(i, j, 0)) - end if + @:analytical() - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded2D() + end if + if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then + !zero density, reassign according to Tait EOS + q_prim_vf(1)%sf(i, j, 0) = & + (((q_prim_vf(E_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))* & + rhoref*(1._wp - q_prim_vf(alf_idx)%sf(i, j, 0)) end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id end if end if end do @@ -1160,13 +1147,11 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - !! @param ib True if this patch is an immersed boundary - subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary ! Generic loop iterators integer :: i, j, k @@ -1179,19 +1164,12 @@ contains ! Transferring spherical patch's radius, centroid, smoothing patch ! identity and smoothing coefficient information - if (present(ib_flag)) then - x_centroid = patch_ib(patch_id)%x_centroid - y_centroid = patch_ib(patch_id)%y_centroid - z_centroid = patch_ib(patch_id)%z_centroid - radius = patch_ib(patch_id)%radius - else - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - z_centroid = patch_icpp(patch_id)%z_centroid - radius = patch_icpp(patch_id)%radius - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - end if + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + z_centroid = patch_icpp(patch_id)%z_centroid + radius = patch_icpp(patch_id)%radius + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the @@ -1213,7 +1191,7 @@ contains cart_z = z_cc(k) end if - if (.not. present(ib_flag) .and. patch_icpp(patch_id)%smoothen) then + if (patch_icpp(patch_id)%smoothen) then eta = tanh(smooth_coeff/min(dx, dy, dz)* & (sqrt((x_cc(i) - x_centroid)**2 & + (cart_y - y_centroid)**2 & @@ -1221,29 +1199,20 @@ contains - radius))*(-0.5_wp) + 0.5_wp end if - if (present(ib_flag)) then - ! Updating the patch identities bookkeeping variable - if (((x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2)) then - patch_id_fp(i, j, k) = patch_id - end if - else - if ((((x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2) .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & - patch_id_fp(i, j, k) == smooth_patch_id) then - - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) + if ((((x_cc(i) - x_centroid)**2 & + + (cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2) .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & + patch_id_fp(i, j, k) == smooth_patch_id) then - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded3D() - end if + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded3D() end if + end if end do end do @@ -1263,10 +1232,9 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id - logical, optional, intent(in) :: ib_flag integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf @@ -1275,21 +1243,12 @@ contains @:Hardcoded3DVariables() ! Transferring the cuboid's centroid and length information - if (present(ib_flag)) then - x_centroid = patch_ib(patch_id)%x_centroid - y_centroid = patch_ib(patch_id)%y_centroid - z_centroid = patch_ib(patch_id)%z_centroid - length_x = patch_ib(patch_id)%length_x - length_y = patch_ib(patch_id)%length_y - length_z = patch_ib(patch_id)%length_z - else - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - z_centroid = patch_icpp(patch_id)%z_centroid - length_x = patch_icpp(patch_id)%length_x - length_y = patch_icpp(patch_id)%length_y - length_z = patch_icpp(patch_id)%length_z - end if + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + z_centroid = patch_icpp(patch_id)%z_centroid + length_x = patch_icpp(patch_id)%length_x + length_y = patch_icpp(patch_id)%length_y + length_z = patch_icpp(patch_id)%length_z ! Computing the beginning and the end x-, y- and z-coordinates of ! the cuboid based on its centroid and lengths @@ -1328,24 +1287,19 @@ contains z_boundary%beg <= cart_z .and. & z_boundary%end >= cart_z) then - if (present(ib_flag)) then - ! Updating the patch identities bookkeeping variable - patch_id_fp(i, j, k) = patch_id - else - if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then + if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded3D() - end if + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded3D() + end if - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id - end if end if end if end do @@ -1366,13 +1320,11 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - !! @param ib True if this patch is an immersed boundary - subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf, ib_flag) + subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary integer :: i, j, k !< Generic loop iterators real(wp) :: radius @@ -1381,26 +1333,15 @@ contains ! Transferring the cylindrical patch's centroid, length, radius, ! smoothing patch identity and smoothing coefficient information - - if (present(ib_flag)) then - x_centroid = patch_ib(patch_id)%x_centroid - y_centroid = patch_ib(patch_id)%y_centroid - z_centroid = patch_ib(patch_id)%z_centroid - length_x = patch_ib(patch_id)%length_x - length_y = patch_ib(patch_id)%length_y - length_z = patch_ib(patch_id)%length_z - radius = patch_ib(patch_id)%radius - else - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - z_centroid = patch_icpp(patch_id)%z_centroid - length_x = patch_icpp(patch_id)%length_x - length_y = patch_icpp(patch_id)%length_y - length_z = patch_icpp(patch_id)%length_z - radius = patch_icpp(patch_id)%radius - smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id - smooth_coeff = patch_icpp(patch_id)%smooth_coeff - end if + x_centroid = patch_icpp(patch_id)%x_centroid + y_centroid = patch_icpp(patch_id)%y_centroid + z_centroid = patch_icpp(patch_id)%z_centroid + length_x = patch_icpp(patch_id)%length_x + length_y = patch_icpp(patch_id)%length_y + length_z = patch_icpp(patch_id)%length_z + radius = patch_icpp(patch_id)%radius + smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id + smooth_coeff = patch_icpp(patch_id)%smooth_coeff ! Computing the beginning and the end x-, y- and z-coordinates of ! the cylinder based on its centroid and lengths @@ -1431,7 +1372,7 @@ contains cart_z = z_cc(k) end if - if (.not. present(ib_flag) .and. patch_icpp(patch_id)%smoothen) then + if (patch_icpp(patch_id)%smoothen) then if (.not. f_is_default(length_x)) then eta = tanh(smooth_coeff/min(dy, dz)* & (sqrt((cart_y - y_centroid)**2 & @@ -1450,61 +1391,36 @@ contains end if end if - if (present(ib_flag)) then - if (((.not. f_is_default(length_x) .and. & - (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2 .and. & - x_boundary%beg <= x_cc(i) .and. & - x_boundary%end >= x_cc(i)) & - .or. & - (.not. f_is_default(length_y) .and. & - (x_cc(i) - x_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2 .and. & - y_boundary%beg <= cart_y .and. & - y_boundary%end >= cart_y) & - .or. & - (.not. f_is_default(length_z) .and. & - (x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 <= radius**2 .and. & - z_boundary%beg <= cart_z .and. & - z_boundary%end >= cart_z))) then - - ! Updating the patch identities bookkeeping variable - patch_id_fp(i, j, k) = patch_id - end if - - else - if (((.not. f_is_default(length_x) .and. & - (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2 .and. & - x_boundary%beg <= x_cc(i) .and. & - x_boundary%end >= x_cc(i)) & - .or. & - (.not. f_is_default(length_y) .and. & - (x_cc(i) - x_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2 .and. & - y_boundary%beg <= cart_y .and. & - y_boundary%end >= cart_y) & - .or. & - (.not. f_is_default(length_z) .and. & - (x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 <= radius**2 .and. & - z_boundary%beg <= cart_z .and. & - z_boundary%end >= cart_z) .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & - patch_id_fp(i, j, k) == smooth_patch_id) then - - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) + if (((.not. f_is_default(length_x) .and. & + (cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2 .and. & + x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i)) & + .or. & + (.not. f_is_default(length_y) .and. & + (x_cc(i) - x_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2 .and. & + y_boundary%beg <= cart_y .and. & + y_boundary%end >= cart_y) & + .or. & + (.not. f_is_default(length_z) .and. & + (x_cc(i) - x_centroid)**2 & + + (cart_y - y_centroid)**2 <= radius**2 .and. & + z_boundary%beg <= cart_z .and. & + z_boundary%end >= cart_z) .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & + patch_id_fp(i, j, k) == smooth_patch_id) then - @:analytical() - if (patch_icpp(patch_id)%hcid /= dflt_int) then - @:Hardcoded3D() - end if + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) - ! Updating the patch identities bookkeeping variable - if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id + @:analytical() + if (patch_icpp(patch_id)%hcid /= dflt_int) then + @:Hardcoded3D() end if + + ! Updating the patch identities bookkeeping variable + if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id end if end do end do @@ -1605,10 +1521,9 @@ contains !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Primitive variables - !! @param ib True if this patch is an immersed boundary !! @param STL_levelset STL levelset !! @param STL_levelset_norm STL levelset normals - subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf, ib_flag, STL_levelset, STL_levelset_norm) + subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf, STL_levelset, STL_levelset_norm) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -1617,7 +1532,6 @@ contains ! Variables for IBM+STL type(levelset_field), optional, intent(inout) :: STL_levelset !< Levelset determined by models type(levelset_norm_field), optional, intent(inout) :: STL_levelset_norm !< Levelset_norm determined by models - logical, optional, intent(in) :: ib_flag !< True if this patch is an immersed boundary real(wp) :: normals(1:3) !< Boundary normal buffer integer :: boundary_vertex_count, boundary_edge_count, total_vertices !< Boundary vertex real(wp), allocatable, dimension(:, :, :) :: boundary_v !< Boundary vertex buffer @@ -1640,27 +1554,16 @@ contains real(wp), dimension(1:4, 1:4) :: transform, transform_n - if (present(ib_flag) .and. proc_rank == 0) then - print *, " * Reading model: "//trim(patch_ib(patch_id)%model_filepath) - else if (proc_rank == 0) then + if (proc_rank == 0) then print *, " * Reading model: "//trim(patch_icpp(patch_id)%model_filepath) end if - - if (present(ib_flag)) then - model = f_model_read(patch_ib(patch_id)%model_filepath) - params%scale(:) = patch_ib(patch_id)%model_scale(:) - params%translate(:) = patch_ib(patch_id)%model_translate(:) - params%rotate(:) = patch_ib(patch_id)%model_rotate(:) - params%spc = patch_ib(patch_id)%model_spc - params%threshold = patch_ib(patch_id)%model_threshold - else - model = f_model_read(patch_icpp(patch_id)%model_filepath) - params%scale(:) = patch_icpp(patch_id)%model_scale(:) - params%translate(:) = patch_icpp(patch_id)%model_translate(:) - params%rotate(:) = patch_icpp(patch_id)%model_rotate(:) - params%spc = patch_icpp(patch_id)%model_spc - params%threshold = patch_icpp(patch_id)%model_threshold - end if + + model = f_model_read(patch_icpp(patch_id)%model_filepath) + params%scale(:) = patch_icpp(patch_id)%model_scale(:) + params%translate(:) = patch_icpp(patch_id)%model_translate(:) + params%rotate(:) = patch_icpp(patch_id)%model_rotate(:) + params%spc = patch_icpp(patch_id)%model_spc + params%threshold = patch_icpp(patch_id)%model_threshold if (proc_rank == 0) then print *, " * Transforming model." @@ -1755,99 +1658,26 @@ contains if (grid_geometry == 3) then point = f_convert_cyl_to_cart(point) end if + + eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_icpp(patch_id)%model_spc) - if (present(ib_flag)) then - eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_ib(patch_id)%model_spc) - else - eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_icpp(patch_id)%model_spc) - end if - - if (present(ib_flag)) then - ! Reading STL boundary vertices and compute the levelset and levelset_norm - if (eta > patch_ib(patch_id)%model_threshold) then - patch_id_fp(i, j, k) = patch_id - end if - - ! 3D models - if (p > 0) then - - ! Get the boundary normals and shortest distance between the cell center and the model boundary - call f_distance_normals_3D(model, point, normals, distance) - - ! Get the shortest distance between the cell center and the interpolated model boundary - if (interpolate) then - STL_levelset%sf(i, j, k, patch_id) = f_interpolated_distance(interpolated_boundary_v, & - total_vertices, & - point) - else - STL_levelset%sf(i, j, k, patch_id) = distance - end if - - ! Correct the sign of the levelset - if (patch_id_fp(i, j, k) > 0) then - STL_levelset%sf(i, j, k, patch_id) = -abs(STL_levelset%sf(i, j, k, patch_id)) - end if - - ! Correct the sign of the levelset_norm - if (patch_id_fp(i, j, k) == 0) then - normals(1:3) = -normals(1:3) - end if - - ! Assign the levelset_norm - STL_levelset_norm%sf(i, j, k, patch_id, 1:3) = normals(1:3) - else - ! 2D models - if (interpolate) then - ! Get the shortest distance between the cell center and the model boundary - STL_levelset%sf(i, j, 0, patch_id) = f_interpolated_distance(interpolated_boundary_v, & - total_vertices, & - point) - else - ! Get the shortest distance between the cell center and the interpolated model boundary - STL_levelset%sf(i, j, 0, patch_id) = f_distance(boundary_v, & - boundary_edge_count, & - point) - end if - - ! Correct the sign of the levelset - if (patch_id_fp(i, j, k) > 0) then - STL_levelset%sf(i, j, 0, patch_id) = -abs(STL_levelset%sf(i, j, 0, patch_id)) - end if - - ! Get the boundary normals - call f_normals(boundary_v, & - boundary_edge_count, & - point, & - normals) - - ! Correct the sign of the levelset_norm - if (patch_id_fp(i, j, k) == 0) then - normals(1:3) = -normals(1:3) - end if - - ! Assign the levelset_norm - STL_levelset_norm%sf(i, j, k, patch_id, 1:3) = normals(1:3) - + if (patch_icpp(patch_id)%smoothen) then + if (eta > patch_icpp(patch_id)%model_threshold) then + eta = 1._wp end if else - if (patch_icpp(patch_id)%smoothen) then - if (eta > patch_icpp(patch_id)%model_threshold) then - eta = 1._wp - end if + if (eta > patch_icpp(patch_id)%model_threshold) then + eta = 1._wp else - if (eta > patch_icpp(patch_id)%model_threshold) then - eta = 1._wp - else - eta = 0._wp - end if + eta = 0._wp end if - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) - - ! Note: Should probably use *eta* to compute primitive variables - ! if defining them analytically. - @:analytical() end if + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) + + ! Note: Should probably use *eta* to compute primitive variables + ! if defining them analytically. + @:analytical() end do; end do; end do if (proc_rank == 0) then @@ -1859,52 +1689,4 @@ contains end subroutine s_icpp_model - subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z) - $:GPU_ROUTINE(parallelism='[seq]') - - real(wp), intent(in) :: cyl_y, cyl_z - - cart_y = cyl_y*sin(cyl_z) - cart_z = cyl_y*cos(cyl_z) - - end subroutine s_convert_cylindrical_to_cartesian_coord - - pure function f_convert_cyl_to_cart(cyl) result(cart) - - $:GPU_ROUTINE(parallelism='[seq]') - - real(wp), dimension(1:3), intent(in) :: cyl - real(wp), dimension(1:3) :: cart - - cart = (/cyl(1), & - cyl(2)*sin(cyl(3)), & - cyl(2)*cos(cyl(3))/) - - end function f_convert_cyl_to_cart - - subroutine s_convert_cylindrical_to_spherical_coord(cyl_x, cyl_y) - $:GPU_ROUTINE(parallelism='[seq]') - - real(wp), intent(IN) :: cyl_x, cyl_y - - sph_phi = atan(cyl_y/cyl_x) - - end subroutine s_convert_cylindrical_to_spherical_coord - - !> Archimedes spiral function - !! @param myth Angle - !! @param offset Thickness - !! @param a Starting position - pure elemental function f_r(myth, offset, a) - $:GPU_ROUTINE(parallelism='[seq]') - real(wp), intent(in) :: myth, offset, a - real(wp) :: b - real(wp) :: f_r - - !r(th) = a + b*th - - b = 2._wp*a/(2._wp*pi) - f_r = a + b*myth + offset - end function f_r - end module m_patches From 615bccb12aae0147687d711d9d112105bd771359 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 10:25:40 -0400 Subject: [PATCH 21/43] Final commit before test run --- src/pre_process/m_initial_condition.fpp | 4 +++- src/pre_process/m_start_up.fpp | 4 +++- src/simulation/m_ibm.fpp | 32 ++++--------------------- 3 files changed, 10 insertions(+), 30 deletions(-) diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 53fc9811a2..1351d88e6e 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -27,7 +27,9 @@ module m_initial_condition use m_variables_conversion ! Subroutines to change the state variables from ! one form to another - use m_patches + use m_ib_patches + + use m_icpp_patches use m_assign_variables diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 9e8b9f70fe..85b3d18bd5 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -28,7 +28,9 @@ module m_start_up use m_compile_specific !< Compile-specific procedures - use m_patches + use m_ib_patches + + use m_icpp_patches use m_assign_variables diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 36f8c5a75d..413dec1a35 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -24,6 +24,8 @@ module m_ibm use m_compute_levelset + use m_ib_patches + implicit none private :: s_compute_image_points, & @@ -883,35 +885,9 @@ contains end subroutine s_propagate_mib - impure subroutine s_update_levelset_norms(patch_id, ib_markers_sf, q_prim_vf, levelset, levelset_norm) - - integer, intent(in) :: patch_id - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - integer, dimension(:, :, :), intent(inout), optional :: ib_markers_sf - type(levelset_field), intent(inout), optional :: levelset !< Levelset determined by models - type(levelset_norm_field), intent(inout), optional :: levelset_norm !< Levelset_norm determined by models - - if (patch_ib(patch_id)%geometry == 2) then - call s_circle(patch_id, ib_markers_sf, q_prim_vf, ib) - call s_circle_levelset(patch_id, levelset, levelset_norm) - elseif (patch_ib(patch_id)%geometry == 3) then - call s_rectangle(patch_id, ib_markers_sf, q_prim_vf, ib) - call s_rectangle_levelset(patch_id, levelset, levelset_norm) - elseif (patch_ib(patch_id)%geometry == 4) then - call s_airfoil(patch_id, ib_markers_sf, q_prim_vf, ib) - call s_airfoil_levelset(patch_id, levelset, levelset_norm) - ! STL+IBM patch - elseif (patch_ib(patch_id)%geometry == 5) then - call s_model(patch_id, ib_markers_sf, q_prim_vf, ib, levelset, levelset_norm) - end if - - - end subroutine s_update_levelset_norms - - impure subroutine s_update_mib(num_ibs, ib_markers_sf, q_prim_vf, levelset, levelset_norm) + impure subroutine s_update_mib(num_ibs, ib_markers_sf, levelset, levelset_norm) integer, intent(in) :: num_ibs - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer, dimension(:, :, :), intent(inout), optional :: ib_markers_sf type(levelset_field), intent(inout), optional :: levelset type(levelset_norm_field), intent(inout), optional :: levelset_norm @@ -921,7 +897,7 @@ contains do i = 1, num_ibs if (patch_ib(i)%moving_ibm .ne. 0) then call s_propagate_mib(i) ! TODO :: THIS IS DONE TERRIBLY WITH EULER METHOD - call s_update_levelset_norms(i, ib_markers_sf, q_prim_vf, levelset, levelset_norm) ! TODO :: VERIFY THAT I AM ALLOWED TO JUST APPLY THEM LIKE THIS + call s_apply_ib_patches(patch_id_fp, ib_markers_sf, levelset, levelset_norm) end if end do From 4b81b8ef7fd2494bd664d11e8574db98de3a426d Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 10:30:37 -0400 Subject: [PATCH 22/43] Resolved issue with building the patch filesf --- src/common/m_ib_patches.fpp | 23 ++++--------- src/pre_process/m_icpp_patches.fpp | 52 ++++++++++++++++++++++++++++-- 2 files changed, 56 insertions(+), 19 deletions(-) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index c4d6a190c2..35cded05ce 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -27,7 +27,7 @@ module m_ib_patches implicit none - private; public :: s_apply_domain_patches + private; public :: s_apply_ib_patches real(wp) :: x_centroid, y_centroid, z_centroid real(wp) :: length_x, length_y, length_z @@ -512,17 +512,10 @@ contains lit_gamma = (1._wp + gamma)/gamma ! Transferring the rectangle's centroid and length information - if (present(ib_flag)) then - x_centroid = patch_ib(patch_id)%x_centroid - y_centroid = patch_ib(patch_id)%y_centroid - length_x = patch_ib(patch_id)%length_x - length_y = patch_ib(patch_id)%length_y - else - x_centroid = patch_icpp(patch_id)%x_centroid - y_centroid = patch_icpp(patch_id)%y_centroid - length_x = patch_icpp(patch_id)%length_x - length_y = patch_icpp(patch_id)%length_y - end if + x_centroid = patch_ib(patch_id)%x_centroid + y_centroid = patch_ib(patch_id)%y_centroid + length_x = patch_ib(patch_id)%length_x + length_y = patch_ib(patch_id)%length_y ! Computing the beginning and the end x- and y-coordinates of the ! rectangle based on its centroid and lengths @@ -911,11 +904,7 @@ contains point = f_convert_cyl_to_cart(point) end if - if (present(ib_flag)) then - eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_ib(patch_id)%model_spc) - else - eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_icpp(patch_id)%model_spc) - end if + eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_ib(patch_id)%model_spc) ! Reading STL boundary vertices and compute the levelset and levelset_norm if (eta > patch_ib(patch_id)%model_threshold) then diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index 5921fcf2b6..dd5dc9c080 100644 --- a/src/pre_process/m_icpp_patches.fpp +++ b/src/pre_process/m_icpp_patches.fpp @@ -33,7 +33,7 @@ module m_icpp_patches implicit none - private; public :: s_apply_domain_patches + private; public :: s_apply_icpp_patches real(wp) :: x_centroid, y_centroid, z_centroid real(wp) :: length_x, length_y, length_z @@ -1689,4 +1689,52 @@ contains end subroutine s_icpp_model -end module m_patches + subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z) + $:GPU_ROUTINE(parallelism='[seq]') + + real(wp), intent(in) :: cyl_y, cyl_z + + cart_y = cyl_y*sin(cyl_z) + cart_z = cyl_y*cos(cyl_z) + + end subroutine s_convert_cylindrical_to_cartesian_coord + + pure function f_convert_cyl_to_cart(cyl) result(cart) + + $:GPU_ROUTINE(parallelism='[seq]') + + real(wp), dimension(1:3), intent(in) :: cyl + real(wp), dimension(1:3) :: cart + + cart = (/cyl(1), & + cyl(2)*sin(cyl(3)), & + cyl(2)*cos(cyl(3))/) + + end function f_convert_cyl_to_cart + + subroutine s_convert_cylindrical_to_spherical_coord(cyl_x, cyl_y) + $:GPU_ROUTINE(parallelism='[seq]') + + real(wp), intent(IN) :: cyl_x, cyl_y + + sph_phi = atan(cyl_y/cyl_x) + + end subroutine s_convert_cylindrical_to_spherical_coord + + !> Archimedes spiral function + !! @param myth Angle + !! @param offset Thickness + !! @param a Starting position + pure elemental function f_r(myth, offset, a) + $:GPU_ROUTINE(parallelism='[seq]') + real(wp), intent(in) :: myth, offset, a + real(wp) :: b + real(wp) :: f_r + + !r(th) = a + b*th + + b = 2._wp*a/(2._wp*pi) + f_r = a + b*myth + offset + end function f_r + +end module m_icpp_patches From 58aa07570c849f80ce155250afe6f370735604c8 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 10:35:06 -0400 Subject: [PATCH 23/43] Resolved references to old patch calculations --- src/pre_process/m_icpp_patches.fpp | 8 ++------ src/pre_process/m_initial_condition.fpp | 5 ++--- 2 files changed, 4 insertions(+), 9 deletions(-) diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index dd5dc9c080..a8bc6503dd 100644 --- a/src/pre_process/m_icpp_patches.fpp +++ b/src/pre_process/m_icpp_patches.fpp @@ -66,12 +66,10 @@ module m_icpp_patches contains - impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf, levelset, levelset_norm) + impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf) type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:m, 0:m), intent(inout) :: patch_id_fp - type(levelset_field), intent(inout), optional :: levelset !< Levelset determined by models - type(levelset_norm_field), intent(inout), optional :: levelset_norm !< Levelset_norm determined by models integer :: i @@ -1523,15 +1521,13 @@ contains !! @param q_prim_vf Primitive variables !! @param STL_levelset STL levelset !! @param STL_levelset_norm STL levelset normals - subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf, STL_levelset, STL_levelset_norm) + subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf ! Variables for IBM+STL - type(levelset_field), optional, intent(inout) :: STL_levelset !< Levelset determined by models - type(levelset_norm_field), optional, intent(inout) :: STL_levelset_norm !< Levelset_norm determined by models real(wp) :: normals(1:3) !< Boundary normal buffer integer :: boundary_vertex_count, boundary_edge_count, total_vertices !< Boundary vertex real(wp), allocatable, dimension(:, :, :) :: boundary_v !< Boundary vertex buffer diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 1351d88e6e..d4b4ebd8a7 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -190,10 +190,9 @@ contains end if if (ib) then - call s_apply_domain_patches(patch_id_fp, q_prim_vf, ib_markers%sf, levelset, levelset_norm) + call s_apply_ib_patches(patch_id_fp, ib_markers%sf, levelset, levelset_norm) else - call s_apply_domain_patches(patch_id_fp, q_prim_vf) - end if + call s_apply_icpp_patches(patch_id_fp, q_prim_vf) if (num_bc_patches > 0) call s_apply_boundary_patches(q_prim_vf, bc_type) From c50453cb704bff40f39f14f25e00920de052b107 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 10:45:52 -0400 Subject: [PATCH 24/43] Fixed bad reference to levelset subroutines --- src/common/m_ib_patches.fpp | 8 ++++---- src/pre_process/m_initial_condition.fpp | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index 35cded05ce..b319889aa0 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -82,16 +82,16 @@ contains if (patch_ib(i)%geometry == 8) then call s_ib_sphere(i, ib_markers_sf) - call s_ib_sphere_levelset(i, levelset, levelset_norm) + call s_sphere_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 9) then call s_ib_cuboid(i, ib_markers_sf) - call s_ib_cuboid_levelset(i, levelset, levelset_norm) + call s_cuboid_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 10) then call s_ib_cylinder(i, ib_markers_sf) - call s_ib_cylinder_levelset(i, levelset, levelset_norm) + call s_cylinder_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 11) then call s_ib_3D_airfoil(i, ib_markers_sf) - call s_ib_3D_airfoil_levelset(i, levelset, levelset_norm) + call s_3D_airfoil_levelset(i, levelset, levelset_norm) ! STL+IBM patch elseif (patch_ib(i)%geometry == 12) then call s_ib_model(i, ib_markers_sf, levelset, levelset_norm) diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index d4b4ebd8a7..b5f880fd11 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -191,7 +191,7 @@ contains if (ib) then call s_apply_ib_patches(patch_id_fp, ib_markers%sf, levelset, levelset_norm) - else + end if call s_apply_icpp_patches(patch_id_fp, q_prim_vf) if (num_bc_patches > 0) call s_apply_boundary_patches(q_prim_vf, bc_type) From 8bdec610cdb1b2f2327530dc6419e17c5fc93b42 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 11:47:22 -0400 Subject: [PATCH 25/43] Removed some unnecessary print statements and almost completely resolve compiling issues --- CMakeLists.txt | 1 + src/common/m_ib_patches.fpp | 13 +++++++++++-- src/simulation/m_ibm.fpp | 7 ++++++- src/simulation/p_main.fpp | 2 +- toolchain/mfc/case.py | 5 ----- 5 files changed, 19 insertions(+), 9 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 52362c67df..ef47540b1c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -332,6 +332,7 @@ macro(HANDLE_SOURCES target useCommon) # If we're building post_process, exclude m_compute_levelset.fpp if("${target}" STREQUAL "post_process") list(FILTER common_FPPs EXCLUDE REGEX ".*/m_compute_levelset\.fpp$") + list(FILTER common_FPPs EXCLUDE REGEX ".*/m_ib_patches\.fpp$") endif() list(APPEND ${target}_FPPs ${common_FPPs}) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index b319889aa0..f0cbc47ed9 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -62,7 +62,7 @@ contains impure subroutine s_apply_ib_patches(patch_id_fp, ib_markers_sf, levelset, levelset_norm) - integer, dimension(0:m, 0:m, 0:m), intent(inout) :: patch_id_fp + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp integer, dimension(:, :, :), intent(inout), optional :: ib_markers_sf type(levelset_field), intent(inout), optional :: levelset !< Levelset determined by models type(levelset_norm_field), intent(inout), optional :: levelset_norm !< Levelset_norm determined by models @@ -90,8 +90,10 @@ contains call s_ib_cylinder(i, ib_markers_sf) call s_cylinder_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 11) then +#ifdef MFC_PRE_PROCESS call s_ib_3D_airfoil(i, ib_markers_sf) call s_3D_airfoil_levelset(i, levelset, levelset_norm) +#endif ! STL+IBM patch elseif (patch_ib(i)%geometry == 12) then call s_ib_model(i, ib_markers_sf, levelset, levelset_norm) @@ -115,8 +117,10 @@ contains call s_ib_rectangle(i, ib_markers_sf) call s_rectangle_levelset(i, levelset, levelset_norm) elseif (patch_ib(i)%geometry == 4) then +#ifdef MFC_PRE_PROCESS call s_ib_airfoil(i, ib_markers_sf) call s_airfoil_levelset(i, levelset, levelset_norm) +#endif ! STL+IBM patch elseif (patch_ib(i)%geometry == 5) then call s_ib_model(i, ib_markers_sf, levelset, levelset_norm) @@ -178,9 +182,11 @@ contains end subroutine s_ib_circle +! airfoils are not supported for moving immersed boundaries +! TODO :: REPLACE THIS IFDEF WITH SOMETHING MORE SUSTAINABLE +#ifdef MFC_PRE_PROCESS !! @param patch_id is the patch identifier !! @param patch_id_fp Array to track patch ids - !! @param ib True if this patch is an immersed boundary subroutine s_ib_airfoil(patch_id, patch_id_fp) integer, intent(in) :: patch_id @@ -191,6 +197,7 @@ contains integer :: i, j, k integer :: Np1, Np2 + x0 = patch_ib(patch_id)%x_centroid y0 = patch_ib(patch_id)%y_centroid ca_in = patch_ib(patch_id)%c @@ -488,6 +495,8 @@ contains end subroutine s_ib_3D_airfoil +#endif + !> The rectangular patch is a 2D geometry that may be used, !! for example, in creating a solid boundary, or pre-/post- !! shock region, in alignment with the axes of the Cartesian diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 413dec1a35..9e124fe319 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -38,6 +38,7 @@ module m_ibm s_ibm_correct_state, & s_finalize_ibm_module + integer, allocatable, dimension(:, :, :) :: patch_id_fp type(integer_field), public :: ib_markers type(levelset_field), public :: levelset type(levelset_norm_field), public :: levelset_norm @@ -86,6 +87,9 @@ contains integer :: i, j, k + ! Allocating the patch identities bookkeeping variable + allocate (patch_id_fp(0:m, 0:n, 0:p)) + $:GPU_UPDATE(device='[ib_markers%sf]') $:GPU_UPDATE(device='[levelset%sf]') $:GPU_UPDATE(device='[levelset_norm%sf]') @@ -897,10 +901,11 @@ contains do i = 1, num_ibs if (patch_ib(i)%moving_ibm .ne. 0) then call s_propagate_mib(i) ! TODO :: THIS IS DONE TERRIBLY WITH EULER METHOD - call s_apply_ib_patches(patch_id_fp, ib_markers_sf, levelset, levelset_norm) end if end do + call s_apply_ib_patches(patch_id_fp, ib_markers_sf, levelset, levelset_norm) ! TODO, THIS IS NOT OPTIMIA + end subroutine s_update_mib !> Subroutine to deallocate memory reserved for the IBM module diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 4c088b496b..d7b9c11f41 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -75,7 +75,7 @@ program p_main ! Time-stepping Loop do - call s_update_mib(num_ibs, ib_markers%sf, q_prim_vf, levelset, levelset_norm) + call s_update_mib(num_ibs, ib_markers%sf, levelset, levelset_norm) if (cfl_dt) then if (mytime >= t_stop) then diff --git a/toolchain/mfc/case.py b/toolchain/mfc/case.py index e7af954d83..fb30a21f61 100644 --- a/toolchain/mfc/case.py +++ b/toolchain/mfc/case.py @@ -7,7 +7,6 @@ from .state import ARG from .run import case_dicts -import pprint QPVF_IDX_VARS = { 'alpha_rho': 'contxb', 'vel' : 'momxb', 'pres': 'E_idx', @@ -284,10 +283,6 @@ def _default(_) -> str: "simulation" : self.__get_sim_fpp, }.get(build.get_target(target).name, _default)(print) - pprint.pprint(build.get_target(target).name) - if build.get_target(target).name == 'common': - raise 0 - return _prepend() + result def __getitem__(self, key: str) -> str: From 1371e74fc7fe9e9ba306c0e8419f64a0db9dfa86 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 12:40:42 -0400 Subject: [PATCH 26/43] This code compiles and runs --- CMakeLists.txt | 2 +- src/common/m_ib_patches.fpp | 6 ------ 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index ef47540b1c..1b6970ad9f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -450,7 +450,7 @@ function(MFC_SETUP_TARGET) if (ARGS_SILO) find_package(SILO REQUIRED) - target_link_libraries(${a_target} PRIVATE SILO::SILO) + target_link_libraries(${a_target} PRIVATE SILO::SILO stdc++) endif() if (ARGS_HDF5) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index f0cbc47ed9..e5364873b0 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -76,9 +76,6 @@ contains !> @{ ! Spherical patch do i = 1, num_ibs - if (proc_rank == 0) then - print *, 'Processing 3D ib patch ', i - end if if (patch_ib(i)%geometry == 8) then call s_ib_sphere(i, ib_markers_sf) @@ -107,9 +104,6 @@ contains !> IB Patches !> @{ do i = 1, num_ibs - if (proc_rank == 0) then - print *, 'Processing 2D ib patch ', i - end if if (patch_ib(i)%geometry == 2) then call s_ib_circle(i, ib_markers_sf) call s_circle_levelset(i, levelset, levelset_norm) From 61328184ec59b1f114474987c1b962928d06ac35 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Thu, 18 Sep 2025 15:08:48 -0400 Subject: [PATCH 27/43] Added the logic to reset the cached IB indices --- src/simulation/m_ibm.fpp | 15 +++++++++++++-- src/simulation/p_main.fpp | 5 ++++- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 9e124fe319..226c963baf 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -868,7 +868,7 @@ contains end subroutine s_interpolate_image_point - !> Subroutine the updates the moving imersed boundary positions + !> Subroutine the updates the moving imersed boundary positions via Euler's method impure subroutine s_propagate_mib(patch_id) integer, intent(in) :: patch_id @@ -889,6 +889,8 @@ contains end subroutine s_propagate_mib + !> Resets the current indexes of immersed boundaries and replaces them after updating + !> the position of each moving immersed boundary impure subroutine s_update_mib(num_ibs, ib_markers_sf, levelset, levelset_norm) integer, intent(in) :: num_ibs @@ -896,7 +898,16 @@ contains type(levelset_field), intent(inout), optional :: levelset type(levelset_norm_field), intent(inout), optional :: levelset_norm - integer :: i + integer :: i, j, k + + ! Clears the existing immersed boundary indices + do i = 0, m + do j = 0, n + do k = 0, p + patch_id_fp(i, j, k) = 0 + end do + end do + end do do i = 1, num_ibs if (patch_ib(i)%moving_ibm .ne. 0) then diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index d7b9c11f41..852e1258f2 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -75,7 +75,10 @@ program p_main ! Time-stepping Loop do - call s_update_mib(num_ibs, ib_markers%sf, levelset, levelset_norm) + if (ib) + ! TODO :: FIND A WAY TO ONLY UPDATE WITH MIBM + call s_update_mib(num_ibs, ib_markers%sf, levelset, levelset_norm) + end if if (cfl_dt) then if (mytime >= t_stop) then From 70d38cc0357537a0890e49f04b224d79d7a3a250 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Fri, 19 Sep 2025 10:00:24 -0400 Subject: [PATCH 28/43] I think this should work --- src/simulation/m_ibm.fpp | 8 +++++++- src/simulation/p_main.fpp | 2 +- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 226c963baf..029fda65c8 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -247,7 +247,13 @@ contains vel_norm_IP = sum(vel_IP*norm)*norm vel_g = vel_IP - vel_norm_IP else - vel_g = 0._wp + if (patch_ib(patch_id)%mibm .eq. 0) then + vel_g = 0._wp + else + do q = 1, 3 + vel_g(q) = patch_ib(patch_id)%vel(q) + end do + end if end if ! Set momentum diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 852e1258f2..81788d5354 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -75,7 +75,7 @@ program p_main ! Time-stepping Loop do - if (ib) + if (ib) then ! TODO :: FIND A WAY TO ONLY UPDATE WITH MIBM call s_update_mib(num_ibs, ib_markers%sf, levelset, levelset_norm) end if From f42d9c64e21611809db23b12bf2e2a460ffa0298 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Fri, 19 Sep 2025 10:42:55 -0400 Subject: [PATCH 29/43] Intermittent commit --- src/simulation/m_ibm.fpp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 029fda65c8..1ccdd23213 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -247,10 +247,12 @@ contains vel_norm_IP = sum(vel_IP*norm)*norm vel_g = vel_IP - vel_norm_IP else - if (patch_ib(patch_id)%mibm .eq. 0) then + if (patch_ib(patch_id)%moving_ibm .eq. 0) then + ! we know the object is not moving if moving_ibm is 0 (false) vel_g = 0._wp else do q = 1, 3 + ! if mibm is 1 or 2, then the boundary may be moving vel_g(q) = patch_ib(patch_id)%vel(q) end do end if From 0c561f72dfa6b6bfd00d7f949e3e9fe14f247321 Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Fri, 19 Sep 2025 13:24:20 -0400 Subject: [PATCH 30/43] Fixed an issue in passing mibm conditions to the toolchain --- src/simulation/m_ibm.fpp | 15 +++++++++++++++ src/simulation/p_main.fpp | 1 + toolchain/mfc/run/case_dicts.py | 6 +++++- 3 files changed, 21 insertions(+), 1 deletion(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 1ccdd23213..cd5b29d629 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -908,14 +908,29 @@ contains integer :: i, j, k + print *, "patch_id_fp at (380, 255, 0): ", patch_id_fp(380, 255, 0) + print *, "IB Markers at (380, 255, 0): ", ib_markers_sf(380+1, 255+1, 1) + ! Clears the existing immersed boundary indices do i = 0, m do j = 0, n do k = 0, p + ! if (patch_id_fp(i, j, k) .ne. 0) then + ! print *, i, j, k + ! end if patch_id_fp(i, j, k) = 0 end do end do end do + + ! Clears the existing immersed boundary indices + do i = 1, m + do j = 1, n + do k = 1, p + ib_markers_sf(i, j, k) = 0 + end do + end do + end do do i = 1, num_ibs if (patch_ib(i)%moving_ibm .ne. 0) then diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 81788d5354..2a5acd2805 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -53,6 +53,7 @@ program p_main call nvtxStartRange("INIT-GPU-VARS") call s_initialize_gpu_vars() call nvtxEndRange + print *, "Printing IB conditions:", patch_ib(1)%geometry, patch_ib(1)%x_centroid, patch_ib(1)%y_centroid, patch_ib(1)%radius print *, "Printing mibm conditions:", patch_ib(1)%moving_ibm, patch_ib(1)%vel(1), patch_ib(1)%vel(2), patch_ib(1)%vel(3) ! Setting the time-step iterator to the first time-step diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index aaddb22440..c2d5efbeff 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -343,9 +343,13 @@ def analytic(self): for real_attr, ty in [("geometry", ParamType.INT), ("radius", ParamType.REAL), ("theta", ParamType.REAL), ("slip", ParamType.LOG), ("c", ParamType.REAL), ("p", ParamType.REAL), - ("t", ParamType.REAL), ("m", ParamType.REAL)]: + ("t", ParamType.REAL), ("m", ParamType.REAL), + ("moving_ibm", ParamType.INT)]: SIMULATION[f"patch_ib({ib_id})%{real_attr}"] = ty + for vel_id in range(1, 4): + SIMULATION[f"patch_ib({ib_id})%vel({vel_id})"] = ParamType.REAL + for cmp_id, cmp in enumerate(["x", "y", "z"]): cmp_id += 1 SIMULATION[f'patch_ib({ib_id})%{cmp}_centroid'] = ParamType.REAL From e9336b2d68fd79cb857e2364783c3bb70606af05 Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Mon, 22 Sep 2025 10:02:11 -0400 Subject: [PATCH 31/43] Tracking commit as I debug --- src/simulation/m_ibm.fpp | 60 +++++++++++++++++++++++----------------- 1 file changed, 35 insertions(+), 25 deletions(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index cd5b29d629..3480c750c2 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -102,6 +102,7 @@ contains call s_find_num_ghost_points(num_gps, num_inner_gps) $:GPU_UPDATE(device='[num_gps, num_inner_gps]') + ! TODO :: THIS ALLOCATION COULD CAUSE PROBLEMS LATER WHEN WE ALLOW ODD-SHAPED IBS MOVE @:ALLOCATE(ghost_points(1:num_gps)) @:ALLOCATE(inner_points(1:num_inner_gps)) @@ -407,6 +408,7 @@ contains end if if (f_approx_equal(norm(dim), 0._wp)) then + ! if the ghost point is almost equal to a cell location, we set it equal and continue ghost_points_in(q)%ip_grid(dim) = ghost_points_in(q)%loc(dim) else if (norm(dim) > 0) then @@ -421,6 +423,8 @@ contains .or. temp_loc > s_cc(index + 1))) index = index + dir if (index < -buff_size .or. index > bound) then + print *, q, index, bound, buff_size + print *, "temp_loc=", temp_loc, " s_cc(index)=", s_cc(index), " s_cc(index+1)=", s_cc(index+1) print *, "Increase buff_size further in m_helper_basic (currently set to a minimum of 10)" error stop "Increase buff_size" end if @@ -487,7 +491,7 @@ contains end subroutine s_find_num_ghost_points !> Function that finds the ghost points - pure subroutine s_find_ghost_points(ghost_points_in, inner_points_in) + subroutine s_find_ghost_points(ghost_points_in, inner_points_in) type(ghost_point), dimension(num_gps), intent(INOUT) :: ghost_points_in type(ghost_point), dimension(num_inner_gps), intent(INOUT) :: inner_points_in @@ -505,11 +509,16 @@ contains do i = 0, m do j = 0, n if (p == 0) then + ! 2D if (ib_markers%sf(i, j, 0) /= 0) then subsection_2D = ib_markers%sf( & i - gp_layers:i + gp_layers, & j - gp_layers:j + gp_layers, 0) if (any(subsection_2D == 0)) then + if (count == 1) then + print *, "Found first ghost point: ", i, j + print *, "IB Marker", ib_markers%sf(i, j, 0) + end if ghost_points_in(count)%loc = [i, j, 0] patch_id = ib_markers%sf(i, j, 0) ghost_points_in(count)%ib_patch_id = & @@ -546,6 +555,7 @@ contains end if end if else + ! 3D do k = 0, p if (ib_markers%sf(i, j, k) /= 0) then subsection_3D = ib_markers%sf( & @@ -902,35 +912,19 @@ contains impure subroutine s_update_mib(num_ibs, ib_markers_sf, levelset, levelset_norm) integer, intent(in) :: num_ibs - integer, dimension(:, :, :), intent(inout), optional :: ib_markers_sf - type(levelset_field), intent(inout), optional :: levelset - type(levelset_norm_field), intent(inout), optional :: levelset_norm + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: ib_markers_sf + type(levelset_field), intent(inout) :: levelset + type(levelset_norm_field), intent(inout) :: levelset_norm integer :: i, j, k - print *, "patch_id_fp at (380, 255, 0): ", patch_id_fp(380, 255, 0) - print *, "IB Markers at (380, 255, 0): ", ib_markers_sf(380+1, 255+1, 1) + print *, "Beginning to update MIBs" - ! Clears the existing immersed boundary indices - do i = 0, m - do j = 0, n - do k = 0, p - ! if (patch_id_fp(i, j, k) .ne. 0) then - ! print *, i, j, k - ! end if - patch_id_fp(i, j, k) = 0 - end do - end do - end do + print *, ghost_points(1)%loc(1) ! Clears the existing immersed boundary indices - do i = 1, m - do j = 1, n - do k = 1, p - ib_markers_sf(i, j, k) = 0 - end do - end do - end do + patch_id_fp = 0 + ib_markers_sf = 0 do i = 1, num_ibs if (patch_ib(i)%moving_ibm .ne. 0) then @@ -938,7 +932,23 @@ contains end if end do - call s_apply_ib_patches(patch_id_fp, ib_markers_sf, levelset, levelset_norm) ! TODO, THIS IS NOT OPTIMIA + call s_apply_ib_patches(patch_id_fp, ib_markers_sf, levelset, levelset_norm) ! TODO, THIS IS NOT OPTIMIAL + + + ! recalculate the ghost point locations + print *, "x = ", patch_ib(1)%x_centroid + print *, "y = ", patch_ib(1)%y_centroid + print *, ghost_points(1)%loc(1), ghost_points(1)%loc(2) + + call s_find_num_ghost_points(num_gps, num_inner_gps) + call s_find_ghost_points(ghost_points, inner_points) + print *, "a" + do i = 230, 240 + print *, ib_markers%sf(0, i, 0), i + end do + call s_compute_image_points(ghost_points, levelset, levelset_norm) + print *, "b" + call s_compute_interpolation_coeffs(ghost_points) end subroutine s_update_mib From dc1418dde525a72a75a2457bb40baa1566766dd9 Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Mon, 22 Sep 2025 11:38:28 -0400 Subject: [PATCH 32/43] I am further and ran something that looks rather successful, but it is crashing. Intermittent commit --- src/common/m_ib_patches.fpp | 92 +++++++++++++++++++------------------ src/simulation/m_ibm.fpp | 26 ++++------- src/simulation/p_main.fpp | 2 +- 3 files changed, 58 insertions(+), 62 deletions(-) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index e5364873b0..d721187872 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -60,9 +60,8 @@ module m_ib_patches contains - impure subroutine s_apply_ib_patches(patch_id_fp, ib_markers_sf, levelset, levelset_norm) + impure subroutine s_apply_ib_patches(ib_markers_sf, levelset, levelset_norm) - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp integer, dimension(:, :, :), intent(inout), optional :: ib_markers_sf type(levelset_field), intent(inout), optional :: levelset !< Levelset determined by models type(levelset_norm_field), intent(inout), optional :: levelset_norm !< Levelset_norm determined by models @@ -132,12 +131,12 @@ contains !! are provided. Note that the circular patch DOES allow for !! the smoothing of its boundary. !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids + !! @param ib_markers_sf Array to track patch ids !! @param ib True if this patch is an immersed boundary - subroutine s_ib_circle(patch_id, patch_id_fp) + subroutine s_ib_circle(patch_id, ib_markers_sf) integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: ib_markers_sf real(wp) :: radius @@ -161,7 +160,7 @@ contains ! that cell. If both queries check out, the primitive variables of ! the current patch are assigned to this cell. - ! TODO :: THIS SETS PATCH_ID_FP TO HODL THE PATCH ID, BUT WE NEED TO + ! TODO :: THIS SETS ib_markers_sf TO HOLD THE PATCH ID, BUT WE NEED TO ! NOW ALSO SEARCH FOR OTHER POINTS TO DELETE THE CURRENT PATCH ID do j = 0, n @@ -169,7 +168,10 @@ contains if ((x_cc(i) - x_centroid)**2 & + (y_cc(j) - y_centroid)**2 <= radius**2) & then - patch_id_fp(i, j, 0) = patch_id + if (i .eq. 0) then + print *, "Inside circle: ", i, j + end if + ib_markers_sf(i, j, 0) = patch_id end if end do end do @@ -180,11 +182,11 @@ contains ! TODO :: REPLACE THIS IFDEF WITH SOMETHING MORE SUSTAINABLE #ifdef MFC_PRE_PROCESS !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - subroutine s_ib_airfoil(patch_id, patch_id_fp) + !! @param ib_markers_sf Array to track patch ids + subroutine s_ib_airfoil(patch_id, ib_markers_sf) integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: ib_markers_sf real(wp) :: x0, y0, f, x_act, y_act, ca_in, pa, ma, ta, theta real(wp) :: xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c @@ -286,13 +288,13 @@ contains if (f_approx_equal(airfoil_grid_u(k)%x, x_act)) then if (y_act <= airfoil_grid_u(k)%y) then !!IB - patch_id_fp(i, j, 0) = patch_id + ib_markers_sf(i, j, 0) = patch_id end if else f = (airfoil_grid_u(k)%x - x_act)/(airfoil_grid_u(k)%x - airfoil_grid_u(k - 1)%x) if (y_act <= ((1._wp - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then !!IB - patch_id_fp(i, j, 0) = patch_id + ib_markers_sf(i, j, 0) = patch_id end if end if else @@ -303,14 +305,14 @@ contains if (f_approx_equal(airfoil_grid_l(k)%x, x_act)) then if (y_act >= airfoil_grid_l(k)%y) then !!IB - patch_id_fp(i, j, 0) = patch_id + ib_markers_sf(i, j, 0) = patch_id end if else f = (airfoil_grid_l(k)%x - x_act)/(airfoil_grid_l(k)%x - airfoil_grid_l(k - 1)%x) if (y_act >= ((1._wp - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then !!IB - patch_id_fp(i, j, 0) = patch_id + ib_markers_sf(i, j, 0) = patch_id end if end if end if @@ -331,12 +333,12 @@ contains end subroutine s_ib_airfoil !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids + !! @param ib_markers_sf Array to track patch ids !! @param ib True if this patch is an immersed boundary - subroutine s_ib_3D_airfoil(patch_id, patch_id_fp) + subroutine s_ib_3D_airfoil(patch_id, ib_markers_sf) integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: ib_markers_sf real(wp) :: x0, y0, z0, lz, z_max, z_min, f, x_act, y_act, ca_in, pa, ma, ta, theta, xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c integer :: i, j, k, l @@ -443,13 +445,13 @@ contains if (f_approx_equal(airfoil_grid_u(k)%x, x_act)) then if (y_act <= airfoil_grid_u(k)%y) then !!IB - patch_id_fp(i, j, l) = patch_id + ib_markers_sf(i, j, l) = patch_id end if else f = (airfoil_grid_u(k)%x - x_act)/(airfoil_grid_u(k)%x - airfoil_grid_u(k - 1)%x) if (y_act <= ((1._wp - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then !!IB - patch_id_fp(i, j, l) = patch_id + ib_markers_sf(i, j, l) = patch_id end if end if else @@ -460,14 +462,14 @@ contains if (f_approx_equal(airfoil_grid_l(k)%x, x_act)) then if (y_act >= airfoil_grid_l(k)%y) then !!IB - patch_id_fp(i, j, l) = patch_id + ib_markers_sf(i, j, l) = patch_id end if else f = (airfoil_grid_l(k)%x - x_act)/(airfoil_grid_l(k)%x - airfoil_grid_l(k - 1)%x) if (y_act >= ((1._wp - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then !!IB - patch_id_fp(i, j, l) = patch_id + ib_markers_sf(i, j, l) = patch_id end if end if end if @@ -500,12 +502,12 @@ contains !! rectangular patch DOES NOT allow for the smoothing of its !! boundaries. !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids + !! @param ib_markers_sf Array to track patch ids !! @param ib True if this patch is an immersed boundary - subroutine s_ib_rectangle(patch_id, patch_id_fp) + subroutine s_ib_rectangle(patch_id, ib_markers_sf) integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: ib_markers_sf integer :: i, j, k !< generic loop iterators real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters @@ -545,7 +547,7 @@ contains y_boundary%end >= y_cc(j)) then ! Updating the patch identities bookkeeping variable - patch_id_fp(i, j, 0) = patch_id + ib_markers_sf(i, j, 0) = patch_id end if end do @@ -559,12 +561,12 @@ contains !! provided. Please note that the spherical patch DOES allow !! for the smoothing of its boundary. !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids + !! @param ib_markers_sf Array to track patch ids !! @param ib True if this patch is an immersed boundary - subroutine s_ib_sphere(patch_id, patch_id_fp) + subroutine s_ib_sphere(patch_id, ib_markers_sf) integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: ib_markers_sf ! Generic loop iterators integer :: i, j, k @@ -603,7 +605,7 @@ contains if (((x_cc(i) - x_centroid)**2 & + (cart_y - y_centroid)**2 & + (cart_z - z_centroid)**2 <= radius**2)) then - patch_id_fp(i, j, k) = patch_id + ib_markers_sf(i, j, k) = patch_id end if end do end do @@ -620,11 +622,11 @@ contains !! the cuboidal patch DOES NOT allow for the smearing of its !! boundaries. !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids - subroutine s_ib_cuboid(patch_id, patch_id_fp) + !! @param ib_markers_sf Array to track patch ids + subroutine s_ib_cuboid(patch_id, ib_markers_sf) integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: ib_markers_sf integer :: i, j, k !< Generic loop iterators @@ -674,7 +676,7 @@ contains z_boundary%end >= cart_z) then ! Updating the patch identities bookkeeping variable - patch_id_fp(i, j, k) = patch_id + ib_markers_sf(i, j, k) = patch_id end if end do end do @@ -691,12 +693,12 @@ contains !! that the cylindrical patch DOES allow for the smoothing !! of its lateral boundary. !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids + !! @param ib_markers_sf Array to track patch ids !! @param ib True if this patch is an immersed boundary - subroutine s_ib_cylinder(patch_id, patch_id_fp) + subroutine s_ib_cylinder(patch_id, ib_markers_sf) integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: ib_markers_sf integer :: i, j, k !< Generic loop iterators real(wp) :: radius @@ -760,7 +762,7 @@ contains z_boundary%end >= cart_z))) then ! Updating the patch identities bookkeeping variable - patch_id_fp(i, j, k) = patch_id + ib_markers_sf(i, j, k) = patch_id end if end do end do @@ -770,14 +772,14 @@ contains !> The STL patch is a 2/3D geometry that is imported from an STL file. !! @param patch_id is the patch identifier - !! @param patch_id_fp Array to track patch ids + !! @param ib_markers_sf Array to track patch ids !! @param ib True if this patch is an immersed boundary !! @param STL_levelset STL levelset !! @param STL_levelset_norm STL levelset normals - subroutine s_ib_model(patch_id, patch_id_fp, STL_levelset, STL_levelset_norm) + subroutine s_ib_model(patch_id, ib_markers_sf, STL_levelset, STL_levelset_norm) integer, intent(in) :: patch_id - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp + integer, dimension(0:m, 0:n, 0:p), intent(inout) :: ib_markers_sf ! Variables for IBM+STL type(levelset_field), optional, intent(inout) :: STL_levelset !< Levelset determined by models @@ -911,7 +913,7 @@ contains ! Reading STL boundary vertices and compute the levelset and levelset_norm if (eta > patch_ib(patch_id)%model_threshold) then - patch_id_fp(i, j, k) = patch_id + ib_markers_sf(i, j, k) = patch_id end if ! 3D models @@ -930,12 +932,12 @@ contains end if ! Correct the sign of the levelset - if (patch_id_fp(i, j, k) > 0) then + if (ib_markers_sf(i, j, k) > 0) then STL_levelset%sf(i, j, k, patch_id) = -abs(STL_levelset%sf(i, j, k, patch_id)) end if ! Correct the sign of the levelset_norm - if (patch_id_fp(i, j, k) == 0) then + if (ib_markers_sf(i, j, k) == 0) then normals(1:3) = -normals(1:3) end if @@ -956,7 +958,7 @@ contains end if ! Correct the sign of the levelset - if (patch_id_fp(i, j, k) > 0) then + if (ib_markers_sf(i, j, k) > 0) then STL_levelset%sf(i, j, 0, patch_id) = -abs(STL_levelset%sf(i, j, 0, patch_id)) end if @@ -967,7 +969,7 @@ contains normals) ! Correct the sign of the levelset_norm - if (patch_id_fp(i, j, k) == 0) then + if (ib_markers_sf(i, j, k) == 0) then normals(1:3) = -normals(1:3) end if diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 3480c750c2..6607817c04 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -103,8 +103,8 @@ contains $:GPU_UPDATE(device='[num_gps, num_inner_gps]') ! TODO :: THIS ALLOCATION COULD CAUSE PROBLEMS LATER WHEN WE ALLOW ODD-SHAPED IBS MOVE - @:ALLOCATE(ghost_points(1:num_gps)) - @:ALLOCATE(inner_points(1:num_inner_gps)) + @:ALLOCATE(ghost_points(1:int(num_gps * 1.5))) + @:ALLOCATE(inner_points(1:int(num_inner_gps * 1.5))) $:GPU_ENTER_DATA(copyin='[ghost_points,inner_points]') @@ -516,8 +516,7 @@ contains j - gp_layers:j + gp_layers, 0) if (any(subsection_2D == 0)) then if (count == 1) then - print *, "Found first ghost point: ", i, j - print *, "IB Marker", ib_markers%sf(i, j, 0) + print *, "Found first ghost point: ", i, j, ib_markers%sf(i, j, 0) end if ghost_points_in(count)%loc = [i, j, 0] patch_id = ib_markers%sf(i, j, 0) @@ -909,14 +908,14 @@ contains !> Resets the current indexes of immersed boundaries and replaces them after updating !> the position of each moving immersed boundary - impure subroutine s_update_mib(num_ibs, ib_markers_sf, levelset, levelset_norm) + impure subroutine s_update_mib(num_ibs, levelset, levelset_norm) integer, intent(in) :: num_ibs - integer, dimension(0:m, 0:n, 0:p), intent(inout) :: ib_markers_sf type(levelset_field), intent(inout) :: levelset type(levelset_norm_field), intent(inout) :: levelset_norm integer :: i, j, k + integer, dimension(0:m, 0:n, 0:p) :: ib_marker_sf_reduced print *, "Beginning to update MIBs" @@ -924,7 +923,7 @@ contains ! Clears the existing immersed boundary indices patch_id_fp = 0 - ib_markers_sf = 0 + ib_markers%sf = 0 do i = 1, num_ibs if (patch_ib(i)%moving_ibm .ne. 0) then @@ -932,22 +931,17 @@ contains end if end do - call s_apply_ib_patches(patch_id_fp, ib_markers_sf, levelset, levelset_norm) ! TODO, THIS IS NOT OPTIMIAL - + call s_apply_ib_patches(patch_id_fp, ib_marker_sf_reduced, levelset, levelset_norm) ! TODO, THIS IS NOT OPTIMIAL + ib_markers%sf(0:m, 0:n, 0:p) = ib_marker_sf_reduced + ! recalculate the ghost point locations print *, "x = ", patch_ib(1)%x_centroid - print *, "y = ", patch_ib(1)%y_centroid - print *, ghost_points(1)%loc(1), ghost_points(1)%loc(2) call s_find_num_ghost_points(num_gps, num_inner_gps) + print *, "Number of points: ", num_gps, num_inner_gps call s_find_ghost_points(ghost_points, inner_points) - print *, "a" - do i = 230, 240 - print *, ib_markers%sf(0, i, 0), i - end do call s_compute_image_points(ghost_points, levelset, levelset_norm) - print *, "b" call s_compute_interpolation_coeffs(ghost_points) end subroutine s_update_mib diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 2a5acd2805..45bde8cb96 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -78,7 +78,7 @@ program p_main if (ib) then ! TODO :: FIND A WAY TO ONLY UPDATE WITH MIBM - call s_update_mib(num_ibs, ib_markers%sf, levelset, levelset_norm) + call s_update_mib(num_ibs, levelset, levelset_norm) end if if (cfl_dt) then From 0ac926170789a2f0355425268ad881bf7e516267 Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Tue, 23 Sep 2025 15:56:30 -0400 Subject: [PATCH 33/43] Everything is working for a circle --- src/common/m_ib_patches.fpp | 3 --- src/pre_process/m_initial_condition.fpp | 2 +- src/simulation/m_ibm.fpp | 19 +++++-------------- src/simulation/p_main.fpp | 2 -- 4 files changed, 6 insertions(+), 20 deletions(-) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index d721187872..34dce5dc78 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -168,9 +168,6 @@ contains if ((x_cc(i) - x_centroid)**2 & + (y_cc(j) - y_centroid)**2 <= radius**2) & then - if (i .eq. 0) then - print *, "Inside circle: ", i, j - end if ib_markers_sf(i, j, 0) = patch_id end if end do diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index b5f880fd11..bf3963ee74 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -190,7 +190,7 @@ contains end if if (ib) then - call s_apply_ib_patches(patch_id_fp, ib_markers%sf, levelset, levelset_norm) + call s_apply_ib_patches(ib_markers%sf, levelset, levelset_norm) end if call s_apply_icpp_patches(patch_id_fp, q_prim_vf) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 6607817c04..ddecbd2b41 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -515,13 +515,11 @@ contains i - gp_layers:i + gp_layers, & j - gp_layers:j + gp_layers, 0) if (any(subsection_2D == 0)) then - if (count == 1) then - print *, "Found first ghost point: ", i, j, ib_markers%sf(i, j, 0) - end if ghost_points_in(count)%loc = [i, j, 0] patch_id = ib_markers%sf(i, j, 0) ghost_points_in(count)%ib_patch_id = & patch_id + ghost_points_in(count)%slip = patch_ib(patch_id)%slip ! ghost_points(count)%rank = proc_rank @@ -915,15 +913,11 @@ contains type(levelset_norm_field), intent(inout) :: levelset_norm integer :: i, j, k - integer, dimension(0:m, 0:n, 0:p) :: ib_marker_sf_reduced - - print *, "Beginning to update MIBs" - - print *, ghost_points(1)%loc(1) + integer, dimension(0:m, 0:n, 0:p) :: ib_markers_sf_reduced ! Clears the existing immersed boundary indices - patch_id_fp = 0 ib_markers%sf = 0 + ib_markers_sf_reduced = 0 ! a copy of ib_markers_sf with reduced size to work with s_apply_ib_patches do i = 1, num_ibs if (patch_ib(i)%moving_ibm .ne. 0) then @@ -931,15 +925,12 @@ contains end if end do - call s_apply_ib_patches(patch_id_fp, ib_marker_sf_reduced, levelset, levelset_norm) ! TODO, THIS IS NOT OPTIMIAL + call s_apply_ib_patches(ib_markers_sf_reduced, levelset, levelset_norm) ! TODO, THIS IS NOT OPTIMIAL - ib_markers%sf(0:m, 0:n, 0:p) = ib_marker_sf_reduced + ib_markers%sf(0:m, 0:n, 0:p) = ib_markers_sf_reduced ! recalculate the ghost point locations - print *, "x = ", patch_ib(1)%x_centroid - call s_find_num_ghost_points(num_gps, num_inner_gps) - print *, "Number of points: ", num_gps, num_inner_gps call s_find_ghost_points(ghost_points, inner_points) call s_compute_image_points(ghost_points, levelset, levelset_norm) call s_compute_interpolation_coeffs(ghost_points) diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 45bde8cb96..e654ff9932 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -53,8 +53,6 @@ program p_main call nvtxStartRange("INIT-GPU-VARS") call s_initialize_gpu_vars() call nvtxEndRange - print *, "Printing IB conditions:", patch_ib(1)%geometry, patch_ib(1)%x_centroid, patch_ib(1)%y_centroid, patch_ib(1)%radius - print *, "Printing mibm conditions:", patch_ib(1)%moving_ibm, patch_ib(1)%vel(1), patch_ib(1)%vel(2), patch_ib(1)%vel(3) ! Setting the time-step iterator to the first time-step if (cfl_dt) then From 3e3c2759964d4545b079e2b6726755234f91bc69 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Tue, 23 Sep 2025 16:06:10 -0400 Subject: [PATCH 34/43] Added logic to handle if we actually call moving immersed boundaries or now --- src/simulation/m_ibm.fpp | 17 +++++++++++++---- src/simulation/p_main.fpp | 3 +-- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index ddecbd2b41..eeaf4a30fa 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -52,6 +52,8 @@ module m_ibm integer :: num_inner_gps !< Number of ghost points $:GPU_DECLARE(create='[gp_layers,num_gps,num_inner_gps]') + logical :: moving_immersed_boundary_flag + contains !> Allocates memory for the variables in the IBM module @@ -87,6 +89,14 @@ contains integer :: i, j, k + moving_immersed_boundary_flag = .false. + do i = 1, num_ibs + if (ib_patch%moving_ibm .ne. 0) + moving_immersed_boundary_flag = .true. + exit + end if + end do + ! Allocating the patch identities bookkeeping variable allocate (patch_id_fp(0:m, 0:n, 0:p)) @@ -102,9 +112,8 @@ contains call s_find_num_ghost_points(num_gps, num_inner_gps) $:GPU_UPDATE(device='[num_gps, num_inner_gps]') - ! TODO :: THIS ALLOCATION COULD CAUSE PROBLEMS LATER WHEN WE ALLOW ODD-SHAPED IBS MOVE - @:ALLOCATE(ghost_points(1:int(num_gps * 1.5))) - @:ALLOCATE(inner_points(1:int(num_inner_gps * 1.5))) + @:ALLOCATE(ghost_points(1:int(num_gps * 1.2))) + @:ALLOCATE(inner_points(1:int(num_inner_gps * 1.2))) $:GPU_ENTER_DATA(copyin='[ghost_points,inner_points]') @@ -925,7 +934,7 @@ contains end if end do - call s_apply_ib_patches(ib_markers_sf_reduced, levelset, levelset_norm) ! TODO, THIS IS NOT OPTIMIAL + call s_apply_ib_patches(ib_markers_sf_reduced, levelset, levelset_norm) ib_markers%sf(0:m, 0:n, 0:p) = ib_markers_sf_reduced diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index e654ff9932..39e32497b5 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -74,8 +74,7 @@ program p_main ! Time-stepping Loop do - if (ib) then - ! TODO :: FIND A WAY TO ONLY UPDATE WITH MIBM + if (moving_immersed_boundary_flag) then call s_update_mib(num_ibs, levelset, levelset_norm) end if From ffd34f000be707412c6e131a924667bbbe590f88 Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Tue, 23 Sep 2025 16:50:54 -0400 Subject: [PATCH 35/43] Tests pass --- src/simulation/m_ibm.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index eeaf4a30fa..0b3b4bd0cd 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -91,7 +91,7 @@ contains moving_immersed_boundary_flag = .false. do i = 1, num_ibs - if (ib_patch%moving_ibm .ne. 0) + if (patch_ib(i)%moving_ibm .ne. 0) then moving_immersed_boundary_flag = .true. exit end if From 7fd7a07ad511bb91c9b684b278dc43ba80396b2e Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Tue, 23 Sep 2025 17:03:22 -0400 Subject: [PATCH 36/43] I added airfoils back to the simulation pipeline, but had to add an IFDEF. There is likely a more-elegant way to do this in the future that involves unifying the defintion of dx in pre_process and simulation --- src/common/m_ib_patches.fpp | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index 34dce5dc78..6701f76c9b 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -175,9 +175,6 @@ contains end subroutine s_ib_circle -! airfoils are not supported for moving immersed boundaries -! TODO :: REPLACE THIS IFDEF WITH SOMETHING MORE SUSTAINABLE -#ifdef MFC_PRE_PROCESS !! @param patch_id is the patch identifier !! @param ib_markers_sf Array to track patch ids subroutine s_ib_airfoil(patch_id, ib_markers_sf) @@ -199,8 +196,14 @@ contains ta = patch_ib(patch_id)%t theta = pi*patch_ib(patch_id)%theta/180._wp + ! rank(dx) is not consitent between pre_process and simulation. This IFDEF prevents compilation errors +#ifdef MFC_PRE_PROCESS Np1 = int((pa*ca_in/dx)*20) Np2 = int(((ca_in - pa*ca_in)/dx)*20) +#else + Np1 = int((pa*ca_in/dx(0))*20) + Np2 = int(((ca_in - pa*ca_in)/dx(0))*20) +#endif Np = Np1 + Np2 + 1 allocate (airfoil_grid_u(1:Np)) @@ -351,8 +354,14 @@ contains ta = patch_ib(patch_id)%t theta = pi*patch_ib(patch_id)%theta/180._wp + ! rank(dx) is not consitent between pre_process and simulation. This IFDEF prevents compilation errors +#ifdef MFC_PRE_PROCESS Np1 = int((pa*ca_in/dx)*20) Np2 = int(((ca_in - pa*ca_in)/dx)*20) +#else + Np1 = int((pa*ca_in/dx(0))*20) + Np2 = int(((ca_in - pa*ca_in)/dx(0))*20) +#endif Np = Np1 + Np2 + 1 allocate (airfoil_grid_u(1:Np)) @@ -488,8 +497,6 @@ contains end subroutine s_ib_3D_airfoil -#endif - !> The rectangular patch is a 2D geometry that may be used, !! for example, in creating a solid boundary, or pre-/post- !! shock region, in alignment with the axes of the Cartesian From 46373b87612442d262f1331e15e4c5874346843b Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Tue, 23 Sep 2025 17:07:38 -0400 Subject: [PATCH 37/43] Ran formatting and spelling --- src/common/m_derived_types.fpp | 2 +- src/common/m_ib_patches.fpp | 39 +++++----- src/pre_process/m_checker.fpp | 2 - src/pre_process/m_global_parameters.fpp | 2 +- src/pre_process/m_icpp_patches.fpp | 23 +++--- src/simulation/m_ibm.fpp | 95 ++++++++++++------------- src/simulation/p_main.fpp | 2 +- 7 files changed, 79 insertions(+), 86 deletions(-) diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 1a8cf2cadb..9c55e8b895 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -318,7 +318,7 @@ module m_derived_types real(wp) :: model_threshold !< !! Threshold to turn on smoothen STL patch. - + !! Patch conditions for moving imersed boundaries integer :: moving_ibm ! 0 for no moving, 1 for moving, 2 for moving on forced path real(wp), dimension(1:3) :: vel diff --git a/src/common/m_ib_patches.fpp b/src/common/m_ib_patches.fpp index 6701f76c9b..3403b4c7e5 100644 --- a/src/common/m_ib_patches.fpp +++ b/src/common/m_ib_patches.fpp @@ -149,7 +149,6 @@ contains y_centroid = patch_ib(patch_id)%y_centroid radius = patch_ib(patch_id)%radius - ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the ! case that smoothing of the circular patch's boundary is enabled. @@ -166,7 +165,7 @@ contains do j = 0, n do i = 0, m if ((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2 <= radius**2) & + + (y_cc(j) - y_centroid)**2 <= radius**2) & then ib_markers_sf(i, j, 0) = patch_id end if @@ -187,7 +186,6 @@ contains integer :: i, j, k integer :: Np1, Np2 - x0 = patch_ib(patch_id)%x_centroid y0 = patch_ib(patch_id)%y_centroid ca_in = patch_ib(patch_id)%c @@ -196,7 +194,7 @@ contains ta = patch_ib(patch_id)%t theta = pi*patch_ib(patch_id)%theta/180._wp - ! rank(dx) is not consitent between pre_process and simulation. This IFDEF prevents compilation errors + ! rank(dx) is not consistent between pre_process and simulation. This IFDEF prevents compilation errors #ifdef MFC_PRE_PROCESS Np1 = int((pa*ca_in/dx)*20) Np2 = int(((ca_in - pa*ca_in)/dx)*20) @@ -354,7 +352,7 @@ contains ta = patch_ib(patch_id)%t theta = pi*patch_ib(patch_id)%theta/180._wp - ! rank(dx) is not consitent between pre_process and simulation. This IFDEF prevents compilation errors + ! rank(dx) is not consistent between pre_process and simulation. This IFDEF prevents compilation errors #ifdef MFC_PRE_PROCESS Np1 = int((pa*ca_in/dx)*20) Np2 = int(((ca_in - pa*ca_in)/dx)*20) @@ -552,7 +550,7 @@ contains ! Updating the patch identities bookkeeping variable ib_markers_sf(i, j, 0) = patch_id - + end if end do end do @@ -586,7 +584,6 @@ contains z_centroid = patch_ib(patch_id)%z_centroid radius = patch_ib(patch_id)%radius - ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the ! case that smoothing of the spherical patch's boundary is enabled. @@ -607,8 +604,8 @@ contains end if ! Updating the patch identities bookkeeping variable if (((x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2 <= radius**2)) then + + (cart_y - y_centroid)**2 & + + (cart_z - z_centroid)**2 <= radius**2)) then ib_markers_sf(i, j, k) = patch_id end if end do @@ -752,14 +749,14 @@ contains + (cart_z - z_centroid)**2 <= radius**2 .and. & x_boundary%beg <= x_cc(i) .and. & x_boundary%end >= x_cc(i)) & - .or. & - (.not. f_is_default(length_y) .and. & + .or. & + (.not. f_is_default(length_y) .and. & (x_cc(i) - x_centroid)**2 & + (cart_z - z_centroid)**2 <= radius**2 .and. & y_boundary%beg <= cart_y .and. & y_boundary%end >= cart_y) & - .or. & - (.not. f_is_default(length_z) .and. & + .or. & + (.not. f_is_default(length_z) .and. & (x_cc(i) - x_centroid)**2 & + (cart_y - y_centroid)**2 <= radius**2 .and. & z_boundary%beg <= cart_z .and. & @@ -929,8 +926,8 @@ contains ! Get the shortest distance between the cell center and the interpolated model boundary if (interpolate) then STL_levelset%sf(i, j, k, patch_id) = f_interpolated_distance(interpolated_boundary_v, & - total_vertices, & - point) + total_vertices, & + point) else STL_levelset%sf(i, j, k, patch_id) = distance end if @@ -952,8 +949,8 @@ contains if (interpolate) then ! Get the shortest distance between the cell center and the model boundary STL_levelset%sf(i, j, 0, patch_id) = f_interpolated_distance(interpolated_boundary_v, & - total_vertices, & - point) + total_vertices, & + point) else ! Get the shortest distance between the cell center and the interpolated model boundary STL_levelset%sf(i, j, 0, patch_id) = f_distance(boundary_v, & @@ -968,9 +965,9 @@ contains ! Get the boundary normals call f_normals(boundary_v, & - boundary_edge_count, & - point, & - normals) + boundary_edge_count, & + point, & + normals) ! Correct the sign of the levelset_norm if (ib_markers_sf(i, j, k) == 0) then @@ -981,7 +978,7 @@ contains STL_levelset_norm%sf(i, j, k, patch_id, 1:3) = normals(1:3) end if - end do; end do; end do + end do; end do; end do if (proc_rank == 0) then print *, "" diff --git a/src/pre_process/m_checker.fpp b/src/pre_process/m_checker.fpp index f5a2177606..f07e25dbfa 100644 --- a/src/pre_process/m_checker.fpp +++ b/src/pre_process/m_checker.fpp @@ -258,8 +258,6 @@ contains impure subroutine s_check_moving_IBM - - end subroutine s_check_moving_IBM end module m_checker diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 722f1f28f7..ca379da0cc 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -539,7 +539,7 @@ contains patch_ib(i)%model_spc = num_ray patch_ib(i)%model_threshold = ray_tracing_threshold - ! Variabes to handle moving imersed boundaries, defaulting to no movement + ! Variables to handle moving imersed boundaries, defaulting to no movement patch_ib(i)%moving_ibm = 0 patch_ib(i)%vel(1) = 0._wp patch_ib(i)%vel(2) = 0._wp diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index a8bc6503dd..0157be3767 100644 --- a/src/pre_process/m_icpp_patches.fpp +++ b/src/pre_process/m_icpp_patches.fpp @@ -373,11 +373,10 @@ contains end if - if (((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2 <= radius**2 & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & + + (y_cc(j) - y_centroid)**2 <= radius**2 & + .and. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & .or. & patch_id_fp(i, j, 0) == smooth_patch_id) & then @@ -1200,7 +1199,7 @@ contains if ((((x_cc(i) - x_centroid)**2 & + (cart_y - y_centroid)**2 & + (cart_z - z_centroid)**2 <= radius**2) .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & patch_id_fp(i, j, k) == smooth_patch_id) then call s_assign_patch_primitive_variables(patch_id, i, j, k, & @@ -1394,19 +1393,19 @@ contains + (cart_z - z_centroid)**2 <= radius**2 .and. & x_boundary%beg <= x_cc(i) .and. & x_boundary%end >= x_cc(i)) & - .or. & - (.not. f_is_default(length_y) .and. & + .or. & + (.not. f_is_default(length_y) .and. & (x_cc(i) - x_centroid)**2 & + (cart_z - z_centroid)**2 <= radius**2 .and. & y_boundary%beg <= cart_y .and. & y_boundary%end >= cart_y) & - .or. & - (.not. f_is_default(length_z) .and. & + .or. & + (.not. f_is_default(length_z) .and. & (x_cc(i) - x_centroid)**2 & + (cart_y - y_centroid)**2 <= radius**2 .and. & z_boundary%beg <= cart_z .and. & z_boundary%end >= cart_z) .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & + patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & patch_id_fp(i, j, k) == smooth_patch_id) then call s_assign_patch_primitive_variables(patch_id, i, j, k, & @@ -1553,7 +1552,7 @@ contains if (proc_rank == 0) then print *, " * Reading model: "//trim(patch_icpp(patch_id)%model_filepath) end if - + model = f_model_read(patch_icpp(patch_id)%model_filepath) params%scale(:) = patch_icpp(patch_id)%model_scale(:) params%translate(:) = patch_icpp(patch_id)%model_translate(:) @@ -1654,7 +1653,7 @@ contains if (grid_geometry == 3) then point = f_convert_cyl_to_cart(point) end if - + eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_icpp(patch_id)%model_spc) if (patch_icpp(patch_id)%smoothen) then diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 0b3b4bd0cd..8e6376b128 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -91,10 +91,10 @@ contains moving_immersed_boundary_flag = .false. do i = 1, num_ibs - if (patch_ib(i)%moving_ibm .ne. 0) then - moving_immersed_boundary_flag = .true. - exit - end if + if (patch_ib(i)%moving_ibm /= 0) then + moving_immersed_boundary_flag = .true. + exit + end if end do ! Allocating the patch identities bookkeeping variable @@ -257,14 +257,14 @@ contains vel_norm_IP = sum(vel_IP*norm)*norm vel_g = vel_IP - vel_norm_IP else - if (patch_ib(patch_id)%moving_ibm .eq. 0) then - ! we know the object is not moving if moving_ibm is 0 (false) - vel_g = 0._wp + if (patch_ib(patch_id)%moving_ibm == 0) then + ! we know the object is not moving if moving_ibm is 0 (false) + vel_g = 0._wp else - do q = 1, 3 - ! if mibm is 1 or 2, then the boundary may be moving - vel_g(q) = patch_ib(patch_id)%vel(q) - end do + do q = 1, 3 + ! if mibm is 1 or 2, then the boundary may be moving + vel_g(q) = patch_ib(patch_id)%vel(q) + end do end if end if @@ -433,7 +433,7 @@ contains index = index + dir if (index < -buff_size .or. index > bound) then print *, q, index, bound, buff_size - print *, "temp_loc=", temp_loc, " s_cc(index)=", s_cc(index), " s_cc(index+1)=", s_cc(index+1) + print *, "temp_loc=", temp_loc, " s_cc(index)=", s_cc(index), " s_cc(index+1)=", s_cc(index + 1) print *, "Increase buff_size further in m_helper_basic (currently set to a minimum of 10)" error stop "Increase buff_size" end if @@ -528,7 +528,7 @@ contains patch_id = ib_markers%sf(i, j, 0) ghost_points_in(count)%ib_patch_id = & patch_id - + ghost_points_in(count)%slip = patch_ib(patch_id)%slip ! ghost_points(count)%rank = proc_rank @@ -895,21 +895,20 @@ contains !> Subroutine the updates the moving imersed boundary positions via Euler's method impure subroutine s_propagate_mib(patch_id) - integer, intent(in) :: patch_id - integer :: i + integer, intent(in) :: patch_id + integer :: i - ! start by using euler's method naiively, but eventually incorporate more sophistocation - if (patch_ib(patch_id)%moving_ibm .eq. 1) then - ! this continues with euler's method, which is obviously not that great and we need to add acceleration - do i = 1, 3 - patch_ib(patch_id)%vel(i) = patch_ib(patch_id)%vel(i) + 0.0 * dt ! TODO :: ADD EXTERNAL FORCES HERE - end do - - patch_ib(patch_id)%x_centroid = patch_ib(patch_id)%x_centroid + patch_ib(patch_id)%vel(1) * dt - patch_ib(patch_id)%y_centroid = patch_ib(patch_id)%y_centroid + patch_ib(patch_id)%vel(2) * dt - patch_ib(patch_id)%z_centroid = patch_ib(patch_id)%z_centroid + patch_ib(patch_id)%vel(3) * dt - end if + ! start by using euler's method naiively, but eventually incorporate more sophistocation + if (patch_ib(patch_id)%moving_ibm == 1) then + ! this continues with euler's method, which is obviously not that great and we need to add acceleration + do i = 1, 3 + patch_ib(patch_id)%vel(i) = patch_ib(patch_id)%vel(i) + 0.0*dt ! TODO :: ADD EXTERNAL FORCES HERE + end do + patch_ib(patch_id)%x_centroid = patch_ib(patch_id)%x_centroid + patch_ib(patch_id)%vel(1)*dt + patch_ib(patch_id)%y_centroid = patch_ib(patch_id)%y_centroid + patch_ib(patch_id)%vel(2)*dt + patch_ib(patch_id)%z_centroid = patch_ib(patch_id)%z_centroid + patch_ib(patch_id)%vel(3)*dt + end if end subroutine s_propagate_mib @@ -917,32 +916,32 @@ contains !> the position of each moving immersed boundary impure subroutine s_update_mib(num_ibs, levelset, levelset_norm) - integer, intent(in) :: num_ibs - type(levelset_field), intent(inout) :: levelset - type(levelset_norm_field), intent(inout) :: levelset_norm + integer, intent(in) :: num_ibs + type(levelset_field), intent(inout) :: levelset + type(levelset_norm_field), intent(inout) :: levelset_norm - integer :: i, j, k - integer, dimension(0:m, 0:n, 0:p) :: ib_markers_sf_reduced + integer :: i, j, k + integer, dimension(0:m, 0:n, 0:p) :: ib_markers_sf_reduced - ! Clears the existing immersed boundary indices - ib_markers%sf = 0 - ib_markers_sf_reduced = 0 ! a copy of ib_markers_sf with reduced size to work with s_apply_ib_patches - - do i = 1, num_ibs - if (patch_ib(i)%moving_ibm .ne. 0) then - call s_propagate_mib(i) ! TODO :: THIS IS DONE TERRIBLY WITH EULER METHOD - end if - end do + ! Clears the existing immersed boundary indices + ib_markers%sf = 0 + ib_markers_sf_reduced = 0 ! a copy of ib_markers_sf with reduced size to work with s_apply_ib_patches - call s_apply_ib_patches(ib_markers_sf_reduced, levelset, levelset_norm) + do i = 1, num_ibs + if (patch_ib(i)%moving_ibm /= 0) then + call s_propagate_mib(i) ! TODO :: THIS IS DONE TERRIBLY WITH EULER METHOD + end if + end do + + call s_apply_ib_patches(ib_markers_sf_reduced, levelset, levelset_norm) + + ib_markers%sf(0:m, 0:n, 0:p) = ib_markers_sf_reduced - ib_markers%sf(0:m, 0:n, 0:p) = ib_markers_sf_reduced - - ! recalculate the ghost point locations - call s_find_num_ghost_points(num_gps, num_inner_gps) - call s_find_ghost_points(ghost_points, inner_points) - call s_compute_image_points(ghost_points, levelset, levelset_norm) - call s_compute_interpolation_coeffs(ghost_points) + ! recalculate the ghost point locations + call s_find_num_ghost_points(num_gps, num_inner_gps) + call s_find_ghost_points(ghost_points, inner_points) + call s_compute_image_points(ghost_points, levelset, levelset_norm) + call s_compute_interpolation_coeffs(ghost_points) end subroutine s_update_mib diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 39e32497b5..217c75ee3a 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -75,7 +75,7 @@ program p_main do if (moving_immersed_boundary_flag) then - call s_update_mib(num_ibs, levelset, levelset_norm) + call s_update_mib(num_ibs, levelset, levelset_norm) end if if (cfl_dt) then From de0cd9081718239780cc75b20d7fce771523b6ed Mon Sep 17 00:00:00 2001 From: danieljvickers Date: Wed, 24 Sep 2025 08:29:22 -0400 Subject: [PATCH 38/43] Intermittent commit --- src/common/m_mpi_common.fpp | 31 +++++++++---------------------- 1 file changed, 9 insertions(+), 22 deletions(-) diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index 4332681f11..fcdaa6aabf 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -98,16 +98,6 @@ contains #ifdef MFC_MPI integer :: ierr !< Generic flag used to identify and report MPI errors -#endif - -#ifndef MFC_MPI - - ! Serial run only has 1 processor - num_procs = 1 - ! Local processor rank is 0 - proc_rank = 0 - -#else ! Initializing the MPI environment call MPI_INIT(ierr) @@ -123,7 +113,11 @@ contains ! Querying the rank of the local processor call MPI_COMM_RANK(MPI_COMM_WORLD, proc_rank, ierr) - +#else + ! Serial run only has 1 processor + num_procs = 1 + ! Local processor rank is 0 + proc_rank = 0 #endif end subroutine s_mpi_initialize @@ -168,27 +162,20 @@ contains end if !Additional variables pb and mv for non-polytropic qbmm -#ifdef MFC_PRE_PROCESS if (qbmm .and. .not. polytropic) then do i = 1, nb do j = 1, nnode +#ifdef MFC_PRE_PROCESS MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j)%sf => pb%sf(0:m, 0:n, 0:p, j, i) MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j + nb*nnode)%sf => mv%sf(0:m, 0:n, 0:p, j, i) - end do - end do - end if -#endif - -#ifdef MFC_SIMULATION - if (qbmm .and. .not. polytropic) then - do i = 1, nb - do j = 1, nnode +#elif defined (MFC_SIMULATION) MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j)%sf => pb_ts(1)%sf(0:m, 0:n, 0:p, j, i) MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j + nb*nnode)%sf => mv_ts(1)%sf(0:m, 0:n, 0:p, j, i) +#endif end do end do end if -#endif + ! Define global(g) and local(l) sizes for flow variables sizes_glb(1) = m_glb + 1; sizes_loc(1) = m + 1 if (n > 0) then From db8b514b8cc9f6c41a75c76805da4392aaeb12c3 Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Wed, 24 Sep 2025 10:49:23 -0400 Subject: [PATCH 39/43] Resolved some MPI errors --- src/simulation/m_ibm.fpp | 18 +++++++++--------- src/simulation/m_mpi_proxy.fpp | 6 ++++-- src/simulation/p_main.fpp | 1 + 3 files changed, 14 insertions(+), 11 deletions(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 8e6376b128..a9e309d5bf 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -91,7 +91,7 @@ contains moving_immersed_boundary_flag = .false. do i = 1, num_ibs - if (patch_ib(i)%moving_ibm /= 0) then + if (patch_ib(i)%moving_ibm .ne. 0) then moving_immersed_boundary_flag = .true. exit end if @@ -899,7 +899,7 @@ contains integer :: i ! start by using euler's method naiively, but eventually incorporate more sophistocation - if (patch_ib(patch_id)%moving_ibm == 1) then + if (patch_ib(patch_id)%moving_ibm .eq. 1) then ! this continues with euler's method, which is obviously not that great and we need to add acceleration do i = 1, 3 patch_ib(patch_id)%vel(i) = patch_ib(patch_id)%vel(i) + 0.0*dt ! TODO :: ADD EXTERNAL FORCES HERE @@ -920,25 +920,25 @@ contains type(levelset_field), intent(inout) :: levelset type(levelset_norm_field), intent(inout) :: levelset_norm - integer :: i, j, k - integer, dimension(0:m, 0:n, 0:p) :: ib_markers_sf_reduced + integer :: i ! Clears the existing immersed boundary indices ib_markers%sf = 0 - ib_markers_sf_reduced = 0 ! a copy of ib_markers_sf with reduced size to work with s_apply_ib_patches do i = 1, num_ibs - if (patch_ib(i)%moving_ibm /= 0) then + if (patch_ib(i)%moving_ibm .ne. 0) then call s_propagate_mib(i) ! TODO :: THIS IS DONE TERRIBLY WITH EULER METHOD end if end do - call s_apply_ib_patches(ib_markers_sf_reduced, levelset, levelset_norm) - - ib_markers%sf(0:m, 0:n, 0:p) = ib_markers_sf_reduced + ! recompute the new ib_patch locations and broadcast them. + call s_apply_ib_patches(ib_markers%sf(0:m, 0:n, 0:p), levelset, levelset_norm) + call s_populate_ib_buffers() ! transmitts the new IB markers via MPI ! recalculate the ghost point locations call s_find_num_ghost_points(num_gps, num_inner_gps) + $:GPU_UPDATE(device='[num_gps, num_inner_gps]') + call s_find_ghost_points(ghost_points, inner_points) call s_compute_image_points(ghost_points, levelset, levelset_norm) call s_compute_interpolation_coeffs(ghost_points) diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 93e0126ff8..8e4f6cc97a 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -68,6 +68,7 @@ contains $:GPU_UPDATE(device='[i_halo_size]') @:ALLOCATE(ib_buff_send(0:i_halo_size), ib_buff_recv(0:i_halo_size)) + print *, "Halo Size", proc_rank, i_halo_size end if #endif @@ -203,7 +204,8 @@ contains do i = 1, num_ibs #:for VAR in [ 'radius', 'length_x', 'length_y', & - & 'x_centroid', 'y_centroid', 'c', 'm', 'p', 't', 'theta', 'slip' ] + & 'x_centroid', 'y_centroid', 'c', 'm', 'p', 't', 'theta', 'slip', & + 'moving_ibm', 'vel',] call MPI_BCAST(patch_ib(i)%${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor call MPI_BCAST(patch_ib(i)%geometry, 2, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) @@ -268,7 +270,7 @@ contains integer :: ierr !< Generic flag used to identify and report MPI errors call nvtxStartRange("IB-MARKER-COMM-PACKBUF") - + buffer_counts = (/ & buff_size*(n + 1)*(p + 1), & buff_size*(m + 2*buff_size + 1)*(p + 1), & diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 217c75ee3a..92f92f357b 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -37,6 +37,7 @@ program p_main call nvtxStartRange("INIT") + !Initialize MPI call nvtxStartRange("INIT-MPI") call s_initialize_mpi_domain() From 90426edde476655ecd2675af32124b59e359e3a1 Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Wed, 24 Sep 2025 11:15:33 -0400 Subject: [PATCH 40/43] Moving IBs working with MPI --- src/common/m_mpi_common.fpp | 23 +++++++++++++++++++++++ src/simulation/m_ibm.fpp | 8 ++++++-- src/simulation/m_mpi_proxy.fpp | 3 +-- 3 files changed, 30 insertions(+), 4 deletions(-) diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index fcdaa6aabf..f204f892f6 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -472,6 +472,29 @@ contains end subroutine s_mpi_allreduce_sum + !> The following subroutine takes the input local variable + !! from all processors and reduces to the sum of all + !! values. The reduced variable is recorded back onto the + !! original local variable on each processor. + !! @param var_loc Some variable containing the local value which should be + !! reduced amongst all the processors in the communicator. + !! @param var_glb The globally reduced value + impure subroutine s_mpi_allreduce_integer_sum(var_loc, var_glb) + + integer, intent(in) :: var_loc + integer, intent(out) :: var_glb + +#ifdef MFC_MPI + integer :: ierr !< Generic flag used to identify and report MPI errors + + ! Performing the reduction procedure + call MPI_ALLREDUCE(var_loc, var_glb, 1, mpi_p, & + MPI_SUM, MPI_COMM_WORLD, ierr) + +#endif + + end subroutine s_mpi_allreduce_integer_sum + !> The following subroutine takes the input local variable !! from all processors and reduces to the minimum of all !! values. The reduced variable is recorded back onto the diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index a9e309d5bf..736fb7bc93 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -88,6 +88,7 @@ contains impure subroutine s_ibm_setup() integer :: i, j, k + integer :: max_num_gps, max_num_inner_gps moving_immersed_boundary_flag = .false. do i = 1, num_ibs @@ -109,11 +110,14 @@ contains $:GPU_UPDATE(host='[ib_markers%sf]') + ! find the number of ghost points and set them to be the maximum total across ranks call s_find_num_ghost_points(num_gps, num_inner_gps) + call s_mpi_allreduce_integer_sum(num_gps, max_num_gps) + call s_mpi_allreduce_integer_sum(num_inner_gps, max_num_inner_gps) $:GPU_UPDATE(device='[num_gps, num_inner_gps]') - @:ALLOCATE(ghost_points(1:int(num_gps * 1.2))) - @:ALLOCATE(inner_points(1:int(num_inner_gps * 1.2))) + @:ALLOCATE(ghost_points(1:int(max_num_gps * 1.2))) + @:ALLOCATE(inner_points(1:int(max_num_inner_gps * 1.2))) $:GPU_ENTER_DATA(copyin='[ghost_points,inner_points]') diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 8e4f6cc97a..617afb7c98 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -68,7 +68,6 @@ contains $:GPU_UPDATE(device='[i_halo_size]') @:ALLOCATE(ib_buff_send(0:i_halo_size), ib_buff_recv(0:i_halo_size)) - print *, "Halo Size", proc_rank, i_halo_size end if #endif @@ -270,7 +269,7 @@ contains integer :: ierr !< Generic flag used to identify and report MPI errors call nvtxStartRange("IB-MARKER-COMM-PACKBUF") - + buffer_counts = (/ & buff_size*(n + 1)*(p + 1), & buff_size*(m + 2*buff_size + 1)*(p + 1), & From 841574c79671e887bd8da3bfdfffb282b3f3281b Mon Sep 17 00:00:00 2001 From: "Daniel J. Vickers" Date: Wed, 24 Sep 2025 11:21:32 -0400 Subject: [PATCH 41/43] Added flags for GPUs --- src/simulation/m_ibm.fpp | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 736fb7bc93..f815debca0 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -939,13 +939,18 @@ contains call s_apply_ib_patches(ib_markers%sf(0:m, 0:n, 0:p), levelset, levelset_norm) call s_populate_ib_buffers() ! transmitts the new IB markers via MPI - ! recalculate the ghost point locations + ! recalculate the ghost point locations and coefficients call s_find_num_ghost_points(num_gps, num_inner_gps) $:GPU_UPDATE(device='[num_gps, num_inner_gps]') call s_find_ghost_points(ghost_points, inner_points) + $:GPU_UPDATE(device='[ghost_points, inner_points]') + call s_compute_image_points(ghost_points, levelset, levelset_norm) + $:GPU_UPDATE(device='[ghost_points]') + call s_compute_interpolation_coeffs(ghost_points) + $:GPU_UPDATE(device='[ghost_points]') end subroutine s_update_mib From 52f9bd36928de102d93ac091389d4b1402d9957d Mon Sep 17 00:00:00 2001 From: Daniel J Vickers Date: Fri, 26 Sep 2025 10:41:00 -0400 Subject: [PATCH 42/43] Back to a working example --- src/common/m_mpi_common.fpp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index f204f892f6..07463137f2 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -488,9 +488,10 @@ contains integer :: ierr !< Generic flag used to identify and report MPI errors ! Performing the reduction procedure - call MPI_ALLREDUCE(var_loc, var_glb, 1, mpi_p, & + call MPI_ALLREDUCE(var_loc, var_glb, 1, MPI_INTEGER, & MPI_SUM, MPI_COMM_WORLD, ierr) - +#else + var_glb = var_loc #endif end subroutine s_mpi_allreduce_integer_sum From 710a9e3a066ab362622028c159d06721e6b8afce Mon Sep 17 00:00:00 2001 From: Daniel J Vickers Date: Fri, 26 Sep 2025 15:03:11 -0400 Subject: [PATCH 43/43] Works with GPUs on NVHPC --- src/simulation/m_ibm.fpp | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index f815debca0..6beb433f8e 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -98,6 +98,12 @@ contains end if end do + ! $:GPU_UPDATE(device='[patch_ib]') + ! $:GPU_UPDATE(host='[patch_ib]') + ! print *, "Moving IBM ", patch_ib(1)%moving_ibm + ! print *, "X Velocity ", patch_ib(1)%vel(1) + ! print *, "Y Velocity ", patch_ib(1)%vel(2) + ! Allocating the patch identities bookkeeping variable allocate (patch_id_fp(0:m, 0:n, 0:p)) @@ -934,20 +940,22 @@ contains call s_propagate_mib(i) ! TODO :: THIS IS DONE TERRIBLY WITH EULER METHOD end if end do + $:GPU_UPDATE(device='[patch_ib]') ! recompute the new ib_patch locations and broadcast them. call s_apply_ib_patches(ib_markers%sf(0:m, 0:n, 0:p), levelset, levelset_norm) call s_populate_ib_buffers() ! transmitts the new IB markers via MPI + $:GPU_UPDATE(device='[ib_markers%sf]') ! recalculate the ghost point locations and coefficients call s_find_num_ghost_points(num_gps, num_inner_gps) $:GPU_UPDATE(device='[num_gps, num_inner_gps]') call s_find_ghost_points(ghost_points, inner_points) - $:GPU_UPDATE(device='[ghost_points, inner_points]') + ! $:GPU_UPDATE(device='[ghost_points, inner_points]') call s_compute_image_points(ghost_points, levelset, levelset_norm) - $:GPU_UPDATE(device='[ghost_points]') + ! $:GPU_UPDATE(device='[ghost_points]') call s_compute_interpolation_coeffs(ghost_points) $:GPU_UPDATE(device='[ghost_points]')